X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=a6bbb05e5a14dfb85e5526b13183231a799aba08;hb=4baf4bbe585315493208a73e0aa71b50aded9d7d;hp=692816fa001c279174f941f887ccad971cd329af;hpb=1f490ae449fd0c9dc413b776cbc77557f79d6ab5;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 692816f..a6bbb05 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -27,7 +27,7 @@ BEGIN { # GLOBALS #====================================================================== -our $VERSION = '1.78'; +our $VERSION = '1.81'; # This would confuse some packagers $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases @@ -78,11 +78,6 @@ sub puke (@) { sub is_literal_value ($) { ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ] : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ] - : ( - ref $_[0] eq 'HASH' and keys %{$_[0]} == 1 - and - defined $_[0]->{-ident} and ! length ref $_[0]->{-ident} - ) ? [ $_[0]->{-ident} ] : undef; } @@ -525,7 +520,10 @@ sub _where_ARRAYREF { my (@sql_clauses, @all_bind); # need to use while() so can shift() for pairs - while (my $el = shift @clauses) { + while (@clauses) { + my $el = shift @clauses; + + $el = undef if (defined $el and ! length $el); # switch according to kind of $el and get corresponding ($sql, @bind) my ($sql, @bind) = $self->_SWITCH_refkind($el, { @@ -543,10 +541,12 @@ sub _where_ARRAYREF { SCALARREF => sub { ($$el); }, - SCALAR => sub {# top-level arrayref with scalars, recurse in pairs - $self->_recurse_where({$el => shift(@clauses)})}, + SCALAR => sub { + # top-level arrayref with scalars, recurse in pairs + $self->_recurse_where({$el => shift(@clauses)}) + }, - UNDEF => sub {puke "not supported : UNDEF in arrayref" }, + UNDEF => sub {puke "Supplying an empty left hand side argument is not supported in array-pairs" }, }); if ($sql) { @@ -600,11 +600,20 @@ sub _where_HASHREF { $s = "($s)" unless ( List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}} or - defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k) + ( defined $self->{_nested_func_lhs} and $self->{_nested_func_lhs} eq $k ) ); ($s, @b); } else { + if (! length $k) { + if (is_literal_value ($v) ) { + belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead'; + } + else { + puke "Supplying an empty left hand side argument is not supported in hash-pairs"; + } + } + my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v); $self->$method($k, $v); } @@ -620,6 +629,11 @@ sub _where_HASHREF { sub _where_unary_op { my ($self, $op, $rhs) = @_; + # top level special ops are illegal in general + # this includes the -ident/-value ops (dual purpose unary and special) + puke "Illegal use of top-level '-$op'" + if ! defined $self->{_nested_func_lhs} and List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}}; + if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) { my $handler = $op_entry->{handler}; @@ -644,8 +658,8 @@ sub _where_unary_op { my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, { SCALAR => sub { - puke "Illegal use of top-level '$op'" - unless $self->{_nested_func_lhs}; + puke "Illegal use of top-level '-$op'" + unless defined $self->{_nested_func_lhs}; return ( $self->_convert('?'), @@ -777,7 +791,7 @@ sub _where_op_VALUE { # special-case NULL if (! defined $rhs) { - return $lhs + return defined $lhs ? $self->_convert($self->_quote($lhs)) . ' IS NULL' : undef ; @@ -785,7 +799,7 @@ sub _where_op_VALUE { my @bind = $self->_bindtype ( - ($lhs || $self->{_nested_func_lhs}), + ( defined $lhs ? $lhs : $self->{_nested_func_lhs} ), $rhs, ) ; @@ -836,7 +850,10 @@ sub _where_hashpair_HASHREF { my ($self, $k, $v, $logic) = @_; $logic ||= 'and'; - local $self->{_nested_func_lhs} = $self->{_nested_func_lhs}; + local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs} + ? $self->{_nested_func_lhs} + : $k + ; my ($all_sql, @all_bind); @@ -915,10 +932,6 @@ sub _where_hashpair_HASHREF { }, FALLBACK => sub { # CASE: col => {op/func => $stuff} - - # retain for proper column type bind - $self->{_nested_func_lhs} ||= $k; - ($sql, @bind) = $self->_where_unary_op ($op, $val); $sql = join (' ', @@ -1114,7 +1127,6 @@ sub _where_field_BETWEEN { my ($func, $arg, @rest) = %$val; puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN") if (@rest or $func !~ /^ \- (.+)/x); - local $self->{_nested_func_lhs} = $k; $self->_where_unary_op ($1 => $arg); }, FALLBACK => sub { @@ -1172,7 +1184,6 @@ sub _where_field_IN { my ($func, $arg, @rest) = %$val; puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN") if (@rest or $func !~ /^ \- (.+)/x); - local $self->{_nested_func_lhs} = $k; $self->_where_unary_op ($1 => $arg); }, UNDEF => sub { @@ -1231,8 +1242,29 @@ sub _where_field_IN { # adding them back in the corresponding method sub _open_outer_paren { my ($self, $sql) = @_; - $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs; - return $sql; + + while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) { + + # there are closing parens inside, need the heavy duty machinery + # to reevaluate the extraction starting from $sql (full reevaluation) + if ( $inner =~ /\)/ ) { + require Text::Balanced; + + my (undef, $remainder) = do { + # idiotic design - writes to $@ but *DOES NOT* throw exceptions + local $@; + Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ ); + }; + + # the entire expression needs to be a balanced bracketed thing + # (after an extract no remainder sans trailing space) + last if defined $remainder and $remainder =~ /\S/; + } + + $sql = $inner; + } + + $sql; } @@ -1778,9 +1810,9 @@ Easy, eh? =head1 METHODS -The methods are simple. There's one for each major SQL operation, +The methods are simple. There's one for every major SQL operation, and a constructor you use first. The arguments are specified in a -similar order to each method (table, then fields, then a where +similar order for each method (table, then fields, then a where clause) to try and simplify things. =head2 new(option => 'value') @@ -1952,7 +1984,7 @@ words in your database's SQL dialect. This is the character that will be used to escape Ls appearing in an identifier before it has been quoted. -The paramter default in case of a single L character is the quote +The parameter default in case of a single L character is the quote character itself. When opening-closing-style quoting is used (L is an arrayref) @@ -2219,8 +2251,6 @@ module: =item * C<\[ $sql_string, @bind_values ]> -=item * C<< { -ident => $plain_defined_string } >> - =back On failure returns C, on sucess returns an B reference @@ -2350,7 +2380,7 @@ Which would generate: @bind = ('2', '5', 'nwiger'); If you want to include literal SQL (with or without bind values), just use a -scalar reference or array reference as the value: +scalar reference or reference to an arrayref as the value: my %where = ( date_entered => { '>' => \["to_date(?, 'MM/DD/YYYY')", "11/26/2008"] }, @@ -2359,7 +2389,7 @@ scalar reference or array reference as the value: Which would generate: - $stmt = "WHERE date_entered > "to_date(?, 'MM/DD/YYYY') AND date_expires < now()"; + $stmt = "WHERE date_entered > to_date(?, 'MM/DD/YYYY') AND date_expires < now()"; @bind = ('11/26/2008'); @@ -2373,7 +2403,7 @@ this (notice the C): Because, in Perl you I do this: - priority => { '!=', 2, '!=', 1 } + priority => { '!=' => 2, '!=' => 1 } As the second C key will obliterate the first. The solution is to use the special C<-modifier> form inside an arrayref: @@ -2565,10 +2595,10 @@ to change the logic inside : That would yield: - WHERE ( user = ? AND ( - ( workhrs > ? AND geo = ? ) - OR ( workhrs < ? OR geo = ? ) - ) ) + $stmt = "WHERE ( user = ? + AND ( ( workhrs > ? AND geo = ? ) + OR ( workhrs < ? OR geo = ? ) ) )"; + @bind = ('nwiger', '20', 'ASIA', '50', 'EURO'); =head3 Algebraic inconsistency, for historical reasons @@ -2914,14 +2944,14 @@ Either a coderef or a plain scalar method name. In both cases the expected return is C<< ($sql, @bind) >>. When supplied with a method name, it is simply called on the -L object as: +L object as: $self->$method_name ($field, $op, $arg) Where: - $op is the part that matched the handler regex $field is the LHS of the operator + $op is the part that matched the handler regex $arg is the RHS When supplied with a coderef, it is called as: @@ -2990,7 +3020,7 @@ Either a coderef or a plain scalar method name. In both cases the expected return is C<< $sql >>. When supplied with a method name, it is simply called on the -L object as: +L object as: $self->$method_name ($op, $arg) @@ -3071,13 +3101,27 @@ a fast interface to returning and formatting data. I frequently use these three modules together to write complex database query apps in under 50 lines. -=head1 REPO +=head1 HOW TO CONTRIBUTE + +Contributions are always welcome, in all usable forms (we especially +welcome documentation improvements). The delivery methods include git- +or unified-diff formatted patches, GitHub pull requests, or plain bug +reports either via RT or the Mailing list. Contributors are generally +granted full access to the official repository after their first several +patches pass successful review. + +This project is maintained in a git repository. The code and related tools are +accessible at the following locations: =over -=item * gitweb: L +=item * Official repo: L + +=item * Official gitweb: L + +=item * GitHub mirror: L -=item * git: L +=item * Authorized committers: L =back