From: Peter Rabbitson Date: Wed, 28 Apr 2010 09:10:00 +0000 (+0000) Subject: Refactor SQLA/select interaction (in reality just cleanup) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a6b68a60b376e918a6058f37cb1115ba3163a59b;p=dbsrgits%2FDBIx-Class-Historic.git Refactor SQLA/select interaction (in reality just cleanup) --- diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index 172136b..5e3ab35 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -49,21 +49,21 @@ sub new { # ANSI standard Limit/Offset implementation. DB2 and MSSQL use this sub _RowNumberOver { - my ($self, $sql, $order, $rows, $offset ) = @_; + my ($self, $sql, $rs_attrs, $rows, $offset ) = @_; # get the select to make the final amount of columns equal the original one my ($select) = $sql =~ /^ \s* SELECT \s+ (.+?) \s+ FROM/ix or croak "Unrecognizable SELECT: $sql"; - # get the order_by only (or make up an order if none exists) + # make up an order if none exists my $order_by = $self->_order_by( - (delete $order->{order_by}) || $self->_rno_default_order + (delete $rs_attrs->{order_by}) || $self->_rno_default_order ); # whatever is left of the order_by - my $group_having = $self->_order_by($order); + my $group_having = $self->_parse_rs_attrs($rs_attrs); - my $qalias = $self->_quote ($self->{_dbic_rs_attrs}{alias}); + my $qalias = $self->_quote ($rs_attrs->{alias}); $sql = sprintf (<_order_by ($order), + $self->_parse_rs_attrs ($rs_attrs), ); } # Firebird specific limit, reverse of _SkipFirst for Informix sub _FirstSkip { - my ($self, $sql, $order, $rows, $offset) = @_; + my ($self, $sql, $rs_attrs, $rows, $offset) = @_; $sql =~ s/^ \s* SELECT \s+ //ix or croak "Unrecognizable SELECT: $sql"; @@ -116,13 +116,13 @@ sub _FirstSkip { : '' , $sql, - $self->_order_by ($order), + $self->_parse_rs_attrs ($rs_attrs), ); } # Crappy Top based Limit/Offset support. Legacy from MSSQL. sub _Top { - my ( $self, $sql, $order, $rows, $offset ) = @_; + my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; # mangle the input sql so it can be properly aliased in the outer queries $sql =~ s/^ \s* SELECT \s+ (.+?) \s+ (?=FROM)//ix @@ -131,12 +131,12 @@ sub _Top { my @sql_select = split (/\s*,\s*/, $sql_select); # we can't support subqueries (in fact MSSQL can't) - croak - if (@sql_select != @{$self->{_dbic_rs_attrs}{select}}) { + if (@sql_select != @{$rs_attrs->{select}}) { croak (sprintf ( 'SQL SELECT did not parse cleanly - retrieved %d comma separated elements, while ' . 'the resultset select attribure contains %d elements: %s', scalar @sql_select, - scalar @{$self->{_dbic_rs_attrs}{select}}, + scalar @{$rs_attrs->{select}}, $sql_select, )); } @@ -145,13 +145,13 @@ sub _Top { my $esc_name_sep = "\Q$name_sep\E"; my $col_re = qr/ ^ (?: (.+) $esc_name_sep )? ([^$esc_name_sep]+) $ /x; - my $rs_alias = $self->{_dbic_rs_attrs}{alias}; + my $rs_alias = $rs_attrs->{alias}; my $quoted_rs_alias = $self->_quote ($rs_alias); # construct the new select lists, rename(alias) some columns if necessary my (@outer_select, @inner_select, %seen_names, %col_aliases, %outer_col_aliases); - for (@{$self->{_dbic_rs_attrs}{select}}) { + for (@{$rs_attrs->{select}}) { next if ref $_; my ($table, $orig_colname) = ( $_ =~ $col_re ); next unless $table; @@ -160,7 +160,7 @@ sub _Top { for my $i (0 .. $#sql_select) { - my $colsel_arg = $self->{_dbic_rs_attrs}{select}[$i]; + my $colsel_arg = $rs_attrs->{select}[$i]; my $colsel_sql = $sql_select[$i]; # this may or may not work (in case of a scalarref or something) @@ -217,34 +217,29 @@ sub _Top { %outer_col_aliases = (%outer_col_aliases, %col_aliases); # deal with order - croak '$order supplied to SQLAHacks limit emulators must be a hash' - if (ref $order ne 'HASH'); + croak '$order/attr container supplied to SQLAHacks limit emulators must be a hash' + if (ref $rs_attrs ne 'HASH'); - $order = { %$order }; #copy - - my $req_order = $order->{order_by}; + my $req_order = $rs_attrs->{order_by}; # examine normalized version, collapses nesting - my $limit_order; - if (scalar $self->_order_by_chunks ($req_order)) { - $limit_order = $req_order; - } - else { - $limit_order = [ map + my $limit_order = scalar $self->_order_by_chunks ($req_order) + ? $req_order + : [ map { join ('', $rs_alias, $name_sep, $_ ) } - ( $self->{_dbic_rs_attrs}{_source_handle}->resolve->primary_columns ) - ]; - } + ( $rs_attrs->{_rsroot_source_handle}->resolve->primary_columns ) + ] + ; my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order); my $order_by_requested = $self->_order_by ($req_order); # generate the rest - delete $order->{order_by}; - my $grpby_having = $self->_order_by ($order); + delete $rs_attrs->{order_by}; + my $grpby_having = $self->_parse_rs_attrs ($rs_attrs); # short circuit for counts - the ordering complexity is needless - if ($self->{_dbic_rs_attrs}{-for_count_only}) { + if ($rs_attrs->{-for_count_only}) { return "SELECT TOP $rows $inner_select $sql $grpby_having $order_by_outer"; } @@ -320,14 +315,10 @@ sub _find_syntax { return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax); } -my $for_syntax = { - update => 'FOR UPDATE', - shared => 'FOR SHARE', -}; # Quotes table names, handles "limit" dialects (e.g. where rownum between x and -# y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE. +# y) sub select { - my ($self, $table, $fields, $where, $order, @rest) = @_; + my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_; $self->{"${_}_bind"} = [] for (qw/having from order/); @@ -340,13 +331,10 @@ sub select { @rest = (-1) unless defined $rest[0]; croak "LIMIT 0 Does Not Compute" if $rest[0] == 0; # and anyway, SQL::Abstract::Limit will cause a barf if we don't first + my ($sql, @where_bind) = $self->SUPER::select( - $table, $self->_recurse_fields($fields), $where, $order, @rest + $table, $self->_recurse_fields($fields), $where, $rs_attrs, @rest ); - if (my $for = delete $self->{_dbic_rs_attrs}{for}) { - $sql .= " $for_syntax->{$for}" if $for_syntax->{$for}; - } - return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql; } @@ -390,8 +378,10 @@ sub delete { sub _emulate_limit { my $self = shift; + # my ( $syntax, $sql, $order, $rows, $offset ) = @_; + if ($_[3] == -1) { - return $_[1].$self->_order_by($_[2]); + return $_[1] . $self->_parse_rs_attrs($_[2]); } else { return $self->SUPER::_emulate_limit(@_); } @@ -451,34 +441,55 @@ sub _recurse_fields { } } -sub _order_by { +my $for_syntax = { + update => 'FOR UPDATE', + shared => 'FOR SHARE', +}; + +# this used to be a part of _order_by but is broken out for clarity. +# What we have been doing forever is hijacking the $order arg of +# SQLA::select to pass in arbitrary pieces of data (first the group_by, +# then pretty much the entire resultset attr-hash, as more and more +# things in the SQLA space need to have mopre info about the $rs they +# create SQL for. The alternative would be to keep expanding the +# signature of _select with more and more positional parameters, which +# is just gross. All hail SQLA2! +sub _parse_rs_attrs { my ($self, $arg) = @_; - if (ref $arg eq 'HASH' and keys %$arg and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) { + my $sql = ''; - my $ret = ''; + if (my $g = $self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }) ) { + $sql .= $self->_sqlcase(' group by ') . $g; + } - if (my $g = $self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }) ) { - $ret = $self->_sqlcase(' group by ') . $g; - } + if (defined $arg->{having}) { + my ($frag, @bind) = $self->_recurse_where($arg->{having}); + push(@{$self->{having_bind}}, @bind); + $sql .= $self->_sqlcase(' having ') . $frag; + } - if (defined $arg->{having}) { - my ($frag, @bind) = $self->_recurse_where($arg->{having}); - push(@{$self->{having_bind}}, @bind); - $ret .= $self->_sqlcase(' having ').$frag; - } + if (defined $arg->{order_by}) { + $sql .= $self->_order_by ($arg->{order_by}); + } - if (defined $arg->{order_by}) { - my ($frag, @bind) = $self->SUPER::_order_by($arg->{order_by}); - push(@{$self->{order_bind}}, @bind); - $ret .= $frag; - } + if (my $for = $arg->{for}) { + $sql .= " $for_syntax->{$for}" if $for_syntax->{$for}; + } + + return $sql; +} + +sub _order_by { + my ($self, $arg) = @_; - return $ret; + # check that we are not called in legacy mode (order_by as 4th argument) + if (ref $arg eq 'HASH' and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) { + return $self->_parse_rs_attrs ($arg); } else { my ($sql, @bind) = $self->SUPER::_order_by ($arg); - push(@{$self->{order_bind}}, @bind); + push @{$self->{order_bind}}, @bind; return $sql; } } diff --git a/lib/DBIx/Class/SQLAHacks/OracleJoins.pm b/lib/DBIx/Class/SQLAHacks/OracleJoins.pm index 3a7e059..4254aba 100644 --- a/lib/DBIx/Class/SQLAHacks/OracleJoins.pm +++ b/lib/DBIx/Class/SQLAHacks/OracleJoins.pm @@ -5,13 +5,13 @@ use base qw( DBIx::Class::SQLAHacks ); use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/; sub select { - my ($self, $table, $fields, $where, $order, @rest) = @_; + my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_; if (ref($table) eq 'ARRAY') { $where = $self->_oracle_joins($where, @{ $table }); } - return $self->SUPER::select($table, $fields, $where, $order, @rest); + return $self->SUPER::select($table, $fields, $where, $rs_attrs, @rest); } sub _recurse_from { diff --git a/lib/DBIx/Class/SQLAHacks/SQLite.pm b/lib/DBIx/Class/SQLAHacks/SQLite.pm index dfc77ae..e260786 100644 --- a/lib/DBIx/Class/SQLAHacks/SQLite.pm +++ b/lib/DBIx/Class/SQLAHacks/SQLite.pm @@ -6,12 +6,16 @@ use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/; # # SQLite does not understand SELECT ... FOR UPDATE -# Adjust SQL here instead +# Disable it here # -sub select { - my $self = shift; - local $self->{_dbic_rs_attrs}{for} = undef; - return $self->SUPER::select (@_); +sub _parse_rs_attrs { + my ($self, $attrs) = @_; + + return $self->SUPER::_parse_rs_attrs ($attrs) + if ref $attrs ne 'HASH'; + + local $attrs->{for}; + return $self->SUPER::_parse_rs_attrs ($attrs); } 1; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index ac90066..1acd60e 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1842,31 +1842,18 @@ sub _per_row_update_delete { sub _select { my $self = shift; - - # localization is neccessary as - # 1) there is no infrastructure to pass this around before SQLA2 - # 2) _select_args sets it and _prep_for_execute consumes it - my $sql_maker = $self->sql_maker; - local $sql_maker->{_dbic_rs_attrs}; - - return $self->_execute($self->_select_args(@_)); + $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 before SQLA2 - # 2) _select_args sets it and _prep_for_execute consumes it - my $sql_maker = $self->sql_maker; - local $sql_maker->{_dbic_rs_attrs}; - - # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset) + # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $rs_attrs, $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, [ $select, $cond, $rs_attrs, $rows, $offset ]); my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, \@args); $prepared_bind ||= []; @@ -1879,16 +1866,16 @@ sub _select_args_to_query { sub _select_args { my ($self, $ident, $select, $where, $attrs) = @_; + my $sql_maker = $self->sql_maker; my ($alias2source, $rs_alias) = $self->_resolve_ident_sources ($ident); - my $sql_maker = $self->sql_maker; - $sql_maker->{_dbic_rs_attrs} = { + $attrs = { %$attrs, select => $select, from => $ident, where => $where, $rs_alias && $alias2source->{$rs_alias} - ? ( _source_handle => $alias2source->{$rs_alias}->handle ) + ? ( _rsroot_source_handle => $alias2source->{$rs_alias}->handle ) : () , }; @@ -2018,12 +2005,7 @@ sub _select_args { # invoked, and that's just bad... ### - my $order = { map - { $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () } - (qw/order_by group_by having/ ) - }; - - return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit); + return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $attrs, @limit); } # Returns a counting SELECT for a simple count diff --git a/t/sqlahacks/sql_maker/sql_maker_quote.t b/t/sqlahacks/sql_maker/sql_maker_quote.t index dce696b..4392cc2 100644 --- a/t/sqlahacks/sql_maker/sql_maker_quote.t +++ b/t/sqlahacks/sql_maker/sql_maker_quote.t @@ -48,7 +48,7 @@ my ($sql, @bind) = $sql_maker->select( 'artist.name' => 'Caterwauler McCrae', 'me.year' => 2001 }, - [], + {}, undef, undef ); @@ -80,7 +80,7 @@ is_same_sql_bind( 'me.year' ], undef, - 'year DESC', + { order_by => 'year DESC' }, undef, undef ); @@ -105,10 +105,10 @@ is_same_sql_bind( 'me.year' ], undef, - [ + { order_by => [ 'year DESC', 'title ASC' - ], + ]}, undef, undef ); @@ -133,7 +133,7 @@ is_same_sql_bind( 'me.year' ], undef, - { -desc => 'year' }, + { order_by => { -desc => 'year' } }, undef, undef ); @@ -158,10 +158,10 @@ is_same_sql_bind( 'me.year' ], undef, - [ + { order_by => [ { -desc => 'year' }, - { -asc => 'title' } - ], + { -asc => 'title' }, + ]}, undef, undef ); @@ -188,7 +188,7 @@ is_same_sql_bind( 'me.year' ], undef, - \'year DESC', + { order_by => \'year DESC' }, undef, undef ); @@ -213,10 +213,10 @@ is_same_sql_bind( 'me.year' ], undef, - [ + { order_by => [ \'year DESC', \'title ASC' - ], + ]}, undef, undef ); @@ -283,9 +283,9 @@ is_same_sql_bind( 'me.*' ], undef, - [], undef, - undef + undef, + undef, ); is_same_sql_bind( @@ -328,9 +328,9 @@ $sql_maker->quote_char([qw/[ ]/]); 'artist.name' => 'Caterwauler McCrae', 'me.year' => 2001 }, - [], undef, - undef + undef, + undef, ); is_same_sql_bind(