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