From: Peter Rabbitson Date: Mon, 1 Jun 2009 14:41:49 +0000 (+0000) Subject: Merge 'order_by_refactor' into 'trunk' X-Git-Tag: v0.08106~43 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4c4c6184f04bd8a38aa4396e054be1a6379fc936;hp=109765190925eacd136c768c02c8fac580e4aadd;p=dbsrgits%2FDBIx-Class.git Merge 'order_by_refactor' into 'trunk' --- diff --git a/Changes b/Changes index 9c7b91e..99c933a 100644 --- a/Changes +++ b/Changes @@ -1,9 +1,17 @@ Revision history for DBIx::Class + - order_by now can take \[$sql, @bind] as in + order_by => { -desc => \['colA LIKE ?', 'somestring'] } + - SQL::Abstract errors are now properly croak()ed with the + correct trace - populate() now properly reports the dataset slice in case of an exception - fixed corner case when populate() erroneously falls back to create() + - order_by now can take \[$sql, @bind] as in + order_by => { -desc => \['colA LIKE ?', 'somestring'] } + - SQL::Abstract errors are now properly croak()ed with the + correct trace 0.08103 2009-05-26 19:50:00 (UTC) - Multiple $resultset -> count/update/delete fixes. Now any diff --git a/Makefile.PL b/Makefile.PL index 8ea186c..e0d90c4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -11,7 +11,7 @@ all_from 'lib/DBIx/Class.pm'; requires 'DBD::SQLite' => 1.25; requires 'Data::Page' => 2.00; -requires 'SQL::Abstract' => 1.55; +requires 'SQL::Abstract' => 1.56; requires 'SQL::Abstract::Limit' => 0.13; requires 'Class::C3::Componentised' => 1.0005; requires 'Carp::Clan' => 6.0; diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index 2aca425..c0b9937 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -4,7 +4,28 @@ package # Hide from PAUSE use base qw/SQL::Abstract::Limit/; use strict; use warnings; -use Carp::Clan qw/^DBIx::Class/; +use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/; + +BEGIN { + # reinstall the carp()/croak() functions imported into SQL::Abstract + # as Carp and Carp::Clan do not like each other much + no warnings qw/redefine/; + no strict qw/refs/; + for my $f (qw/carp croak/) { + my $orig = \&{"SQL::Abstract::$f"}; + *{"SQL::Abstract::$f"} = sub { + + local $Carp::CarpLevel = 1; # even though Carp::Clan ignores this, $orig will not + + if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+\(\) called/) { + __PACKAGE__->can($f)->(@_); + } + else { + $orig->(@_); + } + } + } +} sub new { my $self = shift->SUPER::new(@_); @@ -103,6 +124,7 @@ sub _Top { my $last = $rows + $offset; my $req_order = $self->_order_by ($order->{order_by}); + my $limit_order = $req_order ? $order->{order_by} : $order->{_virtual_order_by}; delete $order->{$_} for qw/order_by _virtual_order_by/; @@ -138,8 +160,8 @@ sub _find_syntax { sub select { my ($self, $table, $fields, $where, $order, @rest) = @_; - local $self->{having_bind} = []; - local $self->{from_bind} = []; + + $self->{"${_}_bind"} = [] for (qw/having from order/); if (ref $table eq 'SCALAR') { $table = $$table; @@ -164,7 +186,7 @@ sub select { ) : '' ; - return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql; + return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql; } sub insert { @@ -243,96 +265,46 @@ sub _recurse_fields { } sub _order_by { - my $self = shift; - my $ret = ''; - my @extra; - if (ref $_[0] eq 'HASH') { + my ($self, $arg) = @_; + + if (ref $arg eq 'HASH' and keys %$arg and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) { - if (defined $_[0]->{group_by}) { + my $ret = ''; + + if (defined $arg->{group_by}) { $ret = $self->_sqlcase(' group by ') - .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 }); + .$self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }); } - if (defined $_[0]->{having}) { - my $frag; - ($frag, @extra) = $self->_recurse_where($_[0]->{having}); - push(@{$self->{having_bind}}, @extra); + if (defined $arg->{having}) { + my ($frag, @bind) = $self->_recurse_where($arg->{having}); + push(@{$self->{having_bind}}, @bind); $ret .= $self->_sqlcase(' having ').$frag; } - if (defined $_[0]->{order_by}) { - $ret .= $self->_order_by($_[0]->{order_by}); - } - - if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) { - return $self->SUPER::_order_by($_[0]); + if (defined $arg->{order_by}) { + my ($frag, @bind) = $self->SUPER::_order_by($arg->{order_by}); + push(@{$self->{order_bind}}, @bind); + $ret .= $frag; } - } elsif (ref $_[0] eq 'SCALAR') { - $ret = $self->_sqlcase(' order by ').${ $_[0] }; - } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) { - my @order = map { - my $r = $self->_order_by($_, @_); - $r =~ s/^ ?ORDER BY //i; - $r || (); - } @{+shift}; - - $ret = $self->_sqlcase(' order by ') . join(', ', @order) if @order; - - } else { - $ret = $self->SUPER::_order_by(@_); + return $ret; } - return $ret; -} - -sub _order_directions { - my ($self, $order) = @_; - return $self->SUPER::_order_directions( $self->_resolve_order($order) ); -} - -sub _resolve_order { - my ($self, $order) = @_; - - if (ref $order eq 'HASH') { - $order = [$self->_resolve_order_hash($order)]; - } - elsif (ref $order eq 'ARRAY') { - $order = [map { - if (ref ($_) eq 'SCALAR') { - $$_ - } - elsif (ref ($_) eq 'HASH') { - $self->_resolve_order_hash($_) - } - else { - $_ - } - } @$order]; + else { + my ($sql, @bind) = $self->SUPER::_order_by ($arg); + push(@{$self->{order_bind}}, @bind); + return $sql; } - - return $order; } -sub _resolve_order_hash { +sub _order_directions { my ($self, $order) = @_; - my @new_order; - foreach my $key (keys %{ $order }) { - if ($key =~ /^-(desc|asc)/i ) { - my $direction = $1; - my $type = ref $order->{ $key }; - if ($type eq 'ARRAY') { - push @new_order, map( "$_ $direction", @{ $order->{ $key } } ); - } elsif (!$type) { - push @new_order, "$order->{$key} $direction"; - } else { - croak "hash order_by can only contain Scalar or Array, not $type"; - } - } else { - croak "$key is not a valid direction, use -asc or -desc"; - } - } - return @new_order; + # strip bind values - none of the current _order_directions users support them + return $self->SUPER::_order_directions( [ map + { ref $_ ? $_->[0] : $_ } + $self->_order_by_chunks ($order) + ]); } sub _table { diff --git a/t/95sql_maker.t b/t/95sql_maker.t index 48f66ac..d99d201 100644 --- a/t/95sql_maker.t +++ b/t/95sql_maker.t @@ -2,16 +2,12 @@ use strict; use warnings; use Test::More; +use Test::Exception; use lib qw(t/lib); use DBIC::SqlMakerTest; -BEGIN { - eval "use DBD::SQLite"; - plan $@ - ? ( skip_all => 'needs DBD::SQLite for testing' ) - : ( tests => 3 ); -} +plan tests => 4; use_ok('DBICTest'); @@ -52,3 +48,9 @@ my $sql_maker = $schema->storage->sql_maker; 'sql_maker passes arrayrefs in update' ); } + +# Make sure the carp/croak override in SQLA works (via SQLAHacks) +my $file = __FILE__; +throws_ok (sub { + $schema->resultset ('Artist')->search ({}, { order_by => { -asc => 'stuff', -desc => 'staff' } } )->as_query; +}, qr/$file/, 'Exception correctly croak()ed'); diff --git a/t/47bind_attribute.t b/t/bind/attribute.t similarity index 100% rename from t/47bind_attribute.t rename to t/bind/attribute.t diff --git a/t/bindtype_columns.t b/t/bind/bindtype_columns.t similarity index 100% rename from t/bindtype_columns.t rename to t/bind/bindtype_columns.t diff --git a/t/bind/order_by.t b/t/bind/order_by.t new file mode 100644 index 0000000..7a8bce6 --- /dev/null +++ b/t/bind/order_by.t @@ -0,0 +1,106 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; +use lib qw(t/lib); +use DBICTest; +use DBIC::SqlMakerTest; + +my $schema = DBICTest->init_schema; + +my $rs = $schema->resultset('FourKeys'); + +sub test_order { + + TODO: { + my $args = shift; + + local $TODO = "Not implemented" if $args->{todo}; + + lives_ok { + is_same_sql_bind( + $rs->search( + { foo => 'bar' }, + { + order_by => $args->{order_by}, + having => + [ { read_count => { '>' => 5 } }, \[ 'read_count < ?', 8 ] ] + } + )->as_query, + "( + SELECT me.foo, me.bar, me.hello, me.goodbye, me.sensors, me.read_count + FROM fourkeys me + WHERE ( foo = ? ) + HAVING read_count > ? OR read_count < ? + ORDER BY $args->{order_req} + )", + [ + [qw(foo bar)], + [qw(read_count 5)], + 8, + $args->{bind} + ? @{ $args->{bind} } + : () + ], + ); + }; + fail('Fail the unfinished is_same_sql_bind') if $@; + } +} + +my @tests = ( + { + order_by => \'foo DESC', + order_req => 'foo DESC', + bind => [], + }, + { + order_by => { -asc => 'foo' }, + order_req => 'foo ASC', + bind => [], + }, + { + order_by => { -desc => \[ 'colA LIKE ?', 'test' ] }, + order_req => 'colA LIKE ? DESC', + bind => [qw(test)], + }, + { + order_by => \[ 'colA LIKE ? DESC', 'test' ], + order_req => 'colA LIKE ? DESC', + bind => [qw(test)], + }, + { + order_by => [ + { -asc => \['colA'] }, + { -desc => \[ 'colB LIKE ?', 'test' ] }, + { -asc => \[ 'colC LIKE ?', 'tost' ] } + ], + order_req => 'colA ASC, colB LIKE ? DESC, colC LIKE ? ASC', + bind => [qw(test tost)], + }, + + # (mo) this would be really really nice! + # (ribasushi) I don't think so, not writing it - patches welcome + { + order_by => [ + { -asc => 'colA' }, + { -desc => { colB => { 'LIKE' => 'test' } } }, + { -asc => { colC => { 'LIKE' => 'tost' } } } + ], + order_req => 'colA ASC, colB LIKE ? DESC, colC LIKE ? ASC', + bind => [ [ colB => 'test' ], [ colC => 'tost' ] ], # ??? + todo => 1, + }, + { + order_by => { -desc => { colA => { LIKE => 'test' } } }, + order_req => 'colA LIKE ? DESC', + bind => [qw(test)], + todo => 1, + }, +); + +plan( tests => scalar @tests * 2 ); + +test_order($_) for @tests; +