r55925 - in /branches/upstream/libsql-statement-perl/current: ./ lib/SQL/ lib/SQL/Dialects/ lib/SQL/Statement/ t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Apr 11 02:54:43 UTC 2010
Author: ansgar-guest
Date: Sun Apr 11 02:54:37 2010
New Revision: 55925
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=55925
Log:
[svn-upgrade] Integrating new upstream version, libsql-statement-perl (1.26)
Added:
branches/upstream/libsql-statement-perl/current/t/06aggregate.t
Removed:
branches/upstream/libsql-statement-perl/current/t/06group.t
Modified:
branches/upstream/libsql-statement-perl/current/Changes
branches/upstream/libsql-statement-perl/current/MANIFEST
branches/upstream/libsql-statement-perl/current/MANIFEST.SKIP
branches/upstream/libsql-statement-perl/current/META.yml
branches/upstream/libsql-statement-perl/current/Todo
branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/ANSI.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/AnyData.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/CSV.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/Role.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Eval.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Parser.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Function.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Functions.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/GetInfo.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Operation.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Placeholder.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/RAM.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Syntax.pod
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Term.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/TermFactory.pm
branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Util.pm
Modified: branches/upstream/libsql-statement-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/Changes?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/Changes (original)
+++ branches/upstream/libsql-statement-perl/current/Changes Sun Apr 11 02:54:37 2010
@@ -1,4 +1,19 @@
Changes log for Perl extension SQL::Statement
+
+Version 1.26, release April 09th, 2010
+----------------------------------------------
+
+[Bug fixes]
+* Handle NULL columns in concatenation as empty strings
+
+[Improvements]
+* Change regex's in parser to use \p{Word} instead of \w to allow unicode
+ support
+
+[Documentation]
+* Make clear, that identifiers are handled case insensetive and there is
+ a real good solution provided by DBI which allows to live great with
+ that behaviour.
Version 1.25, release March 15th, 2010
----------------------------------------------
Modified: branches/upstream/libsql-statement-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/MANIFEST?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/MANIFEST (original)
+++ branches/upstream/libsql-statement-perl/current/MANIFEST Sun Apr 11 02:54:37 2010
@@ -29,7 +29,7 @@
t/03executeDBD.t
t/04names.t
t/05create.t
-t/06group.t
+t/06aggregate.t
t/07case.t
t/08join.t
t/09ops.t
Modified: branches/upstream/libsql-statement-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/MANIFEST.SKIP?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libsql-statement-perl/current/MANIFEST.SKIP Sun Apr 11 02:54:37 2010
@@ -4,10 +4,11 @@
\.rej$
\.old$
\..*sw[po]
-.*~
+.*~$
Makefile$
\.project
\bblib\b
pm_to_blib
bugsql
.*\.csv
+\.tmp$
Modified: branches/upstream/libsql-statement-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/META.yml?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/META.yml (original)
+++ branches/upstream/libsql-statement-perl/current/META.yml Sun Apr 11 02:54:37 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: SQL-Statement
-version: 1.25
+version: 1.26
abstract: SQL parsing and processing engine
author:
- Jeff Zucker <jeff at vpservices.com>, Jens Rehsack <rehsack at cpan.org>
Modified: branches/upstream/libsql-statement-perl/current/Todo
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/Todo?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/Todo (original)
+++ branches/upstream/libsql-statement-perl/current/Todo Sun Apr 11 02:54:37 2010
@@ -1,9 +1,3 @@
-Open to do actions for SQL::Statement 1.xx
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-* re-add support for case-sensitive column names, either as typed in query
- or as known by the table
-
Open to do actions for SQL::Statement 2.xx
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/ANSI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/ANSI.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/ANSI.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/ANSI.pm Sun Apr 11 02:54:37 2010
@@ -1,7 +1,7 @@
package SQL::Dialects::ANSI;
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
use SQL::Dialects::Role;
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/AnyData.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/AnyData.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/AnyData.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/AnyData.pm Sun Apr 11 02:54:37 2010
@@ -1,7 +1,7 @@
package SQL::Dialects::AnyData;
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
use SQL::Dialects::Role;
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/CSV.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/CSV.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/CSV.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/CSV.pm Sun Apr 11 02:54:37 2010
@@ -1,7 +1,7 @@
package SQL::Dialects::CSV;
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
use SQL::Dialects::Role;
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/Role.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/Role.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/Role.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Dialects/Role.pm Sun Apr 11 02:54:37 2010
@@ -5,7 +5,7 @@
use base qw(Exporter);
our @EXPORT = qw(get_config_as_hash);
-our $VERSION = '1.25';
+our $VERSION = '1.26';
sub get_config_as_hash
{
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Eval.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Eval.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Eval.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Eval.pm Sun Apr 11 02:54:37 2010
@@ -6,7 +6,7 @@
package SQL::Eval;
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
require SQL::Statement;
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Parser.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Parser.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Parser.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Parser.pm Sun Apr 11 02:54:37 2010
@@ -19,7 +19,7 @@
use Params::Util qw(_ARRAY0 _ARRAY _HASH);
use Scalar::Util qw(looks_like_number);
-$VERSION = '1.25';
+$VERSION = '1.26';
BEGIN
{
@@ -146,7 +146,7 @@
; # FIXME SUBSTR('*')
my $orgname = $col->{fullorg};
my $colname = $orgname;
- $colname = lc $colname unless ( $colname =~ m/^(?:\w+\.)?"/ );
+ $colname = lc $colname unless ( $colname =~ m/^(?:\p{Word}+\.)?"/ );
unless ( defined( $self->{struct}->{ORG_NAME}->{$colname} ) )
{
$self->{struct}->{ORG_NAME}->{$colname} = $self->{struct}->{ORG_NAME}->{$orgname};
@@ -1155,7 +1155,7 @@
);
my $tmpname = $name;
- $tmpname = lc $tmpname unless ( $tmpname =~ m/^(?:\w+\.)?"/ );
+ $tmpname = lc $tmpname unless ( $tmpname =~ m/^(?:\p{Word}+\.)?"/ );
return $self->do_err("Duplicate column names!") if $is_col_name{$tmpname}++;
}
@@ -1326,7 +1326,7 @@
# DAA:
# need better alias test here, since AS is a common
# keyword that might be used in a function
- my ( $fld, $alias ) = ( $col =~ m/^(.+?)\s+(?:AS\s+)?([A-Z]\w*|\?QI\d+\?)$/i ) ? ( $1, $2 ) : ( $col, undef );
+ my ( $fld, $alias ) = ( $col =~ m/^(.+?)\s+(?:AS\s+)?([A-Z]\p{Word}*|\?QI\d+\?)$/i ) ? ( $1, $2 ) : ( $col, undef );
$col = $fld;
if ( $col =~ m/^(\S+)\.\*$/ )
{
@@ -1693,7 +1693,7 @@
#
my $xstr = $str;
my ( $k, $v );
- if ( $str =~ /^\s*([A-Z]\w*)\s*\[/gcs )
+ if ( $str =~ /^\s*([A-Z]\p{Word}*)\s*\[/gcs )
{
#
@@ -1832,7 +1832,7 @@
# DAA
# optimize regex
#
- if ( $str =~ m/\(([\w \*\/\+\-\[\]\?]+)\)/ )
+ if ( $str =~ m/\(([\p{Word} \*\/\+\-\[\]\?]+)\)/ )
{
my $match = $1;
if ( $match !~ m/(LIKE |IS|BETWEEN|IN)/i )
@@ -1850,7 +1850,7 @@
# DAA
# remove scoped recursion
#
- return ( !$has_op and $str =~ /\(([\w \*\/\+\-\[\]\?]+)\)/ )
+ return ( !$has_op and $str =~ /\(([\p{Word} \*\/\+\-\[\]\?]+)\)/ )
? nongroup_numeric($str)
: $str;
}
@@ -2490,7 +2490,7 @@
#
# JZ addition to RR's alias patch
#
- or ( $col_name =~ m/^(?:\w+\.)?"/ )
+ or ( $col_name =~ m/^(?:\p{Word}+\.)?"/ )
);
}
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement.pm Sun Apr 11 02:54:37 2010
@@ -26,15 +26,9 @@
use List::Util qw(first);
use Params::Util qw(_INSTANCE _STRING _ARRAY _ARRAY0 _HASH0 _HASH);
-BEGIN
-{
- eval { local $SIG{__DIE__}; local $SIG{__WARN__}; require 'Data/Dumper.pm'; $Data::Dumper::Indent = 1 };
- *bug = ($@) ? sub { warn @_ } : sub { print Data::Dumper::Dumper( \@_ ) };
-}
-
#use locale;
-$VERSION = '1.25';
+$VERSION = '1.26';
sub new
{
@@ -970,7 +964,7 @@
if ( $self->distinct() )
{
my %seen;
- @{$rows} = map { $seen{ join( "\0", @{$_} ) }++ ? () : $_ } @{$rows};
+ @{$rows} = map { $seen{ join( "\0", ( map { defined($_) ? $_ : '' } @{$_} ) ) }++ ? () : $_ } @{$rows};
}
if ( $self->{has_set_functions} )
@@ -1854,7 +1848,7 @@
my $empty_agg = {
uniq => [],
count => 0,
- sum => 0,
+ sum => undef,
min => undef,
max => undef,
};
@@ -1912,7 +1906,7 @@
{
if ( $coldef->{name} eq 'COUNT' )
{
- push( @row, $result->{agg}->[$colidx]->{count} );
+ push( @row, $result->{agg}->[$colidx]->{count} || 0 );
}
elsif ( $coldef->{name} eq 'MAX' )
{
@@ -1990,11 +1984,20 @@
$self->do_calc();
- foreach my $key ( keys( %{ $self->{final_rows} } ) )
- {
- my $final_row = $self->build_row( $self->{final_rows}->{$key} );
- push( @final_table, $final_row );
- }
+ if( scalar( keys( %{ $self->{final_rows} } ) ) )
+ {
+ foreach my $key ( keys( %{ $self->{final_rows} } ) )
+ {
+ my $final_row = $self->build_row( $self->{final_rows}->{$key} );
+ push( @final_table, $final_row );
+ }
+ }
+ else
+ {
+ my $final_row = $self->build_row( {} );
+ push( @final_table, $final_row );
+ }
+
return \@final_table;
}
@@ -2219,8 +2222,6 @@
=head2 _anycmp
-=head2 bug
-
=head2 buildColumnObjects
=head2 buildSortSpecList
@@ -2384,7 +2385,30 @@
For SQL::Statement 1.xx it's not planned to add new XS parts.
+=item *
+
+Wildcards are expanded to lower cased identifiers. This might confuse
+some people, but it was easier to implement.
+
+The warning from L<DBI>, never trust on case sensetiveness of returned column
+names should be read more often. If you need to rely on identifiers, always
+use C<sth-E<gt>{NAME_lc}> or C<sth-E<gt>{NAME_uc}> - never rely on
+C<sth-E<gt>{NAME}>:
+
+ $dbh->{FetchHashKeyName} = 'NAME_lc';
+ $sth = $dbh->prepare("SELECT FOO, BAR, ID, NAME, BAZ FROM TABLE");
+ $sth->execute;
+ $hash_ref = $sth->fetchall_hashref('id');
+ print "Name for id 42 is $hash_ref->{42}->{name}\n";
+
+See L<DBI/FetchHashKeyName> for more information.
+
=back
+
+Patches to fix those bugs/limitations (or a grant to do it) would be very
+welcome. Please note, that these patches B<must> pass successful all tests
+of C<SQL::Statement>, L<DBD::File> and L<DBD::CSV> and must be a general
+improvement.
=head1 AUTHOR AND COPYRIGHT
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Function.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Function.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Function.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Function.pm Sun Apr 11 02:54:37 2010
@@ -3,7 +3,7 @@
require SQL::Statement::Term;
@ISA = qw(SQL::Statement::Term);
-our $VERSION = '1.25';
+our $VERSION = '1.26';
=pod
@@ -455,7 +455,8 @@
my $rc = '';
foreach my $val ( @{ $_[0]->{PARAMS} } )
{
- $rc .= $val->value( $_[1] );
+ my $catval = $val->value( $_[1] );
+ $rc .= defined( $catval ) ? $catval : '';
}
return $rc;
}
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Functions.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Functions.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Functions.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Functions.pm Sun Apr 11 02:54:37 2010
@@ -198,7 +198,7 @@
=cut
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
=pod
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/GetInfo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/GetInfo.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/GetInfo.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/GetInfo.pm Sun Apr 11 02:54:37 2010
@@ -1,7 +1,7 @@
package SQL::Statement::GetInfo;
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
use SQL::Statement();
use vars qw(%info);
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Operation.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Operation.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Operation.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Operation.pm Sun Apr 11 02:54:37 2010
@@ -5,7 +5,7 @@
require SQL::Statement::Term;
-our $VERSION = '1.25';
+our $VERSION = '1.26';
@ISA = qw(SQL::Statement::Term);
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Placeholder.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Placeholder.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Placeholder.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Placeholder.pm Sun Apr 11 02:54:37 2010
@@ -5,7 +5,7 @@
require SQL::Statement::Term;
-our $VERSION = '1.25';
+our $VERSION = '1.26';
@ISA = qw(SQL::Statement::Term);
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/RAM.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/RAM.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/RAM.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/RAM.pm Sun Apr 11 02:54:37 2010
@@ -3,7 +3,7 @@
############################
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
sub new
{
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Syntax.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Syntax.pod?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Syntax.pod (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Syntax.pod Sun Apr 11 02:54:37 2010
@@ -407,6 +407,10 @@
the same as C<SELECT FOO FROM BAR> (C<FOO> will be evaluated as C<foo>,
similar for C<BAR>).
+Since SQL::Statement is internally using lower cased identifiers (unquoted),
+everytime a wildcard is used, the delivered names of the identifiers are
+lower cased.
+
=back
=head1 Extending SQL syntax using SQL
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Term.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Term.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Term.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Term.pm Sun Apr 11 02:54:37 2010
@@ -1,6 +1,6 @@
package SQL::Statement::Term;
-our $VERSION = '1.25';
+our $VERSION = '1.26';
use Scalar::Util qw(weaken);
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/TermFactory.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/TermFactory.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/TermFactory.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/TermFactory.pm Sun Apr 11 02:54:37 2010
@@ -9,7 +9,7 @@
use Params::Util qw(_HASH _ARRAY0 _INSTANCE);
use Scalar::Util qw(blessed weaken);
-our $VERSION = '1.25';
+our $VERSION = '1.26';
my %oplist = (
'=' => 'Equal',
Modified: branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Util.pm?rev=55925&op=diff
==============================================================================
--- branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Util.pm (original)
+++ branches/upstream/libsql-statement-perl/current/lib/SQL/Statement/Util.pm Sun Apr 11 02:54:37 2010
@@ -1,7 +1,7 @@
package SQL::Statement::Util;
use vars qw($VERSION);
-$VERSION = '1.25';
+$VERSION = '1.26';
sub type
{
Added: branches/upstream/libsql-statement-perl/current/t/06aggregate.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsql-statement-perl/current/t/06aggregate.t?rev=55925&op=file
==============================================================================
--- branches/upstream/libsql-statement-perl/current/t/06aggregate.t (added)
+++ branches/upstream/libsql-statement-perl/current/t/06aggregate.t Sun Apr 11 02:54:37 2010
@@ -1,0 +1,107 @@
+#!/usr/bin/perl -w
+$|=1;
+use strict;
+use Test::More;
+use vars qw($DEBUG);
+eval { require DBI; require DBD::File; };
+if ($@) {
+ plan skip_all => "No DBI or DBD::File available";
+}
+else {
+ plan tests => 15;
+}
+
+use SQL::Statement;
+diag( sprintf( "SQL::Statement v%s\n", $SQL::Statement::VERSION ) );
+diag( sprintf( "DBI v%s\n", $DBI::VERSION ) );
+diag( sprintf( "DBD::File v%s\n", $DBD::File::VERSION ) );
+
+my ($dbh, $sth);
+
+$dbh=DBI->connect('dbi:File(RaiseError=1,PrintError=0):');
+$dbh->do($_) for <DATA>;
+
+$sth=$dbh->prepare("SELECT class,SUM(sales) as foo, MAX(sales) FROM biz GROUP BY class");
+cmp_ok(query2str($sth), 'eq', 'Car~2000~1000^Truck~700~400','GROUP BY one column');
+
+$sth=$dbh->prepare("SELECT color,class,SUM(sales), MAX(sales) FROM biz GROUP BY color,class");
+cmp_ok(query2str($sth), 'eq', 'Blue~Car~500~500^Red~Car~500~500^White~Car~1000~1000^White~Truck~700~400',
+ 'GROUP BY several columns');
+
+$sth=$dbh->prepare("SELECT SUM(sales), MAX(sales) FROM biz");
+cmp_ok(query2str($sth), 'eq', '2700~1000','AGGREGATE FUNCTIONS WITHOUT GROUP BY');
+
+$sth = $dbh->prepare( "SELECT distinct class, COUNT(distinct color) FROM biz GROUP BY class" );
+cmp_ok( query2str($sth), 'eq', 'Car~3^Truck~1', 'COUNT(distinct column) WITH GROUP BY' );
+
+$sth = $dbh->prepare( "SELECT class, COUNT(*) FROM biz GROUP BY class" );
+cmp_ok( query2str($sth), 'eq', 'Car~3^Truck~2', 'COUNT(*) with GROUP BY' );
+
+eval { $sth = $dbh->prepare( "SELECT class, COUNT(distinct *) FROM biz GROUP BY class" ); };
+like( $@, qr/Keyword DISTINCT is not allowed for COUNT/m, 'COUNT(DISTINCT *) fails' );
+
+eval {
+ $sth = $dbh->prepare( "SELECT class, COUNT(color) FROM biz" );
+ $sth->execute();
+};
+like( $@, qr/Column 'biz\.class' must appear in the GROUP BY clause or be used in an aggregate function/, 'GROUP BY required' );
+
+$sth = $dbh->prepare("SELECT SUM(bar) FROM numbers");
+cmp_ok( query2str($sth), 'eq', 'undef', 'SUM(bar) of empty table' );
+
+$sth = $dbh->prepare("SELECT COUNT(bar),c_foo FROM numbers GROUP BY c_foo");
+cmp_ok( query2str($sth), 'eq', '0~undef', 'COUNT(bar) of empty table with GROUP BY' );
+
+$sth = $dbh->prepare("SELECT COUNT(*) FROM numbers");
+cmp_ok( query2str($sth), 'eq', '0', 'COUNT(*) of empty table' );
+
+my $sql_stmt = "INSERT INTO numbers VALUES (?, ?, ?)";
+my $stmt = $dbh->prepare($sql_stmt);
+for my $num ( 1 .. 3999 )
+{
+ my @params = ( $num, ( "a" .. "f" )[ int rand 6 ], int rand 10 );
+ $stmt->execute(@params);
+}
+
+$sth = $dbh->prepare( "SELECT foo AS boo, COUNT (*) AS counted FROM numbers GROUP BY boo" );
+$sth->execute();
+cmp_ok( join( '^', @{$sth->{NAME_lc}} ), 'eq', 'boo^counted', 'Names in aggregated Table' );
+my $res = $sth->fetchall_arrayref();
+cmp_ok( scalar( @{$res} ), '==', '6', 'Number of rows in aggregated Table' );
+my $all_counted = 0;
+foreach my $row (@{$res})
+{
+ $all_counted += $row->[1];
+}
+cmp_ok( $all_counted, '==', 3999, 'SUM(COUNTED)' );
+
+$sth = $dbh->prepare( "SELECT MIN(c_foo), MAX(c_foo), AVG(c_foo) FROM numbers" );
+cmp_ok( query2str($sth), 'eq', '1~3999~2000', 'Aggregate functions');
+
+$sth=$dbh->prepare("SELECT COUNT(*) FROM trick");
+cmp_ok(query2str($sth), 'eq', '2','Nasty COUNT(*)');
+
+sub query2str {
+ my($sth)=@_;
+ $sth->execute();
+ my @rows;
+ while (my $r=$sth->fetch()) {
+ push( @rows, join( '~', map { defined $_ ? $_ : 'undef' } @{$r} ) );
+ }
+ my $str = join( "^", sort @rows );
+ return $str unless $DEBUG;
+ printf "%s\n",join',',@{$sth->{NAME}};
+ print "<$str>\n";
+ return $str;
+}
+__END__
+CREATE TEMP TABLE biz (class TEXT, color TEXT, sales INTEGER, BUGNULL TEXT)
+INSERT INTO biz VALUES ('Car', 'White', 1000, NULL)
+INSERT INTO biz VALUES ('Car', 'Blue', 500, NULL )
+INSERT INTO biz VALUES ('Truck', 'White', 400, NULL )
+INSERT INTO biz VALUES ('Car', 'Red', 500, NULL )
+INSERT INTO biz VALUES ('Truck', 'White', 300, NULL )
+CREATE TEMP TABLE numbers (c_foo INTEGER, foo TEXT, bar INTEGER)
+CREATE TEMP TABLE trick (id INTEGER, foo TEXT)
+INSERT INTO trick VALUES (1, '1foo')
+INSERT INTO trick VALUES (11, 'foo')
More information about the Pkg-perl-cvs-commits
mailing list