r49930 - in /branches/upstream/liborlite-mirror-perl/current: Changes MANIFEST META.yml README lib/ORLite/Mirror.pm t/03_gzip.t t/03_zipped.t t/07_badfile.t t/data/ t/data/broken.db t/data/broken.db.gz t/lib/Test.pm
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Jan 2 16:59:07 UTC 2010
Author: jawnsy-guest
Date: Sat Jan 2 16:59:01 2010
New Revision: 49930
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49930
Log:
[svn-upgrade] Integrating new upstream version, liborlite-mirror-perl (1.18)
Added:
branches/upstream/liborlite-mirror-perl/current/t/03_gzip.t
branches/upstream/liborlite-mirror-perl/current/t/07_badfile.t
branches/upstream/liborlite-mirror-perl/current/t/data/
branches/upstream/liborlite-mirror-perl/current/t/data/broken.db
branches/upstream/liborlite-mirror-perl/current/t/data/broken.db.gz (with props)
Removed:
branches/upstream/liborlite-mirror-perl/current/t/03_zipped.t
Modified:
branches/upstream/liborlite-mirror-perl/current/Changes
branches/upstream/liborlite-mirror-perl/current/MANIFEST
branches/upstream/liborlite-mirror-perl/current/META.yml
branches/upstream/liborlite-mirror-perl/current/README
branches/upstream/liborlite-mirror-perl/current/lib/ORLite/Mirror.pm
branches/upstream/liborlite-mirror-perl/current/t/lib/Test.pm
Modified: branches/upstream/liborlite-mirror-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/Changes?rev=49930&op=diff
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/Changes (original)
+++ branches/upstream/liborlite-mirror-perl/current/Changes Sat Jan 2 16:59:01 2010
@@ -1,7 +1,13 @@
Changes for Perl extension ORLite-Mirror
+1.18 Sat 2 Jan 2010
+ - Upgrading ORLite dependency to 1.30 to get improved startup
+ error handling, and new DBD::SQLite 1.27
+ - Added user_version consistency checking on ->refresh
+ - Completing the first basic implementation of stub support
+
1.17 Fri 25 Sep 2009
- - Updating ORLite dep to 1.28 to get prune support.
+ - Updating ORLite dep to 1.28 to get prune support
- Integrated support for prune to ORLite::Mirror
- Switch all tests to use prune
Modified: branches/upstream/liborlite-mirror-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/MANIFEST?rev=49930&op=diff
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/MANIFEST (original)
+++ branches/upstream/liborlite-mirror-perl/current/MANIFEST Sat Jan 2 16:59:01 2010
@@ -21,11 +21,14 @@
t/01_compile.t
t/02_basics.sql
t/02_basics.t
-t/03_zipped.t
+t/03_gzip.t
t/04_bzip2.t
t/05_stub.t
t/06_stubgz.t
+t/07_badfile.t
t/97_meta.t
t/98_pod.t
t/99_pmv.t
+t/data/broken.db
+t/data/broken.db.gz
t/lib/Test.pm
Modified: branches/upstream/liborlite-mirror-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/META.yml?rev=49930&op=diff
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/META.yml (original)
+++ branches/upstream/liborlite-mirror-perl/current/META.yml Sat Jan 2 16:59:01 2010
@@ -34,11 +34,11 @@
IO::Uncompress::Gunzip: 2.008
LWP::Online: 1.07
LWP::UserAgent: 5.806
- ORLite: 1.28
+ ORLite: 1.30
Params::Util: 0.33
perl: 5.6.0
resources:
ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/ORLite-Mirror
license: http://dev.perl.org/licenses/
repository: http://svn.ali.as/cpan/trunk/ORLite-Mirror
-version: 1.17
+version: 1.18
Modified: branches/upstream/liborlite-mirror-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/README?rev=49930&op=diff
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/README (original)
+++ branches/upstream/liborlite-mirror-perl/current/README Sat Jan 2 16:59:01 2010
@@ -39,7 +39,7 @@
Adam Kennedy <adamk at cpan.org>
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: branches/upstream/liborlite-mirror-perl/current/lib/ORLite/Mirror.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/lib/ORLite/Mirror.pm?rev=49930&op=diff
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/lib/ORLite/Mirror.pm (original)
+++ branches/upstream/liborlite-mirror-perl/current/lib/ORLite/Mirror.pm Sat Jan 2 16:59:01 2010
@@ -14,11 +14,11 @@
use IO::Uncompress::Bunzip2 2.008 ();
use LWP::UserAgent 5.806 ();
use LWP::Online 1.07 ();
-use ORLite 1.28 ();
+use ORLite 1.30 ();
use vars qw{$VERSION @ISA};
BEGIN {
- $VERSION = '1.17';
+ $VERSION = '1.18';
@ISA = 'ORLite';
}
@@ -77,13 +77,13 @@
unless ( Params::Util::_NONNEGINT($maxage) ) {
Carp::croak("Invalid maxage param '$maxage'");
}
-
+
# Find the stub database
my $stub = delete $params{stub};
if ( $stub ) {
$stub = File::ShareDir::module_file(
$params{package} => 'stub.db'
- );
+ ) if $stub eq '1';
unless ( -f $stub ) {
Carp::croak("Stub database '$stub' does not exist");
}
@@ -92,7 +92,7 @@
# Check when we should update
my $update = delete $params{update};
unless ( defined $update ) {
- $update = 'compile';
+ $update = $stub ? 'connect' : 'compile';
}
unless ( $update =~ /^(?:compile|connect)$/ ) {
Carp::croak("Invalid update param '$update'");
@@ -189,7 +189,7 @@
# If we updated the file, add any extra indexes that we need
if ( $refreshed and $params{index} ) {
- my $dbh = DBI->connect("DBI:SQLite:$db", undef, undef, {
+ my $dbh = DBI->connect( "DBI:SQLite:$db", undef, undef, {
RaiseError => 1,
PrintError => 1,
} );
@@ -208,17 +208,6 @@
# If and only if they update at connect-time, replace the
# original dbh method with one that syncs the database.
if ( $update eq 'connect' ) {
- # Generate the user_version checking fragment
- my $check_version = '';
- if ( $params{user_version} ) {
- $check_version = <<"END_PERL";
- unless ( \$class->pragma('user_version') == $params{user_version} ) {
-
- }
-
-END_PERL
- }
-
# Generate the archive decompression fragment
my $decompress = '';
if ( $path =~ /\.gz$/ ) {
@@ -232,7 +221,7 @@
require IO::Uncompress::Gunzip;
IO::Uncompress::Gunzip::gunzip(
- \$PATH => \$sqlite,
+ \$PATH => \$sqlite,
BinModeOut => 1,
) or Carp::croak("Error: gunzip(\$PATH) failed");
}
@@ -249,7 +238,7 @@
require IO::Uncompress::Bunzip2;
IO::Uncompress::Bunzip2::bunzip2(
- \$PATH => \$sqlite,
+ \$PATH => \$sqlite,
BinModeOut => 1,
) or Carp::croak("Error: bunzip2(\$PATH) failed");
}
@@ -264,15 +253,16 @@
use vars qw{ \$REFRESHED };
BEGIN {
\$REFRESHED = 0;
- delete \$$params{package}::{DBH};
+ # delete \$$params{package}::{DBH};
}
my \$URL = '$url';
my \$PATH = '$path';
sub refresh {
- my \$class = shift;
- my \%param = \@_;
+ my \$class = shift;
+ my \%param = \@_;
+
require LWP::UserAgent;
my \$useragent = LWP::UserAgent->new(
agent => '$agent',
@@ -280,6 +270,13 @@
show_progress => !! \$param{show_progress},
);
+ # Set the refresh flag now, so the call to ->pragma won't
+ # head off into an infinite recursion.
+ \$REFRESHED = 1;
+
+ # Save the old schema version
+ my \$old_version = \$class->pragma('user_version');
+
# Flush the existing database
require File::Remove;
if ( -f \$PATH and not File::Remove::remove(\$PATH) ) {
@@ -293,9 +290,12 @@
}
$decompress
- \$REFRESHED = 1;
-
-$check_version
+ # The new schema version must match the previous or stub version
+ my \$version = \$class->pragma('user_version');
+ unless ( \$version == \$old_version ) {
+ Carp::croak("Schema user_version mismatch (got \$version, wanted \$old_version)");
+ }
+
return 1;
}
@@ -307,7 +307,10 @@
show_progress => $show_progress,
);
}
- DBI->connect(\$class->dsn);
+ DBI->connect( \$class->dsn, undef, undef, {
+ RaiseError => 1,
+ PrintError => 0,
+ } );
}
END_PERL
}
@@ -370,7 +373,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.
Added: branches/upstream/liborlite-mirror-perl/current/t/03_gzip.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/t/03_gzip.t?rev=49930&op=file
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/t/03_gzip.t (added)
+++ branches/upstream/liborlite-mirror-perl/current/t/03_gzip.t Sat Jan 2 16:59:01 2010
@@ -1,0 +1,93 @@
+#!/usr/bin/perl
+
+# Tests the basic functionality of SQLite.
+
+use strict;
+
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More tests => 26;
+use File::Spec::Functions ':ALL';
+use File::Remove 'clear';
+use IO::Compress::Gzip ();
+use URI::file ();
+use t::lib::Test;
+
+# Flush any existing mirror database file
+clear(mirror_db('ORLite::Mirror::Test'));
+
+# Set up the file
+my $file = test_db();
+my $dbh = create_ok(
+ catfile(qw{ t 02_basics.sql }),
+ "dbi:SQLite:$file",
+);
+my $zipped = $file . '.gz';
+clear($zipped);
+IO::Compress::Gzip::gzip( $file => $zipped )
+ or die 'Failed to compress test script';
+
+# Convert the file into a URI
+my $url = URI::file->new_abs($zipped)->as_string;
+
+# Create the test package
+eval <<"END_PERL"; die $@ if $@;
+package ORLite::Mirror::Test;
+
+use strict;
+use vars qw{\$VERSION};
+BEGIN {
+ \$VERSION = '1.00';
+}
+use ORLite::Mirror {
+ url => '$url',
+ maxage => 1,
+ index => [ 'table_one.col2' ],
+ prune => 1,
+};
+
+1;
+
+END_PERL
+
+ok( ORLite::Mirror::Test->can('dbh'), 'Created database methods' );
+ok( ! ORLite::Mirror::Test->can('begin'), 'Did not create transaction methods' );
+
+# Check the ->count method
+is( ORLite::Mirror::Test::TableOne->count, 3, 'Found 3 rows' );
+is( ORLite::Mirror::Test::TableOne->count('where col2 = ?', 'bar'), 2, 'Condition count works' );
+
+# Fetch the rows (list context)
+SCOPE: {
+ my @ones = ORLite::Mirror::Test::TableOne->select('order by col1');
+ is( scalar(@ones), 3, 'Got 3 objects' );
+ isa_ok( $ones[0], 'ORLite::Mirror::Test::TableOne' );
+ isa_ok( $ones[1], 'ORLite::Mirror::Test::TableOne' );
+ isa_ok( $ones[2], 'ORLite::Mirror::Test::TableOne' );
+ is( $ones[0]->col1, 1, '->col1 ok' );
+ is( $ones[1]->col1, 2, '->col1 ok' );
+ is( $ones[2]->col1, 3, '->col1 ok' );
+ is( $ones[0]->col2, 'foo', '->col2 ok' );
+ is( $ones[1]->col2, 'bar', '->col2 ok' );
+ is( $ones[2]->col2, 'bar', '->col2 ok' );
+}
+
+# Fetch the rows (scalar context)
+SCOPE: {
+ my $ones = ORLite::Mirror::Test::TableOne->select('order by col1');
+ is( scalar(@$ones), 3, 'Got 3 objects' );
+ isa_ok( $ones->[0], 'ORLite::Mirror::Test::TableOne' );
+ isa_ok( $ones->[1], 'ORLite::Mirror::Test::TableOne' );
+ isa_ok( $ones->[2], 'ORLite::Mirror::Test::TableOne' );
+ is( $ones->[0]->col1, 1, '->col1 ok' );
+ is( $ones->[1]->col1, 2, '->col1 ok' );
+ is( $ones->[2]->col1, 3, '->col1 ok' );
+ is( $ones->[0]->col2, 'foo', '->col2 ok' );
+ is( $ones->[1]->col2, 'bar', '->col2 ok' );
+ is( $ones->[2]->col2, 'bar', '->col2 ok' );
+
+ ok( ! ORLite::Mirror::Test::TableOne->can('delete'), 'Did not add data manipulation methods' );
+}
Added: branches/upstream/liborlite-mirror-perl/current/t/07_badfile.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/t/07_badfile.t?rev=49930&op=file
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/t/07_badfile.t (added)
+++ branches/upstream/liborlite-mirror-perl/current/t/07_badfile.t Sat Jan 2 16:59:01 2010
@@ -1,0 +1,132 @@
+#!/usr/bin/perl
+
+# Tests the basic functionality of SQLite.
+
+use strict;
+
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More tests => 9;
+use File::Spec::Functions ':ALL';
+use File::Remove 'clear';
+use IO::Compress::Gzip ();
+use URI::file ();
+use t::lib::Test;
+
+# Flush any existing mirror database file
+clear(mirror_db('ORLite::Mirror::Test'));
+
+# Locate the broken compressed database
+my $broken = catfile(qw{ t data broken.db });
+my $broken_gz = catfile(qw{ t data broken.db.gz });
+my $broken_url = URI::file->new_abs($broken_gz)->as_string;
+ok( -f $broken, 'Found test broken database' );
+
+# Locate the stub file
+my $stub = catfile(qw{ share stub.db });
+my $stub_url = URI::file->new_abs($stub)->as_string;
+ok( -f $stub, 'Found test stub database' );
+
+
+
+
+
+######################################################################
+# Compile-time mirror and loading failure
+
+SCOPE: {
+ # Create the test package
+ eval <<"END_PERL";
+ package ORLite::Mirror::Test1;
+
+ use strict;
+ use vars qw{\$VERSION};
+ BEGIN {
+ \$VERSION = '1.00';
+ }
+
+ use ORLite::Mirror {
+ url => '$broken_url',
+ prune => 1,
+ };
+
+ 1;
+END_PERL
+
+ # Did the class fail at compile time as expected
+ ok( $@, 'Loading broke as expected' );
+ like( $@, qr/not a database/, 'Error message matches expected' );
+}
+
+
+
+
+
+######################################################################
+# Compile-time stub failure
+
+SCOPE: {
+ # Create the test package
+ eval <<"END_PERL";
+ package ORLite::Mirror::Test1;
+
+ use strict;
+ use vars qw{\$VERSION};
+ BEGIN {
+ \$VERSION = '1.00';
+ }
+
+ use ORLite::Mirror {
+ url => '$stub_url',
+ stub => '$broken',
+ prune => 1,
+ };
+
+ 1;
+END_PERL
+
+ # Did the class fail at compile time as expected
+ ok( $@, 'Loading broke as expected' );
+ like( $@, qr/not a database/, 'Error message matches expected' );
+}
+
+
+
+
+
+######################################################################
+# Run-time mirror and loading failure
+
+SCOPE: {
+ # Create the test package
+ eval <<"END_PERL";
+ package ORLite::Mirror::Test2;
+
+ use strict;
+ use vars qw{\$VERSION};
+ BEGIN {
+ \$VERSION = '1.00';
+ }
+
+ use ORLite::Mirror {
+ url => '$broken_url',
+ stub => '$stub',
+ prune => 1,
+ };
+
+ 1;
+END_PERL
+
+ # Did the class fail at compile time as expected
+ is( $@, '', 'Compiling worked as expected' );
+
+ # It should now fail to connect-time
+ eval {
+ ORLite::Mirror::Test2->connect;
+ };
+ ok( $@, 'Loading broke as expected' );
+ like( $@, qr/not a database/, 'Error message matches expected' );
+}
Added: branches/upstream/liborlite-mirror-perl/current/t/data/broken.db
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/t/data/broken.db?rev=49930&op=file
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/t/data/broken.db (added)
+++ branches/upstream/liborlite-mirror-perl/current/t/data/broken.db Sat Jan 2 16:59:01 2010
@@ -1,0 +1,1 @@
+Corrupted
Added: branches/upstream/liborlite-mirror-perl/current/t/data/broken.db.gz
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/t/data/broken.db.gz?rev=49930&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/liborlite-mirror-perl/current/t/data/broken.db.gz
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Modified: branches/upstream/liborlite-mirror-perl/current/t/lib/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-mirror-perl/current/t/lib/Test.pm?rev=49930&op=diff
==============================================================================
--- branches/upstream/liborlite-mirror-perl/current/t/lib/Test.pm (original)
+++ branches/upstream/liborlite-mirror-perl/current/t/lib/Test.pm Sat Jan 2 16:59:01 2010
@@ -10,7 +10,7 @@
use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
- $VERSION = '1.17';
+ $VERSION = '1.18';
@ISA = 'Exporter';
@EXPORT = qw{ test_db mirror_db connect_ok create_ok };
}
More information about the Pkg-perl-cvs-commits
mailing list