lib/SQL/Abstract/ExtraClauses.pm

   1 package SQL::Abstract::ExtraClauses;
   2
   3 use strict;
   4 use warnings;
   5 use if $] < '5.010', 'MRO::Compat';
   6 use mro 'c3';
   7 use base qw(SQL::Abstract::Clauses);
   8
   9 BEGIN { *puke = \&SQL::Abstract::puke }
  10
  11 sub new {
  12   my ($proto, @args) = @_;
  13   my $new = $proto->next::method(@args);
  14   $new->{clauses_of}{select} = [
  15     @{$new->{clauses_of}{select}}, qw(group_by having)
  16   ];
  17   $new->{expand_clause}{'select.group_by'} = sub {
  18     $_[0]->_expand_maybe_list_expr($_[1], -ident)
  19   };
  20   $new->{expand_clause}{'select.having'} = sub {
  21     $_[0]->expand_expr($_[1])
  22   };
  23   $new->{expand}{from_list} = '_expand_from_list';
  24   $new->{render}{from_list} = '_render_from_list';
  25   $new->{expand}{join} = '_expand_join';
  26   $new->{render}{join} = '_render_join';
  27   $new->{expand_op}{as} = '_expand_op_as';
  28   $new->{expand}{as} = '_expand_op_as';
  29   $new->{render}{as} = '_render_as';
  30   return $new;
  31 }
  32
  33 sub _expand_select_clause_from {
  34   my ($self, $from) = @_;
  35   +(from => $self->_expand_from_list(undef, $from));
  36 }
  37
  38 sub _expand_from_list {
  39   my ($self, undef, $args) = @_;
  40   if (ref($args) eq 'HASH') {
  41     return { -from_list => [ $self->expand_expr($args) ] };
  42   }
  43   my @list;
  44   my @args = ref($args) ? @$args : ($args);
  45   while (my $entry = shift @args) {
  46     if (!ref($entry) and $entry =~ /^-(.*)/) {
  47       if ($1 eq 'as') {
  48         $list[-1] = $self->expand_expr({ -as => [
  49           $list[-1], map +(ref($_) eq 'ARRAY' ? @$_ : $_), shift(@args)
  50         ]});
  51         next;
  52       }
  53       $entry = { $entry => shift @args };
  54     }
  55     my $aqt = $self->expand_expr($entry, -ident);
  56     if ($aqt->{-join} and not $aqt->{-join}{from}) {
  57       $aqt->{-join}{from} = pop @list;
  58     }
  59     push @list, $aqt;
  60   }
  61   return { -from_list => \@list };
  62 }
  63
  64 sub _expand_join {
  65   my ($self, undef, $args) = @_;
  66   my %proto = (
  67     ref($args) eq 'HASH'
  68       ? %$args
  69       : (to => $args->[0], @{$args}[1..$#$args])
  70   );
  71   if (my $as = delete $proto{as}) {
  72     $proto{to} = { -as => [ $proto{to}, ref($as) eq 'ARRAY' ? @$as : $as ] };
  73   }
  74   my %ret = map +($_ => $self->expand_expr($proto{$_}, -ident)),
  75               sort keys %proto;
  76   return +{ -join => \%ret };
  77 }
  78
  79 sub _render_from_list {
  80   my ($self, $list) = @_;
  81   return $self->_join_parts(', ', map [ $self->render_aqt($_) ], @$list);
  82 }
  83
  84 sub _render_join {
  85   my ($self, $args) = @_;
  86
  87   my @parts = (
  88     [ $self->render_aqt($args->{from}) ],
  89     [ $self->_sqlcase(
  90         ($args->{type}
  91           ? join(' ', split '_', $args->{type}).' '
  92           : ''
  93         )
  94         .'join'
  95       )
  96     ],
  97     [ $self->render_aqt(
  98         map +($_->{-ident} or $_->{-as} ? $_ : { -row => [ $_ ] }), $args->{to}
  99     ) ],
 100     ($args->{on} ? (
 101       [ $self->_sqlcase('on') ],
 102       [ $self->render_aqt($args->{on}) ],
 103     ) : ()),
 104     ($args->{using} ? (
 105       [ $self->_sqlcase('using') ],
 106       [ $self->render_aqt($args->{using}) ],
 107     ) : ()),
 108   );
 109   return $self->_join_parts(' ', @parts);
 110 }
 111
 112 sub _expand_op_as {
 113   my ($self, undef, $vv, $k) = @_;
 114   my @as = map $self->expand_expr($_, -ident),
 115              (defined($k) ? ($k) : ()), ref($vv) eq 'ARRAY' ? @$vv : $vv;
 116   return { -as => \@as };
 117 }
 118
 119 sub _render_as {
 120   my ($self, $args) = @_;
 121   my ($thing, $as, @cols) = @$args;
 122   return $self->_join_parts(
 123     ' ',
 124     [ $self->render_aqt(
 125         map +($_->{-ident} ? $_ : { -row => [ $_ ] }), $thing
 126     ) ],
 127     [ $self->_sqlcase('as') ],
 128     (@cols
 129       ? [ $self->_join_parts('',
 130             [ $self->render_aqt($as) ],
 131             [ '(' ],
 132             [ $self->_join_parts(
 133                 ', ',
 134                 map [ $self->render_aqt($_) ], @cols
 135             ) ],
 136             [ ')' ],
 137         ) ]
 138       : [ $self->render_aqt($as) ]
 139     ),
 140   );
 141 }
 142
 143 1;