From: Peter Rabbitson Date: Thu, 26 Dec 2013 05:07:25 +0000 (+0100) Subject: Remove many of the settled-by-time comments, modernize a bit X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=46dc2f3e47d514cd376003cea2df63222c492b0b;p=scpubgit%2FQ-Branch.git Remove many of the settled-by-time comments, modernize a bit --- diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index d017b85..6dabd39 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -1,10 +1,5 @@ package SQL::Abstract; # see doc at end of file -# LDNOTE : this code is heavy refactoring from original SQLA. -# Several design decisions will need discussion during -# the test / diffusion / acceptance phase; those are marked with flag -# 'LDNOTE' (note by laurent.dami AT free.fr) - use strict; use warnings; use Carp (); @@ -79,8 +74,6 @@ sub new { $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR'; # how to return bind vars - # LDNOTE: changed nwiger code : why this 'delete' ?? - # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal'; $opt{bindtype} ||= 'normal'; # default comparison is "=", but can be overridden @@ -457,11 +450,6 @@ sub _where_ARRAYREF { }, HASHREF => sub {$self->_recurse_where($el, 'and') if %$el}, - # LDNOTE : previous SQLA code for hashrefs was creating a dirty - # side-effect: the first hashref within an array would change - # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ] - # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)", - # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)". SCALARREF => sub { ($$el); }, @@ -741,7 +729,6 @@ sub _where_hashpair_ARRAYREF { return $self->_recurse_where(\@distributed, $logic); } else { - # LDNOTE : not sure of this one. What does "distribute over nothing" mean? $self->_debug("empty ARRAY($k) means 0=1"); return ($self->{sqlfalse}); } @@ -1252,16 +1239,6 @@ sub _quote { # Conversion, if applicable sub _convert ($) { #my ($self, $arg) = @_; - -# LDNOTE : modified the previous implementation below because -# it was not consistent : the first "return" is always an array, -# the second "return" is context-dependent. Anyway, _convert -# seems always used with just a single argument, so make it a -# scalar function. -# return @_ unless $self->{convert}; -# my $conv = $self->_sqlcase($self->{convert}); -# my @ret = map { $conv.'('.$_.')' } @_; -# return wantarray ? @ret : $ret[0]; if ($_[0]->{convert}) { return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')'; } @@ -1271,11 +1248,6 @@ sub _convert ($) { # And bindtype sub _bindtype (@) { #my ($self, $col, @vals) = @_; - - #LDNOTE : changed original implementation below because it did not make - # sense when bindtype eq 'columns' and @vals > 1. -# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals; - # called often - tighten code return $_[0]->{bindtype} eq 'columns' ? map {[$_[1], $_]} @_[2 .. $#_] @@ -2845,6 +2817,9 @@ can be as simple as the following: #!/usr/bin/perl + use warnings; + use strict; + use CGI::FormBuilder; use SQL::Abstract; diff --git a/t/00new.t b/t/00new.t index bbba692..5da3446 100644 --- a/t/00new.t +++ b/t/00new.t @@ -1,24 +1,14 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; -use SQL::Abstract::Test import => ['is_same_sql_bind']; - -#LDNOTE: renamed all "bind" into "where" because that's what they are +use SQL::Abstract::Test import => ['is_same_sql']; +use SQL::Abstract; my @handle_tests = ( #1 { args => {logic => 'OR'}, -# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )' -# LDNOTE: modified the line above (changing the test suite!!!) because -# the test was not consistent with the doc: hashrefs should not be -# influenced by the current logic, they always mean 'AND'. So -# { a => 4, b => 0} should ALWAYS mean ( a = ? AND b = ? ). -# -# acked by RIBASUSHI stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )' }, #2 @@ -39,9 +29,6 @@ my @handle_tests = ( #5 { args => {cmp => "=", logic => 'or'}, -# LDNOTE idem -# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )' -# acked by RIBASUSHI stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )' }, #6 @@ -52,9 +39,6 @@ my @handle_tests = ( #7 { args => {logic => "or", cmp => "like"}, -# LDNOTE idem -# stmt => 'SELECT * FROM test WHERE ( a LIKE ? OR b LIKE ? )' -# acked by RIBASUSHI stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )' }, #8 @@ -101,20 +85,15 @@ my @handle_tests = ( }, ); - -use_ok('SQL::Abstract'); - for (@handle_tests) { - local $" = ', '; - #print "creating a handle with args ($_->{args}): "; - my $sql = SQL::Abstract->new($_->{args}); - my $where = $_->{where} || { a => 4, b => 0}; - my($stmt, @bind) = $sql->select('test', '*', $where); + my $sqla = SQL::Abstract->new($_->{args}); + my($stmt) = $sqla->select( + 'test', + '*', + $_->{where} || { a => 4, b => 0} + ); - # LDNOTE: this original test suite from NWIGER did no comparisons - # on @bind values, just checking if @bind is nonempty. - # So here we just fake a [1] bind value for the comparison. - is_same_sql_bind($stmt, [@bind ? 1 : 0], $_->{stmt}, [1]); + is_same_sql($stmt, $_->{stmt}); } done_testing; diff --git a/t/01generate.t b/t/01generate.t index 969dd07..328abc3 100644 --- a/t/01generate.t +++ b/t/01generate.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; @@ -253,10 +251,6 @@ my @tests = ( }, { func => 'update', -# LDNOTE : removed the "-maybe", because we no longer admit unknown ops -# -# acked by RIBASUSHI -# args => ['fhole', {fpoles => 4}, [-maybe => {race => [-and => [qw(black white asian)]]}, args => ['fhole', {fpoles => 4}, [ { race => [qw/-or black white asian /] }, { -nest => { firsttime => [-or => {'=','yes'}, undef] } }, @@ -277,11 +271,6 @@ my @tests = ( }, { func => 'select', -# LDNOTE: modified test below because we agreed with MST that literal SQL -# should not automatically insert a '='; the user has to do it -# -# acked by MSTROUT -# args => ['test', '*', { a => \["to_date(?, 'MM/DD/YY')", '02/02/02']}], args => ['test', '*', { a => \["= to_date(?, 'MM/DD/YY')", '02/02/02']}], stmt => q{SELECT * FROM test WHERE ( a = to_date(?, 'MM/DD/YY') )}, stmt_q => q{SELECT * FROM `test` WHERE ( `a` = to_date(?, 'MM/DD/YY') )}, @@ -588,10 +577,7 @@ my @tests = ( ); for my $t (@tests) { - local $"=', '; - my $new = $t->{new} || {}; - $new->{debug} = $ENV{DEBUG} || 0; for my $quoted (0, 1) { diff --git a/t/02where.t b/t/02where.t index ee5dbd8..572d502 100644 --- a/t/02where.t +++ b/t/02where.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; @@ -8,9 +6,6 @@ use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where) ]; use SQL::Abstract; -# Make sure to test the examples, since having them break is somewhat -# embarrassing. :-( - my $not_stringifiable = bless {}, 'SQLA::NotStringifiable'; my @handle_tests = ( @@ -81,9 +76,6 @@ my @handle_tests = ( completion_date => { 'between', ['2002-10-01', '2003-02-06'] }, }, order => \'ticket, requestor', -#LDNOTE: modified parentheses -# -# acked by RIBASUSHI stmt => "WHERE ( ( completion_date BETWEEN ? AND ? ) AND status = ? ) ORDER BY ticket, requestor", bind => [qw/2002-10-01 2003-02-06 completed/], }, @@ -139,9 +131,6 @@ my @handle_tests = ( requestor => { 'like', undef }, }, order => \'requestor, ticket', -#LDNOTE: modified parentheses -# -# acked by RIBASUSHI stmt => " WHERE ( ( priority BETWEEN ? AND ? ) AND requestor IS NULL ) ORDER BY requestor, ticket", bind => [qw/1 3/], }, @@ -155,15 +144,11 @@ my @handle_tests = ( '>' => 10, }, }, -# LDNOTE : modified test below, just parentheses differ -# -# acked by RIBASUSHI stmt => " WHERE ( id = ? AND ( num <= ? AND num > ? ) )", bind => [qw/1 20 10/], }, { -# LDNOTE 23.03.09 : modified test below, just parentheses differ where => { foo => {-not_like => [7,8,9]}, fum => {'like' => [qw/a b/]}, nix => {'between' => [100,200] }, diff --git a/t/03values.t b/t/03values.t index 7ebb7fc..9915712 100644 --- a/t/03values.t +++ b/t/03values.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; diff --git a/t/04modifiers.t b/t/04modifiers.t index 3e77cf3..27db12c 100644 --- a/t/04modifiers.t +++ b/t/04modifiers.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; diff --git a/t/05in_between.t b/t/05in_between.t index f39b3e6..1cb6b43 100644 --- a/t/05in_between.t +++ b/t/05in_between.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; @@ -150,10 +148,12 @@ my @in_between_tests = ( bind => [], test => '-in with a literal scalarref', }, + + # note that outer parens are opened even though literal was requested below { parenthesis_significant => 1, where => { x => { -in => \['( ( ?,?,lower(y) ) )', 1, 2] } }, - stmt => "WHERE ( x IN ( ?,?,lower(y) ) )", # note that outer parens are opened even though literal was requested (RIBASUSHI) + stmt => "WHERE ( x IN ( ?,?,lower(y) ) )", bind => [1, 2], test => '-in with a literal arrayrefref', }, @@ -162,7 +162,6 @@ my @in_between_tests = ( where => { status => { -in => \"(SELECT status_codes\nFROM states)" }, }, - # failed to open outer parens on a multi-line query in 1.61 (semifor) stmt => " WHERE ( status IN ( SELECT status_codes FROM states )) ", bind => [], test => '-in multi-line subquery test', @@ -185,6 +184,7 @@ my @in_between_tests = ( bind => [2000], test => '-in POD test', }, + { where => { x => { -in => [ \['LOWER(?)', 'A' ], \'LOWER(b)', { -lower => 'c' } ] } }, stmt => " WHERE ( x IN ( LOWER(?), LOWER(b), LOWER ? ) )", diff --git a/t/06order_by.t b/t/06order_by.t index bf478df..4236e70 100644 --- a/t/06order_by.t +++ b/t/06order_by.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; diff --git a/t/07subqueries.t b/t/07subqueries.t index 2ea48e8..7d5fbd4 100644 --- a/t/07subqueries.t +++ b/t/07subqueries.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; diff --git a/t/08special_ops.t b/t/08special_ops.t index dc6a618..d989a79 100644 --- a/t/08special_ops.t +++ b/t/08special_ops.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; diff --git a/t/09refkind.t b/t/09refkind.t index 6ab9da8..8a69b8a 100644 --- a/t/09refkind.t +++ b/t/09refkind.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings; use Test::More; diff --git a/t/10test.t b/t/10test.t index a3122e0..8d02f4e 100644 --- a/t/10test.t +++ b/t/10test.t @@ -1,5 +1,3 @@ -#!/usr/bin/perl - use strict; use warnings;