lib/SQL/Abstract/Clauses.pm

   1 package SQL::Abstract::Clauses;
   2
   3 use strict;
   4 use warnings;
   5 use mro 'c3';
   6 use base 'SQL::Abstract';
   7
   8 BEGIN { *puke = \&SQL::Abstract::puke }
   9
  10 sub new {
  11   shift->next::method(@_)->register_defaults
  12 }
  13
  14 sub register_defaults {
  15   my ($self) = @_;
  16   $self->{clauses_of}{select} = [ qw(select from where order_by) ];
  17   $self->{expand}{select} = sub { shift->_expand_statement(@_) };
  18   $self->{render}{select} = sub { shift->_render_statement(select => @_) };
  19   $self->{expand_clause}{'select.select'} = sub {
  20     $_[0]->_expand_maybe_list_expr($_[1], -ident)
  21   };
  22   $self->{expand_clause}{'select.from'} = sub {
  23     $_[0]->_expand_maybe_list_expr($_[1], -ident)
  24   };
  25   $self->{expand_clause}{'select.where'} = 'expand_expr';
  26   $self->{expand_clause}{'select.order_by'} = '_expand_order_by';
  27   $self->{clauses_of}{update} = [ qw(update set where returning) ];
  28   $self->{expand}{update} = sub { shift->_expand_statement(@_) };
  29   $self->{render}{update} = sub { shift->_render_statement(update => @_) };
  30   $self->{expand_clause}{'update.update'} = sub {
  31     $_[0]->expand_expr($_[1], -ident)
  32   };
  33   $self->{expand_clause}{'update.set'} = '_expand_update_set_values';
  34   $self->{expand_clause}{'update.where'} = 'expand_expr';
  35   $self->{expand_clause}{'update.returning'} = sub {
  36     shift->_expand_maybe_list_expr(@_, -ident);
  37   };
  38   return $self;
  39 }
  40
  41 sub _expand_statement {
  42   my ($self, $type, $args) = @_;
  43   my $ec = $self->{expand_clause};
  44   return +{ "-${type}" => +{
  45     map +($_ => (do {
  46       my $val = $args->{$_};
  47       if (defined($val) and my $exp = $ec->{"${type}.$_"}) {
  48         $self->$exp($val);
  49       } else {
  50         $val;
  51       }
  52     })), sort keys %$args
  53   } };
  54 }
  55
  56 sub _render_statement {
  57   my ($self, $type, $args) = @_;
  58   my @parts;
  59   foreach my $clause (@{$self->{clauses_of}{$type}}) {
  60     next unless my $clause_expr = $args->{$clause};
  61     local $self->{convert_where} = $self->{convert} if $clause eq 'where';
  62     my ($sql, @bind) = $self->render_aqt($clause_expr);
  63     next unless defined($sql) and length($sql);
  64     push @parts, [
  65       $self->_sqlcase(join ' ', split '_', $clause).' '.$sql,
  66       @bind
  67     ];
  68   }
  69   return $self->_join_parts(' ', @parts);
  70 }
  71
  72 sub select {
  73   my ($self, @args) = @_;
  74   my %clauses;
  75   @clauses{qw(from select where order_by)} = @args;
  76
  77   # This oddity is to literalify since historically SQLA doesn't quote
  78   # a single identifier argument, so we convert it into a literal
  79
  80   $clauses{select} = { -literal => [ $clauses{select}||'*' ] }
  81     unless ref($clauses{select});
  82
  83   my ($sql, @bind) = $self->render_expr({ -select => \%clauses });
  84   return wantarray ? ($sql, @bind) : $sql;
  85 }
  86
  87 sub update {
  88   my ($self, $table, $set, $where, $options) = @_;
  89   my %clauses;
  90   @clauses{qw(update set where)} = ($table, $set, $where);
  91   puke "Unsupported data type specified to \$sql->update"
  92     unless ref($clauses{set}) eq 'HASH';
  93   @clauses{keys %$options} = values %$options;
  94   my ($sql, @bind) = $self->render_expr({ -update => \%clauses });
  95   return wantarray ? ($sql, @bind) : $sql;
  96 }
  97
  98 1;