Commit | Line | Data |
8f306bb1 |
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(@_) }; |
25b45941 |
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 | }; |
8f306bb1 |
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}; |
25b45941 |
31 | return +{ "-${type}" => +{ |
8f306bb1 |
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 |
25b45941 |
40 | } }; |
8f306bb1 |
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}; |
b96fbdc0 |
48 | local $self->{convert_where} = $self->{convert} if $clause eq 'where'; |
49 | my ($sql, @bind) = $self->render_aqt($clause_expr); |
8f306bb1 |
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 | |
b96fbdc0 |
59 | sub select { |
60 | my ($self, @args) = @_; |
61 | my %clauses; |
62 | @clauses{qw(from select where order_by)} = @args; |
63 | # This oddity is to literalify since historically SQLA doesn't quote |
64 | # a single identifier argument, and the .'' is to copy $clauses{select} |
65 | # before taking a reference to it to avoid making a reference loop |
66 | $clauses{select}= \(($clauses{select}||'*').'') |
67 | unless ref($clauses{select}); |
68 | my ($sql, @bind) = $self->render_expr({ -select => \%clauses }); |
69 | return wantarray ? ($sql, @bind) : $sql; |
70 | } |
71 | |
8f306bb1 |
72 | 1; |