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