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   method dispatch (ArrayRef $ast) {
  16
  17     local $_ = $ast->[0];
  18     s/^-/_/g or croak "Unknown type tag '$_'";
  19     my $meth = $self->can($_) || \&_generic_func;
  20     return $meth->($self, $ast);
  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 @output;
 102     foreach (@$clauses) {
 103       croak "invalid component in where clause" unless ArrayRef->check($_);
 104       my $op = $_->[0];
 105
 106       unless (substr($op, 0, 1) eq '-') {
 107         # A simple comparison op (==, >, etc.)
 108
 109         push @output, $self->_binop(@$_);
 110
 111       } elsif ($op =~ /^-(and|or)$/) {
 112         my $sub_prio = $SQL::Abstract::PRIO{$1};
 113
 114         if ($sub_prio <= $prio) {
 115           push @output, $self->_recurse_where($_);
 116         } else {
 117           push @output, '(' . $self->_recurse_where($_) . ')';
 118         }
 119       } else {
 120         push @output, $self->dispatch($_);
 121       }
 122     }
 123
 124     return join(" $OP ", @output);
 125   }
 126
 127   method _binop($op, $lhs, $rhs) {
 128     join (' ', $self->dispatch($lhs),
 129                $SQL::Abstract::OP_MAP{$op} || croak("Unknown binary operator $op"),
 130                $self->dispatch($rhs)
 131     );
 132   }
 133
 134   method _in($ast) {
 135     my (undef, $field, @values) = @$ast;
 136
 137     return $self->_false if @values == 0;
 138     return $self->dispatch($field) .
 139            " IN (" .
 140            join(", ", map { $self->dispatch($_) } @values ) .
 141            ")";
 142   }
 143
 144   method _generic_func(ArrayRef $ast) {
 145   }
 146
 147   # 'constants' that are portable across DBs
 148   method _false($ast?) { "0 = 1" }
 149   method _true($ast?) { "1 = 1" }
 150
 151 }