X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FClauses.pm;h=86f74b9634dfd7bbb9186130e7109d83e3b172f6;hb=93253a11f1f3e0ad2479e38f50963593394c9afc;hp=d769abd401541d7782330ee2a5e563b64640c92d;hpb=df0f5af9acf9eb0d408dfbbd59382850a1cbf1e6;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/Clauses.pm b/lib/SQL/Abstract/Clauses.pm index d769abd..86f74b9 100644 --- a/lib/SQL/Abstract/Clauses.pm +++ b/lib/SQL/Abstract/Clauses.pm @@ -2,6 +2,7 @@ package SQL::Abstract::Clauses; use strict; use warnings; +use if $] < '5.010', 'MRO::Compat'; use mro 'c3'; use base 'SQL::Abstract'; @@ -18,40 +19,55 @@ sub register_defaults { $self->{render}{select} = sub { shift->_render_statement(select => @_) }; $self->{expand_clause}{"select.$_"} = "_expand_select_clause_$_" for @{$self->{clauses_of}{select}}; - $self->{clauses_of}{update} = [ qw(update set where returning) ]; + $self->{clauses_of}{update} = [ qw(target set where returning) ]; $self->{expand}{update} = sub { shift->_expand_statement(@_) }; $self->{render}{update} = sub { shift->_render_statement(update => @_) }; - $self->{expand_clause}{'update.update'} = sub { - $_[0]->expand_expr($_[1], -ident) + $self->{expand_clause}{"update.$_"} = "_expand_update_clause_$_" + for @{$self->{clauses_of}{update}}; + $self->{expand_clause}{'update.update'} = '_expand_update_clause_target'; + $self->{render_clause}{'update.target'} = sub { + my ($self, $target) = @_; + my ($sql, @bind) = $self->render_aqt($target); + ($self->_sqlcase('update ').$sql, @bind); }; - $self->{expand_clause}{'update.set'} = '_expand_update_set_values'; - $self->{expand_clause}{'update.where'} = 'expand_expr'; - $self->{expand_clause}{'update.returning'} = sub { - shift->_expand_maybe_list_expr(@_, -ident); - }; - $self->{clauses_of}{delete} = [ qw(delete_from where returning) ]; + $self->{clauses_of}{delete} = [ qw(target where returning) ]; $self->{expand}{delete} = sub { shift->_expand_statement(@_) }; $self->{render}{delete} = sub { shift->_render_statement(delete => @_) }; - $self->{expand_clause}{'delete.delete_from'} = sub { - $_[0]->_expand_maybe_list_expr($_[1], -ident) - }; - $self->{expand_clause}{'delete.where'} = 'expand_expr'; - $self->{expand_clause}{'delete.returning'} = sub { - shift->_expand_maybe_list_expr(@_, -ident); + $self->{expand_clause}{"delete.$_"} = "_expand_delete_clause_$_" + for @{$self->{clauses_of}{delete}}; + $self->{expand_clause}{"delete.from"} = '_expand_delete_clause_target'; + $self->{render_clause}{'delete.target'} = sub { + my ($self, $from) = @_; + my ($sql, @bind) = $self->render_aqt($from); + ($self->_sqlcase('delete from ').$sql, @bind); }; $self->{clauses_of}{insert} = [ - 'insert_into', 'fields', 'values', 'returning' + 'target', 'fields', 'from', 'returning' ]; $self->{expand}{insert} = sub { shift->_expand_statement(@_) }; $self->{render}{insert} = sub { shift->_render_statement(insert => @_) }; - $self->{expand_clause}{'insert.insert_into'} = sub { - shift->expand_expr(@_, -ident); + $self->{expand_clause}{'insert.into'} = '_expand_insert_clause_target'; + $self->{expand_clause}{'insert.target'} = '_expand_insert_clause_target'; + $self->{expand_clause}{'insert.fields'} = sub { + return +{ -row => [ + shift->_expand_maybe_list_expr(@_, -ident) + ] } if ref($_[1]) eq 'ARRAY'; + return $_[1]; # should maybe still expand somewhat? }; + $self->{expand_clause}{'insert.values'} = '_expand_insert_clause_values'; $self->{expand_clause}{'insert.returning'} = sub { shift->_expand_maybe_list_expr(@_, -ident); }; $self->{render_clause}{'insert.fields'} = sub { - return $_[0]->render_aqt({ -row => [ $_[1] ] }); + return $_[0]->render_aqt($_[1]); + }; + $self->{render_clause}{'insert.target'} = sub { + my ($self, $from) = @_; + my ($sql, @bind) = $self->render_aqt($from); + ($self->_sqlcase('insert into ').$sql, @bind); + }; + $self->{render_clause}{'insert.from'} = sub { + return $_[0]->render_aqt($_[1]); }; return $self; } @@ -76,6 +92,34 @@ sub _expand_select_clause_order_by { +(order_by => $self->_expand_order_by($order_by)); } +sub _expand_update_clause_target { + my ($self, $target) = @_; + +(target => $self->_expand_maybe_list_expr($target, -ident)); +} + +sub _expand_update_clause_set { + return $_[1] if ref($_[1]) eq 'HASH' and ($_[1]->{-op}||[''])->[0] eq ','; + +(set => shift->_expand_update_set_values(@_)); +} + +sub _expand_update_clause_where { + +(where => shift->expand_expr(@_)); +} + +sub _expand_update_clause_returning { + +(returning => shift->_expand_maybe_list_expr(@_, -ident)); +} + +sub _expand_delete_clause_target { + +(target => shift->_expand_maybe_list_expr(@_, -ident)); +} + +sub _expand_delete_clause_where { +(where => shift->expand_expr(@_)); } + +sub _expand_delete_clause_returning { + +(returning => shift->_expand_maybe_list_expr(@_, -ident)); +} + sub _expand_statement { my ($self, $type, $args) = @_; my $ec = $self->{expand_clause}; @@ -89,7 +133,7 @@ sub _expand_statement { @exp } } else { - ($_ => $val) + ($_ => $self->expand_expr($val)) } } sort keys %$args } }; @@ -120,6 +164,9 @@ sub _render_statement { sub select { my ($self, @args) = @_; + + return $self->render_expr({ -select => $_[1] }) if ref($_[1]) eq 'HASH'; + my %clauses; @clauses{qw(from select where order_by)} = @args; @@ -129,36 +176,52 @@ sub select { $clauses{select} = { -literal => [ $clauses{select}||'*' ] } unless ref($clauses{select}); - my ($sql, @bind) = $self->render_expr({ -select => \%clauses }); - return wantarray ? ($sql, @bind) : $sql; + return $self->render_expr({ -select => \%clauses }); } sub update { my ($self, $table, $set, $where, $options) = @_; + + return $self->render_expr({ -update => $_[1] }) if ref($_[1]) eq 'HASH'; + my %clauses; - @clauses{qw(update set where)} = ($table, $set, $where); + @clauses{qw(target set where)} = ($table, $set, $where); puke "Unsupported data type specified to \$sql->update" unless ref($clauses{set}) eq 'HASH'; @clauses{keys %$options} = values %$options; - my ($sql, @bind) = $self->render_expr({ -update => \%clauses }); - return wantarray ? ($sql, @bind) : $sql; + return $self->render_expr({ -update => \%clauses }); } sub delete { my ($self, $table, $where, $options) = @_; - my %clauses = (delete_from => $table, where => $where, %{$options||{}}); - my ($sql, @bind) = $self->render_expr({ -delete => \%clauses }); - return wantarray ? ($sql, @bind) : $sql; + + return $self->render_expr({ -delete => $_[1] }) if ref($_[1]) eq 'HASH'; + + my %clauses = (target => $table, where => $where, %{$options||{}}); + return $self->render_expr({ -delete => \%clauses }); } sub insert { my ($self, $table, $data, $options) = @_; - my %clauses = (insert_into => $table, %{$options||{}}); + + return $self->render_expr({ -insert => $_[1] }) if ref($_[1]) eq 'HASH'; + + my %clauses = (target => $table, values => $data, %{$options||{}}); + return $self->render_expr({ -insert => \%clauses }); +} + +sub _expand_insert_clause_target { + +(target => shift->_expand_maybe_list_expr(@_, -ident)); +} + +sub _expand_insert_clause_values { + my ($self, $data) = @_; + if (ref($data) eq 'HASH' and (keys(%$data))[0] =~ /^-/) { + return $self->expand_expr($data); + } + return $data if ref($data) eq 'HASH' and $data->{-row}; my ($f_aqt, $v_aqt) = $self->_expand_insert_values($data); - $clauses{fields} = $f_aqt if $f_aqt; - $clauses{values} = $v_aqt; - my ($sql, @bind) = $self->render_expr({ -insert => \%clauses }); - return wantarray ? ($sql, @bind) : $sql; + return (from => { -values => $v_aqt }, ($f_aqt ? (fields => $f_aqt) : ())); } 1;