lib/SQL/Abstract/AST/v1.pm

   1 use MooseX::Declare;
   2
   3 class SQL::Abstract::AST::v1 extends SQL::Abstract {
   4
   5   use Carp qw/croak/;
   6   use Data::Dump qw/pp/;
   7
   8   use Moose::Util::TypeConstraints;
   9   use MooseX::Types -declare => [qw/NameSeparator/];
  10   use MooseX::Types::Moose qw/ArrayRef Str Int/;
  11   use MooseX::AttributeHelpers;
  12
  13   clean;
  14
  15   # set things that are valid in where clauses
  16   override _build_where_dispatch_table {
  17     return {
  18       %{super()},
  19       -in => $self->can('_in'),
  20       -not_in => $self->can('_in'),
  21       map { +"-$_" => $self->can("_$_") } qw/
  22         value
  23         name
  24         true
  25         false
  26       /
  27     };
  28   }
  29
  30   method _select(ArrayRef $ast) {
  31
  32   }
  33
  34   method _where(ArrayRef $ast) {
  35     my (undef, @clauses) = @$ast;
  36
  37     return 'WHERE ' . $self->_recurse_where(\@clauses);
  38   }
  39
  40   method _order_by(ArrayRef $ast) {
  41     my (undef, @clauses) = @$ast;
  42
  43     my @output;
  44
  45     for (@clauses) {
  46       if ($_->[0] =~ /^-(asc|desc)$/) {
  47         my $o = $1;
  48         push @output, $self->dispatch($_->[1]) . " " . uc($o);
  49         next;
  50       }
  51       push @output, $self->dispatch($_);
  52     }
  53
  54     return "ORDER BY " . join(", ", @output);
  55   }
  56
  57   method _name(ArrayRef $ast) {
  58     my (undef, @names) = @$ast;
  59
  60     my $sep = $self->name_separator;
  61
  62     return $sep->[0] .
  63            join( $sep->[1] . $sep->[0], @names ) .
  64            $sep->[1]
  65               if (@$sep > 1);
  66
  67     return join($sep->[0], @names);
  68   }
  69
  70   method _join(ArrayRef $ast) {
  71
  72   }
  73
  74   method _list(ArrayRef $ast) {
  75     my (undef, @items) = @$ast;
  76
  77     return join(
  78       $self->list_separator,
  79       map { $self->dispatch($_) } @items);
  80   }
  81
  82   method _alias(ArrayRef $ast) {
  83     my (undef, $alias, $as) = @$ast;
  84
  85     return $self->dispatch($alias) . " AS $as";
  86
  87   }
  88
  89   method _value(ArrayRef $ast) {
  90     my ($undef, $value) = @$ast;
  91
  92     $self->add_bind($value);
  93     return "?";
  94   }
  95
  96   method _recurse_where($clauses) {
  97
  98     my $OP = 'AND';
  99     my $prio = $SQL::Abstract::PRIO{and};
 100     my $first = $clauses->[0];
 101
 102     if (!ref $first && $first =~ /^-(and|or)$/) {
 103       $OP = uc($1);
 104       $prio = $SQL::Abstract::PRIO{$1};
 105       shift @$clauses;
 106     }
 107
 108     my $dispatch_table = $self->where_dispatch_table;
 109
 110     my @output;
 111     foreach (@$clauses) {
 112       croak "invalid component in where clause: $_" unless ArrayRef->check($_);
 113       my $op = $_->[0];
 114
 115       if ($op =~ /^-(and|or)$/) {
 116         my $sub_prio = $SQL::Abstract::PRIO{$1};
 117
 118         if ($sub_prio <= $prio) {
 119           push @output, $self->_recurse_where($_);
 120         } else {
 121           push @output, '(' . $self->_recurse_where($_) . ')';
 122         }
 123       } else {
 124         push @output, $self->_where_component($_);
 125       }
 126     }
 127
 128     return join(" $OP ", @output);
 129   }
 130
 131   method _where_component($ast) {
 132     my $op = $ast->[0];
 133
 134     if (my $code = $self->lookup_where_dispatch($op)) {
 135
 136       return $code->($self, $ast);
 137
 138     }
 139     croak "'$op' is not a valid clause in a where AST"
 140       if $op =~ /^-/;
 141
 142     croak "'$op' is not a valid operator";
 143
 144   }
 145
 146
 147   method _binop($ast) {
 148     my ($op, $lhs, $rhs) = @$ast;
 149
 150     join (' ', $self->_where_component($lhs),
 151                $self->binop_mapping($op) || croak("Unknown binary operator $op"),
 152                $self->_where_component($rhs)
 153     );
 154   }
 155
 156   method _in($ast) {
 157     my ($tag, $field, @values) = @$ast;
 158
 159     my $not = $tag =~ /^-not/ ? " NOT" : "";
 160
 161     return $self->_false if @values == 0;
 162     return $self->_where_component($field) .
 163            $not.
 164            " IN (" .
 165            join(", ", map { $self->dispatch($_) } @values ) .
 166            ")";
 167   }
 168
 169   method _like($ast) {
 170     my ($tag, $field, @values) = @$ast;
 171
 172     my $not = $tag =~ /^-not/ ? " NOT" : "";
 173
 174     return $self->_false if @values == 0;
 175     return $self->_where_component($field) .
 176            $not.
 177            " LIKE " .
 178            join(", ", map { $self->_where_component($_) } @values ) .
 179            "";
 180   }
 181
 182   method _generic_func(ArrayRef $ast) {
 183   }
 184
 185   # 'constants' that are portable across DBs
 186   method _false($ast?) { "0 = 1" }
 187   method _true($ast?) { "1 = 1" }
 188
 189 }