X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=74fadd9d91eb451bd8d73777db92491c6e129dcd;hb=299d8683826c74c030d6657ab4f21d95a711c228;hp=7251ccf2f683cd86c8796531adc306d0bd17aca2;hpb=291bf95f152ff0e9008d67f9d80310b2c6111fdd;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 7251ccf..74fadd9 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,6 +856,8 @@ sub _connect { $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr)) if !$dbh || $@; + $self->_dbh_autocommit($dbh->{AutoCommit}); + $dbh; } @@ -789,7 +865,7 @@ sub _connect { sub txn_begin { my $self = shift; $self->ensure_connected(); - if($self->{transaction_depth}++ == 0) { + if($self->{transaction_depth} == 0) { $self->debugobj->txn_begin() if $self->debug; # this isn't ->_dbh-> because @@ -797,6 +873,7 @@ sub txn_begin { # for AutoCommit users $self->dbh->begin_work; } + $self->{transaction_depth}++; } sub txn_commit { @@ -807,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}-- @@ -817,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}--; @@ -839,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); } } @@ -858,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) = @_; @@ -867,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); @@ -898,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); } @@ -934,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 @@ -975,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); } @@ -1003,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}, @@ -1021,8 +1122,12 @@ sub _select { } else { $self->throw_exception("rows attribute must be positive if present") if (defined($attrs->{rows}) && !($attrs->{rows} > 0)); + + # MySQL actually recommends this approach. I cringe. + $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset}; push @args, $attrs->{rows}, $attrs->{offset}; } + return $self->_execute(@args); } @@ -1055,7 +1160,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 { @@ -1200,7 +1305,7 @@ sub bind_attribute_by_data_type { return; } -=head2 create_ddl_dir (EXPERIMENTAL) +=head2 create_ddl_dir =over 4 @@ -1211,9 +1316,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 @@ -1411,14 +1513,14 @@ sub deploy { next if($line =~ /^BEGIN TRANSACTION/m); next if($line =~ /^COMMIT/m); next if $line =~ /^\s+$/; # skip whitespace only - $self->debugobj->query_start($line) if $self->debug; + $self->_query_start($line); eval { $self->dbh->do($line); # shouldn't be using ->dbh ? }; if ($@) { warn qq{$@ (running "${line}")}; } - $self->debugobj->query_end($line) if $self->debug; + $self->_query_end($line); } } } @@ -1431,7 +1533,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