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}) || '=';
# 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;
$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') {
# 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) {
$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);
}
}
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;
--- /dev/null
+use Test::More;\r
+\r
+plan tests => 56;\r
+\r
+use DBIx::Class::SQL::Abstract;\r
+\r
+# Make sure to test the examples, since having them break is somewhat\r
+# embarrassing. :-(\r
+\r
+my @handle_tests = (\r
+ {\r
+ where => {\r
+ requestor => 'inna',\r
+ worker => ['nwiger', 'rcwe', 'sfz'],\r
+ status => { '!=', 'completed' }\r
+ },\r
+ stmt => "( requestor = ? AND status != ? AND ( ( worker = ? ) OR"\r
+ . " ( worker = ? ) OR ( worker = ? ) ) )",\r
+ bind => [qw/inna completed nwiger rcwe sfz/],\r
+ },\r
+\r
+ {\r
+ where => {\r
+ user => 'nwiger',\r
+ status => 'completed'\r
+ },\r
+ stmt => "( status = ? AND user = ? )",\r
+ bind => [qw/completed nwiger/],\r
+ },\r
+\r
+ {\r
+ where => {\r
+ user => 'nwiger',\r
+ status => { '!=', 'completed' }\r
+ },\r
+ stmt => "( status != ? AND user = ? )",\r
+ bind => [qw/completed nwiger/],\r
+ },\r
+\r
+ {\r
+ where => {\r
+ status => 'completed',\r
+ reportid => { 'in', [567, 2335, 2] }\r
+ },\r
+ stmt => "( reportid IN ( ?, ?, ? ) AND status = ? )",\r
+ bind => [qw/567 2335 2 completed/],\r
+ },\r
+\r
+ {\r
+ where => {\r
+ status => 'completed',\r
+ reportid => { 'not in', [567, 2335, 2] }\r
+ },\r
+ stmt => "( reportid NOT IN ( ?, ?, ? ) AND status = ? )",\r
+ bind => [qw/567 2335 2 completed/],\r
+ },\r
+\r
+ {\r
+ where => {\r
+ status => 'completed',\r
+ completion_date => { 'between', ['2002-10-01', '2003-02-06'] },\r
+ },\r
+ stmt => "( completion_date BETWEEN ? AND ? AND status = ? )",\r
+ bind => [qw/2002-10-01 2003-02-06 completed/],\r
+ },\r
+\r
+ {\r
+ where => [\r
+ {\r
+ user => 'nwiger',\r
+ status => { 'in', ['pending', 'dispatched'] },\r
+ },\r
+ {\r
+ user => 'robot',\r
+ status => 'unassigned',\r
+ },\r
+ ],\r
+ stmt => "( ( status IN ( ?, ? ) AND user = ? ) OR ( status = ? AND user = ? ) )",\r
+ bind => [qw/pending dispatched nwiger unassigned robot/],\r
+ },\r
+\r
+ {\r
+ where => { \r
+ priority => [ {'>', 3}, {'<', 1} ],\r
+ requestor => \'is not null',\r
+ },\r
+ stmt => "( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor is not null )",\r
+ bind => [qw/3 1/],\r
+ },\r
+\r
+ {\r
+ where => { \r
+ priority => [ {'>', 3}, {'<', 1} ],\r
+ requestor => { '!=', undef }, \r
+ },\r
+ stmt => "( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor IS NOT NULL )",\r
+ bind => [qw/3 1/],\r
+ },\r
+\r
+ {\r
+ where => { \r
+ priority => { 'between', [1, 3] },\r
+ requestor => { 'like', undef }, \r
+ },\r
+ stmt => "( priority BETWEEN ? AND ? AND requestor IS NULL )",\r
+ bind => [qw/1 3/],\r
+ },\r
+\r
+\r
+ {\r
+ where => { \r
+ id => 1,\r
+ num => {\r
+ '<=' => 20,\r
+ '>' => 10,\r
+ },\r
+ },\r
+ stmt => "( id = ? AND num <= ? AND num > ? )",\r
+ bind => [qw/1 20 10/],\r
+ },\r
+\r
+ {\r
+ where => { foo => {-not_like => [7,8,9]},\r
+ fum => {'like' => [qw/a b/]},\r
+ nix => {'between' => [100,200] },\r
+ nox => {'not between' => [150,160] },\r
+ wix => {'in' => [qw/zz yy/]},\r
+ wux => {'not_in' => [qw/30 40/]}\r
+ },\r
+ 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 ( ?, ? ) )",\r
+ bind => [7,8,9,'a','b',100,200,150,160,'zz','yy','30','40'],\r
+ },\r
+ \r
+ # a couple of the more complex tests from S::A 01generate.t that test -nest, etc.\r
+ {\r
+ where => { name => {'like', '%smith%', -not_in => ['Nate','Jim','Bob','Sally']},\r
+ -nest => [ -or => [ -and => [age => { -between => [20,30] }, age => {'!=', 25} ],\r
+ yob => {'<', 1976} ] ] },\r
+ stmt => "( ( ( ( ( ( ( age BETWEEN ? AND ? ) AND ( age != ? ) ) ) OR ( yob < ? ) ) ) ) AND name NOT IN ( ?, ?, ?, ? ) AND name LIKE ? )",\r
+ bind => [qw(20 30 25 1976 Nate Jim Bob Sally %smith%)],\r
+ },\r
+ \r
+ {\r
+ where => [-maybe => {race => [-and => [qw(black white asian)]]},\r
+ {-nest => {firsttime => [-or => {'=','yes'}, undef]}},\r
+ [ -and => {firstname => {-not_like => 'candace'}}, {lastname => {-in => [qw(jugs canyon towers)]}} ] ],\r
+ stmt => "( ( ( ( ( ( ( race = ? ) OR ( race = ? ) OR ( race = ? ) ) ) ) ) ) OR ( ( ( ( firsttime = ? ) OR ( firsttime IS NULL ) ) ) ) OR ( ( ( firstname NOT LIKE ? ) ) AND ( lastname IN ( ?, ?, ? ) ) ) )",\r
+ bind => [qw(black white asian yes candace jugs canyon towers)],\r
+ }\r
+);\r
+\r
+for (@handle_tests) {\r
+ local $" = ', '; \r
+\r
+ # run twice\r
+ for (my $i=0; $i < 2; $i++) {\r
+ my($stmt, @bind) = DBIx::Class::SQL::Abstract->_cond_resolve($_->{where}, {});\r
+\r
+ is($stmt, $_->{stmt}, 'SQL ok');\r
+ cmp_ok(@bind, '==', @{$_->{bind}}, 'bind vars ok');\r
+ }\r
+}\r
+\r
+\r
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff