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