From: Arthur Axel "fREW" Schmidt Date: Thu, 11 Jun 2009 16:13:02 +0000 (+0000) Subject: still busted :-( X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=764a1b60957e129ef39a8592ec53b128d3a9d1ae;p=dbsrgits%2FDBIx-Class-Historic.git still busted :-( --- diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 7be8aab..2e855e2 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI; use base 'DBIx::Class::Storage'; -use strict; +use strict; use warnings; use Carp::Clan qw/^DBIx::Class/; use DBI; @@ -89,8 +89,8 @@ recognized by DBIx::Class: =item * -A single code reference which returns a connected -L optionally followed by +A single code reference which returns a connected +L optionally followed by L recognized by DBIx::Class: @@ -109,7 +109,7 @@ mixed together: %extra_attributes, }]; -This is particularly useful for L based applications, allowing the +This is particularly useful for L based applications, allowing the following config (L style): @@ -128,7 +128,7 @@ Please note that the L docs recommend that you always explicitly set C to either I<0> or I<1>. L further recommends that it be set to I<1>, and that you perform transactions via our L method. L 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 for details. =head3 DBIx::Class specific connection attributes @@ -182,7 +182,7 @@ storage object. If set to a true value, this option will disable the caching of statement handles via L. -=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 @@ driver alone. See also L. =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 as well. C expects either a single character, in which case is it @@ -202,8 +202,8 @@ SQL Server you should use C<< quote_char => [qw/[ ]/] >>. =item name_sep -This only needs to be used in conjunction with C, and is used to -specify the charecter that seperates elements (schemas, tables, columns) from +This only needs to be used in conjunction with C, 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 @@ -594,7 +594,7 @@ sub dbh { sub _sql_maker_args { my ($self) = @_; - + return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} ); } @@ -753,11 +753,11 @@ sub svp_begin { $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 @@ sub svp_rollback { } $self->debugobj->svp_rollback($name) if $self->debug; - + return $self->_svp_rollback($name); } @@ -931,7 +931,7 @@ sub _query_start { if ( $self->debug ) { @bind = $self->_fix_bind_params(@bind); - + $self->debugobj->query_start( $sql, @bind ); } } @@ -954,7 +954,7 @@ sub _dbh_execute { 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 _execute { 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 @@ sub insert { } ## 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 @@ sub insert_bulk { 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 @@ sub insert_bulk { 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 @@ sub update { 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 update { 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 @@ sub _select_args { 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 _grouped_count_select { 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 @@ By default, C<\%sqlt_args> will have { 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 @@ sub create_ddl_dir { $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 @@ sub create_ddl_dir { } print $file $output; close($file); - + next unless ($preversion); require SQL::Translator::Diff; @@ -1602,7 +1632,7 @@ sub create_ddl_dir { carp("Overwriting existing diff file - $difffile"); unlink($difffile); } - + my $source_schema; { my $t = SQL::Translator->new($sqltargs); @@ -1621,7 +1651,7 @@ sub create_ddl_dir { 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 @@ sub create_ddl_dir { $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 @@ sub deployment_statements { 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 @@ sub deployment_statements { 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 @@ returned by databases that don't support replication. sub is_replicating { return; - + } =head2 lag_behind_master diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index ad92e1a..75e9497 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -11,31 +11,27 @@ sub _prep_for_execute { 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 $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; - } - } - if ($auto_inc_col) { - $sql = "SET IDENTITY_INSERT $table ON; $sql; SET IDENTITY_INSERT $table OFF;" + 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} || '.'; + + $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; } } + 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); }