[Bast-commits] r6627 - in DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage: . DBI/ODBC

frew at dev.catalyst.perl.org frew at dev.catalyst.perl.org
Thu Jun 11 16:13:03 GMT 2009


Author: frew
Date: 2009-06-11 16:13:02 +0000 (Thu, 11 Jun 2009)
New Revision: 6627

Modified:
   DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
Log:
still busted :-(

Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm	2009-06-11 15:39:40 UTC (rev 6626)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm	2009-06-11 16:13:02 UTC (rev 6627)
@@ -11,31 +11,27 @@
   my ($sql, $bind) = $self->next::method (@_);
   $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert';
 
-  use Scalar::Util 'blessed';
-  use List::Util 'first';
-  if ( blessed $ident ) {
-    my %auto_inc_columns;
-    foreach my $column ($ident->columns) {
-      if ($ident->column_info($column)->{is_auto_increment}) {
-	$auto_inc_columns{$column} = 1;
-      }
-    }
+  my $alias2src = $self->_resolve_ident_sources($ident);
+  my %identity_insert_tables;
+  foreach my $bound (@{$bind}) {
+    my $col =  $bound->[0];
+    my $name_sep = $self->_sql_maker_opts->{name_sep} || '.';
 
-    my $table = $ident->from;
-    my $auto_inc_col = 0;
-    BINDS:
-    foreach my $bound (@{$bind}) {
-      my $col =  $bound->[0];
-      if ($auto_inc_columns{$col}) {
-	$auto_inc_col = 1;
-	last BINDS;
-      }
+    $col =~ s/^([^\Q${name_sep}\E]*)\Q${name_sep}\E//;
+    my $alias = $1 || 'me';
+    my $rsrc = $alias2src->{$alias};
+
+    my $is_auto_increment = $rsrc && $rsrc->column_info($col)->{is_auto_increment};
+    my $table;
+    if ($is_auto_increment) {
+      $identity_insert_tables{$rsrc->from} = 1;
     }
-    if ($auto_inc_col) {
-      $sql = "SET IDENTITY_INSERT $table ON; $sql; SET IDENTITY_INSERT $table OFF;"
-    }
   }
 
+  my $identity_insert_on = join '', map { "SET IDENTITY_INSERT $_ ON; " } keys %identity_insert_tables;
+  my $identity_insert_off = join '', map { "SET IDENTITY_INSERT $_ OFF; " } keys %identity_insert_tables;
+  $sql = "$identity_insert_on $sql $identity_insert_off";
+
   return ($sql, $bind);
 }
 

Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm	2009-06-11 15:39:40 UTC (rev 6626)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm	2009-06-11 16:13:02 UTC (rev 6627)
@@ -3,7 +3,7 @@
 
 use base 'DBIx::Class::Storage';
 
-use strict;    
+use strict;
 use warnings;
 use Carp::Clan qw/^DBIx::Class/;
 use DBI;
@@ -89,8 +89,8 @@
 
 =item *
 
-A single code reference which returns a connected 
-L<DBI database handle|DBI/connect> optionally followed by 
+A single code reference which returns a connected
+L<DBI database handle|DBI/connect> optionally followed by
 L<extra attributes|/DBIx::Class specific connection attributes> recognized
 by DBIx::Class:
 
@@ -109,7 +109,7 @@
     %extra_attributes,
   }];
 
-This is particularly useful for L<Catalyst> based applications, allowing the 
+This is particularly useful for L<Catalyst> based applications, allowing the
 following config (L<Config::General> style):
 
   <Model::DB>
@@ -128,7 +128,7 @@
 set C<AutoCommit> to either I<0> or I<1>.  L<DBIx::Class> further
 recommends that it be set to I<1>, and that you perform transactions
 via our L<DBIx::Class::Schema/txn_do> method.  L<DBIx::Class> will set it
-to I<1> if you do not do explicitly set it to zero.  This is the default 
+to I<1> if you do not do explicitly set it to zero.  This is the default
 for most DBDs. See L</DBIx::Class and AutoCommit> for details.
 
 =head3 DBIx::Class specific connection attributes
@@ -182,7 +182,7 @@
 If set to a true value, this option will disable the caching of
 statement handles via L<DBI/prepare_cached>.
 
-=item limit_dialect 
+=item limit_dialect
 
 Sets the limit dialect. This is useful for JDBC-bridge among others
 where the remote SQL-dialect cannot be determined by the name of the
@@ -190,7 +190,7 @@
 
 =item quote_char
 
-Specifies what characters to use to quote table and column names. If 
+Specifies what characters to use to quote table and column names. If
 you use this you will want to specify L</name_sep> as well.
 
 C<quote_char> expects either a single character, in which case is it
@@ -202,8 +202,8 @@
 
 =item name_sep
 
-This only needs to be used in conjunction with C<quote_char>, and is used to 
-specify the charecter that seperates elements (schemas, tables, columns) from 
+This only needs to be used in conjunction with C<quote_char>, and is used to
+specify the charecter that seperates elements (schemas, tables, columns) from
 each other. In most cases this is simply a C<.>.
 
 The consequences of not supplying this value is that L<SQL::Abstract>
@@ -594,7 +594,7 @@
 
 sub _sql_maker_args {
     my ($self) = @_;
-    
+
     return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
 }
 
@@ -753,11 +753,11 @@
 
   $self->throw_exception ("Your Storage implementation doesn't support savepoints")
     unless $self->can('_svp_begin');
-  
+
   push @{ $self->{savepoints} }, $name;
 
   $self->debugobj->svp_begin($name) if $self->debug;
-  
+
   return $self->_svp_begin($name);
 }
 
@@ -817,7 +817,7 @@
   }
 
   $self->debugobj->svp_rollback($name) if $self->debug;
-  
+
   return $self->_svp_rollback($name);
 }
 
@@ -931,7 +931,7 @@
 
     if ( $self->debug ) {
         @bind = $self->_fix_bind_params(@bind);
-        
+
         $self->debugobj->query_start( $sql, @bind );
     }
 }
@@ -954,7 +954,7 @@
 
   my $sth = $self->sth($sql,$op);
 
-  my $placeholder_index = 1; 
+  my $placeholder_index = 1;
 
   foreach my $bound (@$bind) {
     my $attributes = {};
@@ -990,8 +990,8 @@
 
 sub insert {
   my ($self, $source, $to_insert) = @_;
-  
-  my $ident = $source->from; 
+
+  my $ident = $source->from;
   my $bind_attributes = $self->source_bind_attributes($source);
 
   my $updated_cols = {};
@@ -1013,7 +1013,7 @@
 }
 
 ## Still not quite perfect, and EXPERIMENTAL
-## Currently it is assumed that all values passed will be "normal", i.e. not 
+## Currently it is assumed that all values passed will be "normal", i.e. not
 ## scalar refs, or at least, all the same type as the first set, the statement is
 ## only prepped once.
 sub insert_bulk {
@@ -1022,7 +1022,7 @@
   my $table = $source->from;
   @colvalues{@$cols} = (0..$#$cols);
   my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
-  
+
   $self->_query_start( $sql, @bind );
   my $sth = $self->sth($sql);
 
@@ -1035,7 +1035,7 @@
   my $bind_attributes = $self->source_bind_attributes($source);
 
   ## Bind the values and execute
-  my $placeholder_index = 1; 
+  my $placeholder_index = 1;
 
   foreach my $bound (@bind) {
 
@@ -1083,7 +1083,7 @@
   my $self = shift @_;
   my $source = shift @_;
   my $bind_attributes = $self->source_bind_attributes($source);
-  
+
   return $self->_execute('update' => [], $source, $bind_attributes, @_);
 }
 
@@ -1091,9 +1091,9 @@
 sub delete {
   my $self = shift @_;
   my $source = shift @_;
-  
+
   my $bind_attrs = {}; ## If ever it's needed...
-  
+
   return $self->_execute('delete' => [], $source, $bind_attrs, @_);
 }
 
@@ -1223,6 +1223,36 @@
   return @args;
 }
 
+sub _resolve_ident_sources {
+  my ($self, $ident) = @_;
+
+  my $alias2source = {};
+
+  # the reason this is so contrived is that $ident may be a {from}
+  # structure, specifying multiple tables to join
+  if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+    # this is compat mode for insert/update/delete which do not deal with aliases
+    $alias2source->{me} = $ident;
+  }
+  elsif (ref $ident eq 'ARRAY') {
+
+    for (@$ident) {
+      my $tabinfo;
+      if (ref $_ eq 'HASH') {
+        $tabinfo = $_;
+      }
+      if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
+        $tabinfo = $_->[0];
+      }
+
+      $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-result_source}
+        if ($tabinfo->{-result_source});
+    }
+  }
+
+  return $alias2source;
+}
+
 sub count {
   my ($self, $source, $attrs) = @_;
 
@@ -1288,10 +1318,10 @@
 
 sub source_bind_attributes {
   my ($self, $source) = @_;
-  
+
   my $bind_attributes;
   foreach my $column ($source->columns) {
-  
+
     my $data_type = $source->column_info($column)->{data_type} || '';
     $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
      if $data_type;
@@ -1519,13 +1549,13 @@
 
  { add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1 }
 
-merged with the hash passed in. To disable any of those features, pass in a 
+merged with the hash passed in. To disable any of those features, pass in a
 hashref like the following
 
  { ignore_constraint_names => 0, # ... other options }
 
 
-Note that this feature is currently EXPERIMENTAL and may not work correctly 
+Note that this feature is currently EXPERIMENTAL and may not work correctly
 across all databases, or fully handle complex relationships.
 
 WARNING: Please check all SQL files created, before applying them.
@@ -1546,7 +1576,7 @@
   $version ||= $schema_version;
 
   $sqltargs = {
-    add_drop_table => 1, 
+    add_drop_table => 1,
     ignore_constraint_names => 1,
     ignore_index_names => 1,
     %{$sqltargs || {}}
@@ -1586,7 +1616,7 @@
     }
     print $file $output;
     close($file);
-  
+
     next unless ($preversion);
 
     require SQL::Translator::Diff;
@@ -1602,7 +1632,7 @@
       carp("Overwriting existing diff file - $difffile");
       unlink($difffile);
     }
-    
+
     my $source_schema;
     {
       my $t = SQL::Translator->new($sqltargs);
@@ -1621,7 +1651,7 @@
         unless ( $source_schema->name );
     }
 
-    # The "new" style of producers have sane normalization and can support 
+    # The "new" style of producers have sane normalization and can support
     # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
     # And we have to diff parsed SQL against parsed SQL.
     my $dest_schema = $sqlt_schema;
@@ -1642,12 +1672,12 @@
       $dest_schema->name( $filename )
         unless $dest_schema->name;
     }
-    
+
     my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
                                                   $dest_schema,   $db,
                                                   $sqltargs
                                                  );
-    if(!open $file, ">$difffile") { 
+    if(!open $file, ">$difffile") {
       $self->throw_exception("Can't write to $difffile ($!)");
       next;
     }
@@ -1691,7 +1721,7 @@
   if(-f $filename)
   {
       my $file;
-      open($file, "<$filename") 
+      open($file, "<$filename")
         or $self->throw_exception("Can't open $filename ($!)");
       my @rows = <$file>;
       close($file);
@@ -1706,7 +1736,7 @@
   eval qq{use SQL::Translator::Producer::${type}};
   $self->throw_exception($@) if $@;
 
-  # sources needs to be a parser arg, but for simplicty allow at top level 
+  # sources needs to be a parser arg, but for simplicty allow at top level
   # coming in
   $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
       if exists $sqltargs->{sources};
@@ -1811,7 +1841,7 @@
 
 sub is_replicating {
     return;
-    
+
 }
 
 =head2 lag_behind_master




More information about the Bast-commits mailing list