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 NameSeparator QuoteChars/;
   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   # TODO: a metaclass trait to automatically use this on vistior construction
  51   has quote_char => (
  52     is => 'rw',
  53     isa => QuoteChars,
  54     coerce => 1,
  55     predicate => "has_quote_chars"
  56   );
  57
  58   has name_sep => (
  59     is => 'rw',
  60     isa => NameSeparator,
  61     predicate => "has_name_sep"
  62   );
  63
  64   method _build_visitor() {
  65     my %args = (
  66       ast_version => 1
  67     );
  68     $args{quote_chars} = $self->quote_char
  69       if $self->has_quote_chars;
  70     $args{ident_separator} = $self->name_sep
  71       if $self->has_name_sep;
  72
  73     # TODO: this needs improving along with SQL::A::create
  74     my $visitor = SQL::Abstract::AST::v1->new(%args);
  75   }
  76
  77   method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
  78                 WhereType $where?,
  79                 WhereType $order?)
  80   {
  81     my $ast = $self->select_ast($from,$fields,$where,$order);
  82
  83     return ($self->visitor->dispatch($ast), @{$self->visitor->binds});
  84   }
  85
  86   method update(Str|ArrayRef|ScalarRef $from,
  87                 HashRef $fields, WhereType $where? )
  88   {
  89     my $ast = $self->update_aste($from,$fields,$where);
  90
  91     return ($self->visitor->dispatch($ast), @{$self->visitor->binds});
  92   }
  93
  94   method update_ast(Str|ArrayRef|ScalarRef $from,
  95                     HashRef $fields, WhereType $where? )
  96   {
  97     return { -type => 'update' };
  98   }
  99
 100   method select_ast(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
 101                 WhereType $where?,
 102                 WhereType $order?)
 103   {
 104     my $ast = {
 105       -type => 'select',
 106       columns => [
 107         map {
 108           $self->mk_name(0, $_)
 109         } ( is_Str($fields) ? $fields : @$fields )
 110       ],
 111       tablespec => $self->tablespec($from)
 112     };
 113
 114
 115     $ast->{where} = $self->recurse_where($where)
 116       if defined $where;
 117
 118     if (defined $order) {
 119       my @order = is_ArrayRef($order) ? @$order : $order;
 120       $ast->{order_by} = [ map { $self->mk_name(0, $_) } @order ];
 121     }
 122
 123     return $ast;
 124   }
 125
 126   method where(WhereType $where,
 127                WhereType $order?)
 128   {
 129     my $ret = "";
 130
 131     if ($where) {
 132       my $ast = $self->recurse_where($where);
 133       $ret .= "WHERE " . $self->visitor->_expr($ast);
 134     }
 135
 136     return $ret;
 137   }
 138
 139
 140   # method mk_name(Bool $use_convert, Str @names) {
 141   sub mk_name {
 142     my ($self, $use_convert, @names) = @_;
 143
 144     @names = split /\Q@{[$self->name_sep]}\E/, $names[0]
 145       if (@names == 1 && $self->has_name_sep);
 146
 147     my $ast = { -type => 'identifier', elements => [ @names ] };
 148
 149     return $ast
 150       unless $use_convert && $self->has_field_convertor;
 151
 152     return $self->apply_convert($ast);
 153   }
 154
 155   method tablespec(Str|ArrayRef|ScalarRef $from) {
 156     return $self->mk_name(0, $from)
 157       if is_Str($from);
 158
 159     return {
 160       -type => 'list',
 161       args => [ map {
 162         $self->mk_name(0, $_)
 163       } @$from ]
 164     };
 165   }
 166
 167   method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
 168     return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
 169     return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
 170     croak "Unknown where clause type " . dump($ast);
 171   }
 172
 173   # Deals with where({ .... }) case
 174   method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
 175     my @args;
 176     my $ret = {
 177       -type => 'expr',
 178       op => lc $logic,
 179       args => \@args
 180     };
 181
 182     for my $key ( sort keys %$ast ) {
 183       my $value = $ast->{$key};
 184
 185       if ($key =~ /^-(or|and)$/) {
 186         my $val = $self->recurse_where($value, uc $1);
 187         if ($val->{op} eq $ret->{op}) {
 188           push @args, @{$val->{args}};
 189         }
 190         else {
 191           push @args, $val;
 192         }
 193         next;
 194       }
 195
 196       push @args, $self->field($key, $value);
 197     }
 198
 199     return $args[0] if @args == 1;
 200
 201     return $ret;
 202   }
 203
 204   # Deals with where([ .... ]) case
 205   method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
 206     my @args;
 207     my $ret = {
 208       -type => 'expr',
 209       op => lc $logic,
 210       args => \@args
 211     };
 212     my @nodes = @$ast;
 213
 214     while (my $key = shift @nodes) {
 215       if ($key =~ /^-(or|and)$/) {
 216         my $value = shift @nodes
 217           or confess "missing value after $key at " . dump($ast);
 218
 219         my $val = $self->recurse_where($value, uc $1);
 220         if ($val->{op} eq $ret->{op}) {
 221           push @args, @{$val->{args}};
 222         }
 223         else {
 224           push @args, $val;
 225         }
 226         next;
 227       }
 228
 229       push @args, $self->recurse_where($key);
 230     }
 231
 232     return $args[0] if @args == 1;
 233
 234     return $ret;
 235   }
 236
 237   # { field => { .... } } case
 238   method field_hash(Str $key, HashRef $value) returns (AST) {
 239     my ($op, @rest) = keys %$value;
 240
 241     confess "Don't know how to handle " . dump($value) . " (too many keys)"
 242       if @rest;
 243
 244     $value = $value->{$op};
 245
 246     my $ret = {
 247       -type => 'expr',
 248       op => $op,
 249       args => [
 250         $self->mk_name(1, $key)
 251       ],
 252     };
 253     $ret->{op} = $op;
 254
 255     # TODO: Validate the op?
 256     # 'word_like' operator
 257     if ($op =~ /^-?(?:(not)[_ ])?([a-z_]+)$/i) {
 258       $ret->{op} = lc $2;
 259       $ret->{op} = "not_" . $ret->{op} if $1;
 260
 261
 262       if (is_ArrayRef($value)) {
 263         push @{$ret->{args}}, $self->value($_) for @{$value};
 264         return $ret;
 265       }
 266     }
 267
 268     # Cases like:
 269     #   field => { '!=' =>  [ 'a','b','c'] }
 270     #   field => { '<' =>  [ 'a','b','c'] }
 271     #
 272     # *not* when op is a work or function operator - basic cmp operator only
 273     if (is_ArrayRef($value)) {
 274       local $self->{cmp} = $op;
 275
 276       my $ast = {
 277         -type => 'expr',
 278         op => 'or',
 279         args => [ map {
 280           $self->field($key, $_)
 281         } @{$value} ]
 282       };
 283       return $ast;
 284     }
 285
 286
 287     push @{$ret->{args}}, $self->value($value);
 288     return $ret;
 289   }
 290
 291   # Handle [ { ... }, { ... } ]
 292   method field_array(Str $key, ArrayRef $value) {
 293     # Return an or clause, sort of.
 294     return {
 295       -type => 'expr',
 296       op => 'or',
 297       args => [ map {
 298           $self->field($key, $_)
 299       } @$value ]
 300     };
 301   }
 302
 303   method field(Str $key, $value) returns (AST) {
 304
 305     if (is_HashRef($value)) {
 306       return $self->field_hash($key, $value);
 307     }
 308     elsif (is_ArrayRef($value)) {
 309       return $self->field_array($key, $value);
 310     }
 311
 312     my $ret = {
 313       -type => 'expr',
 314       op => $CMP_MAP{$self->cmp} || $self->cmp,
 315       args => [
 316         $self->mk_name(1, $key),
 317         $self->value($value)
 318       ],
 319     };
 320
 321     return $ret;
 322   }
 323
 324   method value($value) returns (AST) {
 325     return $self->apply_convert( { -type => 'value', value => $value })
 326       if is_Str($value);
 327
 328     confess "Don't know how to handle terminal value " . dump($value);
 329   }
 330
 331   method apply_convert(AST $ast) {
 332     return $ast unless $self->has_field_convertor;
 333
 334     return {
 335       -type => 'expr',
 336       op => $self->convert,
 337       args => [ $ast ]
 338     };
 339   }
 340
 341
 342 }
 343
 344 =head1 NAME
 345
 346 SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx
 347
 348 =head1 DESCRIPTION
 349
 350 This class attempts to maintain the original behaviour of version 1 of
 351 SQL::Abstract. It does this by internally converting to an AST and then using
 352 the standard AST visitor.
 353
 354 If so desired, you can get hold of this transformed AST somehow. This is aimed
 355 at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or
 356 hashes as part of their public interface.
 357
 358 =head1 AUTHOR
 359
 360 Ash Berlin C<< <ash@cpan.org> >>
 361
 362 =cut
 363
 364 1;