X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FClauses.pm;h=f60ddad71f5e356ca94b86bfc0b50fb5755e9e8f;hb=3f312d2ef239a20bc7b339a15383a94d18980b03;hp=5fd0fdd7e9ebd3f561182633321ac2c28eedd3da;hpb=aa03ef045e4d6d83de753177a32c8256eb6f282c;p=scpubgit%2FQ-Branch.git diff --git a/lib/SQL/Abstract/Clauses.pm b/lib/SQL/Abstract/Clauses.pm index 5fd0fdd..f60ddad 100644 --- a/lib/SQL/Abstract/Clauses.pm +++ b/lib/SQL/Abstract/Clauses.pm @@ -44,18 +44,10 @@ sub register_defaults { ]; $self->{expand}{insert} = sub { shift->_expand_statement(@_) }; $self->{render}{insert} = sub { shift->_render_statement(@_) }; + $self->{expand_clause}{"insert.$_"} = "_expand_insert_clause_$_" + for @{$self->{clauses_of}{insert}}; $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 => [ - $_[0]->_expand_maybe_list_expr($_[2], -ident) - ] } if ref($_[2]) eq 'ARRAY'; - return $_[2]; # should maybe still expand somewhat? - }; - $self->{expand_clause}{'insert.values'} = '_expand_insert_clause_values'; - $self->{expand_clause}{'insert.returning'} = sub { - $_[0]->_expand_maybe_list_expr($_[2], -ident); - }; + $self->{expand_clause}{'insert.values'} = '_expand_insert_clause_from'; $self->{render_clause}{'insert.fields'} = sub { return $_[0]->render_aqt($_[2]); }; @@ -156,24 +148,23 @@ sub _render_statement { my @parts; foreach my $clause (@{$self->{clauses_of}{$type}}) { next unless my $clause_expr = $args->{$clause}; - my @part = do { + my $part = do { if (my $rdr = $self->{render_clause}{"${type}.${clause}"}) { $self->$rdr($clause, $clause_expr); } else { - my ($clause_sql, @bind) = $self->render_aqt($clause_expr, 1); - my $sql = join ' ', - $self->_sqlcase(join ' ', split '_', $clause), - $clause_sql; - ($sql, @bind); + $self->join_query_parts(' ', + $self->format_keyword($clause), + $self->render_aqt($clause_expr, 1) + ); } }; - push @parts, \@part; + push @parts, $part; } - my ($sql, @bind) = $self->join_query_parts(' ', @parts); - return ( + my ($sql, @bind) = @{ $self->join_query_parts(' ', @parts) }; + return [ (our $Render_Top_Level ? $sql : '('.$sql.')'), @bind - ); + ]; } sub render_aqt { @@ -184,65 +175,95 @@ sub render_aqt { sub render_statement { my ($self, $expr, $default_scalar_to) = @_; - my ($sql, @bind) = $self->render_aqt( + $self->render_aqt( $self->expand_expr($expr, $default_scalar_to), 1 ); - return (wantarray ? ($sql, @bind) : $sql); } sub select { my ($self, @args) = @_; - return $self->render_statement({ -select => $_[1] }) if ref($_[1]) eq 'HASH'; - - my %clauses; - @clauses{qw(from select where order_by)} = @args; + my $stmt = do { + if (ref(my $sel = $args[0]) eq 'HASH') { + $sel + } else { + my %clauses; + @clauses{qw(from select where order_by)} = @args; - # This oddity is to literalify since historically SQLA doesn't quote - # a single identifier argument, so we convert it into a literal + # This oddity is to literalify since historically SQLA doesn't quote + # a single identifier argument, so we convert it into a literal - $clauses{select} = { -literal => [ $clauses{select}||'*' ] } - unless ref($clauses{select}); + $clauses{select} = { -literal => [ $clauses{select}||'*' ] } + unless ref($clauses{select}); + \%clauses; + } + }; - return $self->render_statement({ -select => \%clauses }); + my $rendered = $self->render_statement({ -select => $stmt }); + return wantarray ? @$rendered : $rendered->[0]; } sub update { my ($self, $table, $set, $where, $options) = @_; - return $self->render_statement({ -update => $_[1] }) if ref($_[1]) eq 'HASH'; - - my %clauses; - @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; - return $self->render_statement({ -update => \%clauses }); + my $stmt = do { + if (ref($table) eq 'HASH') { + $table + } else { + my %clauses; + @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; + \%clauses; + } + }; + my $rendered = $self->render_statement({ -update => $stmt }); + return wantarray ? @$rendered : $rendered->[0]; } sub delete { my ($self, $table, $where, $options) = @_; - return $self->render_statement({ -delete => $_[1] }) if ref($_[1]) eq 'HASH'; - - my %clauses = (target => $table, where => $where, %{$options||{}}); - return $self->render_statement({ -delete => \%clauses }); + my $stmt = do { + if (ref($table) eq 'HASH') { + $table; + } else { + my %clauses = (target => $table, where => $where, %{$options||{}}); + \%clauses; + } + }; + my $rendered = $self->render_statement({ -delete => $stmt }); + return wantarray ? @$rendered : $rendered->[0]; } sub insert { my ($self, $table, $data, $options) = @_; - return $self->render_statement({ -insert => $_[1] }) if ref($_[1]) eq 'HASH'; - - my %clauses = (target => $table, values => $data, %{$options||{}}); - return $self->render_statement({ -insert => \%clauses }); + my $stmt = do { + if (ref($table) eq 'HASH') { + $table; + } else { + my %clauses = (target => $table, values => $data, %{$options||{}}); + \%clauses; + } + }; + my $rendered = $self->render_statement({ -insert => $stmt }); + return wantarray ? @$rendered : $rendered->[0]; } sub _expand_insert_clause_target { +(target => $_[0]->_expand_maybe_list_expr($_[2], -ident)); } -sub _expand_insert_clause_values { +sub _expand_insert_clause_fields { + return +{ -row => [ + $_[0]->_expand_maybe_list_expr($_[2], -ident) + ] } if ref($_[2]) eq 'ARRAY'; + return $_[2]; # should maybe still expand somewhat? +} + +sub _expand_insert_clause_from { my ($self, undef, $data) = @_; if (ref($data) eq 'HASH' and (keys(%$data))[0] =~ /^-/) { return $self->expand_expr($data); @@ -252,6 +273,10 @@ sub _expand_insert_clause_values { return (from => { -values => $v_aqt }, ($f_aqt ? (fields => $f_aqt) : ())); } +sub _expand_insert_clause_returning { + +(returning => $_[0]->_expand_maybe_list_expr($_[2], -ident)); +} + sub _expand_values { my ($self, undef, $values) = @_; return { -values => [ @@ -265,14 +290,12 @@ sub _expand_values { sub _render_values { my ($self, undef, $values) = @_; - my $inner = [ - $self->join_query_parts(' ', - $self->format_keyword('values'), - [ $self->join_query_parts(', ', - ref($values) eq 'ARRAY' ? @$values : $values - ) ], + my $inner = $self->join_query_parts(' ', + $self->format_keyword('values'), + $self->join_query_parts(', ', + ref($values) eq 'ARRAY' ? @$values : $values ), - ]; + ); return $self->join_query_parts('', (our $Render_Top_Level ? $inner : ('(', $inner, ')')) );