X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=b668f44235e69566762cf76a34160e3dcef73345;hb=dd7ae774c024f460ef47e1c6a5b3a3d945cb9936;hp=89b9096d86abe455a63964f215579cf0a2662605;hpb=ada35b5225425ea5e0ebd7324f189553f72bb8c0;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 89b9096..b668f44 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -7,21 +7,22 @@ use strict; use warnings; use Carp::Clan qw/^DBIx::Class/; use DBI; -use DBIx::Class::SQLAHacks; use DBIx::Class::Storage::DBI::Cursor; use DBIx::Class::Storage::Statistics; -use Scalar::Util qw/blessed weaken/; +use Scalar::Util(); use List::Util(); __PACKAGE__->mk_group_accessors('simple' => qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts - _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/ + _conn_pid _conn_tid transaction_depth _dbh_autocommit _on_connect_do + _on_disconnect_do _on_connect_do_store _on_disconnect_do_store + savepoints/ ); # the values for these accessors are picked out (and deleted) from # the attribute hashref passed to connect_info my @storage_options = qw/ - on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint + on_connect_call on_disconnect_call disable_sth_caching unsafe auto_savepoint /; __PACKAGE__->mk_group_accessors('simple' => @storage_options); @@ -178,6 +179,91 @@ immediately before disconnecting from the database. Note, this only runs if you explicitly call L on the storage object. +=item on_connect_call + +A more generalized form of L that calls the specified +C methods in your storage driver. + + on_connect_do => 'select 1' + +is equivalent to: + + on_connect_call => [ [ do_sql => 'select 1' ] ] + +Its values may contain: + +=over + +=item a scalar + +Will call the C method. + +=item a code reference + +Will execute C<< $code->($storage) >> + +=item an array reference + +Each value can be a method name or code reference. + +=item an array of arrays + +For each array, the first item is taken to be the C method name +or code reference, and the rest are parameters to it. + +=back + +Some predefined storage methods you may use: + +=over + +=item do_sql + +Executes a SQL string or a code reference that returns a SQL string. This is +what L and L use. + +It can take: + +=over + +=item a scalar + +Will execute the scalar as SQL. + +=item an arrayref + +Taken to be arguments to L, the SQL string optionally followed by the +attributes hashref and bind values. + +=item a code reference + +Will execute C<< $code->($storage) >> and execute the return array refs as +above. + +=back + +=item datetime_setup + +Execute any statements necessary to initialize the database session to return +and accept datetime/timestamp values used with +L. + +Only necessary for some databases, see your specific storage driver for +implementation details. + +=back + +=item on_disconnect_call + +Takes arguments in the same form as L and executes them +immediately before disconnecting from the database. + +Calls the C methods as opposed to the +C methods called by L. + +Note, this only runs if you explicitly call L on the +storage object. + =item disable_sth_caching If set to a true value, this option will disable the caching of @@ -348,6 +434,11 @@ sub connect_info { $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val; } } + for my $connect_do_opt (qw/on_connect_do on_disconnect_do/) { + if(my $opt_val = delete $attrs{$connect_do_opt}) { + $self->$connect_do_opt($opt_val); + } + } } %attrs = () if (ref $args[0] eq 'CODE'); # _connect() never looks past $args[0] in this case @@ -360,6 +451,55 @@ sub connect_info { This method is deprecated in favour of setting via L. +=cut + +sub on_connect_do { + my $self = shift; + $self->_setup_connect_do(on_connect_do => @_); +} + +=head2 on_disconnect_do + +This method is deprecated in favour of setting via L. + +=cut + +sub on_disconnect_do { + my $self = shift; + $self->_setup_connect_do(on_disconnect_do => @_); +} + +sub _setup_connect_do { + my ($self, $opt) = (shift, shift); + + my $accessor = "_$opt"; + my $store = "_${opt}_store"; + + return $self->$accessor if not @_; + + my $val = shift; + + if (not defined $val) { + $self->$accessor(undef); + $self->$store(undef); + return; + } + + my @store; + + if (not ref($val)) { + push @store, [ 'do_sql', $val ]; + } elsif (ref($val) eq 'CODE') { + push @store, $val; + } elsif (ref($val) eq 'ARRAY') { + push @store, map [ 'do_sql', $_ ], @$val; + } else { + $self->throw_exception("Invalid type for $opt ".ref($val)); + } + + $self->$store(\@store); + $self->$accessor($val); +} =head2 dbh_do @@ -507,8 +647,12 @@ sub disconnect { my ($self) = @_; if( $self->connected ) { - my $connection_do = $self->on_disconnect_do; - $self->_do_connection_actions($connection_do) if ref($connection_do); + if (my $connection_call = $self->on_disconnect_call) { + $self->_do_connection_actions(disconnect_call_ => $connection_call) + } + if (my $connection_do = $self->_on_disconnect_do_store) { + $self->_do_connection_actions(disconnect_call_ => $connection_do) + } $self->_dbh->rollback unless $self->_dbh_autocommit; $self->_dbh->disconnect; @@ -603,6 +747,7 @@ sub sql_maker { my ($self) = @_; unless ($self->_sql_maker) { my $sql_maker_class = $self->sql_maker_class; + $self->ensure_class_loaded ($sql_maker_class); $self->_sql_maker($sql_maker_class->new( $self->_sql_maker_args )); } return $self->_sql_maker; @@ -624,8 +769,12 @@ sub _populate_dbh { # there is no transaction in progress by definition $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1; - my $connection_do = $self->on_connect_do; - $self->_do_connection_actions($connection_do) if $connection_do; + if (my $connection_call = $self->on_connect_call) { + $self->_do_connection_actions(connect_call_ => $connection_call) + } + if (my $connection_do = $self->_on_connect_do_store) { + $self->_do_connection_actions(connect_call_ => $connection_do) + } } sub _determine_driver { @@ -650,25 +799,41 @@ sub _determine_driver { } sub _do_connection_actions { - my $self = shift; - my $connection_do = shift; - - if (!ref $connection_do) { - $self->_do_query($connection_do); - } - elsif (ref $connection_do eq 'ARRAY') { - $self->_do_query($_) foreach @$connection_do; - } - elsif (ref $connection_do eq 'CODE') { - $connection_do->($self); - } - else { - $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) ); + my $self = shift; + my $method_prefix = shift; + my $call = shift; + + if (not ref($call)) { + my $method = $method_prefix . $call; + $self->$method(@_); + } elsif (ref($call) eq 'CODE') { + $self->$call(@_); + } elsif (ref($call) eq 'ARRAY') { + if (ref($call->[0]) ne 'ARRAY') { + $self->_do_connection_actions($method_prefix, $_) for @$call; + } else { + $self->_do_connection_actions($method_prefix, @$_) for @$call; + } + } else { + $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) ); } return $self; } +sub connect_call_do_sql { + my $self = shift; + $self->_do_query(@_); +} + +sub disconnect_call_do_sql { + my $self = shift; + $self->_do_query(@_); +} + +# override in db-specific backend when necessary +sub connect_call_datetime_setup { 1 } + sub _do_query { my ($self, $action) = @_; @@ -717,7 +882,7 @@ sub _connect { if($dbh && !$self->unsafe) { my $weak_self = $self; - weaken($weak_self); + Scalar::Util::weaken($weak_self); $dbh->{HandleError} = sub { if ($weak_self) { $weak_self->throw_exception("DBI Exception: $_[0]"); @@ -898,7 +1063,7 @@ sub txn_rollback { sub _prep_for_execute { my ($self, $op, $extra_bind, $ident, $args) = @_; - if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { + if( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { $ident = $ident->from(); } @@ -910,6 +1075,7 @@ sub _prep_for_execute { return ($sql, \@bind); } + sub _fix_bind_params { my ($self, @bind) = @_; @@ -931,7 +1097,7 @@ sub _query_start { if ( $self->debug ) { @bind = $self->_fix_bind_params(@bind); - + $self->debugobj->query_start( $sql, @bind ); } } @@ -990,8 +1156,8 @@ sub _execute { sub insert { my ($self, $source, $to_insert) = @_; - - my $ident = $source->from; + + my $ident = $source->from; my $bind_attributes = $self->source_bind_attributes($source); my $updated_cols = {}; @@ -1092,7 +1258,7 @@ sub delete { my $self = shift @_; my $source = shift @_; - my $bind_attrs = {}; ## If ever it's needed... + my $bind_attrs = $self->source_bind_attributes($source); return $self->_execute('delete' => [], $source, $bind_attrs, @_); } @@ -1104,7 +1270,7 @@ sub delete { # Genarating a single PK column subquery is trivial and supported # by all RDBMS. However if we have a multicolumn PK, things get ugly. # Look at _multipk_update_delete() -sub subq_update_delete { +sub _subq_update_delete { my $self = shift; my ($rs, $op, $values) = @_; @@ -1195,25 +1361,60 @@ sub _select { return $self->_execute($self->_select_args(@_)); } +sub _select_args_to_query { + my $self = shift; + + my $sql_maker = $self->sql_maker; + local $sql_maker->{for}; + + # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset) + # = $self->_select_args($ident, $select, $cond, $attrs); + my ($op, $bind, $ident, $bind_attrs, @args) = + $self->_select_args(@_); + + # my ($sql, $bind) = $self->_prep_for_execute($op, $bind, $ident, [ $select, $cond, $order, $rows, $offset ]); + my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, \@args); + + return \[ "($sql)", @{ $prepared_bind || [] }]; +} + sub _select_args { my ($self, $ident, $select, $condition, $attrs) = @_; - my $order = $attrs->{order_by}; my $for = delete $attrs->{for}; my $sql_maker = $self->sql_maker; $sql_maker->{for} = $for; - my @in_order_attrs = qw/group_by having _virtual_order_by/; - if (List::Util::first { exists $attrs->{$_} } (@in_order_attrs) ) { - $order = { - ($order - ? (order_by => $order) - : () - ), - ( map { $_ => $attrs->{$_} } (@in_order_attrs) ) - }; + my $order = { map + { $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () } + (qw/order_by group_by having _virtual_order_by/ ) + }; + + + my $bind_attrs = {}; + + my $alias2source = $self->_resolve_ident_sources ($ident); + + for my $alias (keys %$alias2source) { + my $bindtypes = $self->source_bind_attributes ($alias2source->{$alias}) || {}; + for my $col (keys %$bindtypes) { + + my $fqcn = join ('.', $alias, $col); + $bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col}; + + # so that unqualified searches can be bound too + $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq 'me'; + } } - my $bind_attrs = {}; ## Future support + + # This would be the point to deflate anything found in $condition + # (and leave $attrs->{bind} intact). Problem is - inflators historically + # expect a row object. And all we have is a resultsource (it is trivial + # to extract deflator coderefs via $alias2source above). + # + # I don't see a way forward other than changing the way deflators are + # invoked, and that's just bad... + my @args = ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $condition, $order); if ($attrs->{software_limit} || $sql_maker->_default_limit_syntax eq "GenericSubQ") { @@ -1229,6 +1430,36 @@ sub _select_args { return @args; } +sub _resolve_ident_sources { + my ($self, $ident) = @_; + + my $alias2source = {}; + + # the reason this is so contrived is that $ident may be a {from} + # structure, specifying multiple tables to join + if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { + # this is compat mode for insert/update/delete which do not deal with aliases + $alias2source->{me} = $ident; + } + elsif (ref $ident eq 'ARRAY') { + + for (@$ident) { + my $tabinfo; + if (ref $_ eq 'HASH') { + $tabinfo = $_; + } + if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') { + $tabinfo = $_->[0]; + } + + $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-result_source} + if ($tabinfo->{-result_source}); + } + } + + return $alias2source; +} + sub count { my ($self, $source, $attrs) = @_; @@ -1269,7 +1500,7 @@ sub count_grouped { } $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($source->primary_columns) ]; - $sub_attrs->{select} = $self->_grouped_count_select ($sub_attrs); + $sub_attrs->{select} = $self->_grouped_count_select ($source, $sub_attrs); $attrs->{from} = [{ count_subq => $source->resultset_class->new ($source, $sub_attrs )->as_query @@ -1288,8 +1519,8 @@ sub count_grouped { # choke in various ways. # sub _grouped_count_select { - my ($self, $attrs) = @_; - return $attrs->{group_by}; + my ($self, $source, $rs_args) = @_; + return $rs_args->{group_by}; } sub source_bind_attributes { @@ -1479,6 +1710,27 @@ sub bind_attribute_by_data_type { return; } +=head2 is_datatype_numeric + +Given a datatype from column_info, returns a boolean value indicating if +the current RDBMS considers it a numeric value. This controls how +L decides whether to mark the column as +dirty - when the datatype is deemed numeric a C<< != >> comparison will +be performed instead of the usual C. + +=cut + +sub is_datatype_numeric { + my ($self, $dt) = @_; + + return 0 unless $dt; + + return $dt =~ /^ (?: + numeric | int(?:eger)? | (?:tiny|small|medium|big)int | dec(?:imal)? | real | float | double (?: \s+ precision)? | (?:big)?serial + ) $/ix; +} + + =head2 create_ddl_dir (EXPERIMENTAL) =over 4