From: Matt S Trout Date: Wed, 17 Apr 2019 00:46:00 +0000 (+0000) Subject: move clause rendering to better calling convention X-Git-Tag: v2.000000~3^2~220 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1107714be1247d3560769d2ed50d9b5243f249d4;p=dbsrgits%2FSQL-Abstract.git move clause rendering to better calling convention --- diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 326fd0d..3a21089 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -393,12 +393,12 @@ sub _update_set_values { my ($self, $data) = @_; return $self->render_aqt( - $self->_expand_update_set_values($data), + $self->_expand_update_set_values(undef, $data), ); } sub _expand_update_set_values { - my ($self, $data) = @_; + my ($self, undef, $data) = @_; $self->_expand_maybe_list_expr( [ map { my ($k, $set) = @$_; diff --git a/lib/SQL/Abstract/Clauses.pm b/lib/SQL/Abstract/Clauses.pm index fc36e74..605424f 100644 --- a/lib/SQL/Abstract/Clauses.pm +++ b/lib/SQL/Abstract/Clauses.pm @@ -26,7 +26,7 @@ sub register_defaults { for @{$self->{clauses_of}{update}}; $self->{expand_clause}{'update.update'} = '_expand_update_clause_target'; $self->{render_clause}{'update.target'} = sub { - my ($self, $target) = @_; + my ($self, undef, $target) = @_; my ($sql, @bind) = $self->render_aqt($target); ($self->_sqlcase('update ').$sql, @bind); }; @@ -37,7 +37,7 @@ sub register_defaults { for @{$self->{clauses_of}{delete}}; $self->{expand_clause}{"delete.from"} = '_expand_delete_clause_target'; $self->{render_clause}{'delete.target'} = sub { - my ($self, $from) = @_; + my ($self, undef, $from) = @_; my ($sql, @bind) = $self->render_aqt($from); ($self->_sqlcase('delete from ').$sql, @bind); }; @@ -50,24 +50,24 @@ sub register_defaults { $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? + shift->_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 { shift->_expand_maybe_list_expr(@_, -ident); }; $self->{render_clause}{'insert.fields'} = sub { - return $_[0]->render_aqt($_[1]); + return $_[0]->render_aqt($_[2]); }; $self->{render_clause}{'insert.target'} = sub { - my ($self, $from) = @_; + my ($self, undef, $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], 1); + return $_[0]->render_aqt($_[2], 1); }; $self->{expand}{values} = '_expand_values'; $self->{render}{values} = '_render_values'; @@ -78,51 +78,51 @@ sub register_defaults { } sub _expand_select_clause_select { - my ($self, $select) = @_; + my ($self, undef, $select) = @_; +(select => $self->_expand_maybe_list_expr($select, -ident)); } sub _expand_select_clause_from { - my ($self, $from) = @_; + my ($self, undef, $from) = @_; +(from => $self->_expand_maybe_list_expr($from, -ident)); } sub _expand_select_clause_where { - my ($self, $where) = @_; + my ($self, undef, $where) = @_; +(where => $self->expand_expr($where)); } sub _expand_select_clause_order_by { - my ($self, $order_by) = @_; + my ($self, undef, $order_by) = @_; +(order_by => $self->_expand_order_by($order_by)); } sub _expand_update_clause_target { - my ($self, $target) = @_; + my ($self, undef, $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(@_)); + return $_[2] if ref($_[2]) eq 'HASH' and ($_[2]->{-op}||[''])->[0] eq ','; + +(set => $_[0]->_expand_update_set_values($_[1], $_[2])); } sub _expand_update_clause_where { - +(where => shift->expand_expr(@_)); + +(where => $_[0]->expand_expr($_[2])); } sub _expand_update_clause_returning { - +(returning => shift->_expand_maybe_list_expr(@_, -ident)); + +(returning => $_[0]->_expand_maybe_list_expr($_[2], -ident)); } sub _expand_delete_clause_target { - +(target => shift->_expand_maybe_list_expr(@_, -ident)); + +(target => $_[0]->_expand_maybe_list_expr($_[2], -ident)); } -sub _expand_delete_clause_where { +(where => shift->expand_expr(@_)); } +sub _expand_delete_clause_where { +(where => $_[0]->expand_expr($_[2])); } sub _expand_delete_clause_returning { - +(returning => shift->_expand_maybe_list_expr(@_, -ident)); + +(returning => $_[0]->_expand_maybe_list_expr($_[2], -ident)); } sub _expand_statement { @@ -136,7 +136,7 @@ sub _expand_statement { map { my $val = $args->{$_}; if (defined($val) and my $exp = $ec->{"${type}.$_"}) { - if ((my (@exp) = $self->$exp($val)) == 1) { + if ((my (@exp) = $self->$exp($_ => $val)) == 1) { ($_ => $exp[0]) } else { @exp @@ -156,7 +156,7 @@ sub _render_statement { local $self->{convert_where} = $self->{convert} if $clause eq 'where'; my ($sql) = my @part = do { if (my $rdr = $self->{render_clause}{"${type}.${clause}"}) { - $self->$rdr($clause_expr); + $self->$rdr($clause, $clause_expr); } else { my ($clause_sql, @bind) = $self->render_aqt($clause_expr, 1); my $sql = join ' ', @@ -238,11 +238,11 @@ sub insert { } sub _expand_insert_clause_target { - +(target => shift->_expand_maybe_list_expr(@_, -ident)); + +(target => $_[0]->_expand_maybe_list_expr($_[2], -ident)); } sub _expand_insert_clause_values { - my ($self, $data) = @_; + my ($self, undef, $data) = @_; if (ref($data) eq 'HASH' and (keys(%$data))[0] =~ /^-/) { return $self->expand_expr($data); } @@ -327,5 +327,4 @@ sub clone { ); } - 1; diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index 7c534c1..ad49758 100644 --- a/lib/SQL/Abstract/ExtraClauses.pm +++ b/lib/SQL/Abstract/ExtraClauses.pm @@ -24,9 +24,9 @@ sub register_defaults { $self->clauses_of(select => 'with', @clauses); $self->clause_expanders( 'select.group_by', sub { - $_[0]->_expand_maybe_list_expr($_[1], -ident) + $_[0]->_expand_maybe_list_expr($_[2], -ident) }, - 'select.having', 'expand_expr', + 'select.having', sub { $_[0]->expand_expr($_[2]) }, ); foreach my $thing (qw(join from_list)) { $self->expander($thing => "_expand_${thing}") @@ -51,13 +51,13 @@ sub register_defaults { $self->clause_expanders( 'update.from' => '_expand_select_clause_from', 'delete.using' => sub { - +(using => $_[0]->_expand_from_list(undef, $_[1])); + +(using => $_[0]->_expand_from_list(undef, $_[2])); }, 'insert.rowvalues' => sub { - +(from => $_[0]->expand_expr({ -values => $_[1] })); + +(from => $_[0]->expand_expr({ -values => $_[2] })); }, 'insert.select' => sub { - +(from => $_[0]->expand_expr({ -select => $_[1] })); + +(from => $_[0]->expand_expr({ -select => $_[2] })); }, ); @@ -86,7 +86,7 @@ sub register_defaults { $self->expanders(map +($_ => $expand_setop), qw(union intersect except)); $self->clause_renderer('select.setop' => sub { - my ($self, $setop) = @_; + my ($self, undef, $setop) = @_; $self->render_aqt($setop); }); @@ -103,7 +103,7 @@ sub register_defaults { $self->clause_expander("select.${setop}" => sub { +(setop => $_[0]->expand_expr({ "-${setop}" => { - queries => (ref($_[1]) eq 'ARRAY' ? $_[1] : [ $_[1] ]), + queries => (ref($_[2]) eq 'ARRAY' ? $_[2] : [ $_[2] ]), } })); }); @@ -111,13 +111,13 @@ sub register_defaults { +(setop => $_[0]->expand_expr({ "-${setop}" => { type => 'all', - queries => (ref($_[1]) eq 'ARRAY' ? $_[1] : [ $_[1] ]), + queries => (ref($_[2]) eq 'ARRAY' ? $_[2] : [ $_[2] ]), } })); }); } $self->clause_expander('select.with' => my $with_expander = sub { - my ($self, $with) = @_; + my ($self, undef, $with) = @_; if (ref($with) eq 'HASH') { return +{ %$with, @@ -137,15 +137,15 @@ sub register_defaults { return +{ queries => \@exp }; }); $self->clause_expander('select.with_recursive' => sub { - my ($self, $with) = @_; - my $exp = $self->$with_expander($with); + my ($self, undef, $with) = @_; + my $exp = $self->$with_expander(undef, $with); return +(with => +{ %$exp, type => 'recursive' }); }); $self->clause_renderer('select.with' => sub { - my ($self, $with) = @_; + my ($self, undef, $with) = @_; my $q_part = [ $self->join_clauses(', ', map { my ($alias, $query) = @$_; @@ -168,7 +168,7 @@ sub register_defaults { sub format_keyword { $_[0]->_sqlcase(join ' ', split '_', $_[1]) } sub _expand_select_clause_from { - my ($self, $from) = @_; + my ($self, undef, $from) = @_; +(from => $self->_expand_from_list(undef, $from)); } @@ -281,7 +281,7 @@ sub _render_alias { } sub _expand_update_clause_target { - my ($self, $target) = @_; + my ($self, undef, $target) = @_; +(target => $self->_expand_from_list(undef, $target)); } diff --git a/t/01generate.t b/t/01generate.t index 4fa38ed..87bce6a 100644 --- a/t/01generate.t +++ b/t/01generate.t @@ -863,6 +863,7 @@ for my $t (@tests) { } else { lives_ok(sub { + alarm(5); local $SIG{ALRM} = sub { die "Timed out" }; warnings_like( sub { $cref->() }, $t->{warns} || [],