X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=1ed743d7c15cb1c96f72f3ef40b59c73310f0217;hb=f1952f5c69e092d9ce416586f29942f8c2f66bce;hp=666d3185124f5c4fe2e62e647602d08a2544a5bc;hpb=ba61fa2a8d50d0068905aa968b7514f1136ce110;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 666d318..1ed743d 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -7,7 +7,6 @@ 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(); @@ -603,6 +602,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; @@ -910,6 +910,7 @@ sub _prep_for_execute { return ($sql, \@bind); } + sub _fix_bind_params { my ($self, @bind) = @_; @@ -931,7 +932,7 @@ sub _query_start { if ( $self->debug ) { @bind = $self->_fix_bind_params(@bind); - + $self->debugobj->query_start( $sql, @bind ); } } @@ -991,7 +992,7 @@ 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 = {}; @@ -1104,7 +1105,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) = @_; @@ -1190,53 +1191,56 @@ sub _per_row_update_delete { sub _select { my $self = shift; + + # localization is neccessary as + # 1) there is no infrastructure to pass this around (easy to do, but will wait) + # 2) _select_args sets it and _prep_for_execute consumes it my $sql_maker = $self->sql_maker; local $sql_maker->{for}; + return $self->_execute($self->_select_args(@_)); } +sub _select_args_to_query { + my $self = shift; + + # localization is neccessary as + # 1) there is no infrastructure to pass this around (easy to do, but will wait) + # 2) _select_args sets it and _prep_for_execute consumes it + 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, $prepared_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); + $prepared_bind ||= []; + + return wantarray + ? ($sql, $prepared_bind, $bind_attrs) + : \[ "($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) ) - }; - } - - # the reason this is so contrived is because we have several tables in - # from, each with its own set of bindattrs - my $alias2source; - if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { - $alias2source->{$ident->alias} = $ident; - } - elsif (ref $ident eq 'ARRAY') { + $sql_maker->{for} = delete $attrs->{for}; - for (@$ident) { - my $tabinfo; - if (ref $_ eq 'HASH') { - $tabinfo = $_; - } - if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') { - $tabinfo = $_->[0]; - } + my $order = { map + { $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () } + (qw/order_by group_by having _virtual_order_by/ ) + }; - $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-result_source} - if ($tabinfo->{-result_source}); - } - } 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) { @@ -1249,6 +1253,14 @@ sub _select_args { } } + # 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") { @@ -1264,16 +1276,46 @@ 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->{-source_handle}->resolve + if ($tabinfo->{-source_handle}); + } + } + + return $alias2source; +} + sub count { my ($self, $source, $attrs) = @_; my $tmp_attrs = { %$attrs }; - # take off any column specs, any pagers, record_filter is cdbi, and no point of ordering a count - delete $tmp_attrs->{$_} for (qw/columns +columns select +select as +as rows offset page pager order_by record_filter/); + # take off any pagers, record_filter is cdbi, and no point of ordering a count + delete $tmp_attrs->{$_} for (qw/select as rows offset page order_by record_filter/); + # overwrite the selector $tmp_attrs->{select} = { count => '*' }; - $tmp_attrs->{as} = [qw/count/]; my $tmp_rs = $source->resultset_class->new($source, $tmp_attrs); my ($count) = $tmp_rs->cursor->next; @@ -1294,7 +1336,7 @@ sub count_grouped { my $sub_attrs = { %$attrs }; # these can not go in the subquery, and there is no point of ordering it - delete $sub_attrs->{$_} for qw/prefetch collapse select +select as +as columns +columns order_by/; + delete $sub_attrs->{$_} for qw/prefetch collapse select as order_by/; # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all # simply deleting group_by suffices, as the code below will re-fill it @@ -1303,18 +1345,30 @@ sub count_grouped { delete $sub_attrs->{group_by}; } - $sub_attrs->{columns} = $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($source->primary_columns) ]; + $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($source->primary_columns) ]; + $sub_attrs->{select} = $self->_grouped_count_select ($source, $sub_attrs); $attrs->{from} = [{ count_subq => $source->resultset_class->new ($source, $sub_attrs )->as_query }]; # the subquery replaces this - delete $attrs->{$_} for qw/where bind prefetch collapse distinct group_by having having_bind rows offset page pager/; + delete $attrs->{$_} for qw/where bind prefetch collapse group_by having having_bind rows offset page pager/; return $self->count ($source, $attrs); } +# +# Returns a SELECT to go with a supplied GROUP BY +# (caled by count_grouped so a group_by is present) +# Most databases expect them to match, but some +# choke in various ways. +# +sub _grouped_count_select { + my ($self, $source, $rs_args) = @_; + return $rs_args->{group_by}; +} + sub source_bind_attributes { my ($self, $source) = @_; @@ -1502,6 +1556,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