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::Moose qw/ArrayRef Str Int Ref HashRef/;
  10   use MooseX::AttributeHelpers;
  11   use SQL::Abstract::Types qw/AST ArrayAST HashAST/;
  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(HashAST $ast) {
  31
  32   }
  33
  34   method _where(ArrayAST $ast) {
  35     my (undef, @clauses) = @$ast;
  36
  37     return 'WHERE ' . $self->_recurse_where(\@clauses);
  38   }
  39
  40   method _order_by(ArrayAST $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(ArrayAST $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(HashAST $ast) {
  71
  72     my $output = 'JOIN ' . $self->dispatch($ast->{tablespec});
  73
  74     $output .= exists $ast->{on}
  75              ? ' ON (' . $self->_recurse_where( $ast->{on} )
  76              : ' USING (' .$self->dispatch($ast->{using} || croak "No 'on' or 'join' clause passed to -join");
  77
  78     $output .= ")";
  79     return $output;
  80
  81   }
  82
  83   method _list(ArrayAST $ast) {
  84     my (undef, @items) = @$ast;
  85
  86     return join(
  87       $self->list_separator,
  88       map { $self->dispatch($_) } @items);
  89   }
  90
  91   method _alias(ArrayAST $ast) {
  92     my (undef, $alias, $as) = @$ast;
  93
  94     return $self->dispatch($alias) . " AS $as";
  95
  96   }
  97
  98   method _value(ArrayAST $ast) {
  99     my ($undef, $value) = @$ast;
 100
 101     $self->add_bind($value);
 102     return "?";
 103   }
 104
 105   method _recurse_where(ArrayRef $clauses) {
 106
 107     my $OP = 'AND';
 108     my $prio = $SQL::Abstract::PRIO{and};
 109     my $first = $clauses->[0];
 110
 111     if (!ref $first) {
 112       if ($first =~ /^-(and|or)$/) {
 113         $OP = uc($1);
 114         $prio = $SQL::Abstract::PRIO{$1};
 115         shift @$clauses;
 116       } else {
 117         $clauses = [ $clauses ];
 118       }
 119     }
 120
 121     my $dispatch_table = $self->where_dispatch_table;
 122
 123     my @output;
 124     foreach (@$clauses) {
 125       croak "invalid component in where clause: $_" unless is_ArrayRef($_);
 126       my $op = $_->[0];
 127
 128       if ($op =~ /^-(and|or)$/) {
 129         my $sub_prio = $SQL::Abstract::PRIO{$1};
 130
 131         if ($sub_prio <= $prio) {
 132           push @output, $self->_recurse_where($_);
 133         } else {
 134           push @output, '(' . $self->_recurse_where($_) . ')';
 135         }
 136       } else {
 137         push @output, $self->_where_component($_);
 138       }
 139     }
 140
 141     return join(" $OP ", @output);
 142   }
 143
 144   method _where_component(ArrayRef $ast) {
 145     my $op = $ast->[0];
 146
 147     if (my $code = $self->lookup_where_dispatch($op)) {
 148
 149       return $code->($self, $ast);
 150
 151     }
 152     croak "'$op' is not a valid clause in a where AST"
 153       if $op =~ /^-/;
 154
 155     croak "'$op' is not a valid operator";
 156
 157   }
 158
 159
 160   method _binop(ArrayRef $ast) {
 161     my ($op, $lhs, $rhs) = @$ast;
 162
 163     join (' ', $self->_where_component($lhs),
 164                $self->binop_mapping($op) || croak("Unknown binary operator $op"),
 165                $self->_where_component($rhs)
 166     );
 167   }
 168
 169   method _in(ArrayAST $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            " IN (" .
 178            join(", ", map { $self->dispatch($_) } @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 }