From: Andy Grundman Date: Tue, 2 Aug 2005 00:42:22 +0000 (+0000) Subject: Upgraded to SQL::Abstract 1.19 syntax, imported tests from S::A X-Git-Tag: v0.03001~107 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b31e9bb77e27dbdb62e9ad0ec50f615b3dccb762;p=dbsrgits%2FDBIx-Class.git Upgraded to SQL::Abstract 1.19 syntax, imported tests from S::A --- diff --git a/lib/DBIx/Class/SQL/Abstract.pm b/lib/DBIx/Class/SQL/Abstract.pm index 8a45a2a..42657ac 100644 --- a/lib/DBIx/Class/SQL/Abstract.pm +++ b/lib/DBIx/Class/SQL/Abstract.pm @@ -6,6 +6,7 @@ sub _debug { } sub _cond_resolve { my ($self, $cond, $attrs, $join) = @_; + $cond = $self->_anoncopy($cond); # prevent destroying original my $ref = ref $cond || ''; $join ||= $attrs->{logic} || ($ref eq 'ARRAY' ? 'OR' : 'AND'); my $cmp = uc($attrs->{cmp}) || '='; @@ -15,17 +16,19 @@ sub _cond_resolve { # If an arrayref, then we join each element if ($ref eq 'ARRAY') { + use Data::Dumper; + #$self->_debug( Dumper($cond) ); # need to use while() so can shift() for arrays + my $subjoin; while (my $el = shift @$cond) { - my $subjoin = 'OR'; - + # skip empty elements, otherwise get invalid trailing AND stuff if (my $ref2 = ref $el) { if ($ref2 eq 'ARRAY') { next unless @$el; } elsif ($ref2 eq 'HASH') { next unless %$el; - $subjoin = 'AND'; + $subjoin ||= 'AND'; } elsif ($ref2 eq 'SCALAR') { # literal SQL push @sqlf, $$el; @@ -34,10 +37,11 @@ sub _cond_resolve { $self->_debug("$ref2(*top) means join with $subjoin"); } else { # top-level arrayref with scalars, recurse in pairs - $self->_debug("NOREF(*top) means join with $subjoin"); + $self->_debug("NOREF(*top) means join with $subjoin") if $subjoin; $el = {$el => shift(@$cond)}; } - push @sqlf, scalar $self->_cond_resolve($el, $attrs, $subjoin); + my @ret = $self->_cond_resolve($el, $attrs, $subjoin); + push @sqlf, shift @ret; } } elsif ($ref eq 'HASH') { @@ -45,19 +49,33 @@ sub _cond_resolve { # since it needs to point a column => value. So this be the end. for my $k (sort keys %$cond) { my $v = $cond->{$k}; - if (! defined($v)) { + if ($k =~ /^-(.*)/) { + # special nesting, like -and, -or, -nest, so shift over + my $subjoin = $self->_modlogic($attrs, uc($1)); + $self->_debug("OP(-$1) means special logic ($subjoin), recursing..."); + my @ret = $self->_cond_resolve($v, $attrs, $subjoin); + push @sqlf, shift @ret; + } elsif (! defined($v)) { # undef = null $self->_debug("UNDEF($k) means IS NULL"); push @sqlf, $k . ' IS NULL' } elsif (ref $v eq 'ARRAY') { # multiple elements: multiple options - $self->_debug("ARRAY($k) means multiple elements: [ @$v ]"); + # warnings... $self->_debug("ARRAY($k) means multiple elements: [ @$v ]"); + + # special nesting, like -and, -or, -nest, so shift over + my $subjoin = 'OR'; + if ($v->[0] =~ /^-(.*)/) { + $subjoin = $self->_modlogic($attrs, uc($1)); # override subjoin + $self->_debug("OP(-$1) means special logic ($subjoin), shifting..."); + shift @$v; + } # map into an array of hashrefs and recurse - my @w = (); - push @w, { $k => $_ } for @$v; - push @sqlf, scalar $self->_cond_resolve(\@w, $attrs, 'OR'); - + my @ret = $self->_cond_resolve([map { {$k => $_} } @$v], $attrs, $subjoin); + + # push results into our structure + push @sqlf, shift @ret; } elsif (ref $v eq 'HASH') { # modified operator { '!=', 'completed' } for my $f (sort keys %$v) { @@ -65,38 +83,44 @@ sub _cond_resolve { $self->_debug("HASH($k) means modified operator: { $f }"); # check for the operator being "IN" or "BETWEEN" or whatever - if ($f =~ /^([\s\w]+)$/i && ref $x eq 'ARRAY') { - my $u = uc($1); - if ($u =~ /BETWEEN/) { - # SQL sucks - $self->throw( "BETWEEN must have exactly two arguments" ) unless @$x == 2; - push @sqlf, join ' ', - $self->_cond_key($attrs => $k), $u, - $self->_cond_value($attrs => $k => $x->[0]), - 'AND', - $self->_cond_value($attrs => $k => $x->[1]); + if (ref $x eq 'ARRAY') { + if ($f =~ /^-?\s*(not[\s_]+)?(in|between)\s*$/i) { + my $mod = $1 ? $1 . $2 : $2; # avoid uninitialized value warnings + my $u = $self->_modlogic($attrs, uc($mod)); + $self->_debug("HASH($f => $x) uses special operator: [ $u ]"); + if ($u =~ /BETWEEN/) { + # SQL sucks + $self->throw( "BETWEEN must have exactly two arguments" ) unless @$x == 2; + push @sqlf, join ' ', + $self->_cond_key($attrs => $k), $u, + $self->_cond_value($attrs => $k => $x->[0]), + 'AND', + $self->_cond_value($attrs => $k => $x->[1]); + } else { + push @sqlf, join ' ', $self->_cond_key($attrs, $k), $u, '(', + join(', ', + map { $self->_cond_value($attrs, $k, $_) } @$x), + ')'; + } } else { - push @sqlf, join ' ', $self->_cond_key($attrs, $k), $u, '(', - join(', ', - map { $self->_cond_value($attrs, $k, $_) } @$x), - ')'; - } - } elsif (ref $x eq 'ARRAY') { - # multiple elements: multiple options - $self->_debug("ARRAY($x) means multiple elements: [ @$x ]"); - - # map into an array of hashrefs and recurse - my @w = (); - push @w, { $k => { $f => $_ } } for @$x; - push @sqlf, scalar $self->_cond_resolve(\@w, $attrs, 'OR'); + # multiple elements: multiple options + $self->_debug("ARRAY($x) means multiple elements: [ @$x ]"); + + # map into an array of hashrefs and recurse + my @ret = $self->_cond_resolve([map { {$k => {$f, $_}} } @$x], $attrs); + # push results into our structure + push @sqlf, shift @ret; + } } elsif (! defined($x)) { # undef = NOT null my $not = ($f eq '!=' || $f eq 'not like') ? ' NOT' : ''; push @sqlf, $self->_cond_key($attrs => $k) . " IS${not} NULL"; } else { # regular ol' value - push @sqlf, join ' ', $self->_cond_key($attrs => $k), $f, + $f =~ s/^-//; # strip leading -like => + $f =~ s/_/ /; # _ => " " + push @sqlf, join ' ', $self->_cond_key($attrs => $k), uc($f), $self->_cond_value($attrs => $k => $x); } } @@ -138,6 +162,22 @@ sub _cond_value { push(@{$attrs->{bind}}, $value); return '?'; } + +# Anon copies of arrays/hashes +sub _anoncopy { + my ($self, $orig) = @_; + return (ref $orig eq 'HASH' ) ? { %$orig } + : (ref $orig eq 'ARRAY') ? [ @$orig ] + : $orig; # rest passthru ok +} + +sub _modlogic { + my ($self, $attrs, $sym) = @_; + $sym ||= $attrs->{logic}; + $sym =~ tr/_/ /; + $sym = $attrs->{logic} if $sym eq 'nest'; + return uc($sym); # override join +} 1; diff --git a/t/07abstract.t b/t/07abstract.t new file mode 100644 index 0000000..698a51e --- /dev/null +++ b/t/07abstract.t @@ -0,0 +1,164 @@ +use Test::More; + +plan tests => 56; + +use DBIx::Class::SQL::Abstract; + +# Make sure to test the examples, since having them break is somewhat +# embarrassing. :-( + +my @handle_tests = ( + { + where => { + requestor => 'inna', + worker => ['nwiger', 'rcwe', 'sfz'], + status => { '!=', 'completed' } + }, + stmt => "( requestor = ? AND status != ? AND ( ( worker = ? ) OR" + . " ( worker = ? ) OR ( worker = ? ) ) )", + bind => [qw/inna completed nwiger rcwe sfz/], + }, + + { + where => { + user => 'nwiger', + status => 'completed' + }, + stmt => "( status = ? AND user = ? )", + bind => [qw/completed nwiger/], + }, + + { + where => { + user => 'nwiger', + status => { '!=', 'completed' } + }, + stmt => "( status != ? AND user = ? )", + bind => [qw/completed nwiger/], + }, + + { + where => { + status => 'completed', + reportid => { 'in', [567, 2335, 2] } + }, + stmt => "( reportid IN ( ?, ?, ? ) AND status = ? )", + bind => [qw/567 2335 2 completed/], + }, + + { + where => { + status => 'completed', + reportid => { 'not in', [567, 2335, 2] } + }, + stmt => "( reportid NOT IN ( ?, ?, ? ) AND status = ? )", + bind => [qw/567 2335 2 completed/], + }, + + { + where => { + status => 'completed', + completion_date => { 'between', ['2002-10-01', '2003-02-06'] }, + }, + stmt => "( completion_date BETWEEN ? AND ? AND status = ? )", + bind => [qw/2002-10-01 2003-02-06 completed/], + }, + + { + where => [ + { + user => 'nwiger', + status => { 'in', ['pending', 'dispatched'] }, + }, + { + user => 'robot', + status => 'unassigned', + }, + ], + stmt => "( ( status IN ( ?, ? ) AND user = ? ) OR ( status = ? AND user = ? ) )", + bind => [qw/pending dispatched nwiger unassigned robot/], + }, + + { + where => { + priority => [ {'>', 3}, {'<', 1} ], + requestor => \'is not null', + }, + stmt => "( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor is not null )", + bind => [qw/3 1/], + }, + + { + where => { + priority => [ {'>', 3}, {'<', 1} ], + requestor => { '!=', undef }, + }, + stmt => "( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor IS NOT NULL )", + bind => [qw/3 1/], + }, + + { + where => { + priority => { 'between', [1, 3] }, + requestor => { 'like', undef }, + }, + stmt => "( priority BETWEEN ? AND ? AND requestor IS NULL )", + bind => [qw/1 3/], + }, + + + { + where => { + id => 1, + num => { + '<=' => 20, + '>' => 10, + }, + }, + stmt => "( id = ? AND num <= ? AND num > ? )", + bind => [qw/1 20 10/], + }, + + { + where => { foo => {-not_like => [7,8,9]}, + fum => {'like' => [qw/a b/]}, + nix => {'between' => [100,200] }, + nox => {'not between' => [150,160] }, + wix => {'in' => [qw/zz yy/]}, + wux => {'not_in' => [qw/30 40/]} + }, + stmt => "( ( ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) OR ( foo NOT LIKE ? ) ) AND ( ( fum LIKE ? ) OR ( fum LIKE ? ) ) AND nix BETWEEN ? AND ? AND nox NOT BETWEEN ? AND ? AND wix IN ( ?, ? ) AND wux NOT IN ( ?, ? ) )", + bind => [7,8,9,'a','b',100,200,150,160,'zz','yy','30','40'], + }, + + # a couple of the more complex tests from S::A 01generate.t that test -nest, etc. + { + where => { name => {'like', '%smith%', -not_in => ['Nate','Jim','Bob','Sally']}, + -nest => [ -or => [ -and => [age => { -between => [20,30] }, age => {'!=', 25} ], + yob => {'<', 1976} ] ] }, + stmt => "( ( ( ( ( ( ( age BETWEEN ? AND ? ) AND ( age != ? ) ) ) OR ( yob < ? ) ) ) ) AND name NOT IN ( ?, ?, ?, ? ) AND name LIKE ? )", + bind => [qw(20 30 25 1976 Nate Jim Bob Sally %smith%)], + }, + + { + where => [-maybe => {race => [-and => [qw(black white asian)]]}, + {-nest => {firsttime => [-or => {'=','yes'}, undef]}}, + [ -and => {firstname => {-not_like => 'candace'}}, {lastname => {-in => [qw(jugs canyon towers)]}} ] ], + stmt => "( ( ( ( ( ( ( race = ? ) OR ( race = ? ) OR ( race = ? ) ) ) ) ) ) OR ( ( ( ( firsttime = ? ) OR ( firsttime IS NULL ) ) ) ) OR ( ( ( firstname NOT LIKE ? ) ) AND ( lastname IN ( ?, ?, ? ) ) ) )", + bind => [qw(black white asian yes candace jugs canyon towers)], + } +); + +for (@handle_tests) { + local $" = ', '; + + # run twice + for (my $i=0; $i < 2; $i++) { + my($stmt, @bind) = DBIx::Class::SQL::Abstract->_cond_resolve($_->{where}, {}); + + is($stmt, $_->{stmt}, 'SQL ok'); + cmp_ok(@bind, '==', @{$_->{bind}}, 'bind vars ok'); + } +} + +