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