r61527 - in /branches/upstream/liborlite-perl/current: Changes MANIFEST META.yml README lib/ORLite.pm t/08_prune.pl t/17_cache.sql t/17_cache.t t/lib/Test.pm
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Thu Aug 12 13:28:21 UTC 2010
Author: angelabad-guest
Date: Thu Aug 12 13:27:36 2010
New Revision: 61527
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=61527
Log:
[svn-upgrade] new version liborlite-perl (1.45)
Added:
branches/upstream/liborlite-perl/current/t/17_cache.sql
branches/upstream/liborlite-perl/current/t/17_cache.t
Modified:
branches/upstream/liborlite-perl/current/Changes
branches/upstream/liborlite-perl/current/MANIFEST
branches/upstream/liborlite-perl/current/META.yml
branches/upstream/liborlite-perl/current/README
branches/upstream/liborlite-perl/current/lib/ORLite.pm
branches/upstream/liborlite-perl/current/t/08_prune.pl
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=61527&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/Changes (original)
+++ branches/upstream/liborlite-perl/current/Changes Thu Aug 12 13:27:36 2010
@@ -1,4 +1,7 @@
Changes for Perl extension ORLite
+
+1.45 Sun 8 Aug 2010
+ - Adding initial support for cache => $directory (ADAMK)
1.44 Fri 23 Jul 2010
- Upgrading to Module::Install::DSL 1.00 (ADAMK)
Modified: branches/upstream/liborlite-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/MANIFEST?rev=61527&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/MANIFEST (original)
+++ branches/upstream/liborlite-perl/current/MANIFEST Thu Aug 12 13:27:36 2010
@@ -36,6 +36,8 @@
t/14_array_fk.t
t/15_array_xs.t
t/16_array_create.t
+t/17_cache.sql
+t/17_cache.t
t/lib/Test.pm
xt/meta.t
xt/pmv.t
Modified: branches/upstream/liborlite-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/META.yml?rev=61527&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/META.yml (original)
+++ branches/upstream/liborlite-perl/current/META.yml Thu Aug 12 13:27:36 2010
@@ -35,4 +35,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.44
+version: 1.45
Modified: branches/upstream/liborlite-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/README?rev=61527&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/README (original)
+++ branches/upstream/liborlite-perl/current/README Thu Aug 12 13:27:36 2010
@@ -222,6 +222,18 @@
class for every table in the main schema that is not prefixed with with
"sqlite_".
+ cache
+ use ORLite {
+ file => 'dbi:SQLite:sqlite.db',
+ user_version => 2,
+ cache => 'cache/directory',
+ };
+
+ The "cache" option is used to reduce the time needed to scan the SQLite
+ database table structures and generate the code for them, by saving the
+ generated code to a cache directory and loading from that file instead
+ of generating it each time from scratch.
+
cleanup
When working with embedded SQLite database containing rapidly changing
state data, it is important for database performance and general health
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=61527&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/lib/ORLite.pm (original)
+++ branches/upstream/liborlite-perl/current/lib/ORLite.pm Thu Aug 12 13:27:36 2010
@@ -14,7 +14,7 @@
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.44';
+ $VERSION = '1.45';
}
# Support for the 'prune' option
@@ -45,7 +45,7 @@
}
# Check params and apply defaults
- my %params;
+ my %params = ();
if ( defined Params::Util::_STRING($_[1]) ) {
# Support the short form "use ORLite 'db.sqlite'"
%params = ( file => $_[1] );
@@ -89,11 +89,44 @@
Carp::croak("Missing or invalid package class");
}
- # Connect to the database
+ # Check caching params
+ my $cached = undef;
+ my $pkg = $params{package};
+ if ( defined $params{cache} ) {
+ # Caching is illogical or invalid in some situations
+ if ( $params{prune} ) {
+ Carp::croak("Cannot set a 'cache' directory while 'prune' enabled");
+ }
+ unless ( $params{user_version} ) {
+ Carp::croak("Cannot set a 'cache' directory without 'user_version'");
+ }
+
+ # To make the caching work, the version be defined before ORLite is called.
+ no strict 'refs';
+ unless ( ${"$pkg\::VERSION"} ) {
+ Carp::croak("Cannot set a 'cache' directory without a package \$VERSION");
+ }
+
+ # Build the cache file from the super path using an inlined Class::ISA
+ my @queue = ( $class );
+ my %seen = ( $pkg => 1 );
+ my @parts = ( $pkg => ${"$pkg\::VERSION"} );
+ while ( @queue ) {
+ my $c = Params::Util::_STRING(shift @queue) or next;
+ push @parts, $c => ${"$c\::VERSION"};
+ unshift @queue, grep { not $seen{$c}++ } @{"$c\::ISA"};
+ }
+ $cached = join '-', @parts, user_version => $params{user_version};
+ $cached =~ s/[:.-]+/-/g;
+ $cached = File::Spec->rel2abs(
+ File::Spec->catfile( $params{cache}, "$cached.pm" )
+ );
+ }
+
+ # Create the parent directory if needed
my $file = File::Spec->rel2abs($params{file});
my $created = ! -f $params{file};
if ( $created ) {
- # Create the parent directory
my $dir = File::Basename::dirname($file);
unless ( -d $dir ) {
my @dirs = File::Path::mkpath( $dir, { verbose => 0 } );
@@ -101,7 +134,34 @@
}
$class->prune($file) if $params{prune};
}
- my $pkg = $params{package};
+
+ # Connect to the database
+ my $dsn = "dbi:SQLite:$file";
+ my $dbh = DBI->connect( $dsn, undef, undef, {
+ PrintError => 0,
+ RaiseError => 1,
+ } );
+
+ # Schema custom creation support
+ if ( $created and Params::Util::_CODELIKE($params{create}) ) {
+ $params{create}->( $dbh );
+ }
+
+ # Check the schema version before generating
+ my $user_version = $dbh->selectrow_arrayref('pragma user_version')->[0];
+ if ( exists $params{user_version} and $user_version != $params{user_version} ) {
+ Carp::croak("Schema user_version mismatch (got $user_version, wanted $params{user_version})");
+ }
+
+ # If caching and the cached version exists, load and shortcut.
+ # Don't try to catch exceptions, just let them blow up.
+ if ( $cached and -f $cached ) {
+ $dbh->disconnect;
+ require $cached;
+ return 1;
+ }
+
+ # Prepare to generate code
my $readonly = $params{readonly};
my $cleanup = $params{cleanup};
my $xsaccessor = $params{xsaccessor};
@@ -111,22 +171,6 @@
my $r = $array ? ']' : '}';
my $slice = $array ? '{}' : '{ Slice => {} }';
my $rowref = $array ? 'arrayref' : 'hashref';
- my $dsn = "dbi:SQLite:$file";
- my $dbh = DBI->connect( $dsn, undef, undef, {
- PrintError => 0,
- RaiseError => 1,
- } );
-
- # Schema creation support
- if ( $created and Params::Util::_CODELIKE($params{create}) ) {
- $params{create}->( $dbh );
- }
-
- # Check the schema version before generating
- my $user_version = $dbh->selectrow_arrayref('pragma user_version')->[0];
- if ( exists $params{user_version} and $user_version != $params{user_version} ) {
- Carp::croak("Schema user_version mismatch (got $user_version, wanted $params{user_version})");
- }
# Generate the support package code
my $code = <<"END_PERL";
@@ -586,6 +630,20 @@
}
$code .= "\n\n1;\n";
+ # Save to the cache location if caching is enabled
+ if ( $cached ) {
+ my $dir = File::Basename::dirname($cached);
+ unless ( -d $dir ) {
+ File::Path::mkpath( $dir, { verbose => 0 } );
+ }
+
+ # Save a copy of the code to the file
+ local *FILE;
+ open( FILE, ">$cached" ) or Carp::croak("open($cached): $!");
+ print FILE $code;
+ close FILE;
+ }
+
# Compile the code
local $@;
if ( $^P and $^V >= 5.008009 ) {
@@ -612,14 +670,14 @@
unlink $filename;
# Print the debugging output
- my @trace = map {
- s/\s*[{;]$//;
- s/^s/ s/;
- s/^p/\np/;
- "$_\n"
- } grep {
- /^(?:package|sub)\b/
- } split /\n/, $_[0];
+ # my @trace = map {
+ # s/\s*[{;]$//;
+ # s/^s/ s/;
+ # s/^p/\np/;
+ # "$_\n"
+ # } grep {
+ # /^(?:package|sub)\b/
+ # } split /\n/, $_[0];
# print STDERR @trace, "\nCode saved as $filename\n\n";
return 1;
@@ -865,6 +923,19 @@
a class for every table in the main schema that is not prefixed with
with C<sqlite_>.
+=head2 cache
+
+ use ORLite {
+ file => 'dbi:SQLite:sqlite.db',
+ user_version => 2,
+ cache => 'cache/directory',
+ };
+
+The C<cache> option is used to reduce the time needed to scan the SQLite
+database table structures and generate the code for them, by saving the
+generated code to a cache directory and loading from that file instead
+of generating it each time from scratch.
+
=head2 cleanup
When working with embedded SQLite database containing rapidly changing
Modified: branches/upstream/liborlite-perl/current/t/08_prune.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/t/08_prune.pl?rev=61527&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/t/08_prune.pl (original)
+++ branches/upstream/liborlite-perl/current/t/08_prune.pl Thu Aug 12 13:27:36 2010
@@ -4,7 +4,7 @@
use strict;
-our $VERSION = '1.44';
+our $VERSION = '1.45';
unless ( $ORLite::VERSION eq $VERSION ) {
die('Failed to load correct ORLite version');
Added: branches/upstream/liborlite-perl/current/t/17_cache.sql
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/t/17_cache.sql?rev=61527&op=file
==============================================================================
--- branches/upstream/liborlite-perl/current/t/17_cache.sql (added)
+++ branches/upstream/liborlite-perl/current/t/17_cache.sql Thu Aug 12 13:27:36 2010
@@ -1,0 +1,6 @@
+pragma user_version = 2;
+
+create table table_one (
+ col1 integer not null primary key,
+ col2 string
+)
Added: branches/upstream/liborlite-perl/current/t/17_cache.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liborlite-perl/current/t/17_cache.t?rev=61527&op=file
==============================================================================
--- branches/upstream/liborlite-perl/current/t/17_cache.t (added)
+++ branches/upstream/liborlite-perl/current/t/17_cache.t Thu Aug 12 13:27:36 2010
@@ -1,0 +1,93 @@
+#!/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 t::lib::Test;
+
+# Where will the cache file be written to
+my $cached = catfile( qw{ t Foo-Bar-1-23-ORLite-1-45-user_version-2.pm } );
+clear($cached);
+ok( ! -e $cached, 'Cache file does not initially exist' );
+
+# Set up the database
+my $file = test_db();
+my $dbh = create_ok(
+ file => catfile(qw{ t 17_cache.sql }),
+ connect => [ "dbi:SQLite:$file" ],
+);
+
+# Create the test package
+eval <<"END_PERL"; die $@ if $@;
+package Foo::Bar;
+
+use strict;
+use vars qw{\$VERSION};
+BEGIN {
+ \$VERSION = '1.23';
+}
+
+use ORLite {
+ file => '$file',
+ cache => 't',
+ user_version => 2,
+};
+
+1;
+END_PERL
+
+# Check some basics
+$file = rel2abs($file);
+is( Foo::Bar->sqlite, $file, '->sqlite ok' );
+is( Foo::Bar->dsn, "dbi:SQLite:$file", '->dsn ok' );
+
+# Did the cache file get created?
+ok( -f $cached, "Cache file $cached created" );
+my $inc1 = scalar keys %INC;
+
+# Delete the generated class (using hacky inlined Class::Unload)
+SCOPE: {
+ no strict 'refs';
+
+ ok( Foo::Bar->VERSION, 'Foo::Bar exists' );
+ my $symtab = "Foo::Bar::";
+ @Foo::Bar::ISA = ();
+ for my $symbol ( keys %$symtab ) {
+ delete $symtab->{$symbol};
+ }
+}
+
+# Load the class again
+eval <<"END_PERL"; die $@ if $@;
+package Foo::Bar;
+
+use strict;
+use vars qw{\$VERSION};
+BEGIN {
+ \$VERSION = '1.23';
+}
+
+use ORLite {
+ file => '$file',
+ cache => 't',
+ user_version => 2,
+};
+
+1;
+END_PERL
+
+# Did it load the second time?
+is( Foo::Bar->sqlite, $file, '->sqlite ok' );
+is( Foo::Bar->dsn, "dbi:SQLite:$file", '->dsn ok' );
+
+# There should be one extra entry now
+my $inc2 = scalar keys %INC;
+is( $inc2, $inc1 + 1, '%INC is larger by one from cache' );
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=61527&op=diff
==============================================================================
--- branches/upstream/liborlite-perl/current/t/lib/Test.pm (original)
+++ branches/upstream/liborlite-perl/current/t/lib/Test.pm Thu Aug 12 13:27:36 2010
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
- $VERSION = '1.44';
+ $VERSION = '1.45';
@ISA = 'Exporter';
@EXPORT = qw{ test_db connect_ok create_ok };
}
More information about the Pkg-perl-cvs-commits
mailing list