lib/SQL/Abstract/Compat.pm

   1 use MooseX::Declare;
   2
   3 class SQL::Abstract::Compat {
   4
   5   use Moose::Util::TypeConstraints;
   6   use MooseX::Types::Moose qw/Str ScalarRef ArrayRef HashRef/;
   7   use SQL::Abstract::Types::Compat ':all';
   8   use SQL::Abstract::Types qw/AST/;
   9   use SQL::Abstract::AST::v1;
  10   use Data::Dump qw/pp/;
  11   use Devel::PartialDump qw/dump/;
  12   use Carp qw/croak/;
  13
  14   class_type 'SQL::Abstract';
  15   clean;
  16
  17   has logic => (
  18     is => 'rw',
  19     isa => LogicEnum,
  20     default => 'AND',
  21     coerce => 1
  22   );
  23
  24   has visitor => (
  25     is => 'rw',
  26     isa => 'SQL::Abstract',
  27     clearer => 'clear_visitor',
  28     lazy => 1,
  29     builder => '_build_visitor',
  30   );
  31
  32
  33   method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
  34                 WhereType $where?,
  35                 WhereType $order?)
  36   {
  37     my $ast = {
  38       -type => 'select',
  39       columns => [
  40         map {
  41           $self->mk_name($_)
  42         } ( is_Str($fields) ? $fields : @$fields )
  43       ],
  44       tablespec => $self->tablespec($from)
  45     };
  46
  47
  48     $ast->{where} = $self->recurse_where($where)
  49       if defined $where;
  50
  51     return ($self->visitor->dispatch($ast), $self->visitor->binds);
  52   }
  53
  54   method where(WhereType $where,
  55                WhereType $order?)
  56   {
  57     my $ret = "";
  58
  59     if ($where) {
  60       my $ast = $self->recurse_where($where);
  61       $ret .= "WHERE " . $self->visitor->_expr($ast);
  62     }
  63
  64     return $ret;
  65   }
  66
  67   method _build_visitor() {
  68     return SQL::Abstract->create(1);
  69   }
  70
  71   sub mk_name {
  72     shift;
  73     return { -type => 'name', args => [ @_ ] };
  74   }
  75
  76   method tablespec(Str|ArrayRef|ScalarRef $from) {
  77     return $self->mk_name($from)
  78       if is_Str($from);
  79   }
  80
  81   method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
  82     return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
  83     return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
  84     croak "Unknown where clause type " . dump($ast);
  85   }
  86
  87   method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
  88     my @args;
  89     my $ret = {
  90       -type => 'expr',
  91       op => lc $logic,
  92       args => \@args
  93     };
  94
  95     while (my ($key,$value) = each %$ast) {
  96       if ($key =~ /^-(or|and)$/) {
  97         my $val = $self->recurse_where($value, uc $1);
  98         if ($val->{op} eq $ret->{op}) {
  99           push @args, @{$val->{args}};
 100         }
 101         else {
 102           push @args, $val;
 103         }
 104         next;
 105       }
 106
 107       push @args, $self->field($key, $value);
 108     }
 109
 110     return $args[0] if @args == 1;
 111
 112     return $ret;
 113   }
 114
 115   method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
 116     my @args;
 117     my $ret = {
 118       -type => 'expr',
 119       op => lc $logic,
 120       args => \@args
 121     };
 122     my @nodes = @$ast;
 123
 124     while (my $key = shift @nodes) {
 125       if ($key =~ /^-(or|and)$/) {
 126         my $value = shift @nodes
 127           or confess "missing value after $key at " . dump($ast);
 128
 129         my $val = $self->recurse_where($value, uc $1);
 130         if ($val->{op} eq $ret->{op}) {
 131           push @args, @{$val->{args}};
 132         }
 133         else {
 134           push @args, $val;
 135         }
 136         next;
 137       }
 138
 139       push @args, $self->recurse_where($key);
 140     }
 141
 142     return $args[0] if @args == 1;
 143
 144     return $ret;
 145   }
 146
 147   method field(Str $key, $value) returns (AST) {
 148     my $ret = {
 149       -type => 'expr',
 150       op => '==',
 151       args => [
 152         { -type => 'name', args => [$key] }
 153       ],
 154     };
 155
 156     if (is_HashRef($value)) {
 157       my ($op, @rest) = keys %$value;
 158       confess "Don't know how to handle " . dump($value) . " (too many keys)"
 159         if @rest;
 160
 161       # TODO: Validate the op?
 162       if ($op =~ /^-([a-z_]+)$/i) {
 163         $ret->{op} = lc $1;
 164
 165         if (is_ArrayRef($value->{$op})) {
 166           push @{$ret->{args}}, $self->value($_)
 167             for @{$value->{$op}};
 168           return $ret;
 169         }
 170       }
 171       else {
 172         $ret->{op} = $op;
 173       }
 174
 175       push @{$ret->{args}}, $self->value($value->{$op});
 176
 177     }
 178     elsif (is_ArrayRef($value)) {
 179       # Return an or clause, sort of.
 180       return {
 181         -type => 'expr',
 182         op => 'or',
 183         args => [ map {
 184           {
 185             -type => 'expr',
 186             op => '==',
 187             args => [
 188               { -type => 'name', args => [$key] },
 189               $self->value($_)
 190             ],
 191           }
 192         } @$value ]
 193       };
 194     }
 195     else {
 196       push @{$ret->{args}}, $self->value($value);
 197     }
 198
 199     return $ret;
 200   }
 201
 202   method value($value) returns (AST) {
 203     return { -type => 'value', value => $value }
 204       if is_Str($value);
 205
 206     confess "Don't know how to handle terminal value " . dump($value);
 207   }
 208
 209
 210 }
 211
 212 =head1 NAME
 213
 214 SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx
 215
 216 =head1 DESCRIPTION
 217
 218 This class attempts to maintain the original behaviour of version 1 of
 219 SQL::Abstract. It does this by internally converting to an AST and then using
 220 the standard AST visitor.
 221
 222 If so desired, you can get hold of this transformed AST somehow. This is aimed
 223 at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or
 224 hashes as part of their public interface.
 225
 226 =head1 AUTHOR
 227
 228 Ash Berlin C<< <ash@cpan.org> >>
 229
 230 =cut
 231
 232 1;