X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=ab28f8398499ef128faba4c3e9105b33d4925931;hb=2ab60eb9452d546818fe8a20e58e9d19c8379272;hp=e1d50efce1332bc461370323b876c021aab0a96f;hpb=40dce2a5f0f24e152fe1773760904619804abb1f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index e1d50ef..ab28f83 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -9,13 +9,12 @@ use DBI; use SQL::Abstract::Limit; use DBIx::Class::Storage::DBI::Cursor; use DBIx::Class::Storage::Statistics; -use IO::File; -use Scalar::Util 'blessed'; +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/ + transaction_depth unsafe/ ); BEGIN { @@ -380,6 +379,22 @@ This only needs to be used in conjunction with L, and is used to specify the charecter that seperates elements (schemas, tables, columns) from each other. In most cases this is simply a C<.>. +=item unsafe + +This Storage driver normally installs its own C, sets +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 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 +and/or disable C. + =back These options can be mixed in with your other L connection attributes, @@ -390,12 +405,6 @@ Every time C is invoked, any previous settings for these options will be cleared before setting the new ones, regardless of whether any options are specified in the new C. -Important note: DBIC expects the returned database handle provided by -a subref argument to have RaiseError set on it. If it doesn't, things -might not work very well, YMMV. If you don't use a subref, DBIC will -force this setting for you anyways. Setting HandleError to anything -other than simple exception object wrapper might cause problems too. - Another Important Note: DBIC can do some wonderful magic with handling exceptions, @@ -470,7 +479,7 @@ 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/) { + for my $storage_opt (qw/on_connect_do disable_sth_caching unsafe/) { if(my $value = delete $last_info->{$storage_opt}) { $self->$storage_opt($value); } @@ -739,13 +748,13 @@ sub _connect { my ($self, @info) = @_; $self->throw_exception("You failed to provide any connection info") - if !@info; + if !@info; my ($old_connect_via, $dbh); if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) { - $old_connect_via = $DBI::connect_via; - $DBI::connect_via = 'connect'; + $old_connect_via = $DBI::connect_via; + $DBI::connect_via = 'connect'; } eval { @@ -754,9 +763,17 @@ sub _connect { } else { $dbh = DBI->connect(@info); - $dbh->{RaiseError} = 1; - $dbh->{PrintError} = 0; - $dbh->{PrintWarn} = 0; + } + + if(!$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; } }; @@ -771,6 +788,7 @@ sub _connect { sub txn_begin { my $self = shift; + $self->ensure_connected(); if($self->{transaction_depth}++ == 0) { $self->debugobj->txn_begin() if $self->debug; @@ -840,8 +858,8 @@ sub _prep_for_execute { return ($sql, \@bind); } -sub _execute { - my ($self, $op, $extra_bind, $ident, $bind_attributes, @args) = @_; +sub _dbh_execute { + my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_; if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { $ident = $ident->from(); @@ -855,54 +873,52 @@ sub _execute { $self->debugobj->query_start($sql, @debug_bind); } - my $sth = eval { $self->sth($sql,$op) }; - $self->throw_exception("no sth generated via sql ($@): $sql") if $@; + my $sth = $self->sth($sql,$op); - my $rv = eval { - my $placeholder_index = 1; + my $placeholder_index = 1; - foreach my $bound (@$bind) { - my $attributes = {}; - my($column_name, @data) = @$bound; + foreach my $bound (@$bind) { + my $attributes = {}; + my($column_name, @data) = @$bound; - if ($bind_attributes) { - $attributes = $bind_attributes->{$column_name} - if defined $bind_attributes->{$column_name}; - } + if ($bind_attributes) { + $attributes = $bind_attributes->{$column_name} + if defined $bind_attributes->{$column_name}; + } - foreach my $data (@data) { - $data = ref $data ? ''.$data : $data; # stringify args + foreach my $data (@data) { + $data = ref $data ? ''.$data : $data; # stringify args - $sth->bind_param($placeholder_index, $data, $attributes); - $placeholder_index++; - } + $sth->bind_param($placeholder_index, $data, $attributes); + $placeholder_index++; } - $sth->execute(); - }; + } - $self->throw_exception("Error executing '$sql': " . ($@ || $sth->errstr)) - if $@ || !$rv; + # Can this fail without throwing an exception anyways??? + 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); } + return (wantarray ? ($rv, $sth, @$bind) : $rv); } +sub _execute { + my $self = shift; + $self->dbh_do($self->can('_dbh_execute'), @_) +} + sub insert { my ($self, $source, $to_insert) = @_; my $ident = $source->from; my $bind_attributes = $self->source_bind_attributes($source); - eval { $self->_execute('insert' => [], $source, $bind_attributes, $to_insert) }; - $self->throw_exception( - "Couldn't insert ".join(', ', - map "$_ => $to_insert->{$_}", keys %$to_insert - )." into ${ident}: $@" - ) if $@; + $self->_execute('insert' => [], $source, $bind_attributes, $to_insert); return $to_insert; } @@ -926,8 +942,6 @@ sub insert_bulk { # @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args - my $rv; - ## This must be an arrayref, else nothing works! my $tuple_status = []; @@ -935,47 +949,32 @@ sub insert_bulk { ##use Data::Dumper; ##print STDERR Dumper( $data, $sql, [@bind] ); - if ($sth) { - - my $time = time(); - - ## Get the bind_attributes, if any exist - my $bind_attributes = $self->source_bind_attributes($source); + my $time = time(); - ## Bind the values and execute - $rv = eval { - - my $placeholder_index = 1; + ## Get the bind_attributes, if any exist + my $bind_attributes = $self->source_bind_attributes($source); - foreach my $bound (@bind) { + ## Bind the values and execute + my $placeholder_index = 1; - my $attributes = {}; - my ($column_name, $data_index) = @$bound; + foreach my $bound (@bind) { - if( $bind_attributes ) { - $attributes = $bind_attributes->{$column_name} - if defined $bind_attributes->{$column_name}; - } + my $attributes = {}; + my ($column_name, $data_index) = @$bound; - my @data = map { $_->[$data_index] } @$data; + if( $bind_attributes ) { + $attributes = $bind_attributes->{$column_name} + if defined $bind_attributes->{$column_name}; + } - $sth->bind_param_array( $placeholder_index, [@data], $attributes ); - $placeholder_index++; - } - $sth->execute_array( {ArrayTupleStatus => $tuple_status} ); + my @data = map { $_->[$data_index] } @$data; - }; - - if ($@ || !defined $rv) { - my $errors = ''; - foreach my $tuple (@$tuple_status) { - $errors .= "\n" . $tuple->[1] if(ref $tuple); - } - $self->throw_exception("Error executing '$sql': ".($@ || $errors)); - } - } else { - $self->throw_exception("'$sql' did not generate a statement."); + $sth->bind_param_array( $placeholder_index, [@data], $attributes ); + $placeholder_index++; } + 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); @@ -1090,7 +1089,7 @@ sub _dbh_sth { # XXX You would think RaiseError would make this impossible, # but apparently that's not true :( - die $dbh->errstr if !$sth; + $self->throw_exception($dbh->errstr) if !$sth; $sth; } @@ -1405,16 +1404,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->debugobj->query_start($line) if $self->debug; + eval { + $self->dbh->do($line); # shouldn't be using ->dbh ? + }; + if ($@) { + warn qq{$@ (running "${line}")}; + } + $self->debugobj->query_end($line) if $self->debug; } } }