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       $ret->{op} = $op;
 104       push @{$ret->{args}}, $self->value($value->{$op});
 105
 106     }
 107     elsif (is_ArrayRef($value)) {
 108       # Return an or clause, sort of.
 109       return {
 110         -type => 'expr',
 111         op => 'or',
 112         args => [ map {
 113           {
 114             -type => 'expr',
 115             op => '==',
 116             args => [
 117               { -type => 'name', args => [$key] },
 118               $self->value($_)
 119             ],
 120           }
 121         } @$value ]
 122       };
 123     }
 124     else {
 125       push @{$ret->{args}}, $self->value($value);
 126     }
 127
 128     return $ret;
 129   }
 130
 131   method value($value) returns (AST) {
 132     if (is_Str($value)) {
 133       return { -type => 'value', value => $value };
 134     }
 135     else {
 136       confess "Don't know how to handle " . dump($value);
 137     }
 138   }
 139
 140
 141 };
 142
 143 1;
 144
 145 =head1 NAME
 146
 147 SQL::Abstract::AST::Compat - v1.xx AST -> v2 AST visitor
 148
 149 =head1 DESCRIPTION
 150
 151 The purpose of this module is to take the where clause arguments from version
 152 1.x of SQL::Abstract, and turn it into a proper, explicit AST, suitable for use
 153 in the rest of the code.
 154
 155 Please note that this module does not have the same interface as other
 156 SQL::Abstract ASTs.
 157
 158 =head1 AUTHOR
 159
 160 Ash Berlin C<< <ash@cpan.org> >>
 161
 162 =cut