X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=1b0561501c1a676f7125942a26f29a1bed113493;hb=557657cd3455b495ba4439b8b045060051081abb;hp=c6ca8f24cf9f795a9d3ec8fb09637001c122b917;hpb=849d23b85659bb2bc1f917f9a27492929d450c27;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index c6ca8f2..1b05615 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -50,6 +50,9 @@ sub new { $self; } +# DB2 is the only remaining DB using this. Even though we are not sure if +# RowNumberOver is still needed here (should be part of SQLA) leave the +# code in place sub _RowNumberOver { my ($self, $sql, $order, $rows, $offset ) = @_; @@ -57,7 +60,7 @@ sub _RowNumberOver { my $last = $rows + $offset; my ( $order_by ) = $self->_order_by( $order ); - $sql = <<""; + $sql = <<"SQL"; SELECT * FROM ( SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM ( @@ -67,6 +70,8 @@ SELECT * FROM ) Q2 WHERE ROW_NUM BETWEEN $offset AND $last +SQL + return $sql; } @@ -76,17 +81,26 @@ WHERE ROW_NUM BETWEEN $offset AND $last use Scalar::Util 'blessed'; sub _find_syntax { my ($self, $syntax) = @_; - my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax; + + # DB2 is the only remaining DB using this. Even though we are not sure if + # RowNumberOver is still needed here (should be part of SQLA) leave the + # code in place + my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax; if(ref($self) && $dbhname && $dbhname eq 'DB2') { return 'RowNumberOver'; } - + $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax); } sub select { my ($self, $table, $fields, $where, $order, @rest) = @_; - $table = $self->_quote($table) unless ref($table); + if (ref $table eq 'SCALAR') { + $table = $$table; + } + elsif (not ref $table) { + $table = $self->_quote($table); + } local $self->{rownum_hack_count} = 1 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum'); @rest = (-1) unless defined $rest[0]; @@ -157,6 +171,13 @@ sub _recurse_fields { .'( '.$self->_recurse_fields($fields->{$func}).' )'; } } + # Is the second check absolutely necessary? + elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) { + return $self->_bind_to_sql( $fields ); + } + else { + Carp::croak($ref . qq{ unexpected in _recurse_fields()}) + } } sub _order_by { @@ -177,6 +198,9 @@ sub _order_by { if (defined $_[0]->{order_by}) { $ret .= $self->_order_by($_[0]->{order_by}); } + if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) { + return $self->SUPER::_order_by($_[0]); + } } elsif (ref $_[0] eq 'SCALAR') { $ret = $self->_sqlcase(' order by ').${ $_[0] }; } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) { @@ -242,10 +266,20 @@ sub _recurse_from { return join('', @sqlf); } +sub _bind_to_sql { + my $self = shift; + my $arr = shift; + my $sql = shift @$$arr; + $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg; + return $sql +} + sub _make_as { my ($self, $from) = @_; - return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) } - reverse each %{$self->_skip_options($from)}); + return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ + : ref $_ eq 'REF' ? $self->_bind_to_sql($_) + : $self->_quote($_)) + } reverse each %{$self->_skip_options($from)}); } sub _skip_options { @@ -875,7 +909,7 @@ sub dbh { sub _sql_maker_args { my ($self) = @_; - return ( bindtype=>'columns', limit_dialect => $self->dbh, %{$self->_sql_maker_opts} ); + return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} ); } sub sql_maker { @@ -906,11 +940,11 @@ sub _populate_dbh { } } - my $connection_do = $self->on_connect_do; - $self->_do_connection_actions($connection_do) if ref($connection_do); - $self->_conn_pid($$); $self->_conn_tid(threads->tid) if $INC{'threads.pm'}; + + my $connection_do = $self->on_connect_do; + $self->_do_connection_actions($connection_do) if ref($connection_do); } sub _do_connection_actions { @@ -921,7 +955,7 @@ sub _do_connection_actions { $self->_do_query($_) foreach @$connection_do; } elsif (ref $connection_do eq 'CODE') { - $connection_do->(); + $connection_do->($self); } return $self; @@ -935,10 +969,18 @@ sub _do_query { $self->_do_query($_) foreach @$action; } else { - my @to_run = (ref $action eq 'ARRAY') ? (@$action) : ($action); - $self->_query_start(@to_run); - $self->_dbh->do(@to_run); - $self->_query_end(@to_run); + # Most debuggers expect ($sql, @bind), so we need to exclude + # the attribute hash which is the second argument to $dbh->do + # furthermore the bind values are usually to be presented + # as named arrayref pairs, so wrap those here too + my @do_args = (ref $action eq 'ARRAY') ? (@$action) : ($action); + my $sql = shift @do_args; + my $attrs = shift @do_args; + my @bind = map { [ undef, $_ ] } @do_args; + + $self->_query_start($sql, @bind); + $self->_dbh->do($sql, $attrs, @do_args); + $self->_query_end($sql, @bind); } return $self; @@ -1148,11 +1190,15 @@ sub txn_rollback { sub _prep_for_execute { my ($self, $op, $extra_bind, $ident, $args) = @_; + if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { + $ident = $ident->from(); + } + my ($sql, @bind) = $self->sql_maker->$op($ident, @$args); + unshift(@bind, map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind) if $extra_bind; - return ($sql, \@bind); } @@ -1193,10 +1239,6 @@ sub _query_end { sub _dbh_execute { my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_; - - if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { - $ident = $ident->from(); - } my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args); @@ -1216,7 +1258,8 @@ sub _dbh_execute { } foreach my $data (@data) { - $data = ref $data ? ''.$data : $data; # stringify args + my $ref = ref $data; + $data = $ref && $ref ne 'ARRAY' ? ''.$data : $data; # stringify args (except arrayrefs) $sth->bind_param($placeholder_index, $data, $attributes); $placeholder_index++; @@ -1331,6 +1374,13 @@ sub delete { } sub _select { + my $self = shift; + my $sql_maker = $self->sql_maker; + local $sql_maker->{for}; + return $self->_execute($self->_select_args(@_)); +} + +sub _select_args { my ($self, $ident, $select, $condition, $attrs) = @_; my $order = $attrs->{order_by}; @@ -1344,7 +1394,7 @@ sub _select { my $for = delete $attrs->{for}; my $sql_maker = $self->sql_maker; - local $sql_maker->{for} = $for; + $sql_maker->{for} = $for; if (exists $attrs->{group_by} || $attrs->{having}) { $order = { @@ -1366,8 +1416,7 @@ sub _select { $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset}; push @args, $attrs->{rows}, $attrs->{offset}; } - - return $self->_execute(@args); + return @args; } sub source_bind_attributes { @@ -1406,7 +1455,8 @@ sub select_single { my $self = shift; my ($rv, $sth, @bind) = $self->_select(@_); my @row = $sth->fetchrow_array; - if(@row && $sth->fetchrow_array) { + my @nextrow = $sth->fetchrow_array if @row; + if(@row && @nextrow) { carp "Query returned more than one row. SQL that returns multiple rows is DEPRECATED for ->find and ->single"; } # Need to call finish() to work round broken DBDs @@ -1578,7 +1628,10 @@ sub create_ddl_dir { } $databases ||= ['MySQL', 'SQLite', 'PostgreSQL']; $databases = [ $databases ] if(ref($databases) ne 'ARRAY'); - $version ||= $schema->VERSION || '1.x'; + + my $schema_version = $schema->schema_version || '1.x'; + $version ||= $schema_version; + $sqltargs = { add_drop_table => 1, ignore_constraint_names => 1, @@ -1586,7 +1639,7 @@ sub create_ddl_dir { %{$sqltargs || {}} }; - $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09: '} + $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09003: '} . $self->_check_sqlt_message . q{'}) if !$self->_check_sqlt_version; @@ -1603,7 +1656,7 @@ sub create_ddl_dir { my $file; my $filename = $schema->ddl_filename($db, $version, $dir); - if (-e $filename && (!$version || ($version == $schema->schema_version()))) { + if (-e $filename && ($version eq $schema_version )) { # if we are dumping the current version, overwrite the DDL warn "Overwriting existing DDL file - $filename"; unlink($filename); @@ -1720,9 +1773,9 @@ sub deployment_statements { # Need to be connected to get the correct sqlt_type $self->ensure_connected() unless $type; $type ||= $self->sqlt_type; - $version ||= $schema->VERSION || '1.x'; + $version ||= $schema->schema_version || '1.x'; $dir ||= './'; - my $filename = $schema->ddl_filename($type, $dir, $version); + my $filename = $schema->ddl_filename($type, $version, $dir); if(-f $filename) { my $file; @@ -1733,7 +1786,7 @@ sub deployment_statements { return join('', @rows); } - $self->throw_exception(q{Can't deploy without SQL::Translator 0.09: '} + $self->throw_exception(q{Can't deploy without SQL::Translator 0.09003: '} . $self->_check_sqlt_message . q{'}) if !$self->_check_sqlt_version; @@ -1753,22 +1806,32 @@ sub deployment_statements { sub deploy { my ($self, $schema, $type, $sqltargs, $dir) = @_; - foreach my $statement ( $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } ) ) { - foreach my $line ( split(";\n", $statement)) { - next if($line =~ /^--/); - next if(!$line); -# next if($line =~ /^DROP/m); - next if($line =~ /^BEGIN TRANSACTION/m); - next if($line =~ /^COMMIT/m); - next if $line =~ /^\s+$/; # skip whitespace only - $self->_query_start($line); - eval { - $self->dbh->do($line); # shouldn't be using ->dbh ? - }; - if ($@) { - warn qq{$@ (running "${line}")}; - } - $self->_query_end($line); + my $deploy = sub { + my $line = shift; + return if($line =~ /^--/); + return if(!$line); + # next if($line =~ /^DROP/m); + return if($line =~ /^BEGIN TRANSACTION/m); + return if($line =~ /^COMMIT/m); + return if $line =~ /^\s+$/; # skip whitespace only + $self->_query_start($line); + eval { + $self->dbh->do($line); # shouldn't be using ->dbh ? + }; + if ($@) { + warn qq{$@ (running "${line}")}; + } + $self->_query_end($line); + }; + my @statements = $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } ); + if (@statements > 1) { + foreach my $statement (@statements) { + $deploy->( $statement ); + } + } + elsif (@statements == 1) { + foreach my $line ( split(";\n", $statements[0])) { + $deploy->( $line ); } } } @@ -1815,7 +1878,7 @@ sub build_datetime_parser { my $_check_sqlt_message; # private sub _check_sqlt_version { return $_check_sqlt_version if defined $_check_sqlt_version; - eval 'use SQL::Translator "0.09"'; + eval 'use SQL::Translator "0.09003"'; $_check_sqlt_message = $@ || ''; $_check_sqlt_version = !$@; }