X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=3b9c10cfed5c4ff0a5a6844e18e10f745a4ce360;hb=ffdf4f11299b7dc0f9c57521688823f7cd1ed19f;hp=20948f30c421d5b41ef45c51a82f00e282a6da7a;hpb=942cd0c142a828426a2ba3650991188c7c02178c;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 20948f3..3b9c10c 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -13,10 +13,15 @@ use Scalar::Util qw/blessed weaken/; __PACKAGE__->mk_group_accessors('simple' => qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts - _conn_pid _conn_tid disable_sth_caching cursor on_connect_do - transaction_depth unsafe/ + _conn_pid _conn_tid disable_sth_caching on_connect_do + on_disconnect_do transaction_depth unsafe _dbh_autocommit/ ); +__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor'); + +__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/); +__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract'); + BEGIN { package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :( @@ -81,6 +86,15 @@ sub select { my ($sql, @ret) = $self->SUPER::select( $table, $self->_recurse_fields($fields), $where, $order, @rest ); + $sql .= + $self->{for} ? + ( + $self->{for} eq 'update' ? ' FOR UPDATE' : + $self->{for} eq 'shared' ? ' FOR SHARE' : + '' + ) : + '' + ; return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql; } @@ -115,7 +129,7 @@ sub _emulate_limit { } sub _recurse_fields { - my ($self, $fields) = @_; + my ($self, $fields, $params) = @_; my $ref = ref $fields; return $self->_quote($fields) unless $ref; return $$fields if $ref eq 'SCALAR'; @@ -123,10 +137,10 @@ sub _recurse_fields { if ($ref eq 'ARRAY') { return join(', ', map { $self->_recurse_fields($_) - .(exists $self->{rownum_hack_count} - ? ' AS col'.$self->{rownum_hack_count}++ - : '') - } @$fields); + .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack}) + ? ' AS col'.$self->{rownum_hack_count}++ + : '') + } @$fields); } elsif ($ref eq 'HASH') { foreach my $func (keys %$fields) { return $self->_sqlcase($func) @@ -142,7 +156,7 @@ sub _order_by { if (ref $_[0] eq 'HASH') { if (defined $_[0]->{group_by}) { $ret = $self->_sqlcase(' group by ') - .$self->_recurse_fields($_[0]->{group_by}); + .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 }); } if (defined $_[0]->{having}) { my $frag; @@ -311,7 +325,6 @@ documents DBI-specific methods and behaviors. sub new { my $new = shift->next::method(@_); - $new->cursor("DBIx::Class::Storage::DBI::Cursor"); $new->transaction_depth(0); $new->_sql_maker_opts({}); $new->{_in_dbh_do} = 0; @@ -346,9 +359,30 @@ connection-specific options: =item on_connect_do -This can be set to an arrayref of literal sql statements, which will -be executed immediately after making the connection to the database -every time we [re-]connect. +Specifies things to do immediately after connecting or re-connecting to +the database. Its value may contain: + +=over + +=item an array reference + +This contains SQL statements to execute in order. Each element contains +a string or a code reference that returns a string. + +=item a code reference + +This contains some code to execute. Unlike code references within an +array reference, its return value is ignored. + +=back + +=item on_disconnect_do + +Takes arguments in the same form as L and executes them +immediately before disconnecting from the database. + +Note, this only runs if you explicitly call L on the +storage object. =item disable_sth_caching @@ -382,15 +416,14 @@ each other. In most cases this is simply a C<.>. =item unsafe This Storage driver normally installs its own C, sets -C on, and sets C off on all database handles, -including those supplied by a coderef. It does this so that it can -have consistent and useful error behavior. +C and C on, and sets C off on +all database handles, including those supplied by a coderef. It does this +so that it can have consistent and useful error behavior. If you set this option to a true value, Storage will not do its usual -modifications to the database handle's C, C, and -C attributes, and instead relies on the settings in your -connect_info DBI options (or the values you set in your connection -coderef, in the case that you are connecting via coderef). +modifications to the database handle's attributes, and instead relies on +the settings in your connect_info DBI options (or the values you set in +your connection coderef, in the case that you are connecting via coderef). Note that your custom settings can cause Storage to malfunction, especially if you set a C handler that suppresses exceptions @@ -480,7 +513,11 @@ sub connect_info { my $last_info = $dbi_info->[-1]; if(ref $last_info eq 'HASH') { - for my $storage_opt (qw/on_connect_do disable_sth_caching unsafe/) { + $last_info = { %$last_info }; # so delete is non-destructive + my @storage_option = qw( + on_connect_do on_disconnect_do disable_sth_caching unsafe cursor_class + ); + for my $storage_opt (@storage_option) { if(my $value = delete $last_info->{$storage_opt}) { $self->$storage_opt($value); } @@ -490,6 +527,8 @@ sub connect_info { $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val; } } + # re-insert modified hashref + $dbi_info->[-1] = $last_info; # Get rid of any trailing empty hashref pop(@$dbi_info) if !keys %$last_info; @@ -583,6 +622,8 @@ sub txn_do { ref $coderef eq 'CODE' or $self->throw_exception ('$coderef must be a CODE reference'); + return $coderef->(@_) if $self->{transaction_depth}; + local $self->{_in_dbh_do} = 1; my @result; @@ -643,7 +684,10 @@ sub disconnect { my ($self) = @_; if( $self->connected ) { - $self->_dbh->rollback unless $self->_dbh->{AutoCommit}; + my $connection_do = $self->on_disconnect_do; + $self->_do_connection_actions($connection_do) if ref($connection_do); + + $self->_dbh->rollback unless $self->_dbh_autocommit; $self->_dbh->disconnect; $self->_dbh(undef); $self->{_dbh_gen}++; @@ -661,6 +705,7 @@ sub connected { } else { $self->_verify_pid; + return 0 if !$self->_dbh; } return ($dbh->FETCH('Active') && $dbh->ping); } @@ -673,7 +718,7 @@ sub connected { sub _verify_pid { my ($self) = @_; - return if $self->_conn_pid == $$; + return if defined $self->_conn_pid && $self->_conn_pid == $$; $self->_dbh->{InactiveDestroy} = 1; $self->_dbh(undef); @@ -712,7 +757,8 @@ sub _sql_maker_args { sub sql_maker { my ($self) = @_; unless ($self->_sql_maker) { - $self->_sql_maker(new DBIC::SQL::Abstract( $self->_sql_maker_args )); + my $sql_maker_class = $self->sql_maker_class; + $self->_sql_maker($sql_maker_class->new( $self->_sql_maker_args )); } return $self->_sql_maker; } @@ -724,7 +770,7 @@ sub _populate_dbh { # Always set the transaction depth on connect, since # there is no transaction in progress by definition - $self->{transaction_depth} = $self->_dbh->{AutoCommit} ? 0 : 1; + $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1; if(ref $self eq 'DBIx::Class::Storage::DBI') { my $driver = $self->_dbh->{Driver}->{Name}; @@ -734,17 +780,44 @@ sub _populate_dbh { } } - # if on-connect sql statements are given execute them - foreach my $sql_statement (@{$self->on_connect_do || []}) { - $self->debugobj->query_start($sql_statement) if $self->debug(); - $self->_dbh->do($sql_statement); - $self->debugobj->query_end($sql_statement) if $self->debug(); - } + 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'}; } +sub _do_connection_actions { + my $self = shift; + my $connection_do = shift; + + if (ref $connection_do eq 'ARRAY') { + $self->_do_query($_) foreach @$connection_do; + } + elsif (ref $connection_do eq 'CODE') { + $connection_do->(); + } + + return $self; +} + +sub _do_query { + my ($self, $action) = @_; + + if (ref $action eq 'CODE') { + $action = $action->($self); + $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); + } + + return $self; +} + sub _connect { my ($self, @info) = @_; @@ -766,12 +839,13 @@ sub _connect { $dbh = DBI->connect(@info); } - if(!$self->unsafe) { + if($dbh && !$self->unsafe) { my $weak_self = $self; weaken($weak_self); $dbh->{HandleError} = sub { $weak_self->throw_exception("DBI Exception: $_[0]") }; + $dbh->{ShowErrorStatement} = 1; $dbh->{RaiseError} = 1; $dbh->{PrintError} = 0; } @@ -782,13 +856,16 @@ sub _connect { $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr)) if !$dbh || $@; + $self->_dbh_autocommit($dbh->{AutoCommit}); + $dbh; } sub txn_begin { my $self = shift; - if($self->{transaction_depth}++ == 0) { + $self->ensure_connected(); + if($self->{transaction_depth} == 0) { $self->debugobj->txn_begin() if $self->debug; # this isn't ->_dbh-> because @@ -796,6 +873,7 @@ sub txn_begin { # for AutoCommit users $self->dbh->begin_work; } + $self->{transaction_depth}++; } sub txn_commit { @@ -806,7 +884,7 @@ sub txn_commit { if ($self->debug); $dbh->commit; $self->{transaction_depth} = 0 - if $dbh->{AutoCommit}; + if $self->_dbh_autocommit; } elsif($self->{transaction_depth} > 1) { $self->{transaction_depth}-- @@ -816,15 +894,13 @@ sub txn_commit { sub txn_rollback { my $self = shift; my $dbh = $self->_dbh; - my $autocommit; eval { - $autocommit = $dbh->{AutoCommit}; if ($self->{transaction_depth} == 1) { $self->debugobj->txn_rollback() if ($self->debug); - $dbh->rollback; $self->{transaction_depth} = 0 - if $autocommit; + if $self->_dbh_autocommit; + $dbh->rollback; } elsif($self->{transaction_depth} > 1) { $self->{transaction_depth}--; @@ -838,7 +914,7 @@ sub txn_rollback { my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION"; $error =~ /$exception_class/ and $self->throw_exception($error); # ensure that a failed rollback resets the transaction depth - $self->{transaction_depth} = $autocommit ? 0 : 1; + $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1; $self->throw_exception($error); } } @@ -857,6 +933,40 @@ sub _prep_for_execute { return ($sql, \@bind); } +sub _fix_bind_params { + my ($self, @bind) = @_; + + ### Turn @bind from something like this: + ### ( [ "artist", 1 ], [ "cdid", 1, 3 ] ) + ### to this: + ### ( "'1'", "'1'", "'3'" ) + return + map { + if ( defined( $_ && $_->[1] ) ) { + map { qq{'$_'}; } @{$_}[ 1 .. $#$_ ]; + } + else { q{'NULL'}; } + } @bind; +} + +sub _query_start { + my ( $self, $sql, @bind ) = @_; + + if ( $self->debug ) { + @bind = $self->_fix_bind_params(@bind); + $self->debugobj->query_start( $sql, @bind ); + } +} + +sub _query_end { + my ( $self, $sql, @bind ) = @_; + + if ( $self->debug ) { + @bind = $self->_fix_bind_params(@bind); + $self->debugobj->query_end( $sql, @bind ); + } +} + sub _dbh_execute { my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_; @@ -866,11 +976,7 @@ sub _dbh_execute { my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args); - if ($self->debug) { - my @debug_bind = - map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind; - $self->debugobj->query_start($sql, @debug_bind); - } + $self->_query_start( $sql, @$bind ); my $sth = $self->sth($sql,$op); @@ -897,11 +1003,7 @@ sub _dbh_execute { my $rv = $sth->execute(); $self->throw_exception($sth->errstr) if !$rv; - if ($self->debug) { - my @debug_bind = - map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind; - $self->debugobj->query_end($sql, @debug_bind); - } + $self->_query_end( $sql, @$bind ); return (wantarray ? ($rv, $sth, @$bind) : $rv); } @@ -933,10 +1035,7 @@ sub insert_bulk { @colvalues{@$cols} = (0..$#$cols); my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues); - if ($self->debug) { - my @debug_bind = map { defined $_->[1] ? qq{$_->[1]} : q{'NULL'} } @bind; - $self->debugobj->query_start($sql, @debug_bind); - } + $self->_query_start( $sql, @bind ); my $sth = $self->sth($sql); # @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args @@ -974,10 +1073,7 @@ sub insert_bulk { my $rv = $sth->execute_array({ArrayTupleStatus => $tuple_status}); $self->throw_exception($sth->errstr) if !$rv; - if ($self->debug) { - my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind; - $self->debugobj->query_end($sql, @debug_bind); - } + $self->_query_end( $sql, @bind ); return (wantarray ? ($rv, $sth, @bind) : $rv); } @@ -1002,9 +1098,15 @@ sub delete { sub _select { my ($self, $ident, $select, $condition, $attrs) = @_; my $order = $attrs->{order_by}; + if (ref $condition eq 'SCALAR') { $order = $1 if $$condition =~ s/ORDER BY (.*)$//i; } + + my $for = delete $attrs->{for}; + my $sql_maker = $self->sql_maker; + local $sql_maker->{for} = $for; + if (exists $attrs->{group_by} || $attrs->{having}) { $order = { group_by => $attrs->{group_by}, @@ -1022,6 +1124,7 @@ sub _select { if (defined($attrs->{rows}) && !($attrs->{rows} > 0)); push @args, $attrs->{rows}, $attrs->{offset}; } + return $self->_execute(@args); } @@ -1054,7 +1157,7 @@ Handle a SQL select statement. sub select { my $self = shift; my ($ident, $select, $condition, $attrs) = @_; - return $self->cursor->new($self, \@_, $attrs); + return $self->cursor_class->new($self, \@_, $attrs); } sub select_single { @@ -1199,7 +1302,7 @@ sub bind_attribute_by_data_type { return; } -=head2 create_ddl_dir (EXPERIMENTAL) +=head2 create_ddl_dir =over 4 @@ -1210,9 +1313,6 @@ sub bind_attribute_by_data_type { Creates a SQL file based on the Schema, for each of the specified database types, in the given directory. -Note that this feature is currently EXPERIMENTAL and may not work correctly -across all databases, or fully handle complex relationships. - =cut sub create_ddl_dir @@ -1229,21 +1329,22 @@ sub create_ddl_dir $version ||= $schema->VERSION || '1.x'; $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} }; - $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.08: '} + $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09: '} . $self->_check_sqlt_message . q{'}) if !$self->_check_sqlt_version; my $sqlt = SQL::Translator->new({ -# debug => 1, add_drop_table => 1, }); + + $sqlt->parser('SQL::Translator::Parser::DBIx::Class'); + my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error; + foreach my $db (@$databases) { $sqlt->reset(); - $sqlt->parser('SQL::Translator::Parser::DBIx::Class'); -# $sqlt->parser_args({'DBIx::Class' => $schema); $sqlt = $self->configure_sqlt($sqlt, $db); - $sqlt->data($schema); + $sqlt->{schema} = $sqlt_schema; $sqlt->producer($db); my $file; @@ -1251,23 +1352,22 @@ sub create_ddl_dir if(-e $filename) { warn("$filename already exists, skipping $db"); - next; - } - - my $output = $sqlt->translate; - if(!$output) - { - warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")"); - next; - } - if(!open($file, ">$filename")) - { - $self->throw_exception("Can't open $filename for writing ($!)"); + next unless ($preversion); + } else { + my $output = $sqlt->translate; + if(!$output) + { + warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")"); next; - } - print $file $output; - close($file); - + } + if(!open($file, ">$filename")) + { + $self->throw_exception("Can't open $filename for writing ($!)"); + next; + } + print $file $output; + close($file); + } if($preversion) { require SQL::Translator::Diff; @@ -1279,43 +1379,48 @@ sub create_ddl_dir warn("No previous schema file found ($prefilename)"); next; } - #### We need to reparse the SQLite file we just wrote, so that - ## Diff doesnt get all confoosed, and Diff is *very* confused. - ## FIXME: rip Diff to pieces! -# my $target_schema = $sqlt->schema; -# unless ( $target_schema->name ) { -# $target_schema->name( $filename ); -# } - my @input; - push @input, {file => $prefilename, parser => $db}; - push @input, {file => $filename, parser => $db}; - my ( $source_schema, $source_db, $target_schema, $target_db ) = map { - my $file = $_->{'file'}; - my $parser = $_->{'parser'}; + my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion); + print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n"; + if(-e $difffile) + { + warn("$difffile already exists, skipping"); + next; + } + + my $source_schema; + { my $t = SQL::Translator->new; $t->debug( 0 ); $t->trace( 0 ); - $t->parser( $parser ) or die $t->error; - my $out = $t->translate( $file ) or die $t->error; - my $schema = $t->schema; - unless ( $schema->name ) { - $schema->name( $file ); + $t->parser( $db ) or die $t->error; + my $out = $t->translate( $prefilename ) or die $t->error; + $source_schema = $t->schema; + unless ( $source_schema->name ) { + $source_schema->name( $prefilename ); } - ($schema, $parser); - } @input; + } + + # 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; + + unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) { + my $t = SQL::Translator->new; + $t->debug( 0 ); + $t->trace( 0 ); + $t->parser( $db ) or die $t->error; + my $out = $t->translate( $filename ) or die $t->error; + $dest_schema = $t->schema; + $dest_schema->name( $filename ) + unless $dest_schema->name; + } my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db, - $target_schema, $db, + $dest_schema, $db, {} ); - my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion); - print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n"; - if(-e $difffile) - { - warn("$difffile already exists, skipping"); - next; - } if(!open $file, ">$difffile") { $self->throw_exception("Can't write to $difffile ($!)"); @@ -1379,7 +1484,7 @@ sub deployment_statements { return join('', @rows); } - $self->throw_exception(q{Can't deploy without SQL::Translator 0.08: '} + $self->throw_exception(q{Can't deploy without SQL::Translator 0.09: '} . $self->_check_sqlt_message . q{'}) if !$self->_check_sqlt_version; @@ -1403,16 +1508,21 @@ 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 || {} } } ) ) { - for ( split(";\n", $statement)) { - next if($_ =~ /^--/); - next if(!$_); -# next if($_ =~ /^DROP/m); - next if($_ =~ /^BEGIN TRANSACTION/m); - next if($_ =~ /^COMMIT/m); - next if $_ =~ /^\s+$/; # skip whitespace only - $self->debugobj->query_start($_) if $self->debug; - $self->dbh->do($_); # shouldn't be using ->dbh ? - $self->debugobj->query_end($_) if $self->debug; + 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); } } } @@ -1425,7 +1535,10 @@ Returns the datetime parser class sub datetime_parser { my $self = shift; - return $self->{datetime_parser} ||= $self->build_datetime_parser(@_); + return $self->{datetime_parser} ||= do { + $self->ensure_connected; + $self->build_datetime_parser(@_); + }; } =head2 datetime_parser_type @@ -1456,9 +1569,9 @@ 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.08'; - $_check_sqlt_message = $@ ? $@ : ''; - $_check_sqlt_version = $@ ? 0 : 1; + eval 'use SQL::Translator "0.09"'; + $_check_sqlt_message = $@ || ''; + $_check_sqlt_version = !$@; } sub _check_sqlt_message {