[Bast-commits] r7687 - in SQL-Abstract/1.x/branches/test_refactor:
. lib/SQL lib/SQL/Abstract t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Fri Sep 18 11:05:40 GMT 2009
Author: ribasushi
Date: 2009-09-18 11:05:39 +0000 (Fri, 18 Sep 2009)
New Revision: 7687
Added:
SQL-Abstract/1.x/branches/test_refactor/t/90pod.t
SQL-Abstract/1.x/branches/test_refactor/t/91podcoverage.t
Modified:
SQL-Abstract/1.x/branches/test_refactor/
SQL-Abstract/1.x/branches/test_refactor/Changes
SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract.pm
SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract/Test.pm
SQL-Abstract/1.x/branches/test_refactor/t/02where.t
SQL-Abstract/1.x/branches/test_refactor/t/10test.t
Log:
r7528 at Thesaurus (orig r7525): ribasushi | 2009-09-03 21:41:56 +0200
r6207 at Thesaurus (orig r6206): nigel | 2009-05-11 15:10:44 +0200
New branch for -bool operator integration
r6208 at Thesaurus (orig r6207): nigel | 2009-05-11 15:38:52 +0200
Added -bool/-not_bool operators - required some refactoring
r6209 at Thesaurus (orig r6208): nigel | 2009-05-11 15:39:33 +0200
Imported POD/POD::Coverage tests
r6212 at Thesaurus (orig r6211): nigel | 2009-05-11 21:23:01 +0200
Made unary_ops a direct equivalent of special_ops with supporting documentation.
r6298 at Thesaurus (orig r6297): nigel | 2009-05-18 17:00:52 +0200
Doc typo fix
r7352 at Thesaurus (orig r7349): nigel | 2009-08-20 11:55:53 +0200
Reduced regex munging of operators and streamlined backcompat syntax implementation.
r7527 at Thesaurus (orig r7524): ribasushi | 2009-09-03 21:41:47 +0200
Final cleanups
r7556 at Thesaurus (orig r7553): nigel | 2009-09-04 16:34:55 +0200
Extended -bool handling to handle more types of parameters
r7557 at Thesaurus (orig r7554): nigel | 2009-09-04 16:36:20 +0200
Removed debugging code accidently added
r7558 at Thesaurus (orig r7555): ribasushi | 2009-09-04 17:13:57 +0200
Fix Tester to deal properly with NOT and single parenthesized expressions
r7559 at Thesaurus (orig r7556): ribasushi | 2009-09-04 17:19:05 +0200
Release 1.58
r7599 at Thesaurus (orig r7596): nigel | 2009-09-07 15:36:40 +0200
Documentation tweak on how you handle booleans
r7672 at Thesaurus (orig r7661): ribasushi | 2009-09-15 06:54:36 +0200
Fix some warnings
Property changes on: SQL-Abstract/1.x/branches/test_refactor
___________________________________________________________________
Name: svk:merge
- b9bda2dc-4395-4011-945f-8c81d782bde1:/branches/matthewt:18
b9bda2dc-4395-4011-945f-8c81d782bde1:/trunk:23
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/and_or:6008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/special_op_handling:6158
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/SQL-Abstract:3093
+ b9bda2dc-4395-4011-945f-8c81d782bde1:/branches/matthewt:18
b9bda2dc-4395-4011-945f-8c81d782bde1:/trunk:23
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/and_or:6008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/bool_operator:7524
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/branches/special_op_handling:6158
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/SQL-Abstract/1.x/trunk:7661
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/SQL-Abstract:3093
Modified: SQL-Abstract/1.x/branches/test_refactor/Changes
===================================================================
--- SQL-Abstract/1.x/branches/test_refactor/Changes 2009-09-18 10:44:08 UTC (rev 7686)
+++ SQL-Abstract/1.x/branches/test_refactor/Changes 2009-09-18 11:05:39 UTC (rev 7687)
@@ -1,5 +1,16 @@
Revision history for SQL::Abstract
+ - Fixed a couple of untrapped undefined warnings
+
+revision 1.58 2009-09-04 15:20 (UTC)
+----------------------------
+ - expanded the scope of -bool and -not_bool operators
+ - added proper testing support
+
+revision 1.57 2009-09-03 20:18 (UTC)
+----------------------------
+ - added -bool and -not_bool operators
+
revision 1.56 2009-05-30 16:31 (UTC)
----------------------------
- support for \[$sql, @bind] in order_by clauses e.g.:
Modified: SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract/Test.pm 2009-09-18 10:44:08 UTC (rev 7686)
+++ SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract/Test.pm 2009-09-18 11:05:39 UTC (rev 7687)
@@ -53,6 +53,7 @@
# These are binary operator keywords always a single LHS and RHS
# * AND/OR are handled separately as they are N-ary
+# * so is NOT as being unary
# * BETWEEN without paranthesis around the ANDed arguments (which
# makes it a non-binary op) is detected and accomodated in
# _recurse_parse()
@@ -63,7 +64,7 @@
);
my $tokenizer_re_str = join("\n\t|\n",
- ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR' ),
+ ( map { '\b' . $_ . '\b' } @expression_terminator_sql_keywords, 'AND', 'OR', 'NOT'),
( map { q! (?<= [\w\s\`\'\)] ) ! . $_ . q! (?= [\w\s\`\'\(] ) ! } @binary_op_keywords ),
);
@@ -261,7 +262,7 @@
or
($state == PARSE_IN_EXPR && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords ) )
or
- ($state == PARSE_RHS && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords, @binary_op_keywords, 'AND', 'OR' ) )
+ ($state == PARSE_RHS && grep { $lookahead =~ /^ $_ $/xi } ('\)', @expression_terminator_sql_keywords, @binary_op_keywords, 'AND', 'OR', 'NOT' ) )
) {
return $left;
}
@@ -310,6 +311,14 @@
$left = $left ? [@$left, [$op => [$right] ]]
: [[ $op => [$right] ]];
}
+ # NOT (last as to allow all other NOT X pieces first)
+ elsif ( $token =~ /^ not $/ix ) {
+ my $op = uc $token;
+ my $right = _recurse_parse ($tokens, PARSE_RHS);
+ $left = $left ? [ @$left, [$op => [$right] ]]
+ : [[ $op => [$right] ]];
+
+ }
# leaf expression
else {
$left = $left ? [@$left, [EXPR => [$token] ] ]
@@ -357,6 +366,14 @@
$changes++;
}
+ # only one EXPR element in the parenthesis
+ elsif (
+ @{$child->[1]} == 1 && $child->[1][0][0] eq 'EXPR'
+ ) {
+ push @children, $child->[1][0];
+ $changes++;
+ }
+
# only one element in the parenthesis which is a binary op with two EXPR sub-children
elsif (
@{$child->[1]} == 1
Modified: SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract.pm 2009-09-18 10:44:08 UTC (rev 7686)
+++ SQL-Abstract/1.x/branches/test_refactor/lib/SQL/Abstract.pm 2009-09-18 11:05:39 UTC (rev 7687)
@@ -15,7 +15,7 @@
# GLOBALS
#======================================================================
-our $VERSION = '1.56';
+our $VERSION = '1.58';
# This would confuse some packagers
#$VERSION = eval $VERSION; # numify for warning-free dev releases
@@ -29,6 +29,15 @@
{regex => qr/^(not )?in$/i, handler => '_where_field_IN'},
);
+# 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' },
+);
+
#======================================================================
# DEBUGGING AND ERROR REPORTING
#======================================================================
@@ -86,6 +95,10 @@
$opt{special_ops} ||= [];
push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
+ # unary operators
+ $opt{unary_ops} ||= [];
+ push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
+
return bless \%opt, $class;
}
@@ -426,7 +439,7 @@
my $v = $where->{$k};
# ($k => $v) is either a special op or a regular hashpair
- my ($sql, @bind) = ($k =~ /^-(.+)/) ? $self->_where_op_in_hash($1, $v)
+ my ($sql, @bind) = ($k =~ /^(-.+)/) ? $self->_where_op_in_hash($1, $v)
: do {
my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
$self->$method($k, $v);
@@ -441,49 +454,90 @@
sub _where_op_in_hash {
- my ($self, $op_str, $v) = @_;
+ my ($self, $orig_op, $v) = @_;
- $op_str =~ /^ (AND|OR|NEST) ( \_? \d* ) $/xi
- or puke "unknown operator: -$op_str";
+ # put the operator in canonical form
+ my $op = $orig_op;
+ $op =~ s/^-//; # remove initial dash
+ $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
+ $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
- my $op = uc($1); # uppercase, remove trailing digits
- if ($2) {
- belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
- . "You probably wanted ...-and => [ $op_str => COND1, $op_str => COND2 ... ]";
+ $self->_debug("OP(-$op) within hashref, recursing...");
+
+ my $op_entry = first {$op =~ $_->{regex}} @{$self->{unary_ops}};
+ my $handler = $op_entry->{handler};
+ if (! $handler) {
+ puke "unknown operator: $orig_op";
}
+ elsif (not ref $handler) {
+ if ($op =~ s/\s?\d+$//) {
+ belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
+ . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
+ }
+ return $self->$handler ($op, $v);
+ }
+ elsif (ref $handler eq 'CODE') {
+ return $handler->($self, $op, $v);
+ }
+ else {
+ puke "Illegal handler for operator $orig_op - expecting a method name or a coderef";
+ }
+}
- $self->_debug("OP(-$op) within hashref, recursing...");
+sub _where_op_ANDOR {
+ my ($self, $op, $v) = @_;
$self->_SWITCH_refkind($v, {
+ ARRAYREF => sub {
+ return $self->_where_ARRAYREF($v, $op);
+ },
+ HASHREF => sub {
+ return ( $op =~ /^or/i )
+ ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
+ : $self->_where_HASHREF($v);
+ },
+
+ SCALARREF => sub {
+ puke "-$op => \\\$scalar not supported, use -nest => ...";
+ },
+
+ ARRAYREFREF => sub {
+ puke "-$op => \\[..] not supported, use -nest => ...";
+ },
+
+ SCALAR => sub { # permissively interpreted as SQL
+ puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
+ },
+
+ UNDEF => sub {
+ puke "-$op => undef not supported";
+ },
+ });
+}
+
+sub _where_op_NEST {
+ my ($self, $op, $v) = @_;
+
+ $self->_SWITCH_refkind($v, {
+
ARRAYREF => sub {
- return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
+ return $self->_where_ARRAYREF($v, '');
},
HASHREF => sub {
- if ($op eq 'OR') {
- return $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], 'OR');
- }
- else { # NEST | AND
- return $self->_where_HASHREF($v);
- }
+ return $self->_where_HASHREF($v);
},
SCALARREF => sub { # literal SQL
- $op eq 'NEST'
- or puke "-$op => \\\$scalar not supported, use -nest => ...";
return ($$v);
},
ARRAYREFREF => sub { # literal SQL
- $op eq 'NEST'
- or puke "-$op => \\[..] not supported, use -nest => ...";
return @{${$v}};
},
SCALAR => sub { # permissively interpreted as SQL
- $op eq 'NEST'
- or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
belch "literal SQL should be -nest => \\'scalar' "
. "instead of -nest => 'scalar' ";
return ($v);
@@ -496,6 +550,43 @@
}
+sub _where_op_BOOL {
+ my ($self, $op, $v) = @_;
+
+ my ( $prefix, $suffix ) = ( $op =~ /\bnot\b/i )
+ ? ( '(NOT ', ')' )
+ : ( '', '' );
+ $self->_SWITCH_refkind($v, {
+ ARRAYREF => sub {
+ my ( $sql, @bind ) = $self->_where_ARRAYREF($v, '');
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
+ ARRAYREFREF => sub {
+ my ( $sql, @bind ) = @{ ${$v} };
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
+ HASHREF => sub {
+ my ( $sql, @bind ) = $self->_where_HASHREF($v);
+ return ( ($prefix . $sql . $suffix), @bind );
+ },
+
+ SCALARREF => sub { # literal SQL
+ return ($prefix . $$v . $suffix);
+ },
+
+ SCALAR => sub { # interpreted as SQL column
+ return ($prefix . $self->_convert($self->_quote($v)) . $suffix);
+ },
+
+ UNDEF => sub {
+ puke "-$op => undef not supported";
+ },
+ });
+}
+
+
sub _where_hashpair_ARRAYREF {
my ($self, $k, $v) = @_;
@@ -533,15 +624,14 @@
my ($all_sql, @all_bind);
- for my $op (sort keys %$v) {
- my $val = $v->{$op};
+ for my $orig_op (sort keys %$v) {
+ my $val = $v->{$orig_op};
# put the operator in canonical form
- $op =~ s/^-//; # remove initial dash
- $op =~ tr/_/ /; # underscores become spaces
- $op =~ s/^\s+//; # no initial space
- $op =~ s/\s+$//; # no final space
- $op =~ s/\s+/ /; # multiple spaces become one
+ my $op = $orig_op;
+ $op =~ s/^-//; # remove initial dash
+ $op =~ s/[_\t ]+/ /g; # underscores and whitespace become single spaces
+ $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
my ($sql, @bind);
@@ -550,7 +640,7 @@
if ($special_op) {
my $handler = $special_op->{handler};
if (! $handler) {
- puke "No handler supplied for special operator matching $special_op->{regex}";
+ puke "No handler supplied for special operator $orig_op";
}
elsif (not ref $handler) {
($sql, @bind) = $self->$handler ($k, $op, $val);
@@ -559,7 +649,7 @@
($sql, @bind) = $handler->($self, $k, $op, $val);
}
else {
- puke "Illegal handler for special operator matching $special_op->{regex} - expecting a method name or a coderef";
+ puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
}
}
else {
@@ -591,10 +681,10 @@
UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
my $is = ($op =~ $self->{equality_op}) ? 'is' :
($op =~ $self->{inequality_op}) ? 'is not' :
- puke "unexpected operator '$op' with undef operand";
+ puke "unexpected operator '$orig_op' with undef operand";
$sql = $self->_quote($k) . $self->_sqlcase(" $is null");
},
-
+
FALLBACK => sub { # CASE: col => {op => $scalar}
$sql = join ' ', $self->_convert($self->_quote($k)),
$self->_sqlcase($op),
@@ -618,11 +708,14 @@
my @vals = @$vals; #always work on a copy
if(@vals) {
- $self->_debug("ARRAY($vals) means multiple elements: [ @vals ]");
+ $self->_debug(sprintf '%s means multiple elements: [ %s ]',
+ $vals,
+ join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
+ );
# see if the first element is an -and/-or op
my $logic;
- if ($vals[0] =~ /^ - ( AND|OR ) $/ix) {
+ if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
$logic = uc $1;
shift @vals;
}
@@ -804,8 +897,6 @@
-
-
#======================================================================
# ORDER BY
#======================================================================
@@ -1549,8 +1640,14 @@
to extend the syntax understood by L<SQL::Abstract>.
See section L</"SPECIAL OPERATORS"> for details.
+=item unary_ops
+Takes a reference to a list of "unary operators"
+to extend the syntax understood by L<SQL::Abstract>.
+See section L</"UNARY OPERATORS"> for details.
+
+
=back
=head2 insert($table, \@values || \%fieldvals)
@@ -1869,6 +1966,39 @@
These are the two builtin "special operators"; but the
list can be expanded : see section L</"SPECIAL OPERATORS"> below.
+=head2 Unary operators: bool
+
+If you wish to test against boolean columns or functions within your
+database you can use the C<-bool> and C<-not_bool> operators. For
+example to test the column C<is_user> being true and the column
+<is_enabled> being false you would use:-
+
+ my %where = (
+ -bool => 'is_user',
+ -not_bool => 'is_enabled',
+ );
+
+Would give you:
+
+ WHERE is_user AND NOT is_enabled
+
+If a more complex combination is required, testing more conditions,
+then you should use the and/or operators:-
+
+ my %where = (
+ -and => [
+ -bool => 'one',
+ -bool => 'two',
+ -bool => 'three',
+ -not_bool => 'four',
+ ],
+ );
+
+Would give you:
+
+ WHERE one AND two AND three AND NOT four
+
+
=head2 Nested conditions, -and/-or prefixes
So far, we've seen how multiple conditions are joined with a top-level
@@ -1989,8 +2119,10 @@
TMTOWTDI.
-Conditions on boolean columns can be expressed in the
-same way, passing a reference to an empty string :
+Conditions on boolean columns can be expressed in the same way, passing
+a reference to an empty string, however using liternal SQL in this way
+is deprecated - the preferred method is to use the boolean operators -
+see L</"Unary operators: bool"> :
my %where = (
priority => { '<', 2 },
@@ -2247,6 +2379,59 @@
]);
+=head1 UNARY OPERATORS
+
+ my $sqlmaker = SQL::Abstract->new(unary_ops => [
+ {
+ regex => qr/.../,
+ handler => sub {
+ my ($self, $op, $arg) = @_;
+ ...
+ },
+ },
+ {
+ regex => qr/.../,
+ handler => 'method_name',
+ },
+ ]);
+
+A "unary operator" is a SQL syntactic clause that can be
+applied to a field - the operator goes before the field
+
+You can write your own operator handlers - supply a C<unary_ops>
+argument to the C<new> method. That argument takes an arrayref of
+operator definitions; each operator definition is a hashref with two
+entries:
+
+=over
+
+=item regex
+
+the regular expression to match the operator
+
+=item handler
+
+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<SQL::Abstract/> object as:
+
+ $self->$method_name ($op, $arg)
+
+ Where:
+
+ $op is the part that matched the handler regex
+ $arg is the RHS or argument of the operator
+
+When supplied with a coderef, it is called as:
+
+ $coderef->($self, $op, $arg)
+
+
+=back
+
+
=head1 PERFORMANCE
Thanks to some benchmarking by Mark Stosberg, it turns out that
Modified: SQL-Abstract/1.x/branches/test_refactor/t/02where.t
===================================================================
--- SQL-Abstract/1.x/branches/test_refactor/t/02where.t 2009-09-18 10:44:08 UTC (rev 7686)
+++ SQL-Abstract/1.x/branches/test_refactor/t/02where.t 2009-09-18 11:05:39 UTC (rev 7687)
@@ -117,6 +117,14 @@
{
where => {
+ requestor => { '!=', ['-and', undef, ''] },
+ },
+ stmt => " WHERE ( requestor IS NOT NULL AND requestor != ? )",
+ bind => [''],
+ },
+
+ {
+ where => {
priority => [ {'>', 3}, {'<', 1} ],
requestor => { '!=', undef },
},
@@ -216,6 +224,91 @@
stmt => " WHERE (foo = ?)",
bind => [ "bar" ],
},
+
+ {
+ where => { -bool => \'function(x)' },
+ stmt => " WHERE function(x)",
+ bind => [],
+ },
+
+ {
+ where => { -bool => 'foo' },
+ stmt => " WHERE foo",
+ bind => [],
+ },
+
+ {
+ where => { -and => [-bool => 'foo', -bool => 'bar'] },
+ stmt => " WHERE foo AND bar",
+ bind => [],
+ },
+
+ {
+ where => { -or => [-bool => 'foo', -bool => 'bar'] },
+ stmt => " WHERE foo OR bar",
+ bind => [],
+ },
+
+ {
+ where => { -not_bool => \'function(x)' },
+ stmt => " WHERE NOT function(x)",
+ bind => [],
+ },
+
+ {
+ where => { -not_bool => 'foo' },
+ stmt => " WHERE NOT foo",
+ bind => [],
+ },
+
+ {
+ where => { -and => [-not_bool => 'foo', -not_bool => 'bar'] },
+ stmt => " WHERE (NOT foo) AND (NOT bar)",
+ bind => [],
+ },
+
+ {
+ where => { -or => [-not_bool => 'foo', -not_bool => 'bar'] },
+ stmt => " WHERE (NOT foo) OR (NOT bar)",
+ bind => [],
+ },
+
+ {
+ where => { -bool => \['function(?)', 20] },
+ stmt => " WHERE function(?)",
+ bind => [20],
+ },
+
+ {
+ where => { -not_bool => \['function(?)', 20] },
+ stmt => " WHERE NOT function(?)",
+ bind => [20],
+ },
+
+ {
+ where => { -bool => { a => 1, b => 2} },
+ stmt => " WHERE a = ? AND b = ?",
+ bind => [1, 2],
+ },
+
+ {
+ where => { -bool => [ a => 1, b => 2] },
+ stmt => " WHERE a = ? OR b = ?",
+ bind => [1, 2],
+ },
+
+ {
+ where => { -not_bool => { a => 1, b => 2} },
+ stmt => " WHERE NOT (a = ? AND b = ?)",
+ bind => [1, 2],
+ },
+
+ {
+ where => { -not_bool => [ a => 1, b => 2] },
+ stmt => " WHERE NOT ( a = ? OR b = ? )",
+ bind => [1, 2],
+ },
+
);
plan tests => ( @handle_tests * 2 ) + 1;
Modified: SQL-Abstract/1.x/branches/test_refactor/t/10test.t
===================================================================
--- SQL-Abstract/1.x/branches/test_refactor/t/10test.t 2009-09-18 10:44:08 UTC (rev 7686)
+++ SQL-Abstract/1.x/branches/test_refactor/t/10test.t 2009-09-18 11:05:39 UTC (rev 7687)
@@ -136,7 +136,31 @@
]
},
{
+ equal => 1,
+ statements => [
+ q/SELECT foo FROM bar WHERE (a) AND (b = 2)/,
+ q/SELECT foo FROM bar WHERE (a AND b = 2)/,
+ q/SELECT foo FROM bar WHERE (a AND (b = 2))/,
+ q/SELECT foo FROM bar WHERE a AND (b = 2)/,
+ ]
+ },
+ {
+ equal => 1,
+ statements => [
+ q/SELECT foo FROM bar WHERE ((NOT a) AND b = 2)/,
+ q/SELECT foo FROM bar WHERE (NOT a) AND (b = 2)/,
+ q/SELECT foo FROM bar WHERE (NOT (a)) AND b = 2/,
+ ],
+ },
+ {
equal => 0,
+ statements => [
+ q/SELECT foo FROM bar WHERE NOT a AND (b = 2)/,
+ q/SELECT foo FROM bar WHERE (NOT a) AND (b = 2)/,
+ ]
+ },
+ {
+ equal => 0,
parenthesis_significant => 1,
statements => [
q/SELECT foo FROM bar WHERE a = 1 AND b = 1 AND c = 1/,
Added: SQL-Abstract/1.x/branches/test_refactor/t/90pod.t
===================================================================
--- SQL-Abstract/1.x/branches/test_refactor/t/90pod.t (rev 0)
+++ SQL-Abstract/1.x/branches/test_refactor/t/90pod.t 2009-09-18 11:05:39 UTC (rev 7687)
@@ -0,0 +1,6 @@
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+
+all_pod_files_ok();
Added: SQL-Abstract/1.x/branches/test_refactor/t/91podcoverage.t
===================================================================
--- SQL-Abstract/1.x/branches/test_refactor/t/91podcoverage.t (rev 0)
+++ SQL-Abstract/1.x/branches/test_refactor/t/91podcoverage.t 2009-09-18 11:05:39 UTC (rev 7687)
@@ -0,0 +1,49 @@
+use Test::More;
+
+eval "use Pod::Coverage 0.19";
+plan skip_all => 'Pod::Coverage 0.19 required' if $@;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+
+plan skip_all => 'set TEST_POD to enable this test'
+ unless ( $ENV{TEST_POD} || -e 'MANIFEST.SKIP' );
+
+my @modules = sort { $a cmp $b } ( Test::Pod::Coverage::all_modules() );
+plan tests => scalar(@modules);
+
+# Since this is about checking documentation, a little documentation
+# of what this is doing might be in order...
+# The exceptions structure below is a hash keyed by the module
+# name. The value for each is a hash, which contains one or more
+# (although currently more than one makes no sense) of the following
+# things:-
+# skip => a true value means this module is not checked
+# ignore => array ref containing list of methods which
+# do not need to be documented.
+my $exceptions = {
+ 'SQL::Abstract' => {
+ ignore => [
+ qw/belch
+ puke/
+ ]
+ },
+ 'SQL::Abstract::Test' => { skip => 1 },
+};
+
+foreach my $module (@modules) {
+ SKIP:
+ {
+ skip "$module - No user visible methods",
+ 1
+ if ( $exceptions->{$module}{skip} );
+
+ # build parms up from ignore list
+ my $parms = {};
+ $parms->{trustme} =
+ [ map { qr/^$_$/ } @{ $exceptions->{$module}{ignore} } ]
+ if exists( $exceptions->{$module}{ignore} );
+
+ # run the test with the potentially modified parm set
+ pod_coverage_ok( $module, $parms, "$module POD coverage" );
+ }
+}
More information about the Bast-commits
mailing list