r13573 - in /branches/upstream/libclass-dbi-plugin-abstractcount-perl: ./ current/ current/t/

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Sat Jan 26 08:09:19 UTC 2008


Author: dmn
Date: Sat Jan 26 08:09:19 2008
New Revision: 13573

URL: http://svn.debian.org/wsvn/?sc=1&rev=13573
Log:
[svn-inject] Installing original source of libclass-dbi-plugin-abstractcount-perl

Added:
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/AbstractCount.pm
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Changes
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/MANIFEST
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/META.yml
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Makefile.PL
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/README
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/01use.t   (with props)
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/02can.t   (with props)
    branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/03sql.t   (with props)

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/AbstractCount.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/AbstractCount.pm?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/AbstractCount.pm (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/AbstractCount.pm Sat Jan 26 08:09:19 2008
@@ -1,0 +1,144 @@
+package Class::DBI::Plugin::AbstractCount;
+# vim:set tabstop=2 shiftwidth=2 expandtab:
+
+use strict;
+use base 'Class::DBI::Plugin';
+use SQL::Abstract;
+
+our $VERSION = '0.06';
+
+sub init
+{
+  my $class = shift;
+  $class->set_sql( count_search_where => qq{
+      SELECT COUNT(*)
+      FROM __TABLE__
+      %s
+    } );
+}
+
+sub count_search_where : Plugged
+{
+  my $class = shift;
+  my %where = ();
+  my $rh_attr = {};
+  if ( ref $_[0] ) {
+    $class->_croak( "where-clause must be a hashref it it's a reference" )
+      unless ref( $_[0] ) eq 'HASH';
+    %where = %{ $_[0] };
+    $rh_attr = $_[1];
+  }
+  else {
+    $rh_attr = pop if @_ % 2;
+    %where = @_;
+  }
+  delete $rh_attr->{order_by};
+
+  $class->can( 'retrieve_from_sql' )
+    or $class->_croak( "$class should inherit from Class::DBI >= 0.95" );
+  
+  my ( %columns, %accessors ) = ();
+  for my $column ( $class->columns ) {
+    ++$columns{ $column };
+    $accessors{ $column->accessor } = $column;
+  }
+
+  COLUMN: for my $column ( keys %where ) {
+    next COLUMN if exists $columns{ $column };
+    $where{ $accessors{ $column }} = delete $where{ $column }, next COLUMN
+      if exists $accessors{ $column };
+
+    # Check for functions
+    if ( index( $column, '(' )
+      && index( $column, ')' ))
+    {
+      my @tokens = ( $column =~ /(\w+(?:\s*\(\s*)?|\W+)/g );
+      TOKEN: for my $token ( @tokens ) {
+        if ( $token !~ /\W/ ) { # must be column or accessor name
+          next TOKEN if exists $columns{ $token };
+          $token = $accessors{ $token }, next TOKEN
+            if exists $accessors{ $token };
+          $class->_croak(
+            qq{"$token" is not a column/accessor of class "$class"} );
+        }
+      }
+
+      my $normalized = join "", @tokens;
+      $where{ $normalized } = delete $where{ $column }
+        if $normalized ne $column;
+      next COLUMN;
+    }
+
+    $class->_croak( qq{"$column" is not a column/accessor of class "$class"} );
+  }
+
+  my ( $phrase, @bind ) = SQL::Abstract
+    -> new( %$rh_attr )
+    -> where( \%where );
+  $class
+    -> sql_count_search_where( $phrase )
+    -> select_val( @bind );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Class::DBI::Plugin::AbstractCount - get COUNT(*) results with abstract SQL
+
+=head1 SYNOPSIS
+
+  use base 'Class::DBI';
+  use Class::DBI::Plugin::AbstractCount;
+  
+  my $count = Music::Vinyl->count_search_where(
+    { artist   => 'Frank Zappa'
+    , title    => { like    => '%Shut Up 'n Play Yer Guitar%' }
+    , released => { between => [ 1980, 1982 ] }
+    });
+
+=head1 DESCRIPTION
+
+This Class::DBI plugin combines the functionality from
+Class::DBI::Plugin::CountSearch (counting objects without having to use an
+array or an iterator), and Class::DBI::AbstractSearch, which allows complex
+where-clauses a la SQL::Abstract.
+
+=head1 METHODS
+
+=head2 count_search_where
+
+Takes a hashref with the abstract where-clause. An additional attribute hashref
+can be passed to influence the default behaviour: arrayrefs are OR'ed, hashrefs
+are AND'ed.
+
+=head1 TODO
+
+More tests, more doc.
+
+=head1 SEE ALSO
+
+=over
+
+=item SQL::Abstract for details about the where-clause and the attributes.
+
+=item Class::DBI::AbstractSearch
+
+=item Class::DBI::Plugin::CountSearch
+
+=back
+
+=head1 AUTHOR
+
+Jean-Christophe Zeus, E<lt>mail at jczeus.comE<gt> with some help from
+Tatsuhiko Myagawa and Todd Holbrook.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2004 by Jean-Christophe Zeus
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Changes?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Changes (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Changes Sat Jan 26 08:09:19 2008
@@ -1,0 +1,23 @@
+Revision history for Perl extension Class::DBI::Plugin::AbstractCount.
+
+0.06  Mon Aug 22 16:54:00 2005
+	- fixed function-call-on-column-in-where-clause issue
+	- added eight more tests (to check function call issue)
+0.05  Sun Aug 21 16:33:00 2005
+	- improved on function-call-on-column-in-where-clause issue
+	- added four more tests (to check function call issue)
+	- changed accessor tests
+0.04  Mon Jul 20 00:12:00 2005
+	- fixed column <-> accessor name issue
+	- fixed too restrictive tests (changes in SQL::Abstract)
+	- added two more tests (to check if accessor names work)
+	- add dependency on SQL::Abstract
+	- now requires Perl >= 5.6.0
+0.03  Mon Jul 05 22:40:00 2004
+	- use of Class::DBI::Plugin as a base class
+0.02  ??
+	- minor improvements in docs
+0.01  Thu Jun 10 08:49:23 2004
+	- original version; created by h2xs 1.22 with options
+		-XAn Class::DBI::Plugin::AbstractCount -b 5.5.2
+

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/MANIFEST?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/MANIFEST (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/MANIFEST Sat Jan 26 08:09:19 2008
@@ -1,0 +1,9 @@
+AbstractCount.pm
+Changes
+Makefile.PL
+MANIFEST
+README
+t/01use.t
+t/02can.t
+t/03sql.t
+META.yml                                 Module meta-data (added by MakeMaker)

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/META.yml?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/META.yml (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/META.yml Sat Jan 26 08:09:19 2008
@@ -1,0 +1,13 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Class-DBI-Plugin-AbstractCount
+version:      0.06
+version_from: AbstractCount.pm
+installdirs:  site
+requires:
+    Class::DBI:                    0.95
+    Class::DBI::Plugin:            0.02
+    SQL::Abstract:                 1.1
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Makefile.PL?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Makefile.PL (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/Makefile.PL Sat Jan 26 08:09:19 2008
@@ -1,0 +1,16 @@
+use 5.006;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    NAME              => 'Class::DBI::Plugin::AbstractCount',
+    VERSION_FROM      => 'AbstractCount.pm', # finds $VERSION
+    PREREQ_PM         =>
+			{ 'Class::DBI'         => 0.95
+			, 'Class::DBI::Plugin' => 0.02
+			, 'SQL::Abstract'      => 1.10
+			},
+    ($] >= 5.006 ?     ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM  => 'AbstractCount.pm', # retrieve abstract from module
+       AUTHOR         => 'Jean-Christophe Zeus <mail at ljczeus.com>') : ()),
+);

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/README?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/README (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/README Sat Jan 26 08:09:19 2008
@@ -1,0 +1,66 @@
+Class/DBI/Plugin/AbstractCount version 0.04
+===========================================
+
+INSTALLATION
+
+To install this module type the following:
+
+  perl Makefile.PL
+  make
+  make test
+  make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  Class::DBI >= 0.90
+
+SYNOPSIS
+
+  use base 'Class::DBI';
+  use Class::DBI::Plugin::AbstractCount;
+
+  my $count = Music::Vinyl->count_search_where(
+    { artist   => 'Frank Zappa'
+    , title    => { like    => '%Shut Up 'n Play Yer Guitar%' }
+    , released => { between => [ 1980, 1982 ] }
+    });
+
+DESCRIPTION
+
+This Class::DBI plugin combines the functionality from
+Class::DBI::Plugin::CountSearch (counting objects without having to use an
+array or an iterator), and Class::DBI::AbstractSearch, which allows complex
+where-clauses a la SQL::Abstract.
+
+METHODS
+
+  count_search_where
+
+  Takes a hashref with the abstract where-clause. An additional attribute
+  hashref can be passed to influence the default behaviour: arrayrefs are
+  OR'ed, hashrefs are AND'ed.
+
+TODO
+
+More tests, more doc.
+
+SEE ALSO
+
+  SQL::Abstract for details about the where-clause and the attributes.
+  Class::DBI::AbstractSearch
+  Class::DBI::Plugin::CountSearch
+
+AUTHOR
+
+Jean-Christophe Zeus, <mail at jczeus.com> with some help from Tatsuhiko
+Myagawa and Todd Holbrook.
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2004 Jean-Christophe Zeus
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/01use.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/01use.t?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/01use.t (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/01use.t Sat Jan 26 08:09:19 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl -I. -w
+use strict;
+
+use Test::More tests => 1;
+
+sub set_sql
+{ }
+
+BEGIN { use_ok( 'Class::DBI::Plugin::AbstractCount' ) }
+
+__END__

Propchange: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/01use.t
------------------------------------------------------------------------------
    svn:executable = 

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/02can.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/02can.t?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/02can.t (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/02can.t Sat Jan 26 08:09:19 2008
@@ -1,0 +1,19 @@
+#!/usr/bin/perl -I. -w
+use strict;
+
+use Test::More tests => 2;
+
+sub set_sql
+{
+	my ( $class, $name, $sql ) = @_;
+	no strict 'refs';
+	*{ "$class\::sql_$name" } =
+		sub
+		{ };
+}
+
+use Class::DBI::Plugin::AbstractCount;
+can_ok( 'main', qw( count_search_where ) );
+can_ok( 'main', qw( sql_count_search_where ) );
+
+__END__

Propchange: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/02can.t
------------------------------------------------------------------------------
    svn:executable = 

Added: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/03sql.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/03sql.t?rev=13573&op=file
==============================================================================
--- branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/03sql.t (added)
+++ branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/03sql.t Sat Jan 26 08:09:19 2008
@@ -1,0 +1,171 @@
+#!/usr/bin/perl -I. -w
+# vim:set tabstop=2 shiftwidth=2 expandtab syn=perl:
+use strict;
+
+use Test::More tests => 18;
+
+$main::sql = "";
+
+sub set_sql
+{
+  my ( $class, $name, $sql ) = @_;
+  no strict 'refs';
+  *{ "$class\::sql_$name" } =
+    sub
+    {
+      my ( $class, $where ) = @_;
+      ( $main::sql = sprintf $sql, $where ) =~ s/^\s+//mg;
+      return $class;
+    };
+}
+
+sub retrieve_from_sql {} # Make plugin believe we're inheriting from Class::DBI
+
+sub select_val
+{
+  shift;
+  return @_;
+}
+
+sub columns { return qw( artist title release updated ) }
+
+sub _croak
+{
+  shift;
+  die ": _croak(): '@_'\n";
+}
+
+# If we can't be free, at least we can be cheap...
+{
+  package artist;
+  sub accessor { return 'artist_name' }
+}
+{
+  package title;
+  sub accessor { return 'album_title' }
+}
+{
+  package release;
+  sub accessor { return 'release_date' }
+}
+{
+  package updated;
+  sub accessor { return 'last_change' }
+}
+
+use Class::DBI::Plugin::AbstractCount;
+
+# Test simple where-clause
+my ( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist => 'Frank Zappa'
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( artist = \? \)\n/i
+  , 'sql statement 1'
+  );
+is_deeply( \@bind_params, [ 'Frank Zappa' ], 'bind param list 1' );
+
+# Test more complex where-clause
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist  => 'Frank Zappa'
+  , title   => { like => '%Shut Up \'n Play Yer Guitar%' }
+  , release => { between => [ 1980, 1982 ] }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( artist = \? AND release BETWEEN \? AND \? AND title LIKE \? \)\n/i
+  , 'sql statement 2'
+  );
+is_deeply( \@bind_params, [ 'Frank Zappa'
+                          , 1980
+                          , 1982
+                          , '%Shut Up \'n Play Yer Guitar%'
+                          ], 'bind param list 2' );
+
+# Test where-clause with accessors
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist_name  => 'Steve Vai'
+  , album_title  => { like => 'Flexable%' }
+  , release_date => { between => [ 1983, 1984 ] }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( artist = \? AND release BETWEEN \? AND \? AND title LIKE \? \)\n/i
+  , 'sql statement 3'
+  );
+is_deeply( \@bind_params, [ 'Steve Vai'
+                          , 1983
+                          , 1984
+                          , 'Flexable%'
+                          ], 'bind param list 3' );
+
+# Test where-clause with simple function-call on column name
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist            => 'Adrian Belew'
+  , 'YEAR( release )' => { '=', 2005 }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( YEAR\( release \) = \? AND artist = \? \)\n/i
+  , 'sql statement 4'
+  );
+is_deeply( \@bind_params, [ 2005
+                          , 'Adrian Belew'
+                          ], 'bind param list 4' );
+
+# Test where-clause with more complicated (nested) function-call on column name
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist            => 'Adrian Belew'
+  , 'COALESCE( release, NOW() )' => { '=', 2005 }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( COALESCE\( release, NOW\(\) \) = \? AND artist = \? \)\n/i
+  , 'sql statement 5'
+  );
+is_deeply( \@bind_params, [ 2005
+                          , 'Adrian Belew'
+                          ], 'bind param list 5' );
+
+# Test where-clause with simple function-call on accessor
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist_name            => 'Adrian Belew'
+  , 'YEAR( release_date )' => { '=', 2005 }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( YEAR\( release \) = \? AND artist = \? \)\n/i
+  , 'sql statement 6'
+  );
+is_deeply( \@bind_params, [ 2005
+                          , 'Adrian Belew'
+                          ], 'bind param list 6' );
+
+# Test where-clause with more complicated (nested) function-call on accessor
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist_name            => 'Adrian Belew'
+  , 'COALESCE( release_date, NOW() )' => { '=', 2005 }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( COALESCE\( release, NOW\(\) \) = \? AND artist = \? \)\n/i
+  , 'sql statement 7'
+  );
+is_deeply( \@bind_params, [ 2005
+                          , 'Adrian Belew'
+                          ], 'bind param list 7' );
+
+# Test where-clause with more complicated (nested) function-call on multiple
+# column names
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist            => 'Adrian Belew'
+  , 'COALESCE( release, updated, NOW() )' => { '=', 2005 }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( COALESCE\( release, updated, NOW\(\) \) = \? AND artist = \? \)\n/i
+  , 'sql statement 8'
+  );
+is_deeply( \@bind_params, [ 2005
+                          , 'Adrian Belew'
+                          ], 'bind param list 8' );
+
+# Test where-clause with more complicated (nested) function-call on mixed
+# column and accessor names
+( @bind_params ) = __PACKAGE__->count_search_where(
+  { artist            => 'Adrian Belew'
+  , 'COALESCE( release, last_change, NOW() )' => { '=', 2005 }
+  } );
+like( $main::sql, qr/SELECT COUNT\(\*\)\nFROM __TABLE__\nWHERE \( COALESCE\( release, updated, NOW\(\) \) = \? AND artist = \? \)\n/i
+  , 'sql statement 9'
+  );
+is_deeply( \@bind_params, [ 2005
+                          , 'Adrian Belew'
+                          ], 'bind param list 9' );
+
+__END__

Propchange: branches/upstream/libclass-dbi-plugin-abstractcount-perl/current/t/03sql.t
------------------------------------------------------------------------------
    svn:executable = 




More information about the Pkg-perl-cvs-commits mailing list