r25399 - in /trunk/liborlite-perl: Changes MANIFEST META.yml debian/changelog lib/ORLite.pm t/01_compile.t t/04_readonly.t t/05_notables.t t/lib/Test.pm
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Fri Sep 19 20:18:36 UTC 2008
Author: dmn
Date: Fri Sep 19 20:18:32 2008
New Revision: 25399
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25399
Log:
New upstream release
Added:
trunk/liborlite-perl/t/05_notables.t
- copied unchanged from r25398, branches/upstream/liborlite-perl/current/t/05_notables.t
Modified:
trunk/liborlite-perl/Changes
trunk/liborlite-perl/MANIFEST
trunk/liborlite-perl/META.yml
trunk/liborlite-perl/debian/changelog
trunk/liborlite-perl/lib/ORLite.pm
trunk/liborlite-perl/t/01_compile.t
trunk/liborlite-perl/t/04_readonly.t
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=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/Changes (original)
+++ trunk/liborlite-perl/Changes Fri Sep 19 20:18:32 2008
@@ -1,4 +1,15 @@
Changes for Perl extension ORLite
+
+0.13 Fri 19 Sep 2008
+ - Fixed critical bug introduced in 0.10 or somewhere around there,
+ where column accessors were not defined for readonly classes.
+ (This fatally killed ORLite::Mirror)
+
+0.12 Mon 15 Sep 2008
+ - Don't store the database values in a shared hash any more
+ (Makes the classes self-contained and able to run without ORLite)
+ - Add a tables param to the import, to allow the base database
+ connectivity class to be created without the table classes.
0.11 Tue 9 Sep 2008
- If we aren't debugging we don't need to write the temp file
Modified: trunk/liborlite-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/MANIFEST?rev=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/MANIFEST (original)
+++ trunk/liborlite-perl/MANIFEST Fri Sep 19 20:18:32 2008
@@ -20,6 +20,7 @@
t/03_fk.sql
t/03_fk.t
t/04_readonly.t
+t/05_notables.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=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/META.yml (original)
+++ trunk/liborlite-perl/META.yml Fri Sep 19 20:18:32 2008
@@ -25,4 +25,4 @@
perl: 5.6.0
resources:
license: http://dev.perl.org/licenses/
-version: 0.11
+version: 0.13
Modified: trunk/liborlite-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/debian/changelog?rev=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/debian/changelog (original)
+++ trunk/liborlite-perl/debian/changelog Fri Sep 19 20:18:32 2008
@@ -1,3 +1,9 @@
+liborlite-perl (0.13-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Damyan Ivanov <dmn at debian.org> Fri, 19 Sep 2008 23:16:41 +0300
+
liborlite-perl (0.11-1) unstable; urgency=low
* Initial Release. Closes: #498921 -- ITP
Modified: trunk/liborlite-perl/lib/ORLite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/lib/ORLite.pm?rev=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/lib/ORLite.pm (original)
+++ trunk/liborlite-perl/lib/ORLite.pm Fri Sep 19 20:18:32 2008
@@ -20,7 +20,7 @@
use vars qw{$VERSION %DSN %DBH};
BEGIN {
- $VERSION = '0.11';
+ $VERSION = '0.13';
%DSN = ();
%DBH = ();
}
@@ -50,6 +50,7 @@
file => $_[1],
readonly => undef, # Automatic
package => undef, # Automatic
+ tables => 1,
);
} elsif ( _HASH($_[1]) ) {
%params = %{ $_[1] };
@@ -61,6 +62,9 @@
}
unless ( defined $params{readonly} ) {
$params{readonly} = ! -w $params{file};
+ }
+ unless ( defined $params{tables} ) {
+ $params{tables} = 1;
}
unless ( defined $params{package} ) {
$params{package} = scalar caller;
@@ -83,80 +87,27 @@
die "Schema user_version mismatch (got $version, wanted $params{user_version})";
}
- # Capture the raw schema information
- my $tables = $dbh->selectall_arrayref(
- 'select * from sqlite_master where type = ?',
- { Slice => {} }, 'table',
- );
- foreach my $table ( @$tables ) {
- $table->{columns} = $dbh->selectall_arrayref(
- "pragma table_info('$table->{name}')",
- { Slice => {} },
- );
- }
- $dbh->disconnect;
-
-
- # Generate the main additional table level metadata
- my %tindex = map { $_->{name} => $_ } @$tables;
- foreach my $table ( @$tables ) {
- my @columns = @{ $table->{columns} };
- my @names = map { $_->{name} } @columns;
- $table->{cindex} = map { $_->{name} => $_ } @columns;
-
- # Discover the primary key
- $table->{pk} = List::Util::first { $_->{pk} } @columns;
- $table->{pk} = $table->{pk}->{name} if $table->{pk};
-
- # What will be the class for this table
- $table->{class} = ucfirst lc $table->{name};
- $table->{class} =~ s/_([a-z])/uc($1)/ge;
- $table->{class} = "${pkg}::$table->{class}";
-
- # Generate various SQL fragments
- my $sql = $table->{sql} = { create => $table->{sql} };
- $sql->{cols} = join ', ', map { '"' . $_ . '"' } @names;
- $sql->{vals} = join ', ', ('?') x scalar @columns;
- $sql->{select} = "select $table->{sql}->{cols} from $table->{name}";
- $sql->{count} = "select count(*) from $table->{name}";
- $sql->{insert} = join ' ',
- "insert into $table->{name}" .
- "( $table->{sql}->{cols} )" .
- " values ( $table->{sql}->{vals} )";
- }
-
- # Generate the foreign key metadata
- foreach my $table ( @$tables ) {
- # Locate the foreign keys
- my %fk = ();
- my @fk_sql = $table->{sql}->{create} =~ /[(,]\s*(.+?REFERENCES.+?)\s*[,)]/g;
-
- # Extract the details
- foreach ( @fk_sql ) {
- unless ( /^(\w+).+?REFERENCES\s+(\w+)\s*\(\s*(\w+)/ ) {
- die "Invalid foreign key $_";
- }
- $fk{"$1"} = [ "$2", $tindex{"$2"}, "$3" ];
- }
- foreach ( @{ $table->{columns} } ) {
- $_->{fk} = $fk{$_->{name}};
- }
- }
-
# Generate the support package code
my $code = <<"END_PERL";
package $pkg;
use strict;
+my \$DSN = 'dbi:SQLite:$file';
+my \$DBH = undef;
+
sub dsn {
- \$ORLite::DSN{'$pkg'};
+ \$DSN;
}
sub dbh {
- \$ORLite::DBH{'$pkg'} or
- DBI->connect(\$ORLite::DSN{'$pkg'}) or
+ \$DBH or
+ \$_[0]->connect or
Carp::croak("connect: \$DBI::errstr");
+}
+
+sub connect {
+ DBI->connect(\$_[0]->dsn);
}
sub do {
@@ -200,39 +151,99 @@
# Add transaction support if not readonly
$code .= <<"END_PERL" unless $readonly;
sub begin {
- \$ORLite::DBH{'$pkg'} or
- \$ORLite::DBH{'$pkg'} = DBI->connect(\$ORLite::DSN{'$pkg'}) or
+ \$DBH or
+ \$DBH = \$_[0]->connect or
Carp::croak("connect: \$DBI::errstr");
- \$ORLite::DBH{'$pkg'}->begin_work;
+ \$DBH->begin_work;
}
sub commit {
- \$ORLite::DBH{'$pkg'} or return 1;
- \$ORLite::DBH{'$pkg'}->commit;
- \$ORLite::DBH{'$pkg'}->disconnect;
- delete \$ORLite::DBH{'$pkg'};
+ \$DBH or return 1;
+ \$DBH->commit;
+ \$DBH->disconnect;
+ undef \$DBH;
return 1;
}
sub rollback {
- \$ORLite::DBH{'$pkg'} or return 1;
- \$ORLite::DBH{'$pkg'}->rollback;
- \$ORLite::DBH{'$pkg'}->disconnect;
- delete \$ORLite::DBH{'$pkg'};
+ \$DBH or return 1;
+ \$DBH->rollback;
+ \$DBH->disconnect;
+ undef \$DBH;
return 1;
}
END_PERL
- # Generate the per-table code
- foreach my $table ( @$tables ) {
- # Generate the accessors
- my $sql = $table->{sql};
- my @columns = @{ $table->{columns} };
- my @names = map { $_->{name} } @columns;
-
- # Generate the elements in all packages
- $code .= <<"END_PERL";
+ # Optionally generate the table classes
+ if ( $params{tables} ) {
+ # Capture the raw schema information
+ my $tables = $dbh->selectall_arrayref(
+ 'select * from sqlite_master where type = ?',
+ { Slice => {} }, 'table',
+ );
+ foreach my $table ( @$tables ) {
+ $table->{columns} = $dbh->selectall_arrayref(
+ "pragma table_info('$table->{name}')",
+ { Slice => {} },
+ );
+ }
+
+ # Generate the main additional table level metadata
+ my %tindex = map { $_->{name} => $_ } @$tables;
+ foreach my $table ( @$tables ) {
+ my @columns = @{ $table->{columns} };
+ my @names = map { $_->{name} } @columns;
+ $table->{cindex} = map { $_->{name} => $_ } @columns;
+
+ # Discover the primary key
+ $table->{pk} = List::Util::first { $_->{pk} } @columns;
+ $table->{pk} = $table->{pk}->{name} if $table->{pk};
+
+ # What will be the class for this table
+ $table->{class} = ucfirst lc $table->{name};
+ $table->{class} =~ s/_([a-z])/uc($1)/ge;
+ $table->{class} = "${pkg}::$table->{class}";
+
+ # Generate various SQL fragments
+ my $sql = $table->{sql} = { create => $table->{sql} };
+ $sql->{cols} = join ', ', map { '"' . $_ . '"' } @names;
+ $sql->{vals} = join ', ', ('?') x scalar @columns;
+ $sql->{select} = "select $table->{sql}->{cols} from $table->{name}";
+ $sql->{count} = "select count(*) from $table->{name}";
+ $sql->{insert} = join ' ',
+ "insert into $table->{name}" .
+ "( $table->{sql}->{cols} )" .
+ " values ( $table->{sql}->{vals} )";
+ }
+
+ # Generate the foreign key metadata
+ foreach my $table ( @$tables ) {
+ # Locate the foreign keys
+ my %fk = ();
+ my @fk_sql = $table->{sql}->{create} =~ /[(,]\s*(.+?REFERENCES.+?)\s*[,)]/g;
+
+ # Extract the details
+ foreach ( @fk_sql ) {
+ unless ( /^(\w+).+?REFERENCES\s+(\w+)\s*\(\s*(\w+)/ ) {
+ die "Invalid foreign key $_";
+ }
+ $fk{"$1"} = [ "$2", $tindex{"$2"}, "$3" ];
+ }
+ foreach ( @{ $table->{columns} } ) {
+ $_->{fk} = $fk{$_->{name}};
+ }
+ }
+
+ # Generate the per-table code
+ foreach my $table ( @$tables ) {
+ # Generate the accessors
+ my $sql = $table->{sql};
+ my @columns = @{ $table->{columns} };
+ my @names = map { $_->{name} } @columns;
+
+ # Generate the elements in all packages
+ $code .= <<"END_PERL";
package $table->{class};
sub select {
@@ -253,11 +264,11 @@
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;
- $code .= <<"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;
+ $code .= <<"END_PERL";
sub new {
my \$class = shift;
@@ -296,6 +307,8 @@
END_PERL
+ }
+
# Generate the accessors
$code .= join "\n\n", map { $_->{fk} ? <<"END_DIRECT" : <<"END_ACCESSOR" } @columns;
sub $_->{name} {
@@ -309,6 +322,7 @@
}
}
+ $dbh->disconnect;
# Load the code
if ( $DEBUG ) {
Modified: trunk/liborlite-perl/t/01_compile.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/01_compile.t?rev=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/t/01_compile.t (original)
+++ trunk/liborlite-perl/t/01_compile.t Fri Sep 19 20:18:32 2008
@@ -5,9 +5,10 @@
$^W = 1;
}
-use Test::More tests => 3;
+use Test::More tests => 4;
ok( $] >= 5.006, 'Perl version is new enough' );
require_ok( 'ORLite' );
require_ok( 't::lib::Test' );
+is( $ORLite::VERSION, $t::lib::Test::VERSION, '$VERSION match' );
Modified: trunk/liborlite-perl/t/04_readonly.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/04_readonly.t?rev=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/t/04_readonly.t (original)
+++ trunk/liborlite-perl/t/04_readonly.t Fri Sep 19 20:18:32 2008
@@ -9,7 +9,7 @@
$^W = 1;
}
-use Test::More tests => 7;
+use Test::More tests => 8;
use File::Spec::Functions ':ALL';
use t::lib::Test;
@@ -52,6 +52,9 @@
# Check the ->count method
is( Foo::Bar::TableOne->count, 0, 'Found 0 rows' );
+# Make sure we still have the columns defined
+ok( Foo::Bar::TableOne->can('col1'), 'Columns defined' );
+
# There's some things we shouldn't be able to do
ok( ! Foo::Bar->can('commit'), 'No transaction support' );
ok( ! Foo::Bar::TableOne->can('create'), 'Cant create object' );
Modified: trunk/liborlite-perl/t/lib/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/lib/Test.pm?rev=25399&op=diff
==============================================================================
--- trunk/liborlite-perl/t/lib/Test.pm (original)
+++ trunk/liborlite-perl/t/lib/Test.pm Fri Sep 19 20:18:32 2008
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
- $VERSION = '0.10';
+ $VERSION = '0.13';
@ISA = qw{ Exporter };
@EXPORT = qw{ test_db connect_ok create_ok };
}
More information about the Pkg-perl-cvs-commits
mailing list