From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 9 Jun 2013 12:20:44 +0000 (+0200)
Subject: Merge branch 'master' into dq
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c771453abebe09026dad9f31fa2b64971aff2616;p=dbsrgits%2FSQL-Abstract.git

Merge branch 'master' into dq
---

c771453abebe09026dad9f31fa2b64971aff2616
diff --cc lib/SQL/Abstract.pm
index 3a2bead,3940881..d4867ab
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@@ -3,14 -3,55 +3,14 @@@ package SQL::Abstract; # see doc at en
  use Carp ();
  use List::Util ();
  use Scalar::Util ();
 -
 -#======================================================================
 -# GLOBALS
 -#======================================================================
 +use Module::Runtime qw(use_module);
 +use Moo;
 +use namespace::clean;
  
- our $VERSION  = '1.72';
- 
- $VERSION = eval $VERSION;
+ our $VERSION  = '1.74';
 -
+ # This would confuse some packagers
+ $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
  
 -our $AUTOLOAD;
 -
 -# special operators (-in, -between). May be extended/overridden by user.
 -# See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
 -my @BUILTIN_SPECIAL_OPS = (
 -  {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
 -  {regex => qr/^ (?: not \s )? in      $/ix, handler => '_where_field_IN'},
 -  {regex => qr/^ ident                 $/ix, handler => '_where_op_IDENT'},
 -  {regex => qr/^ value                 $/ix, handler => '_where_op_VALUE'},
 -);
 -
 -# unaryish operators - key maps to handler
 -my @BUILTIN_UNARY_OPS = (
 -  # the digits are backcompat stuff
 -  { regex => qr/^ and  (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
 -  { regex => qr/^ or   (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
 -  { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
 -  { regex => qr/^ (?: not \s )? bool     $/xi, handler => '_where_op_BOOL' },
 -  { regex => qr/^ ident                  $/xi, handler => '_where_op_IDENT' },
 -  { regex => qr/^ value                  $/ix, handler => '_where_op_VALUE' },
 -);
 -
 -#======================================================================
 -# DEBUGGING AND ERROR REPORTING
 -#======================================================================
 -
 -sub _debug {
 -  return unless $_[0]->{debug}; shift; # a little faster
 -  my $func = (caller(1))[3];
 -  warn "[$func] ", @_, "\n";
 -}
 -
  sub belch (@) {
    my($func) = (caller(1))[3];
    Carp::carp "[$func] Warning: ", @_;
diff --cc t/02where.t
index 02f5baf,e6e1edd..7a5d064
--- a/t/02where.t
+++ b/t/02where.t
@@@ -400,15 -400,8 +400,13 @@@ my @handle_tests = 
          stmt  => " WHERE ( (NOT ( c AND (NOT ( (NOT a = ?) AND (NOT b) )) )) ) ",
          bind => [ 1 ],
      },
 +    {
 +        where => { foo => { '>=', [] } },
 +        stmt  => " WHERE 0=1",
 +        bind => [ ],
 +    },
  );
  
- plan tests => ( @handle_tests * 2 );
- 
  for my $case (@handle_tests) {
      local $Data::Dumper::Terse = 1;
      my $sql = SQL::Abstract->new;
@@@ -417,8 -410,12 +415,10 @@@
        ($stmt, @bind) = $sql->where($case->{where}, $case->{order});
        is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
          || diag "Search term:\n" . Dumper $case->{where};
 -    });
 +    }));
 +    if ($e) {
 +       fail "Died: $e: Search term:\n" . Dumper $case->{where};
 +    }
  }
+ 
 -dies_ok {
 -    my $sql = SQL::Abstract->new;
 -    $sql->where({ foo => { '>=' => [] }},);
 -};
 -
+ done_testing;
diff --cc t/04modifiers.t
index 71d2c28,3b024c3..efa95a4
--- a/t/04modifiers.t
+++ b/t/04modifiers.t
@@@ -307,9 -308,10 +308,9 @@@ my @and_or_tests = 
    },
  );
  
--# modN and mod_N were a bad design decision - they go away in SQLA2, warn now
--my @numbered_mods = (
 -  {
 -    backcompat => {
++# modN and mod_N were a bad design decision - they went away
++my @invalid_numbered_mods = (
 +    {
        -and => [a => 10, b => 11],
        -and2 => [ c => 20, d => 21 ],
        -nest => [ x => 1 ],
@@@ -355,13 -376,11 +356,35 @@@ my @nest_tests = 
   },
   {
     where => [a => 1, -nest => {b => 2, c => 3}, -nest => [d => 4, e => 5]],
 -   stmt  => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR ( d = ? OR e = ? ) ) )',
 +   stmt  => 'WHERE ( ( a = ? OR ( b = ? AND c = ? ) OR d = ? OR e = ? ) )',
     bind  => [qw/1 2 3 4 5/],
   },
++ {
++   where => { -and => [
++    -and => [a => 10, b => 11],
++    -and => [ c => 20, d => 21 ],
++    -nest => [ x => 1 ],
++    -nest => [ y => 2 ],
++    -or => { m => 7, n => 8 },
++    -or => { m => 17, n => 18 },
++   ] },
++   stmt => 'WHERE ( ( a = ? AND b = ? AND c = ? AND d = ? AND ( x = ? ) AND ( y = ? ) AND ( m = ? OR n = ? ) AND ( m = ? OR n = ? ) ) )',
++   bind => [ 10, 11, 20, 21, 1, 2, 7, 8, 17, 18 ],
++ },
++ {
++   where => [ -and => [
++    -and => [a => 10, b => 11],
++    -and => [ c => 20, d => 21 ],
++    -nest => [ x => 1 ],
++    -nest => [ y => 2 ],
++    -or => { m => 7, n => 8 },
++    -or => { m => 17, n => 18 },
++   ] ],
++   stmt => 'WHERE ( ( ( a = ? AND b = ? AND c = ? AND d = ? AND ( x = ? ) AND ( y = ? ) AND ( m = ? OR n = ? ) AND ( m = ? OR n = ? ) ) ) )',
++   bind => [ 10, 11, 20, 21, 1, 2, 7, 8, 17, 18 ],
++ },
  );
  
- plan tests => @and_or_tests*4 + @numbered_mods + @nest_tests*2;
- 
  for my $case (@and_or_tests) {
    TODO: {
      local $TODO = $case->{todo} if $case->{todo};
@@@ -412,18 -434,41 +438,11 @@@ for my $case (@nest_tests) 
    }
  }
  
--
--
--my $w_str = "\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0\E";
--for my $case (@numbered_mods) {
--  TODO: {
-     local $Data::Dumper::Terse = 1;
- 
-     my @w;
 -    local $TODO = $case->{todo} if $case->{todo};
 -
 -    local $Data::Dumper::Terse = 1;
 -
 -    my @w;
 -    local $SIG{__WARN__} = sub { push @w, @_ };
++for my $case (@invalid_numbered_mods) {
      my $sql = SQL::Abstract->new ($case->{args} || {});
 -    lives_ok (sub {
 -      my ($old_s, @old_b) = $sql->where($case->{backcompat});
 -      my ($new_s, @new_b) = $sql->where($case->{correct});
 -      is_same_sql_bind(
 -        $old_s, \@old_b,
 -        $new_s, \@new_b,
 -        'Backcompat and the correct(tm) syntax result in identical statements',
 -      ) || diag "Search terms:\n" . Dumper {
 -          backcompat => $case->{backcompat},
 -          correct => $case->{correct},
 -        };
 -    });
 -
 -    ok (@w, 'Warnings were emitted about a mod_N construct');
 -
 -    my @non_match;
 -    for (@w) {
 -      push @non_match, $_ if ($_ !~ /$w_str/);
 -    }
 -
 -    is (@non_match, 0, 'All warnings match the deprecation message')
 -      || diag join "\n", 'Rogue warnings:', @non_match;
 -  }
 +    throws_ok (sub {
 +      $sql->where($case);
 +    }, qr/\QUse of [and|or|nest]_N modifiers is no longer supported/, 'Exception thrown on bogus syntax');
-   }
  }
  
+ done_testing;
diff --cc t/05in_between.t
index a50a0c9,12a5658..7336158
--- a/t/05in_between.t
+++ b/t/05in_between.t
@@@ -200,17 -198,20 +198,19 @@@ for my $case (@in_between_tests) 
        my @w;
        local $SIG{__WARN__} = sub { push @w, @_ };
        my $sql = SQL::Abstract->new ($case->{args} || {});
 -      lives_ok (sub { 
 -        my ($stmt, @bind) = $sql->where($case->{where});
 -        is_same_sql_bind(
 -          $stmt,
 -          \@bind,
 -          $case->{stmt},
 -          $case->{bind},
 -        )
 -          || diag "Search term:\n" . Dumper $case->{where};
 -      });
 +      my ($stmt, @bind) = $sql->where($case->{where});
 +      is_same_sql_bind(
 +        $stmt,
 +        \@bind,
 +        $case->{stmt},
 +        $case->{bind},
 +      )
 +        || diag "Search term:\n" . Dumper $case->{where};
        is (@w, 0, $case->{test} || 'No warnings within in-between tests')
          || diag join "\n", 'Emitted warnings:', @w;
 -    }, "$case->{test} doesn't die");
 +    }), "$case->{test} doesn't die");
 +    diag "Error: $e\n Search term:\n".Dumper($case->{where}) if $e;
    }
  }
+ 
+ done_testing;
diff --cc t/06order_by.t
index 00a83cd,bf478df..1017ce5
--- a/t/06order_by.t
+++ b/t/06order_by.t
@@@ -100,30 -100,12 +100,27 @@@ my @cases 
     },
     {
      given => [ { -asc => \['colA'] }, { -desc => \['colB LIKE ?', 'test'] }, { -asc => \['colC LIKE ?', 'tost'] }],
-     expects => ' ORDER BY colA, colB LIKE ? DESC, colC LIKE ?',
-     expects_quoted => ' ORDER BY colA, colB LIKE ? DESC, colC LIKE ?',
+     expects => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
+     expects_quoted => ' ORDER BY colA ASC, colB LIKE ? DESC, colC LIKE ? ASC',
      bind => [qw/test tost/],
     },
 +   {
 +    given => [ { -ASC => 'colA', -NULLS => 'FIRST' }, { -DESC => 'colB', -NULLS => 'LAST' } ],
 +    expects => ' ORDER BY colA NULLS FIRST, colB DESC NULLS LAST',
 +    expects_quoted => ' ORDER BY `colA` NULLS FIRST, `colB` DESC NULLS LAST',
 +   },
 +   {
 +    given => [ { -asc => 'colA', -nulls => 'first' }, { -desc => 'colB', -nulls => 'last' } ],
 +    expects => ' ORDER BY colA NULLS FIRST, colB DESC NULLS LAST',
 +    expects_quoted => ' ORDER BY `colA` NULLS FIRST, `colB` DESC NULLS LAST',
 +   },
 +   {
 +    given => { -asc => [qw/colA colB/], -nulls => 'first' } ,
 +    expects => ' ORDER BY colA NULLS FIRST, colB NULLS FIRST',
 +    expects_quoted => ' ORDER BY `colA` NULLS FIRST, `colB` NULLS FIRST',
 +   },
    );
  
- 
- plan tests => (scalar(@cases) * 2) + 4;
- 
  my $sql  = SQL::Abstract->new;
  my $sqlq = SQL::Abstract->new({quote_char => '`'});
  
@@@ -159,14 -141,4 +156,16 @@@ throws_ok 
    'Undeterministic order exception',
  );
  
 +throws_ok(
 +  sub { $sql->_order_by({-wibble => "fleem" }) },
 +  qr/invalid key in hash/,
 +  'Invalid order exception',
 +);
 +
 +throws_ok(
 +  sub { $sql->_order_by({-nulls => "fleem" }) },
 +  qr/invalid value for -nulls/,
 +  'Invalid nulls exception',
 +);
++
+ done_testing;