r49932 - in /trunk/liborlite-perl: Changes MANIFEST META.yml README debian/changelog debian/copyright lib/ORLite.pm t/02_basics.t t/04_readonly.t t/08_prune.pl t/09_badfile.t t/lib/Test.pm
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Jan 2 17:00:36 UTC 2010
Author: jawnsy-guest
Date: Sat Jan 2 17:00:10 2010
New Revision: 49932
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49932
Log:
New upstream release
Added:
trunk/liborlite-perl/t/09_badfile.t
- copied unchanged from r49928, branches/upstream/liborlite-perl/current/t/09_badfile.t
Modified:
trunk/liborlite-perl/Changes
trunk/liborlite-perl/MANIFEST
trunk/liborlite-perl/META.yml
trunk/liborlite-perl/README
trunk/liborlite-perl/debian/changelog
trunk/liborlite-perl/debian/copyright
trunk/liborlite-perl/lib/ORLite.pm
trunk/liborlite-perl/t/02_basics.t
trunk/liborlite-perl/t/04_readonly.t
trunk/liborlite-perl/t/08_prune.pl
trunk/liborlite-perl/t/lib/Test.pm
Modified: trunk/liborlite-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/Changes?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/Changes (original)
+++ trunk/liborlite-perl/Changes Sat Jan 2 17:00:10 2010
@@ -1,4 +1,34 @@
Changes for Perl extension ORLite
+
+1.31 Sat 2 Jan 2010
+ - Adding explicit versioned-use lines to the generated code (in case
+ the generated code is used independantly to its creation)
+
+1.30 Sat 2 Jan 2010
+ - Switching to a production release, CPAN Testers looks ok
+ - Update DBD::SQLite dependency to 1.27. Some of the metadata pragmas
+ have changed, and we don't want to have to support both the old and
+ new versions.
+ - ORLite will now correctly use RaiseError => 1, PrintError => 0 when
+ itself introspecting the schema, so a corrupted SQLite database
+ won't result in silent failure and the larger parent application
+ won't crash in unpredictable ways.
+
+1.29_03 Thu 1 Oct 2009
+ - Reverse the prune deletion order
+ - Apply recursive delete flag
+
+1.29_02 Tue 29 Sep 2009
+ - Changed ->load to use selectrow_hashref
+ - Allow ->load calls for multiple-columns primary keys
+ - All connections now explicitly RaiseError => 1 for correctness
+ - All connections now explicitly PrintError => 0 to avoid spewing
+ stuff to STDOUT/STDERR unexpectedly in embedded scenarios.
+ - Remove most explicit error handling and allow the native DBI
+ errors to cascade upwards instead.
+
+1.29_01 Mon 28 Sep 2009
+ - Adding first experimental implementation of ->load
1.28 Fri 25 Sep 2009
- Adding ->prune method that so that pruning can also be done
Modified: trunk/liborlite-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/MANIFEST?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/MANIFEST (original)
+++ trunk/liborlite-perl/MANIFEST Sat Jan 2 17:00:10 2010
@@ -27,6 +27,7 @@
t/07_pk.t
t/08_prune.pl
t/08_prune.t
+t/09_badfile.t
t/97_meta.t
t/98_pod.t
t/99_pmv.t
Modified: trunk/liborlite-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/META.yml?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/META.yml (original)
+++ trunk/liborlite-perl/META.yml Sat Jan 2 17:00:10 2010
@@ -21,7 +21,7 @@
- inc
- t
requires:
- DBD::SQLite: 1.25
+ DBD::SQLite: 1.27
DBI: 1.607
File::Basename: 0
File::Path: 2.04
@@ -34,4 +34,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.28
+version: 1.31
Modified: trunk/liborlite-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/README?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/README (original)
+++ trunk/liborlite-perl/README Sat Jan 2 17:00:10 2010
@@ -274,7 +274,7 @@
ORLite::Mirror, ORLite::Migrate
COPYRIGHT
- Copyright 2008 - 2009 Adam Kennedy.
+ Copyright 2008 - 2010 Adam Kennedy.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: trunk/liborlite-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/debian/changelog?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/debian/changelog (original)
+++ trunk/liborlite-perl/debian/changelog Sat Jan 2 17:00:10 2010
@@ -1,9 +1,13 @@
-liborlite-perl (1.28-2) UNRELEASED; urgency=low
+liborlite-perl (1.31-1) UNRELEASED; urgency=low
+ [ Jonathan Yu ]
+ * New upstream release
+
+ [ gregor herrmann ]
* debian/control: Changed: (build-)depend on perl instead of perl-
modules.
- -- gregor herrmann <gregoa at debian.org> Fri, 23 Oct 2009 02:25:40 +0200
+ -- Jonathan Yu <jawnsy at cpan.org> Sat, 02 Jan 2010 12:01:15 -0500
liborlite-perl (1.28-1) unstable; urgency=low
Modified: trunk/liborlite-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/debian/copyright?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/debian/copyright (original)
+++ trunk/liborlite-perl/debian/copyright Sat Jan 2 17:00:10 2010
@@ -5,12 +5,12 @@
Upstream-Name: ORLite
Files: *
-Copyright: 2008-2009, Adam Kennedy <adamk at cpan.org>
+Copyright: 2008-2010, Adam Kennedy <adamk at cpan.org>
License-Alias: Perl
License: Artistic | GPL-1+
Files: debian/*
-Copyright: 2009, Jonathan Yu <jawnsy at cpan.org>
+Copyright: 2009-2010, Jonathan Yu <jawnsy at cpan.org>
2009, Jaldhar H. Vyas <jaldhar at debian.org>
2009, Nathan Handler <nhandler at ubuntu.com>
2009, Rene Mayorga <rmayorga at debian.org>
Modified: trunk/liborlite-perl/lib/ORLite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/lib/ORLite.pm?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/lib/ORLite.pm (original)
+++ trunk/liborlite-perl/lib/ORLite.pm Sat Jan 2 17:00:10 2010
@@ -11,20 +11,20 @@
use File::Basename 0 ();
use Params::Util 0.33 ();
use DBI 1.607 ();
-use DBD::SQLite 1.25 ();
+use DBD::SQLite 1.27 ();
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.28';
+ $VERSION = '1.31';
}
# Support for the 'prune' option
my @PRUNE = ();
END {
- foreach ( @PRUNE ) {
+ foreach ( reverse @PRUNE ) {
next unless -e $_;
require File::Remove;
- File::Remove::remove($_);
+ File::Remove::remove( \1, $_ );
}
}
@@ -101,7 +101,10 @@
my $pkg = $params{package};
my $readonly = $params{readonly};
my $dsn = "dbi:SQLite:$file";
- my $dbh = DBI->connect($dsn);
+ my $dbh = DBI->connect( $dsn, undef, undef, {
+ PrintError => 0,
+ RaiseError => 1,
+ } );
# Schema creation support
if ( $created and Params::Util::_CODELIKE($params{create}) ) {
@@ -111,7 +114,7 @@
# Check the schema version before generating
my $version = $dbh->selectrow_arrayref('pragma user_version')->[0];
if ( exists $params{user_version} and $version != $params{user_version} ) {
- die "Schema user_version mismatch (got $version, wanted $params{user_version})";
+ Carp::croak("Schema user_version mismatch (got $version, wanted $params{user_version})");
}
# Generate the support package code
@@ -119,8 +122,9 @@
package $pkg;
use strict;
-use Carp ();
-use DBI ();
+use Carp ();
+use DBI 1.607 ();
+use DBD::SQLite 1.27 ();
my \$DBH = undef;
@@ -131,13 +135,14 @@
sub dsn { '$dsn' }
sub dbh {
- \$DBH or
- \$_[0]->connect or
- Carp::croak("connect: \$DBI::errstr");
+ \$DBH or \$_[0]->connect;
}
sub connect {
- DBI->connect(\$_[0]->dsn);
+ DBI->connect( \$_[0]->dsn, undef, undef, {
+ PrintError => 0,
+ RaiseError => 1,
+ } );
}
sub prepare {
@@ -194,8 +199,7 @@
$code .= <<"END_PERL" unless $readonly;
sub begin {
\$DBH or
- \$DBH = \$_[0]->connect or
- Carp::croak("connect: \$DBI::errstr");
+ \$DBH = \$_[0]->connect;
\$DBH->begin_work;
}
@@ -260,6 +264,7 @@
# Discover the primary key
@{$table->{pk}} = map($_->{name}, grep { $_->{pk} } @columns);
+ $table->{pks} = scalar(@{$table->{pk}});
# What will be the class for this table
$table->{class} = ucfirst lc $table->{name};
@@ -276,6 +281,7 @@
"insert into $table->{name}" .
"( $table->{sql}->{cols} )" .
" values ( $table->{sql}->{vals} )";
+ $sql->{where_pk} = join(' and ', map("$_ = ?", @{$table->{pk}}))
}
# Generate the foreign key metadata
@@ -343,17 +349,34 @@
END_PERL
+ # Add the primary key based single object loader
+ if ( $table->{pks} ) {
+ $code .= <<"END_PERL";
+sub load {
+ my \$class = shift;
+ my \$row = $pkg->selectrow_hashref(
+ '$sql->{select} where $sql->{where_pk}',
+ undef, \@_,
+ );
+ unless ( \$row ) {
+ Carp::croak("$table->{class} row does not exist");
+ }
+ bless( \$row, '$table->{class}' );
+}
+
+END_PERL
+ }
+
# Generate the elements for tables with primary keys
if ( defined $table->{pk} and ! $readonly ) {
my $nattr = join "\n", map { "\t\t$_ => \$attr{$_}," } @names;
my $iattr = join "\n", map { "\t\t\$self->{$_}," } @names;
my $fill_pk = scalar @{$table->{pk}} == 1
- ? "\t\$self->{$table->{pk}->[0]} = \$dbh->func('last_insert_rowid') unless \$self->{$table->{pk}->[0]};"
- : q{};
+ ? "\t\$self->{$table->{pk}->[0]} = \$dbh->func('last_insert_rowid') unless \$self->{$table->{pk}->[0]};"
+ : q{};
my $where_pk = join(' and ', map("$_ = ?", @{$table->{pk}}));
- my $where_pk_attr = join("\n", map("\t\t\$self->{$_},", @{$table->{pk}}));
+ my $where_pk_attr = join("\n", map("\t\t\$self->{$_},", @{$table->{pk}}));
$code .= <<"END_PERL";
-
sub new {
my \$class = shift;
my \%attr = \@_;
@@ -369,7 +392,7 @@
sub insert {
my \$self = shift;
my \$dbh = $pkg->dbh;
- \$dbh->do('$sql->{insert}', {},
+ \$dbh->do( '$sql->{insert}', {},
$iattr
);
$fill_pk
@@ -759,7 +782,7 @@
=head1 COPYRIGHT
-Copyright 2008 - 2009 Adam Kennedy.
+Copyright 2008 - 2010 Adam Kennedy.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
Modified: trunk/liborlite-perl/t/02_basics.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/02_basics.t?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/t/02_basics.t (original)
+++ trunk/liborlite-perl/t/02_basics.t Sat Jan 2 17:00:10 2010
@@ -9,7 +9,7 @@
$^W = 1;
}
-use Test::More tests => 65;
+use Test::More tests => 68;
use File::Spec::Functions ':ALL';
use t::lib::Test;
@@ -57,6 +57,7 @@
Foo::Bar::TableOne->create( col1 => 1, col2 => 'foo' ),
'Created row 1',
);
+isa_ok( Foo::Bar::TableOne->load(1), 'Foo::Bar::TableOne' );
my $new = Foo::Bar::TableOne->create( col2 => 'bar' );
isa_ok( $new, 'Foo::Bar::TableOne' );
is( $new->col1, 2, '->col1 ok' );
@@ -82,7 +83,6 @@
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)
@@ -160,3 +160,19 @@
ok( Foo::Bar::TableOne->truncate, '->truncate ok' );
is( Foo::Bar::TableOne->count, 0, 'Commit ok' );
}
+
+
+
+
+
+######################################################################
+# Exceptions
+
+# Load an object that does not exist
+SCOPE: {
+ my @rv = eval {
+ Foo::Bar::TableOne->load(undef);
+ };
+ is( scalar(@rv), 0, 'Exception returns nothing' );
+ like( $@, qr/Foo::Bar::TableOne row does not exist/, 'Foo::Bar::TableOne row does not exist' );
+}
Modified: trunk/liborlite-perl/t/04_readonly.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/04_readonly.t?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/t/04_readonly.t (original)
+++ trunk/liborlite-perl/t/04_readonly.t Sat Jan 2 17:00:10 2010
@@ -9,7 +9,7 @@
$^W = 1;
}
-use Test::More tests => 9;
+use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use t::lib::Test;
@@ -46,7 +46,11 @@
1;
END_PERL
+# Check standard methods exist
is( Foo::Bar->orlite, $t::lib::Test::VERSION, '->orlite ok' );
+ok( Foo::Bar->can('sqlite'), '->sqlite method exists' );
+ok( Foo::Bar::TableOne->can('load'), '->load method exists' );
+ok( Foo::Bar::TableOne->can('select'), '->select method exists' );
# Check the user_version value
is( Foo::Bar->pragma('user_version'), 10, '->user_version ok' );
Modified: trunk/liborlite-perl/t/08_prune.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/08_prune.pl?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/t/08_prune.pl (original)
+++ trunk/liborlite-perl/t/08_prune.pl Sat Jan 2 17:00:10 2010
@@ -4,7 +4,9 @@
use strict;
-unless ( $ORLite::VERSION eq '1.28' ) {
+our $VERSION = '1.31';
+
+unless ( $ORLite::VERSION eq $VERSION ) {
die('Failed to load correct ORLite version');
}
Modified: trunk/liborlite-perl/t/lib/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/lib/Test.pm?rev=49932&op=diff
==============================================================================
--- trunk/liborlite-perl/t/lib/Test.pm (original)
+++ trunk/liborlite-perl/t/lib/Test.pm Sat Jan 2 17:00:10 2010
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
- $VERSION = '1.28';
+ $VERSION = '1.31';
@ISA = 'Exporter';
@EXPORT = qw{ test_db connect_ok create_ok };
}
More information about the Pkg-perl-cvs-commits
mailing list