lib/SQL/Abstract.pm

   1 use MooseX::Declare;
   2 use MooseX::Method::Signatures;
   3
   4
   5 class SQL::Abstract {
   6
   7   use Carp qw/croak/;
   8   use Data::Dump qw/pp/;
   9
  10   use Moose::Util::TypeConstraints;
  11   use MooseX::Types -declare => [qw/NameSeparator/];
  12   use MooseX::Types::Moose qw/ArrayRef Str/;
  13   use MooseX::AttributeHelpers;
  14
  15   use namespace::clean -except => ['meta'];
  16
  17   subtype NameSeparator,
  18     as ArrayRef[Str];
  19     #where { @$_ == 1 ||| @$_ == 2 },
  20     #message { "Name separator must be one or two elements" };
  21
  22   coerce NameSeparator, from Str, via { [ $_ ] };
  23
  24   our $VERSION = '2.000000';
  25
  26   our $AST_VERSION = '1';
  27
  28   # Operator precedence for bracketing
  29   our %PRIO = (
  30     and => 10,
  31     or  => 50
  32   );
  33
  34   our %OP_MAP = (
  35     '>' => '>',
  36     '<' => '<',
  37     '==' => '=',
  38     '!=' => '!=',
  39   );
  40
  41   has name_separator => (
  42     is => 'rw',
  43     isa => NameSeparator,
  44     default => sub { ['.'] },
  45     coerece => 1,
  46     required => 1,
  47   );
  48
  49   has list_separator => (
  50     is => 'rw',
  51     isa => Str,
  52     default => ', ',
  53     required => 1,
  54   );
  55
  56   has binds => (
  57     isa => ArrayRef,
  58     default => sub { [ ] },
  59     metaclass => 'Collection::Array',
  60     provides => {
  61       push => 'add_bind',
  62       get => 'binds'
  63     }
  64   );
  65
  66   method generate (Object|ClassName $self: ArrayRef $ast) {
  67     $self = $self->new unless blessed($self);
  68
  69     local $_ = $ast->[0];
  70     s/^-/_/ or croak "Unknown type tag '$_'";
  71     my $meth = $self->can($_) || \&_generic_func;
  72     return $meth->($self, $ast);
  73   }
  74
  75   method _select(ArrayRef $ast) {
  76
  77   }
  78
  79   method _name(ArrayRef $ast) {
  80     my (undef, @names) = @$ast;
  81
  82     my $sep = $self->name_separator;
  83
  84     return $sep->[0] .
  85            join( $sep->[1] . $sep->[0], @names ) .
  86            $sep->[1]
  87               if (@$sep > 1);
  88
  89     return join($sep->[0], @names);
  90   }
  91
  92   method _list(ArrayRef $ast) {
  93     my (undef, @items) = @$ast;
  94
  95     return join(
  96       $self->list_separator,
  97       map { $self->generate($_) } @items);
  98   }
  99
 100   method _alias(ArrayRef $ast) {
 101     my (undef, $alias, $as) = @$ast;
 102
 103     return $self->generate($alias) . " AS $as";
 104
 105   }
 106
 107   method _value(ArrayRef $ast) {
 108     my ($undef, $value) = @$ast;
 109
 110     $self->add_bind($value);
 111     return "?";
 112   }
 113
 114   method _where(ArrayRef $ast) {
 115     my (undef, @clauses) = @$ast;
 116
 117     return 'WHERE ' . $self->_recurse_where(\@clauses);
 118   }
 119
 120   method _recurse_where($clauses) {
 121
 122     my $OP = 'AND';
 123     my $prio = $PRIO{and};
 124     my $first = $clauses->[0];
 125
 126     if (!ref $first && $first =~ /^-(and|or)$/) {
 127       $OP = uc($1);
 128       $prio = $PRIO{$1};
 129       shift @$clauses;
 130     }
 131
 132     my @output;
 133     foreach (@$clauses) {
 134       croak "invalid component in where clause" unless ArrayRef->check($_);
 135       my $op = $_->[0];
 136
 137       unless (substr($op, 0, 1) eq '-') {
 138         # A simple comparison op (==, >, etc.)
 139
 140         push @output, $self->_binop(@$_);
 141
 142       } elsif ($op =~ /^-(and|or)$/) {
 143         my $sub_prio = $PRIO{$1};
 144
 145         if ($sub_prio <= $prio) {
 146           push @output, $self->_recurse_where($_);
 147         } else {
 148           push @output, '(' . $self->_recurse_where($_) . ')';
 149         }
 150       } else {
 151         push @output, $self->generate($_);
 152       }
 153     }
 154
 155     return join(" $OP ", @output);
 156   }
 157
 158   method _binop($op, $lhs, $rhs) {
 159     join (' ', $self->generate($lhs),
 160                $OP_MAP{$op} || croak("Unknown binary operator $op"),
 161                $self->generate($rhs)
 162     );
 163   }
 164
 165   method _generic_func(ArrayRef $ast) {
 166   }
 167
 168
 169 };