1 package DBIx::Class::SQL::Abstract;
3 # Many thanks to SQL::Abstract, from which I stole most of this
8 my ($self, $cond, $attrs, $join) = @_;
9 $cond = $self->_anoncopy($cond); # prevent destroying original
10 my $ref = ref $cond || '';
11 $join ||= $attrs->{logic} || ($ref eq 'ARRAY' ? 'OR' : 'AND');
12 my $cmp = uc($attrs->{cmp}) || '=';
14 # For assembling SQL fields and values
17 # If an arrayref, then we join each element
18 if ($ref eq 'ARRAY') {
19 # need to use while() so can shift() for arrays
21 while (my $el = shift @$cond) {
23 # skip empty elements, otherwise get invalid trailing AND stuff
24 if (my $ref2 = ref $el) {
25 if ($ref2 eq 'ARRAY') {
27 } elsif ($ref2 eq 'HASH') {
30 } elsif ($ref2 eq 'SCALAR') {
35 $self->_debug("$ref2(*top) means join with $subjoin");
37 # top-level arrayref with scalars, recurse in pairs
38 $self->_debug("NOREF(*top) means join with $subjoin") if $subjoin;
39 $el = {$el => shift(@$cond)};
41 my @ret = $self->_cond_resolve($el, $attrs, $subjoin);
42 push @sqlf, shift @ret;
45 elsif ($ref eq 'HASH') {
46 # Note: during recursion, the last element will always be a hashref,
47 # since it needs to point a column => value. So this be the end.
48 for my $k (sort keys %$cond) {
51 # special nesting, like -and, -or, -nest, so shift over
52 my $subjoin = $self->_modlogic($attrs, uc($1));
53 $self->_debug("OP(-$1) means special logic ($subjoin), recursing...");
54 my @ret = $self->_cond_resolve($v, $attrs, $subjoin);
55 push @sqlf, shift @ret;
56 } elsif (! defined($v)) {
58 $self->_debug("UNDEF($k) means IS NULL");
59 push @sqlf, $self->_cond_key($attrs => $k) . ' IS NULL'
60 } elsif (ref $v eq 'ARRAY') {
61 # multiple elements: multiple options
62 # warnings... $self->_debug("ARRAY($k) means multiple elements: [ @$v ]");
64 # special nesting, like -and, -or, -nest, so shift over
66 if ($v->[0] =~ /^-(.*)/) {
67 $subjoin = $self->_modlogic($attrs, uc($1)); # override subjoin
68 $self->_debug("OP(-$1) means special logic ($subjoin), shifting...");
72 # map into an array of hashrefs and recurse
73 my @ret = $self->_cond_resolve([map { {$k => $_} } @$v], $attrs, $subjoin);
75 # push results into our structure
76 push @sqlf, shift @ret;
77 } elsif (ref $v eq 'HASH') {
78 # modified operator { '!=', 'completed' }
79 for my $f (sort keys %$v) {
81 $self->_debug("HASH($k) means modified operator: { $f }");
83 # check for the operator being "IN" or "BETWEEN" or whatever
84 if (ref $x eq 'ARRAY') {
85 if ($f =~ /^-?\s*(not[\s_]+)?(in|between)\s*$/i) {
86 my $mod = $1 ? $1 . $2 : $2; # avoid uninitialized value warnings
87 my $u = $self->_modlogic($attrs, uc($mod));
88 $self->_debug("HASH($f => $x) uses special operator: [ $u ]");
89 if ($u =~ /BETWEEN/) {
91 $self->throw( "BETWEEN must have exactly two arguments" ) unless @$x == 2;
93 $self->_cond_key($attrs => $k), $u,
94 $self->_cond_value($attrs => $k => $x->[0]),
96 $self->_cond_value($attrs => $k => $x->[1]);
98 push @sqlf, join ' ', $self->_cond_key($attrs, $k), $u, '(',
100 map { $self->_cond_value($attrs, $k, $_) } @$x),
104 # multiple elements: multiple options
105 $self->_debug("ARRAY($x) means multiple elements: [ @$x ]");
107 # map into an array of hashrefs and recurse
108 my @ret = $self->_cond_resolve([map { {$k => {$f, $_}} } @$x], $attrs);
110 # push results into our structure
111 push @sqlf, shift @ret;
113 } elsif (! defined($x)) {
115 my $not = ($f eq '!=' || $f eq 'not like') ? ' NOT' : '';
116 push @sqlf, $self->_cond_key($attrs => $k) . " IS${not} NULL";
119 $f =~ s/^-//; # strip leading -like =>
120 $f =~ s/_/ /; # _ => " "
121 push @sqlf, join ' ', $self->_cond_key($attrs => $k), uc($f),
122 $self->_cond_value($attrs => $k => $x);
125 } elsif (ref $v eq 'SCALAR') {
127 $self->_debug("SCALAR($k) means literal SQL: $$v");
128 push @sqlf, join ' ', $self->_cond_key($attrs => $k), $$v;
130 # standard key => val
131 $self->_debug("NOREF($k) means simple key=val: $k ${cmp} $v");
132 push @sqlf, join ' ', $self->_cond_key($attrs => $k), $cmp,
133 $self->_cond_value($attrs => $k => $v);
137 elsif ($ref eq 'SCALAR') {
139 $self->_debug("SCALAR(*top) means literal SQL: $$cond");
142 elsif (defined $cond) {
144 $self->_debug("NOREF(*top) means literal SQL: $cond");
148 # assemble and return sql
149 my $wsql = @sqlf ? '( ' . join(" $join ", @sqlf) . ' )' : '1 = 1';
150 return wantarray ? ($wsql, @{$attrs->{bind} || []}) : $wsql;
154 my ($self, $attrs, $key) = @_;
159 my ($self, $attrs, $key, $value) = @_;
160 push(@{$attrs->{bind}}, $value);
164 # Anon copies of arrays/hashes
166 my ($self, $orig) = @_;
167 return (ref $orig eq 'HASH' ) ? { %$orig }
168 : (ref $orig eq 'ARRAY') ? [ @$orig ]
169 : $orig; # rest passthru ok
173 my ($self, $attrs, $sym) = @_;
174 $sym ||= $attrs->{logic};
176 $sym = $attrs->{logic} if $sym eq 'nest';
177 return uc($sym); # override join
184 DBIx::Class::SQL::Abstract - SQL::Abstract customized for DBIC.
190 This is a customized version of L<SQL::Abstract> for use in
191 generating L<DBIx::Searchbuilder> searches.
197 Matt S. Trout <perl-stuff@trout.me.uk>
201 You may distribute this code under the same terms as Perl itself.