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   # Deals with where({ .... }) case
 117   method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
 118     my @args;
 119     my $ret = {
 120       -type => 'expr',
 121       op => lc $logic,
 122       args => \@args
 123     };
 124
 125     for my $key ( sort keys %$ast ) {
 126       my $value = $ast->{$key};
 127
 128       if ($key =~ /^-(or|and)$/) {
 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->field($key, $value);
 140     }
 141
 142     return $args[0] if @args == 1;
 143
 144     return $ret;
 145   }
 146
 147   # Deals with where([ .... ]) case
 148   method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
 149     my @args;
 150     my $ret = {
 151       -type => 'expr',
 152       op => lc $logic,
 153       args => \@args
 154     };
 155     my @nodes = @$ast;
 156
 157     while (my $key = shift @nodes) {
 158       if ($key =~ /^-(or|and)$/) {
 159         my $value = shift @nodes
 160           or confess "missing value after $key at " . dump($ast);
 161
 162         my $val = $self->recurse_where($value, uc $1);
 163         if ($val->{op} eq $ret->{op}) {
 164           push @args, @{$val->{args}};
 165         }
 166         else {
 167           push @args, $val;
 168         }
 169         next;
 170       }
 171
 172       push @args, $self->recurse_where($key);
 173     }
 174
 175     return $args[0] if @args == 1;
 176
 177     return $ret;
 178   }
 179
 180   # { field => { .... } } case
 181   method field_hash(Str $key, HashRef $value) returns (AST) {
 182     my ($op, @rest) = keys %$value;
 183
 184     confess "Don't know how to handle " . dump($value) . " (too many keys)"
 185       if @rest;
 186
 187     $value = $value->{$op};
 188
 189     my $ret = {
 190       -type => 'expr',
 191       op => $op,
 192       args => [
 193         $self->mk_name(1, $key)
 194       ],
 195     };
 196     $ret->{op} = $op;
 197
 198     # TODO: Validate the op?
 199     # 'word_like' operator
 200     if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) {
 201       $ret->{op} = lc $2;
 202       $ret->{op} = "not_" . $ret->{op} if $1;
 203
 204
 205       if (is_ArrayRef($value)) {
 206         push @{$ret->{args}}, $self->value($_) for @{$value};
 207         return $ret;
 208       }
 209     }
 210
 211     # Cases like:
 212     #   field => { '!=' =>  [ 'a','b','c'] }
 213     #   field => { '<' =>  [ 'a','b','c'] }
 214     #
 215     # *not* when op is a work or function operator - basic cmp operator only
 216     if (is_ArrayRef($value)) {
 217       local $self->{cmp} = $op;
 218
 219       my $ast = {
 220         -type => 'expr',
 221
 222         # Handle e => { '!=', [qw(f g)] }.
 223         # SQLA treats this as a 'DWIM' since e != f AND e != g doesn't make sense
 224         op => $op eq '!=' ? 'or' : 'and',
 225         args => [ map {
 226           $self->field($key, $_)
 227         } @{$value} ]
 228       };
 229       return $ast;
 230     }
 231
 232
 233     push @{$ret->{args}}, $self->value($value);
 234     return $ret;
 235   }
 236
 237   # Handle [ { ... }, { ... } ]
 238   method field_array(Str $key, ArrayRef $value) {
 239     # Return an or clause, sort of.
 240     return {
 241       -type => 'expr',
 242       op => 'or',
 243       args => [ map {
 244           $self->field($key, $_)
 245       } @$value ]
 246     };
 247   }
 248
 249   method field(Str $key, $value) returns (AST) {
 250
 251     if (is_HashRef($value)) {
 252       return $self->field_hash($key, $value);
 253     }
 254     elsif (is_ArrayRef($value)) {
 255       return $self->field_array($key, $value);
 256     }
 257
 258     my $ret = {
 259       -type => 'expr',
 260       op => $CMP_MAP{$self->cmp} || $self->cmp,
 261       args => [
 262         $self->mk_name(1, $key),
 263         $self->value($value)
 264       ],
 265     };
 266
 267     return $ret;
 268   }
 269
 270   method value($value) returns (AST) {
 271     return $self->apply_convert( { -type => 'value', value => $value })
 272       if is_Str($value);
 273
 274     confess "Don't know how to handle terminal value " . dump($value);
 275   }
 276
 277   method apply_convert(AST $ast) {
 278     return $ast unless $self->has_field_convertor;
 279
 280     return {
 281       -type => 'expr',
 282       op => $self->convert,
 283       args => [ $ast ]
 284     };
 285   }
 286
 287
 288 }
 289
 290 =head1 NAME
 291
 292 SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx
 293
 294 =head1 DESCRIPTION
 295
 296 This class attempts to maintain the original behaviour of version 1 of
 297 SQL::Abstract. It does this by internally converting to an AST and then using
 298 the standard AST visitor.
 299
 300 If so desired, you can get hold of this transformed AST somehow. This is aimed
 301 at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or
 302 hashes as part of their public interface.
 303
 304 =head1 AUTHOR
 305
 306 Ash Berlin C<< <ash@cpan.org> >>
 307
 308 =cut
 309
 310 1;