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