r41936 - in /branches/upstream/liborlite-perl/current: Changes META.yml lib/ORLite.pm t/02_basics.t t/lib/Test.pm
rmayorga at users.alioth.debian.org
rmayorga at users.alioth.debian.org
Sun Aug 16 05:42:34 UTC 2009
Author: rmayorga
Date: Sun Aug 16 05:42:21 2009
New Revision: 41936
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41936
Log:
[svn-upgrade] Integrating new upstream version, liborlite-perl (1.25)
Modified:
branches/upstream/liborlite-perl/current/Changes
branches/upstream/liborlite-perl/current/META.yml
branches/upstream/liborlite-perl/current/lib/ORLite.pm
branches/upstream/liborlite-perl/current/t/02_basics.t
branches/upstream/liborlite-perl/current/t/lib/Test.pm
Modified: branches/upstream/liborlite-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/Changes?rev=41936&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/Changes (original)
+++ branches/upstream/liborlite-perl/current/Changes Sun Aug 16 05:42:21 2009
@@ -1,4 +1,11 @@
Changes for Perl extension ORLite
+
+1.25 Sat 15 Aug 2009
+ - Adding base and table metadata methods to each class to support
+ the creation of support/extension methods
+
+1.24 Sat 15 Aug 2009
+ - Adding support for an iterate method
1.23 Thu 11 Jun 2009
- Fixed a bug in method ->delete which deleted more than the actual
Modified: branches/upstream/liborlite-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/META.yml?rev=41936&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/META.yml (original)
+++ branches/upstream/liborlite-perl/current/META.yml Sun Aug 16 05:42:21 2009
@@ -32,4 +32,4 @@
ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/ORLite
license: http://dev.perl.org/licenses/
repository: http://svn.ali.as/cpan/trunk/ORLite
-version: 1.23
+version: 1.25
Modified: branches/upstream/liborlite-perl/current/lib/ORLite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/lib/ORLite.pm?rev=41936&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/lib/ORLite.pm (original)
+++ branches/upstream/liborlite-perl/current/lib/ORLite.pm Sun Aug 16 05:42:21 2009
@@ -15,7 +15,7 @@
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.23';
+ $VERSION = '1.25';
}
@@ -108,6 +108,7 @@
use strict;
use Carp ();
+use DBI ();
my \$DBH = undef;
@@ -127,6 +128,10 @@
DBI->connect(\$_[0]->dsn);
}
+sub prepare {
+ shift->dbh->prepare(\@_);
+}
+
sub do {
shift->dbh->do(\@_);
}
@@ -153,15 +158,22 @@
sub selectrow_hashref {
shift->dbh->selectrow_hashref(\@_);
-}
-
-sub prepare {
- shift->dbh->prepare(\@_);
}
sub pragma {
\$_[0]->do("pragma \$_[1] = \$_[2]") if \@_ > 2;
\$_[0]->selectrow_arrayref("pragma \$_[1]")->[0];
+}
+
+sub iterate {
+ my \$class = shift;
+ my \$call = pop;
+ my \$sth = \$class->prepare( shift );
+ \$sth->execute( \@_ );
+ while ( \$_ = \$sth->fetchrow_arrayref ) {
+ \$call->() or last;
+ }
+ \$sth->finish;
}
END_PERL
@@ -283,6 +295,10 @@
$code .= <<"END_PERL";
package $table->{class};
+sub base { '$pkg' }
+
+sub table { '$table->{name}' }
+
sub select {
my \$class = shift;
my \$sql = '$sql->{select} ';
@@ -297,6 +313,20 @@
my \$sql = '$sql->{count} ';
\$sql .= shift if \@_;
$pkg->selectrow_array( \$sql, {}, \@_ );
+}
+
+sub iterate {
+ my \$class = shift;
+ my \$call = pop;
+ my \$sql = '$sql->{select} ';
+ \$sql .= shift if \@_;
+ my \$sth = $pkg->prepare( \$sql );
+ \$sth->execute( \@_ );
+ while ( \$_ = \$sth->fetchrow_hashref ) {
+ bless( \$_, '$table->{class}' );
+ \$call->() or last;
+ }
+ \$sth->finish;
}
END_PERL
Modified: branches/upstream/liborlite-perl/current/t/02_basics.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/t/02_basics.t?rev=41936&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/t/02_basics.t (original)
+++ branches/upstream/liborlite-perl/current/t/02_basics.t Sun Aug 16 05:42:21 2009
@@ -9,7 +9,7 @@
$^W = 1;
}
-use Test::More tests => 51;
+use Test::More tests => 65;
use File::Spec::Functions ':ALL';
use t::lib::Test;
@@ -70,24 +70,8 @@
is( Foo::Bar::TableOne->count, 3, 'Found 3 rows' );
is( Foo::Bar::TableOne->count('where col2 = ?', 'bar'), 2, 'Condition count works' );
-# Fetch the rows (list context)
-SCOPE: {
- my @ones = Foo::Bar::TableOne->select('order by col1');
- is( scalar(@ones), 3, 'Got 3 objects' );
- isa_ok( $ones[0], 'Foo::Bar::TableOne' );
- is( $ones[0]->col1, 1, '->col1 ok' );
- is( $ones[0]->col2, 'foo', '->col2 ok' );
- isa_ok( $ones[1], 'Foo::Bar::TableOne' );
- is( $ones[1]->col1, 2, '->col1 ok' );
- is( $ones[1]->col2, 'bar', '->col2 ok' );
- isa_ok( $ones[2], 'Foo::Bar::TableOne' );
- is( $ones[2]->col1, 3, '->col1 ok' );
- is( $ones[2]->col2, 'bar', '->col2 ok' );
-}
-
-# Fetch the rows (scalar context)
-SCOPE: {
- my $ones = Foo::Bar::TableOne->select('order by col1');
+sub test_ones {
+ my $ones = shift;
is( scalar(@$ones), 3, 'Got 3 objects' );
isa_ok( $ones->[0], 'Foo::Bar::TableOne' );
is( $ones->[0]->col1, 1, '->col1 ok' );
@@ -98,6 +82,44 @@
isa_ok( $ones->[2], 'Foo::Bar::TableOne' );
is( $ones->[2]->col1, 3, '->col1 ok' );
is( $ones->[2]->col2, 'bar', '->col2 ok' );
+
+}
+
+# Fetch the rows (list context)
+test_ones(
+ [ Foo::Bar::TableOne->select('order by col1') ]
+);
+
+# Fetch the rows (scalar context)
+test_ones(
+ scalar Foo::Bar::TableOne->select('order by col1')
+);
+
+SCOPE: {
+ # Emulate select via iterate
+ my $ones = [];
+ Foo::Bar::TableOne->iterate( 'order by col1', sub {
+ push @$ones, $_;
+ } );
+ test_ones( $ones );
+
+ # Partial fetch
+ my $short = [];
+ Foo::Bar::TableOne->iterate( 'order by col1', sub {
+ push @$short, $_;
+ return 0;
+ } );
+ is( scalar(@$short), 1, 'Found only one record' );
+ is_deeply( $short->[0], $ones->[0], 'Found the same first record' );
+
+ # Lower level equivalent
+ my $short2 = [];
+ Foo::Bar->iterate( 'select * from table_one order by col1', sub {
+ push @$short2, $_;
+ return 0;
+ } );
+ is( scalar(@$short2), 1, 'Found only one record' );
+ is_deeply( $short2->[0], [ 1, 'foo' ], 'Found correct alternative' );
# Delete one of the objects via the class delete method
my $rv1 = Foo::Bar::TableOne->delete('where col2 = ?', 'bar');
Modified: branches/upstream/liborlite-perl/current/t/lib/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/t/lib/Test.pm?rev=41936&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/t/lib/Test.pm (original)
+++ branches/upstream/liborlite-perl/current/t/lib/Test.pm Sun Aug 16 05:42:21 2009
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
- $VERSION = '1.23';
+ $VERSION = '1.25';
@ISA = 'Exporter';
@EXPORT = qw{ test_db connect_ok create_ok };
}
More information about the Pkg-perl-cvs-commits
mailing list