[Bast-commits] r9037 - in DBIx-Class/0.08/trunk/lib/DBIx/Class: . Storage Storage/DBI

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Mon Mar 22 17:03:12 GMT 2010


Author: ribasushi
Date: 2010-03-22 17:03:12 +0000 (Mon, 22 Mar 2010)
New Revision: 9037

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InsertReturning.pm
Log:
Even cleaner way of handling returning (no column interrogation in storage)

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm	2010-03-22 15:45:55 UTC (rev 9036)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm	2010-03-22 17:03:12 UTC (rev 9037)
@@ -342,31 +342,48 @@
     $rollback_guard ||= $source->storage->txn_scope_guard
   }
 
+  ## PK::Auto
+  my %auto_pri;
+  my $auto_idx = 0;
+  for ($self->primary_columns) {
+    if (
+      not defined $self->get_column($_)
+        ||
+      (ref($self->get_column($_)) eq 'SCALAR')
+    ) {
+      my $col_info = $source->column_info($_);
+      $auto_pri{$_} = $auto_idx++ unless $col_info->{auto_nextval};   # auto_nextval's are pre-fetched in the storage
+    }
+  }
+
   MULTICREATE_DEBUG and do {
     no warnings 'uninitialized';
     warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
   };
-  my $updated_cols = $source->storage->insert($source, { $self->get_columns });
+  my $updated_cols = $source->storage->insert(
+    $source,
+    { $self->get_columns },
+    keys %auto_pri
+      ? { returning => [ sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri ] }
+      : ()
+    ,
+  );
+
   foreach my $col (keys %$updated_cols) {
     $self->store_column($col, $updated_cols->{$col});
+    delete $auto_pri{$col};
   }
 
-  ## PK::Auto
-  my @auto_pri = grep {
-                  (not defined $self->get_column($_))
-                    ||
-                  (ref($self->get_column($_)) eq 'SCALAR')
-                 } $self->primary_columns;
-
-  if (@auto_pri) {
-    MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
+  if (keys %auto_pri) {
+    my @missing = sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri;
+    MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @missing )."\n";
     my $storage = $self->result_source->storage;
     $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
       unless $storage->can('last_insert_id');
-    my @ids = $storage->last_insert_id($self->result_source, at auto_pri);
+    my @ids = $storage->last_insert_id($self->result_source, @missing);
     $self->throw_exception( "Can't get last insert id" )
-      unless (@ids == @auto_pri);
-    $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
+      unless (@ids == @missing);
+    $self->store_column($missing[$_] => $ids[$_]) for 0 .. $#missing;
   }
 
   $self->{_dirty_columns} = {};

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InsertReturning.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InsertReturning.pm	2010-03-22 15:45:55 UTC (rev 9036)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InsertReturning.pm	2010-03-22 17:03:12 UTC (rev 9037)
@@ -6,10 +6,6 @@
 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
@@ -19,91 +15,42 @@
 
 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>.
+databases supporting the C<INSERT ... RETURNING> syntax.
 
 =cut
 
-sub _prep_for_execute {
+sub insert {
   my $self = shift;
-  my ($op, $extra_bind, $ident, $args) = @_;
+  my ($source, $to_insert, $opts) = @_;
 
-  if ($op eq 'insert') {
-    $self->_returning_cols([]);
+  return $self->next::method (@_) unless ($opts && $opts->{returning});
 
-    my %pk;
-    @pk{$ident->primary_columns} = ();
+  my $updated_cols = $self->_prefetch_insert_auto_nextvals ($source, $to_insert);
 
-    my @auto_inc_cols = grep {
-      my $inserting = $args->[0]{$_};
+  my $bind_attributes = $self->source_bind_attributes($source);
+  my ($rv, $sth) = $self->_execute (insert => [], $source, $bind_attributes, $to_insert, $opts);
 
-      ($ident->column_info($_)->{is_auto_increment}
-        || exists $pk{$_})
-      && (
-        (not defined $inserting)
-        ||
-        (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
-      )
-    } $ident->columns;
+  if (my @ret_cols = @{$opts->{returning}}) {
 
-    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 {
+    my @ret_vals = eval {
       local $SIG{__WARN__} = sub {};
-      $sth->fetchrow_array
+      my @r = $sth->fetchrow_array;
+      $sth->finish;
+      @r;
     };
-    $self->_returning_cols->[1] = \@returning_cols;
-    $sth->finish;
-  }
 
-  return wantarray ? ($rv, $sth, @bind) : $rv;
-}
+    my %ret;
+    @ret{@ret_cols} = @ret_vals if (@ret_vals);
 
-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 };
+    $updated_cols = {
+      %$updated_cols,
+      %ret,
+    };
   }
 
   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>

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2010-03-22 15:45:55 UTC (rev 9036)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2010-03-22 17:03:12 UTC (rev 9037)
@@ -1363,20 +1363,17 @@
     $self->dbh_do('_dbh_execute', @_);  # retry over disconnects
 }
 
-sub insert {
+sub _prefetch_insert_auto_nextvals {
   my ($self, $source, $to_insert) = @_;
 
-  my $ident = $source->from;
-  my $bind_attributes = $self->source_bind_attributes($source);
+  my $upd = {};
 
-  my $updated_cols = {};
-
   foreach my $col ( $source->columns ) {
     if ( !defined $to_insert->{$col} ) {
       my $col_info = $source->column_info($col);
 
       if ( $col_info->{auto_nextval} ) {
-        $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
+        $upd->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
           'nextval',
           $col_info->{sequence} ||=
             $self->_dbh_get_autoinc_seq($self->_get_dbh, $source, $col)
@@ -1385,6 +1382,17 @@
     }
   }
 
+  return $upd;
+}
+
+sub insert {
+  my $self = shift;
+  my ($source, $to_insert) = @_;
+
+  my $updated_cols = $self->_prefetch_insert_auto_nextvals (@_);
+
+  my $bind_attributes = $self->source_bind_attributes($source);
+
   $self->_execute('insert' => [], $source, $bind_attributes, $to_insert);
 
   return $updated_cols;




More information about the Bast-commits mailing list