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 = {
  55       -type => 'select',
  56       columns => [
  57         map {
  58           $self->mk_name(0, $_)
  59         } ( is_Str($fields) ? $fields : @$fields )
  60       ],
  61       tablespec => $self->tablespec($from)
  62     };
  63
  64
  65     $ast->{where} = $self->recurse_where($where)
  66       if defined $where;
  67
  68     return ($self->visitor->dispatch($ast), $self->visitor->binds);
  69   }
  70
  71   method where(WhereType $where,
  72                WhereType $order?)
  73   {
  74     my $ret = "";
  75
  76     if ($where) {
  77       my $ast = $self->recurse_where($where);
  78       $ret .= "WHERE " . $self->visitor->_expr($ast);
  79     }
  80
  81     return $ret;
  82   }
  83
  84   method _build_visitor() {
  85     return SQL::Abstract->create(1);
  86   }
  87
  88   sub mk_name {
  89     my ($self, $use_convert) = (shift,shift);
  90     my $ast = { -type => 'name', args => [ @_ ] };
  91
  92     return $ast
  93       unless $use_convert && $self->has_field_convertor;
  94
  95     return $self->apply_convert($ast);
  96   }
  97
  98   method tablespec(Str|ArrayRef|ScalarRef $from) {
  99     return $self->mk_name(0, $from)
 100       if is_Str($from);
 101   }
 102
 103   method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
 104     return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
 105     return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
 106     croak "Unknown where clause type " . dump($ast);
 107   }
 108
 109   method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
 110     my @args;
 111     my $ret = {
 112       -type => 'expr',
 113       op => lc $logic,
 114       args => \@args
 115     };
 116
 117     while (my ($key,$value) = each %$ast) {
 118       if ($key =~ /^-(or|and)$/) {
 119         my $val = $self->recurse_where($value, uc $1);
 120         if ($val->{op} eq $ret->{op}) {
 121           push @args, @{$val->{args}};
 122         }
 123         else {
 124           push @args, $val;
 125         }
 126         next;
 127       }
 128
 129       push @args, $self->field($key, $value);
 130     }
 131
 132     return $args[0] if @args == 1;
 133
 134     return $ret;
 135   }
 136
 137   method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
 138     my @args;
 139     my $ret = {
 140       -type => 'expr',
 141       op => lc $logic,
 142       args => \@args
 143     };
 144     my @nodes = @$ast;
 145
 146     while (my $key = shift @nodes) {
 147       if ($key =~ /^-(or|and)$/) {
 148         my $value = shift @nodes
 149           or confess "missing value after $key at " . dump($ast);
 150
 151         my $val = $self->recurse_where($value, uc $1);
 152         if ($val->{op} eq $ret->{op}) {
 153           push @args, @{$val->{args}};
 154         }
 155         else {
 156           push @args, $val;
 157         }
 158         next;
 159       }
 160
 161       push @args, $self->recurse_where($key);
 162     }
 163
 164     return $args[0] if @args == 1;
 165
 166     return $ret;
 167   }
 168
 169   method field(Str $key, $value) returns (AST) {
 170     my $op = $CMP_MAP{$self->cmp} || $self->cmp;
 171     my $ret = {
 172       -type => 'expr',
 173       op => $op,
 174       args => [
 175         $self->mk_name(1, $key)
 176       ],
 177     };
 178
 179     if (is_HashRef($value)) {
 180       my ($op, @rest) = keys %$value;
 181       confess "Don't know how to handle " . dump($value) . " (too many keys)"
 182         if @rest;
 183
 184       # TODO: Validate the op?
 185       if ($op =~ /^-([a-z_]+)$/i) {
 186         $ret->{op} = lc $1;
 187
 188         if (is_ArrayRef($value->{$op})) {
 189           push @{$ret->{args}}, $self->value($_)
 190             for @{$value->{$op}};
 191           return $ret;
 192         }
 193       }
 194       else {
 195         $ret->{op} = $op;
 196       }
 197
 198       push @{$ret->{args}}, $self->value($value->{$op});
 199
 200     }
 201     elsif (is_ArrayRef($value)) {
 202       # Return an or clause, sort of.
 203       return {
 204         -type => 'expr',
 205         op => 'or',
 206         args => [ map {
 207           {
 208             -type => 'expr',
 209             op => $op,
 210             args => [
 211               { -type => 'name', args => [$key] },
 212               $self->value($_)
 213             ],
 214           }
 215         } @$value ]
 216       };
 217     }
 218     else {
 219       push @{$ret->{args}}, $self->value($value);
 220     }
 221
 222     return $ret;
 223   }
 224
 225   method value($value) returns (AST) {
 226     return $self->apply_convert( { -type => 'value', value => $value })
 227       if is_Str($value);
 228
 229     confess "Don't know how to handle terminal value " . dump($value);
 230   }
 231
 232   method apply_convert(AST $ast) {
 233     return $ast unless $self->has_field_convertor;
 234
 235     return {
 236       -type => 'expr',
 237       op => $self->convert,
 238       args => [ $ast ]
 239     };
 240   }
 241
 242
 243 }
 244
 245 =head1 NAME
 246
 247 SQL::Abstract::Compant - compatibility layer for SQL::Abstrct v 1.xx
 248
 249 =head1 DESCRIPTION
 250
 251 This class attempts to maintain the original behaviour of version 1 of
 252 SQL::Abstract. It does this by internally converting to an AST and then using
 253 the standard AST visitor.
 254
 255 If so desired, you can get hold of this transformed AST somehow. This is aimed
 256 at libraries such as L<DBIx::Class> that use SQL::Abstract-style arrays or
 257 hashes as part of their public interface.
 258
 259 =head1 AUTHOR
 260
 261 Ash Berlin C<< <ash@cpan.org> >>
 262
 263 =cut
 264
 265 1;