From: Rafael Kitover <rkitover@cpan.org>
Date: Mon, 22 Mar 2010 15:45:55 +0000 (+0000)
Subject: move INSERT ... RETURNING code into ::DBI::InsertReturning component for Pg and Firebird
X-Git-Tag: v0.08121~47
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=be860760714f5933672f8913d742f6cde6931149;p=dbsrgits%2FDBIx-Class.git

move INSERT ... RETURNING code into ::DBI::InsertReturning component for Pg and Firebird
---

diff --git a/lib/DBIx/Class/Storage/DBI/InsertReturning.pm b/lib/DBIx/Class/Storage/DBI/InsertReturning.pm
new file mode 100644
index 0000000..1948a2f
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/InsertReturning.pm
@@ -0,0 +1,117 @@
+package DBIx::Class::Storage::DBI::InsertReturning;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors(simple => qw/
+  _returning_cols
+/);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::InsertReturning - Storage component for RDBMSes
+supporting INSERT ... RETURNING
+
+=head1 DESCRIPTION
+
+Provides Auto-PK and
+L<is_auto_increment|DBIx::Class::ResultSource/is_auto_increment> support for
+databases supporting the C<INSERT ... RETURNING> syntax. Currently
+L<PostgreSQL|DBIx::Class::Storage::DBI::Pg> and
+L<Firebird|DBIx::Class::Storage::DBI::InterBase>.
+
+=cut
+
+sub _prep_for_execute {
+  my $self = shift;
+  my ($op, $extra_bind, $ident, $args) = @_;
+
+  if ($op eq 'insert') {
+    $self->_returning_cols([]);
+
+    my %pk;
+    @pk{$ident->primary_columns} = ();
+
+    my @auto_inc_cols = grep {
+      my $inserting = $args->[0]{$_};
+
+      ($ident->column_info($_)->{is_auto_increment}
+        || exists $pk{$_})
+      && (
+        (not defined $inserting)
+        ||
+        (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
+      )
+    } $ident->columns;
+
+    if (@auto_inc_cols) {
+      $args->[1]{returning} = \@auto_inc_cols;
+
+      $self->_returning_cols->[0] = \@auto_inc_cols;
+    }
+  }
+
+  return $self->next::method(@_);
+}
+
+sub _execute {
+  my $self = shift;
+  my ($op) = @_;
+
+  my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
+
+  if ($op eq 'insert' && $self->_returning_cols) {
+    local $@;
+    my (@returning_cols) = eval {
+      local $SIG{__WARN__} = sub {};
+      $sth->fetchrow_array
+    };
+    $self->_returning_cols->[1] = \@returning_cols;
+    $sth->finish;
+  }
+
+  return wantarray ? ($rv, $sth, @bind) : $rv;
+}
+
+sub insert {
+  my $self = shift;
+
+  my $updated_cols = $self->next::method(@_);
+
+  if ($self->_returning_cols->[0]) {
+    my %returning_cols;
+    @returning_cols{ @{ $self->_returning_cols->[0] } } = @{ $self->_returning_cols->[1] };
+
+    $updated_cols = { %$updated_cols, %returning_cols };
+  }
+
+  return $updated_cols;
+}
+
+sub last_insert_id {
+  my ($self, $source, @cols) = @_;
+  my @result;
+
+  my %returning_cols;
+  @returning_cols{ @{ $self->_returning_cols->[0] } } =
+    @{ $self->_returning_cols->[1] };
+
+  push @result, $returning_cols{$_} for @cols;
+
+  return @result;
+}
+
+=head1 AUTHOR
+
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/DBIx/Class/Storage/DBI/InterBase.pm b/lib/DBIx/Class/Storage/DBI/InterBase.pm
index f8b31a2..d2585ed 100644
--- a/lib/DBIx/Class/Storage/DBI/InterBase.pm
+++ b/lib/DBIx/Class/Storage/DBI/InterBase.pm
@@ -2,14 +2,10 @@ package DBIx::Class::Storage::DBI::InterBase;
 
 use strict;
 use warnings;
-use base qw/DBIx::Class::Storage::DBI/;
+use base qw/DBIx::Class::Storage::DBI::InsertReturning/;
 use mro 'c3';
 use List::Util();
 
-__PACKAGE__->mk_group_accessors(simple => qw/
-  _auto_incs
-/);
-
 =head1 NAME
 
 DBIx::Class::Storage::DBI::InterBase - Driver for the Firebird RDBMS
@@ -33,57 +29,6 @@ L</connect_call_datetime_setup>.
 
 =cut
 
-sub _prep_for_execute {
-  my $self = shift;
-  my ($op, $extra_bind, $ident, $args) = @_;
-
-  if ($op eq 'insert') {
-    $self->_auto_incs([]);
-
-    my %pk;
-    @pk{$ident->primary_columns} = ();
-
-    my @auto_inc_cols = grep {
-      my $inserting = $args->[0]{$_};
-
-      ($ident->column_info($_)->{is_auto_increment}
-        || exists $pk{$_})
-      && (
-        (not defined $inserting)
-        ||
-        (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
-      )
-    } $ident->columns;
-
-    if (@auto_inc_cols) {
-      $args->[1]{returning} = \@auto_inc_cols;
-
-      $self->_auto_incs->[0] = \@auto_inc_cols;
-    }
-  }
-
-  return $self->next::method(@_);
-}
-
-sub _execute {
-  my $self = shift;
-  my ($op) = @_;
-
-  my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
-
-  if ($op eq 'insert' && $self->_auto_incs) {
-    local $@;
-    my (@auto_incs) = eval {
-      local $SIG{__WARN__} = sub {};
-      $sth->fetchrow_array
-    };
-    $self->_auto_incs->[1] = \@auto_incs;
-    $sth->finish;
-  }
-
-  return wantarray ? ($rv, $sth, @bind) : $rv;
-}
-
 sub _sequence_fetch {
   my ($self, $nextval, $sequence) = @_;
 
@@ -140,34 +85,6 @@ EOF
   return undef;
 }
 
-sub last_insert_id {
-  my ($self, $source, @cols) = @_;
-  my @result;
-
-  my %auto_incs;
-  @auto_incs{ @{ $self->_auto_incs->[0] } } =
-    @{ $self->_auto_incs->[1] };
-
-  push @result, $auto_incs{$_} for @cols;
-
-  return @result;
-}
-
-sub insert {
-  my $self = shift;
-
-  my $updated_cols = $self->next::method(@_);
-
-  if ($self->_auto_incs->[0]) {
-    my %auto_incs;
-    @auto_incs{ @{ $self->_auto_incs->[0] } } = @{ $self->_auto_incs->[1] };
-
-    $updated_cols = { %$updated_cols, %auto_incs };
-  }
-
-  return $updated_cols;
-}
-
 # this sub stolen from DB2
 
 sub _sql_maker_opts {
diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index 10e7c5b..46eee6f 100644
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -3,7 +3,10 @@ package DBIx::Class::Storage::DBI::Pg;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
+use base qw/
+    DBIx::Class::Storage::DBI::MultiColumnIn
+    DBIx::Class::Storage::DBI::InsertReturning
+/;
 use mro 'c3';
 
 use DBD::Pg qw(:pg_types);
@@ -14,62 +17,6 @@ use Context::Preserve ();
 warn __PACKAGE__.": DBD::Pg 2.9.2 or greater is strongly recommended\n"
   if ($DBD::Pg::VERSION < 2.009002);  # pg uses (used?) version::qv()
 
-__PACKAGE__->mk_group_accessors(simple => qw/
-  _auto_cols
-/);
-
-sub _prep_for_execute {
-  my $self = shift;
-  my ($op, $extra_bind, $ident, $args) = @_;
-
-  if ($op eq 'insert') {
-    $self->_auto_cols([]);
-
-    my %pk;
-    @pk{$ident->primary_columns} = ();
-
-    my @auto_inc_cols = grep {
-      my $inserting = $args->[0]{$_};
-
-      ($ident->column_info($_)->{is_auto_increment}
-        || exists $pk{$_})
-      && (
-        (not defined $inserting)
-        ||
-        (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
-      )
-    } $ident->columns;
-
-    if (@auto_inc_cols) {
-      $args->[1]{returning} = \@auto_inc_cols;
-
-      $self->_auto_cols->[0] = \@auto_inc_cols;
-    }
-  }
-
-  return $self->next::method(@_);
-}
-
-sub _execute {
-  my $self = shift;
-  my ($op) = @_;
-
-  my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
-
-  if ($op eq 'insert' && $self->_auto_cols) {
-    local $@;
-    my (@auto_cols) = eval {
-      local $SIG{__WARN__} = sub {};
-      $sth->fetchrow_array
-    };
-    $self->_auto_cols->[1] = \@auto_cols;
-    $sth->finish;
-  }
-
-  return wantarray ? ($rv, $sth, @bind) : $rv;
-}
-
-
 sub with_deferred_fk_checks {
   my ($self, $sub) = @_;
 
@@ -85,34 +32,6 @@ sub with_deferred_fk_checks {
     after => sub { $txn_scope_guard->commit });
 }
 
-sub insert {
-  my $self = shift;
-
-  my $updated_cols = $self->next::method(@_);
-
-  if ($self->_auto_cols->[0]) {
-    my %auto_cols;
-    @auto_cols{ @{ $self->_auto_cols->[0] } } = @{ $self->_auto_cols->[1] };
-
-    $updated_cols = { %$updated_cols, %auto_cols };
-  }
-
-  return $updated_cols;
-}
-
-sub last_insert_id {
-  my ($self, $source, @cols) = @_;
-  my @result;
-
-  my %auto_cols;
-  @auto_cols{ @{ $self->_auto_cols->[0] } } =
-    @{ $self->_auto_cols->[1] };
-
-  push @result, $auto_cols{$_} for @cols;
-
-  return @result;
-}
-
 sub _sequence_fetch {
   my ($self, $function, $sequence) = @_;
 
diff --git a/t/72pg.t b/t/72pg.t
index b306295..9251caa 100644
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -271,6 +271,30 @@ $schema->source('TimestampPrimaryKey')->name('dbic_t_schema.timestamp_primary_ke
 my $row = $schema->resultset('TimestampPrimaryKey')->create({});
 ok $row->id;
 
+######## test with_deferred_fk_checks
+
+$schema->source('CD')->name('dbic_t_schema.cd');
+$schema->source('Track')->name('dbic_t_schema.track');
+lives_ok {
+  $schema->storage->with_deferred_fk_checks(sub {
+    $schema->resultset('Track')->create({
+      trackid => 999, cd => 999, position => 1, title => 'deferred FK track'
+    });
+    $schema->resultset('CD')->create({
+      artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd'
+    });
+  });
+} 'with_deferred_fk_checks code survived';
+
+is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track',
+   'code in with_deferred_fk_checks worked'; 
+
+throws_ok {
+  $schema->resultset('Track')->create({
+    trackid => 1, cd => 9999, position => 1, title => 'Track1'
+  });
+} qr/constraint/i, 'with_deferred_fk_checks is off';
+
 done_testing;
 
 exit;
@@ -306,10 +330,32 @@ EOS
 
       $dbh->do(<<EOS);
 CREATE TABLE dbic_t_schema.timestamp_primary_key_test (
-    id timestamp default current_timestamp
+  id timestamp default current_timestamp
 )
 EOS
       $dbh->do(<<EOS);
+CREATE TABLE dbic_t_schema.cd (
+  cdid int PRIMARY KEY,
+  artist int,
+  title varchar(255),
+  year varchar(4),
+  genreid int,
+  single_track int
+)
+EOS
+      $dbh->do(<<EOS);
+CREATE TABLE dbic_t_schema.track (
+  trackid int,
+  cd int REFERENCES dbic_t_schema.cd(cdid) DEFERRABLE,
+  position int,
+  title varchar(255),
+  last_updated_on date,
+  last_updated_at date,
+  small_dt date
+)
+EOS
+
+      $dbh->do(<<EOS);
 CREATE TABLE dbic_t_schema.sequence_test (
     pkid1 integer
     , pkid2 integer