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