X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=9d443a1d7f1ee032210603ee4fdb36b636264a5d;hb=3d02b69a7f40276c2791f06c8566e49b91f58441;hp=9a456d4c1cc805b7aece65af11bb087fce8395bf;hpb=26aea721d0dd94fe9920efa3c01f081642399c28;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 9a456d4..9d443a1 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -12,9 +12,8 @@ use Scalar::Util qw/refaddr weaken reftype blessed/; use List::Util qw/first/; use Context::Preserve 'preserve_context'; use Try::Tiny; -use Data::Compare (); # no imports!!! guard against insane architecture use SQL::Abstract qw(is_plain_value is_literal_value); -use DBIx::Class::_Util qw(quote_sub perlstring); +use DBIx::Class::_Util qw(quote_sub perlstring serialize detected_reinvoked_destructor); use namespace::clean; # default cursor class, overridable in connect_info attributes @@ -254,6 +253,8 @@ sub new { } sub DESTROY { + return if &detected_reinvoked_destructor; + $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK; # some databases spew warnings on implicit disconnect local $SIG{__WARN__} = sub {}; @@ -1402,7 +1403,19 @@ sub disconnect_call_do_sql { $self->_do_query(@_); } -# override in db-specific backend when necessary +=head2 connect_call_datetime_setup + +A no-op stub method, provided so that one can always safely supply the +L + + on_connect_call => 'datetime_setup' + +This way one does not need to know in advance whether the underlying +storage requires any sort of hand-holding when dealing with calendar +data. + +=cut + sub connect_call_datetime_setup { 1 } sub _do_query { @@ -2058,7 +2071,7 @@ sub _insert_bulk { # can't just hand SQLA a set of some known "values" (e.g. hashrefs that # can be later matched up by address), because we want to supply a real # value on which perhaps e.g. datatype checks will be performed - my ($proto_data, $value_type_by_col_idx); + my ($proto_data, $serialized_bind_type_by_col_idx); for my $col_idx (0..$#$cols) { my $colname = $cols->[$col_idx]; if (ref $data->[0][$col_idx] eq 'SCALAR') { @@ -2077,7 +2090,7 @@ sub _insert_bulk { # store value-less (attrs only) bind info - we will be comparing all # supplied binds against this for sanity - $value_type_by_col_idx->{$col_idx} = [ map { $_->[0] } @$resolved_bind ]; + $serialized_bind_type_by_col_idx->{$col_idx} = serialize [ map { $_->[0] } @$resolved_bind ]; $proto_data->{$colname} = \[ $sql, map { [ # inject slice order to use for $proto_bind construction @@ -2088,7 +2101,7 @@ sub _insert_bulk { ]; } else { - $value_type_by_col_idx->{$col_idx} = undef; + $serialized_bind_type_by_col_idx->{$col_idx} = undef; $proto_data->{$colname} = \[ '?', [ { dbic_colname => $colname, _bind_data_slice_idx => $col_idx } @@ -2104,7 +2117,7 @@ sub _insert_bulk { [ $proto_data ], ); - if (! @$proto_bind and keys %$value_type_by_col_idx) { + if (! @$proto_bind and keys %$serialized_bind_type_by_col_idx) { # if the bindlist is empty and we had some dynamic binds, this means the # storage ate them away (e.g. the NoBindVars component) and interpolated # them directly into the SQL. This obviously can't be good for multi-inserts @@ -2138,7 +2151,7 @@ sub _insert_bulk { for my $row_idx (1..$#$data) { # we are comparing against what we got from [0] above, hence start from 1 my $val = $data->[$row_idx][$col_idx]; - if (! exists $value_type_by_col_idx->{$col_idx}) { # literal no binds + if (! exists $serialized_bind_type_by_col_idx->{$col_idx}) { # literal no binds if (ref $val ne 'SCALAR') { $bad_slice_report_cref->( "Incorrect value (expecting SCALAR-ref \\'$$reference_val')", @@ -2154,7 +2167,7 @@ sub _insert_bulk { ); } } - elsif (! defined $value_type_by_col_idx->{$col_idx} ) { # regular non-literal value + elsif (! defined $serialized_bind_type_by_col_idx->{$col_idx} ) { # regular non-literal value if (is_literal_value($val)) { $bad_slice_report_cref->("Literal SQL found where a plain bind value is expected", $row_idx, $col_idx); } @@ -2182,16 +2195,17 @@ sub _insert_bulk { } # need to check the bind attrs - a bind will happen only once for # the entire dataset, so any changes further down will be ignored. - elsif (! Data::Compare::Compare( - $value_type_by_col_idx->{$col_idx}, - [ + elsif ( + $serialized_bind_type_by_col_idx->{$col_idx} + ne + serialize [ map { $_->[0] } @{$self->_resolve_bindattrs( $source, [ @{$$val}[1 .. $#$$val] ], $colinfos, )} - ], - )) { + ] + ) { $bad_slice_report_cref->( 'Differing bind attributes on literal/bind values not supported', $row_idx, @@ -2982,7 +2996,8 @@ sub create_ddl_dir { =back -Returns the statements used by L and L. +Returns the statements used by L +and L. The L (not L) database driver name can be explicitly provided in C<$type>, otherwise the result of L is used as default. @@ -3259,13 +3274,13 @@ transactions. You're on your own for handling all sorts of exceptional cases if you choose the C<< AutoCommit => 0 >> path, just as you would be with raw DBI. +=head1 FURTHER QUESTIONS? -=head1 AUTHOR AND CONTRIBUTORS - -See L and L in DBIx::Class +Check the list of L. -=head1 LICENSE +=head1 COPYRIGHT AND LICENSE -You may distribute this code under the same terms as Perl itself. - -=cut +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L.