lib/SQL/Abstract/AST/Compat.pm

   1 use MooseX::Declare;
   2
   3 class SQL::Abstract::AST::Compat {
   4
   5   use MooseX::Types::Moose qw/ArrayRef HashRef Str ScalarRef/;
   6   use SQL::Abstract::Types qw/AST/;
   7   use SQL::Abstract::Types::Compat ':all';
   8   use Devel::PartialDump qw/dump/;
   9   use Carp qw/croak/;
  10
  11   clean;
  12
  13   has logic => (
  14     is => 'rw',
  15     isa => LogicEnum,
  16     default => 'AND'
  17   );
  18
  19   sub mk_name {
  20     shift;
  21     return { -type => 'name', args => [ @_ ] };
  22   }
  23
  24   method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
  25                 WhereType $where?,
  26                 WhereType $order?)
  27   {
  28     my $ast = {
  29       -type => 'select',
  30       columns => [
  31         map {
  32           $self->mk_name($_)
  33         } ( is_Str($fields) ? $fields : @$fields )
  34       ],
  35       tablespec => $self->tablespec($from)
  36     };
  37
  38
  39     $ast->{where} = $self->recurse_where($where)
  40       if defined $where;
  41
  42     return $ast;
  43   }
  44
  45   method tablespec(Str|ArrayRef|ScalarRef $from) {
  46     return $self->mk_name($from)
  47       if is_Str($from);
  48   }
  49
  50   method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
  51     return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
  52     return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
  53     croak "Unknown where clause type " . dump($ast);
  54   }
  55
  56   method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
  57     my @args;
  58     my $ret = {
  59       -type => 'expr',
  60       op => lc $logic,
  61       args => \@args
  62     };
  63
  64     while (my ($key,$value) = each %$ast) {
  65       if ($key =~ /^-(or|and)$/) {
  66         my $val = $self->recurse_where($value, uc $1);
  67         if ($val->{op} eq $ret->{op}) {
  68           push @args, @{$val->{args}};
  69         }
  70         else {
  71           push @args, $val;
  72         }
  73         next;
  74       }
  75
  76       push @args, $self->field($key, $value);
  77     }
  78
  79     return $args[0] if @args == 1;
  80
  81     return $ret;
  82   }
  83
  84   method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
  85     my @args;
  86     my $ret = {
  87       -type => 'expr',
  88       op => lc $logic,
  89       args => \@args
  90     };
  91     my @nodes = @$ast;
  92
  93     while (my $key = shift @nodes) {
  94       if ($key =~ /^-(or|and)$/) {
  95         my $value = shift @nodes
  96           or confess "missing value after $key at " . dump($ast);
  97
  98         my $val = $self->recurse_where($value, uc $1);
  99         if ($val->{op} eq $ret->{op}) {
 100           push @args, @{$val->{args}};
 101         }
 102         else {
 103           push @args, $val;
 104         }
 105         next;
 106       }
 107
 108       push @args, $self->recurse_where($key);
 109     }
 110
 111     return $args[0] if @args == 1;
 112
 113     return $ret;
 114   }
 115
 116   method field(Str $key, $value) returns (AST) {
 117     my $ret = {
 118       -type => 'expr',
 119       op => '==',
 120       args => [
 121         { -type => 'name', args => [$key] }
 122       ],
 123     };
 124
 125     if (is_HashRef($value)) {
 126       my ($op, @rest) = keys %$value;
 127       confess "Don't know how to handle " . dump($value) . " (too many keys)"
 128         if @rest;
 129
 130       # TODO: Validate the op?
 131       if ($op =~ /^-([a-z_]+)$/i) {
 132         $ret->{op} = lc $1;
 133
 134         if (is_ArrayRef($value->{$op})) {
 135           push @{$ret->{args}}, $self->value($_)
 136             for @{$value->{$op}};
 137           return $ret;
 138         }
 139       }
 140       else {
 141         $ret->{op} = $op;
 142       }
 143
 144       push @{$ret->{args}}, $self->value($value->{$op});
 145
 146     }
 147     elsif (is_ArrayRef($value)) {
 148       # Return an or clause, sort of.
 149       return {
 150         -type => 'expr',
 151         op => 'or',
 152         args => [ map {
 153           {
 154             -type => 'expr',
 155             op => '==',
 156             args => [
 157               { -type => 'name', args => [$key] },
 158               $self->value($_)
 159             ],
 160           }
 161         } @$value ]
 162       };
 163     }
 164     else {
 165       push @{$ret->{args}}, $self->value($value);
 166     }
 167
 168     return $ret;
 169   }
 170
 171   method value($value) returns (AST) {
 172     return { -type => 'value', value => $value }
 173       if is_Str($value);
 174
 175     confess "Don't know how to handle terminal value " . dump($value);
 176   }
 177
 178
 179 };
 180
 181 1;
 182
 183 =head1 NAME
 184
 185 SQL::Abstract::AST::Compat - v1.xx AST -> v2 AST visitor
 186
 187 =head1 DESCRIPTION
 188
 189 The purpose of this module is to take the where clause arguments from version
 190 1.x of SQL::Abstract, and turn it into a proper, explicit AST, suitable for use
 191 in the rest of the code.
 192
 193 Please note that this module does not have the same interface as other
 194 SQL::Abstract ASTs.
 195
 196 =head1 AUTHOR
 197
 198 Ash Berlin C<< <ash@cpan.org> >>
 199
 200 =cut