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     required => 1,
  23   );
  24
  25   has visitor => (
  26     is => 'rw',
  27     isa => 'SQL::Abstract',
  28     clearer => 'clear_visitor',
  29     lazy => 1,
  30     builder => '_build_visitor',
  31   );
  32
  33   has cmp => (
  34     is => 'rw',
  35     isa => 'Str',
  36     default => '=',
  37     required => 1,
  38   );
  39
  40   our %CMP_MAP = (
  41     '=' => '==',
  42   );
  43
  44   has convert => (
  45     is => 'rw',
  46     isa => 'Str',
  47     predicate => 'has_field_convertor'
  48   );
  49
  50   method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
  51                 WhereType $where?,
  52                 WhereType $order?)
  53   {
  54     my $ast = $self->select_ast($from,$fields,$where,$order);
  55
  56     return ($self->visitor->dispatch($ast), $self->visitor->binds);
  57   }
  58   method select_ast(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
  59                 WhereType $where?,
  60                 WhereType $order?)
  61   {
  62     my $ast = {
  63       -type => 'select',
  64       columns => [
  65         map {
  66           $self->mk_name(0, $_)
  67         } ( is_Str($fields) ? $fields : @$fields )
  68       ],
  69       tablespec => $self->tablespec($from)
  70     };
  71
  72
  73     $ast->{where} = $self->recurse_where($where)
  74       if defined $where;
  75     return $ast;
  76   }
  77
  78   method where(WhereType $where,
  79                WhereType $order?)
  80   {
  81     my $ret = "";
  82
  83     if ($where) {
  84       my $ast = $self->recurse_where($where);
  85       $ret .= "WHERE " . $self->visitor->_expr($ast);
  86     }
  87
  88     return $ret;
  89   }
  90
  91   method _build_visitor() {
  92     return SQL::Abstract->create(1);
  93   }
  94
  95   sub mk_name {
  96     my ($self, $use_convert) = (shift,shift);
  97     my $ast = { -type => 'name', args => [ @_ ] };
  98
  99     return $ast
 100       unless $use_convert && $self->has_field_convertor;
 101
 102     return $self->apply_convert($ast);
 103   }
 104
 105   method tablespec(Str|ArrayRef|ScalarRef $from) {
 106     return $self->mk_name(0, $from)
 107       if is_Str($from);
 108   }
 109
 110   method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
 111     return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
 112     return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
 113     croak "Unknown where clause type " . dump($ast);
 114   }
 115
 116   method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
 117     my @args;
 118     my $ret = {
 119       -type => 'expr',
 120       op => lc $logic,
 121       args => \@args
 122     };
 123
 124     while (my ($key,$value) = each %$ast) {
 125       if ($key =~ /^-(or|and)$/) {
 126         my $val = $self->recurse_where($value, uc $1);
 127         if ($val->{op} eq $ret->{op}) {
 128           push @args, @{$val->{args}};
 129         }
 130         else {
 131           push @args, $val;
 132         }
 133         next;
 134       }
 135
 136       push @args, $self->field($key, $value);
 137     }
 138
 139     return $args[0] if @args == 1;
 140
 141     return $ret;
 142   }
 143
 144   method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
 145     my @args;
 146     my $ret = {
 147       -type => 'expr',
 148       op => lc $logic,
 149       args => \@args
 150     };
 151     my @nodes = @$ast;
 152
 153     while (my $key = shift @nodes) {
 154       if ($key =~ /^-(or|and)$/) {
 155         my $value = shift @nodes
 156           or confess "missing value after $key at " . dump($ast);
 157
 158         my $val = $self->recurse_where($value, uc $1);
 159         if ($val->{op} eq $ret->{op}) {
 160           push @args, @{$val->{args}};
 161         }
 162         else {
 163           push @args, $val;
 164         }
 165         next;
 166       }
 167
 168       push @args, $self->recurse_where($key);
 169     }
 170
 171     return $args[0] if @args == 1;
 172
 173     return $ret;
 174   }
 175
 176   method field(Str $key, $value) returns (AST) {
 177     my $op = $CMP_MAP{$self->cmp} || $self->cmp;
 178     my $ret = {
 179       -type => 'expr',
 180       op => $op,
 181       args => [
 182         $self->mk_name(1, $key)
 183       ],
 184     };
 185
 186     if (is_HashRef($value)) {
 187       my ($op, @rest) = keys %$value;
 188       confess "Don't know how to handle " . dump($value) . " (too many keys)"
 189         if @rest;
 190       $value = $value->{$op};
 191
 192       # TODO: Validate the op?
 193       if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) {
 194         $ret->{op} = lc $2;
 195         $ret->{op} = "not_" . $ret->{op} if $1;
 196
 197         if (is_ArrayRef($value)) {
 198           push @{$ret->{args}}, $self->value($_)
 199             for @{$value};
 200           return $ret;
 201         }
 202       }
 203       else {
 204         $ret->{op} = $op;
 205       }
 206
 207       if (is_ArrayRef($value)) {
 208         local $self->{cmp} = $op;
 209
 210         my $ast = {
 211           -type => 'expr',
 212           # Handle e => { '!=', [qw(f g)] }.
 213           # SQLA treats this as a 'DWIM'
 214           op => $op eq '!=' ? 'or' : 'and',
 215           args => [ map {
 216             $self->field($key, $_)
 217           } @{$value} ]
 218         };
 219         return $ast;
 220       }
 221       push @{$ret->{args}}, $self->value($value);
 222
 223     }
 224     elsif (is_ArrayRef($value)) {
 225       # Return an or clause, sort of.
 226       return {
 227         -type => 'expr',
 228         op => 'or',
 229         args => [ map {
 230             $self->field($key, $_)
 231         } @$value ]
 232       };
 233     }
 234     else {
 235       push @{$ret->{args}}, $self->value($value);
 236     }
 237
 238     return $ret;
 239   }
 240
 241   method value($value) returns (AST) {
 242     return $self->apply_convert( { -type => 'value', value => $value })
 243       if is_Str($value);
 244
 245     confess "Don't know how to handle terminal value " . dump($value);
 246   }
 247
 248   method apply_convert(AST $ast) {
 249     return $ast unless $self->has_field_convertor;
 250
 251     return {
 252       -type => 'expr',
 253       op => $self->convert,
 254       args => [ $ast ]
 255     };
 256   }
 257
 258
 259 }
 260
 261 =head1 NAME
 262
 263 SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx
 264
 265 =head1 DESCRIPTION
 266
 267 This class attempts to maintain the original behaviour of version 1 of
 268 SQL::Abstract. It does this by internally converting to an AST and then using
 269 the standard AST visitor.
 270
 271 If so desired, you can get hold of this transformed AST somehow. This is aimed
 272 at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or
 273 hashes as part of their public interface.
 274
 275 =head1 AUTHOR
 276
 277 Ash Berlin C<< <ash@cpan.org> >>
 278
 279 =cut
 280
 281 1;