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 | |
d5f4b9d3 |
8 | BEGIN { *puke = \&SQL::Abstract::puke } |
9 | |
8f306bb1 |
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(@_) }; |
25b45941 |
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 | }; |
8f306bb1 |
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'; |
d5f4b9d3 |
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 | }; |
be12624c |
38 | $self->{clauses_of}{delete} = [ qw(delete_from where returning) ]; |
39 | $self->{expand}{delete} = sub { shift->_expand_statement(@_) }; |
40 | $self->{render}{delete} = sub { shift->_render_statement(delete => @_) }; |
41 | $self->{expand_clause}{'delete.delete_from'} = sub { |
42 | $_[0]->_expand_maybe_list_expr($_[1], -ident) |
43 | }; |
44 | $self->{expand_clause}{'delete.where'} = 'expand_expr'; |
45 | $self->{expand_clause}{'delete.returning'} = sub { |
46 | shift->_expand_maybe_list_expr(@_, -ident); |
47 | }; |
5ed4a77e |
48 | $self->{clauses_of}{insert} = [ 'insert_into', '', 'values', 'returning' ]; |
49 | $self->{expand}{insert} = sub { shift->_expand_statement(@_) }; |
50 | $self->{render}{insert} = sub { shift->_render_statement(insert => @_) }; |
51 | $self->{expand_clause}{'insert.insert_into'} = sub { |
52 | shift->expand_expr(@_, -ident); |
53 | }; |
54 | $self->{expand_clause}{'insert.returning'} = sub { |
55 | shift->_expand_maybe_list_expr(@_, -ident); |
56 | }; |
8f306bb1 |
57 | return $self; |
58 | } |
59 | |
60 | sub _expand_statement { |
61 | my ($self, $type, $args) = @_; |
62 | my $ec = $self->{expand_clause}; |
25b45941 |
63 | return +{ "-${type}" => +{ |
8f306bb1 |
64 | map +($_ => (do { |
65 | my $val = $args->{$_}; |
66 | if (defined($val) and my $exp = $ec->{"${type}.$_"}) { |
67 | $self->$exp($val); |
68 | } else { |
69 | $val; |
70 | } |
71 | })), sort keys %$args |
25b45941 |
72 | } }; |
8f306bb1 |
73 | } |
74 | |
75 | sub _render_statement { |
76 | my ($self, $type, $args) = @_; |
77 | my @parts; |
78 | foreach my $clause (@{$self->{clauses_of}{$type}}) { |
79 | next unless my $clause_expr = $args->{$clause}; |
b96fbdc0 |
80 | local $self->{convert_where} = $self->{convert} if $clause eq 'where'; |
81 | my ($sql, @bind) = $self->render_aqt($clause_expr); |
8f306bb1 |
82 | next unless defined($sql) and length($sql); |
83 | push @parts, [ |
84 | $self->_sqlcase(join ' ', split '_', $clause).' '.$sql, |
85 | @bind |
86 | ]; |
87 | } |
88 | return $self->_join_parts(' ', @parts); |
89 | } |
90 | |
b96fbdc0 |
91 | sub select { |
92 | my ($self, @args) = @_; |
93 | my %clauses; |
94 | @clauses{qw(from select where order_by)} = @args; |
0c3c4c23 |
95 | |
b96fbdc0 |
96 | # This oddity is to literalify since historically SQLA doesn't quote |
0c3c4c23 |
97 | # a single identifier argument, so we convert it into a literal |
98 | |
91d37de5 |
99 | $clauses{select} = { -literal => [ $clauses{select}||'*' ] } |
100 | unless ref($clauses{select}); |
101 | |
b96fbdc0 |
102 | my ($sql, @bind) = $self->render_expr({ -select => \%clauses }); |
103 | return wantarray ? ($sql, @bind) : $sql; |
104 | } |
105 | |
d5f4b9d3 |
106 | sub update { |
107 | my ($self, $table, $set, $where, $options) = @_; |
108 | my %clauses; |
109 | @clauses{qw(update set where)} = ($table, $set, $where); |
110 | puke "Unsupported data type specified to \$sql->update" |
111 | unless ref($clauses{set}) eq 'HASH'; |
112 | @clauses{keys %$options} = values %$options; |
113 | my ($sql, @bind) = $self->render_expr({ -update => \%clauses }); |
114 | return wantarray ? ($sql, @bind) : $sql; |
115 | } |
116 | |
be12624c |
117 | sub delete { |
118 | my ($self, $table, $where, $options) = @_; |
119 | my %clauses = (delete_from => $table, where => $where, %{$options||{}}); |
120 | my ($sql, @bind) = $self->render_expr({ -delete => \%clauses }); |
121 | return wantarray ? ($sql, @bind) : $sql; |
122 | } |
123 | |
5ed4a77e |
124 | sub insert { |
125 | my ($self, $table, $data, $options) = @_; |
126 | my %clauses = (insert_into => $table, %{$options||{}}); |
127 | my ($f_aqt, $v_aqt) = $self->_expand_insert_values($data); |
128 | $clauses{''} = $f_aqt if $f_aqt; |
129 | $clauses{values} = $v_aqt; |
130 | my ($sql, @bind) = $self->render_expr({ -insert => \%clauses }); |
131 | return wantarray ? ($sql, @bind) : $sql; |
132 | } |
133 | |
8f306bb1 |
134 | 1; |