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 sub new {
   9   shift->next::method(@_)->register_defaults
  10 }
  11
  12 sub register_defaults {
  13   my ($self) = @_;
  14   $self->{clauses_of}{select} = [ qw(select from where order_by) ];
  15   $self->{expand}{select} = sub { shift->_expand_statement(@_) };
  16   $self->{render}{select} = sub { shift->_render_statement(select => @_) };
  17   $self->{expand_clause}{'select.select'} = sub {
  18     $_[0]->_expand_maybe_list_expr($_[1], -ident)
  19   };
  20   $self->{expand_clause}{'select.from'} = sub {
  21     $_[0]->_expand_maybe_list_expr($_[1], -ident)
  22   };
  23   $self->{expand_clause}{'select.where'} = 'expand_expr';
  24   $self->{expand_clause}{'select.order_by'} = '_expand_order_by';
  25   return $self;
  26 }
  27
  28 sub _expand_statement {
  29   my ($self, $type, $args) = @_;
  30   my $ec = $self->{expand_clause};
  31   return +{ "-${type}" => +{
  32     map +($_ => (do {
  33       my $val = $args->{$_};
  34       if (defined($val) and my $exp = $ec->{"${type}.$_"}) {
  35         $self->$exp($val);
  36       } else {
  37         $val;
  38       }
  39     })), sort keys %$args
  40   } };
  41 }
  42
  43 sub _render_statement {
  44   my ($self, $type, $args) = @_;
  45   my @parts;
  46   foreach my $clause (@{$self->{clauses_of}{$type}}) {
  47     next unless my $clause_expr = $args->{$clause};
  48     local $self->{convert_where} = $self->{convert} if $clause eq 'where';
  49     my ($sql, @bind) = $self->render_aqt($clause_expr);
  50     next unless defined($sql) and length($sql);
  51     push @parts, [
  52       $self->_sqlcase(join ' ', split '_', $clause).' '.$sql,
  53       @bind
  54     ];
  55   }
  56   return $self->_join_parts(' ', @parts);
  57 }
  58
  59 sub select {
  60   my ($self, @args) = @_;
  61   my %clauses;
  62   @clauses{qw(from select where order_by)} = @args;
  63
  64   # This oddity is to literalify since historically SQLA doesn't quote
  65   # a single identifier argument, so we convert it into a literal
  66
  67   $clauses{select} = { -literal => [ $clauses{select}||'*' ] }
  68     unless ref($clauses{select});
  69
  70   my ($sql, @bind) = $self->render_expr({ -select => \%clauses });
  71   return wantarray ? ($sql, @bind) : $sql;
  72 }
  73
  74 1;