r65418 - in /trunk/liborlite-perl: Changes MANIFEST META.yml README debian/changelog debian/control debian/copyright lib/ORLite.pm t/08_prune.pl t/17_cache.t t/18_update.sql t/18_update.t t/lib/Test.pm
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Tue Nov 30 17:17:07 UTC 2010
Author: angelabad-guest
Date: Tue Nov 30 17:16:50 2010
New Revision: 65418
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=65418
Log:
* New upstream release
* debian/control: Add libfile-path-perl to Build-Depends-Indep and
Depends
* debian/copyright: Update license information
Added:
trunk/liborlite-perl/t/18_update.sql
- copied unchanged from r65417, branches/upstream/liborlite-perl/current/t/18_update.sql
trunk/liborlite-perl/t/18_update.t
- copied unchanged from r65417, branches/upstream/liborlite-perl/current/t/18_update.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/control
trunk/liborlite-perl/debian/copyright
trunk/liborlite-perl/lib/ORLite.pm
trunk/liborlite-perl/t/08_prune.pl
trunk/liborlite-perl/t/17_cache.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=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/Changes (original)
+++ trunk/liborlite-perl/Changes Tue Nov 30 17:16:50 2010
@@ -1,4 +1,11 @@
Changes for Perl extension ORLite
+
+1.46 Tue 30 Nov 2010
+ - Bumped File::Path dependency to 2.08 to prevent test failures
+ from the one shipped with Perl 5.8.9 (AZAWAWI)
+ - Added experimental base class ->update support (ADAMK)
+ - Added the qname attributes to the generator structs to simplify
+ and improve readability of SQL fragment strings (ADAMK)
1.45 Sun 8 Aug 2010
- Adding initial support for cache => $directory (ADAMK)
Modified: trunk/liborlite-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/MANIFEST?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/MANIFEST (original)
+++ trunk/liborlite-perl/MANIFEST Tue Nov 30 17:16:50 2010
@@ -38,6 +38,8 @@
t/16_array_create.t
t/17_cache.sql
t/17_cache.t
+t/18_update.sql
+t/18_update.t
t/lib/Test.pm
xt/meta.t
xt/pmv.t
Modified: trunk/liborlite-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/META.yml?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/META.yml (original)
+++ trunk/liborlite-perl/META.yml Tue Nov 30 17:16:50 2010
@@ -25,7 +25,7 @@
DBD::SQLite: 1.27
DBI: 1.607
File::Basename: 0
- File::Path: 2.04
+ File::Path: 2.08
File::Remove: 1.40
File::Spec: 0.80
File::Temp: 0.20
@@ -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.45
+version: 1.46
Modified: trunk/liborlite-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/README?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/README (original)
+++ trunk/liborlite-perl/README Tue Nov 30 17:16:50 2010
@@ -32,7 +32,7 @@
tables => [ 'table1', 'table2' ],
cleanup => 'VACUUM',
prune => 1,
- );
+ };
DESCRIPTION
SQLite is a light single file SQL database that provides an excellent
Modified: trunk/liborlite-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/debian/changelog?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/debian/changelog (original)
+++ trunk/liborlite-perl/debian/changelog Tue Nov 30 17:16:50 2010
@@ -1,8 +1,15 @@
-liborlite-perl (1.45-3) UNRELEASED; urgency=low
-
+liborlite-perl (1.46-1) unstable; urgency=low
+
+ [ Ansgar Burchardt]
* Update my email address.
- -- Ansgar Burchardt <ansgar at debian.org> Mon, 01 Nov 2010 11:17:13 +0100
+ [ Angel Abad ]
+ * New upstream release
+ * debian/control: Add libfile-path-perl to Build-Depends-Indep and
+ Depends
+ * debian/copyright: Update license information
+
+ -- Angel Abad <angelabad at gmail.com> Tue, 30 Nov 2010 18:16:27 +0100
liborlite-perl (1.45-2) unstable; urgency=low
Modified: trunk/liborlite-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/debian/control?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/debian/control (original)
+++ trunk/liborlite-perl/debian/control Tue Nov 30 17:16:50 2010
@@ -2,9 +2,11 @@
Section: perl
Priority: optional
Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl, libdbd-sqlite3-perl (>= 1.27), libdbi-perl (>= 1.607),
- perl (>= 5.10.1) | libfile-temp-perl (>= 0.20), libparams-util-perl (>= 0.33),
- libfile-remove-perl, libtest-script-perl, libclass-xsaccessor-perl
+Build-Depends-Indep: libclass-xsaccessor-perl, libdbd-sqlite3-perl (>= 1.27),
+ libdbi-perl (>= 1.607), libfile-path-perl (>= 2.08),
+ libfile-remove-perl, libparams-util-perl (>= 0.33),
+ libtest-script-perl, perl,
+ perl (>= 5.10.1) | libfile-temp-perl (>= 0.20)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Damyan Ivanov <dmn at debian.org>, Gunnar Wolf <gwolf at debian.org>,
Brian Cassidy <brian.cassidy at gmail.com>, Rene Mayorga <rmayorga at debian.org>,
@@ -20,8 +22,8 @@
Package: liborlite-perl
Architecture: all
Depends: ${misc:Depends}, ${perl:Depends}, libdbd-sqlite3-perl (>= 1.27),
- libdbi-perl (>= 1.607), libfile-remove-perl,
- libparams-util-perl (>= 0.33),
+ libdbi-perl (>= 1.607), libfile-path-perl,
+ libfile-remove-perl, libparams-util-perl (>= 0.33),
perl (>= 5.10.1) | libfile-temp-perl (>= 0.20)
Suggests: libclass-xsaccessor-perl
Description: lightweight SQLite-specific ORM
Modified: trunk/liborlite-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/debian/copyright?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/debian/copyright (original)
+++ trunk/liborlite-perl/debian/copyright Tue Nov 30 17:16:50 2010
@@ -31,8 +31,8 @@
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License, which comes with Perl.
.
- On Debian GNU/Linux systems, the complete text of the Artistic License
- can be found in `/usr/share/common-licenses/Artistic'.
+ On Debian systems, the complete text of the Artistic License can be
+ found in `/usr/share/common-licenses/Artistic'.
License: GPL-1+
This program is free software; you can redistribute it and/or modify
@@ -40,5 +40,5 @@
the Free Software Foundation; either version 1, or (at your option)
any later version.
.
- On Debian GNU/Linux systems, the complete text of version 1 of the
- General Public License can be found in `/usr/share/common-licenses/GPL-1'.
+ On Debian systems, the complete text of version 1 of the General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.
Modified: trunk/liborlite-perl/lib/ORLite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/lib/ORLite.pm?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/lib/ORLite.pm (original)
+++ trunk/liborlite-perl/lib/ORLite.pm Tue Nov 30 17:16:50 2010
@@ -6,7 +6,7 @@
use strict;
use Carp ();
use File::Spec 0.80 ();
-use File::Path 2.04 ();
+use File::Path 2.08 ();
use File::Basename 0 ();
use Params::Util 0.33 ();
use DBI 1.607 ();
@@ -14,7 +14,7 @@
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.45';
+ $VERSION = '1.46';
}
# Support for the 'prune' option
@@ -81,6 +81,9 @@
}
unless ( defined $params{tables} ) {
$params{tables} = 1;
+ }
+ unless ( defined $params{x_update} ) {
+ $params{x_update} = 0;
}
unless ( defined $params{package} ) {
$params{package} = scalar caller;
@@ -301,6 +304,29 @@
END_PERL
+ # Experimental update support
+ if ( $params{x_update} ) {
+ $code .= <<"END_PERL";
+
+### EXPERIMENTAL
+sub update {
+ my \$class = shift;
+ my \$table = shift;
+ my \$set = shift;
+ my \@cols = sort keys %\$set;
+ my \$sql = 'update "' . \$table . '" set '
+ . join ', ', map { "\\"\$_\\" = ?" } \@cols;
+ \$sql .= ' ' . shift if \@_;
+ return $pkg->do(
+ \$sql, {},
+ ( map { \$set->{\$_} } \@cols ),
+ \@_,
+ );
+}
+
+END_PERL
+ }
+
# Cleanup and shutdown operations
if ( $cleanup ) {
$code .= <<"END_PERL";
@@ -336,6 +362,9 @@
# Capture the raw schema column information
foreach my $table ( @$tables ) {
+ # Convenience pre-quoted form of the table name
+ $table->{qname} = '"' . $table->{name} . '"';
+
# What will be the class for this table
$table->{class} = ucfirst lc $table->{name};
$table->{class} =~ s/_([a-z])/uc($1)/ge;
@@ -347,11 +376,14 @@
{ Slice => {} },
);
+ # Convenience escaping for the column names
+ $_->{qname} = "\"$_->{name}\"" foreach @$columns;
+
# Generate the object keys for the columns
if ( $array ) {
foreach my $i ( 0 .. $#$columns ) {
- $columns->[$i]->{xs} = $i;
- $columns->[$i]->{key} = "[$i]";
+ $columns->[$i]->{xs} = $i;
+ $columns->[$i]->{key} = "[$i]";
}
} else {
foreach my $c ( @$columns ) {
@@ -366,16 +398,16 @@
$table->{create} = !! ( $table->{pks} and ! $readonly );
# Generate the main SQL fragments
- $table->{sql_cols} = join ', ', map { '"' . $_->{name} . '"' } @$columns;
- $table->{sql_vals} = join ', ', ('?') x scalar @$columns;
- $table->{sql_select} = "select $table->{sql_cols} from \"$table->{name}\"";
- $table->{sql_count} = "select count(*) from \"$table->{name}\"";
+ $table->{sql_cols} = join ', ', map { $_->{qname} } @$columns;
+ $table->{sql_vals} = join ', ', ( '?' ) x scalar @$columns;
+ $table->{sql_select} = "select $table->{sql_cols} from $table->{qname}";
+ $table->{sql_count} = "select count(*) from $table->{qname}";
$table->{sql_insert} =
- "insert into \"$table->{name}\" " .
+ "insert into $table->{qname} " .
"( $table->{sql_cols} ) " .
"values ( $table->{sql_vals} )";
$table->{sql_where} = join ' and ',
- map { "\"$_->{name}\" = ?" } @{$table->{pk}};
+ map { "$_->{qname} = ?" } @{$table->{pk}};
# Generate the new Perl fragments
$table->{pl_new} = join "\n", map {
@@ -560,27 +592,28 @@
sub delete {
my \$self = shift;
return $pkg->do(
- 'delete from \"$table->{name}\" where $table->{sql_where}',
+ 'delete from $table->{qname} where $table->{sql_where}',
{},
$table->{pl_where}
) if ref \$self;
Carp::croak("Must use truncate to delete all rows") unless \@_;
return $pkg->do(
- 'delete from \"$table->{name}\" ' . shift,
+ 'delete from $table->{qname} ' . shift,
{}, \@_,
);
}
sub truncate {
- $pkg->do('delete from \"$table->{name}\"');
+ $pkg->do('delete from $table->{qname}');
}
END_PERL
-
- if ( $table->{create} and $array ) {
- # Add an additional set method to avoid having
- # the user have to enter manual positions.
- $code .= <<"END_PERL";
+ }
+
+ if ( $table->{create} and $array ) {
+ # Add an additional set method to avoid having
+ # the user have to enter manual positions.
+ $code .= <<"END_PERL";
sub set {
my \$self = shift;
my \$i = {
@@ -591,13 +624,12 @@
}
END_PERL
- }
}
- # Generate the boring accessors
- if ( $xsaccessor ) {
- my $type = $table->{create} ? 'accessors' : 'getters';
- $code .= <<"END_PERL";
+ # Generate the boring accessors
+ if ( $xsaccessor ) {
+ my $type = $table->{create} ? 'accessors' : 'getters';
+ $code .= <<"END_PERL";
use $xsclass 1.05 {
getters => {
$table->{pl_accessor}
@@ -605,20 +637,50 @@
};
END_PERL
- } else {
- $code .= join "\n\n", map { <<"END_PERL" } grep { ! $_->{fk} } @columns;
+ } else {
+ $code .= join "\n\n", map { <<"END_PERL" } grep { ! $_->{fk} } @columns;
sub $_->{name} {
\$_[0]->$_->{key};
}
END_PERL
- }
-
- # Generate the foreign key accessors
- $code .= join "\n\n", map { <<"END_PERL" } grep { $_->{fk} } @columns;
+ }
+
+ # Generate the foreign key accessors
+ $code .= join "\n\n", map { <<"END_PERL" } grep { $_->{fk} } @columns;
sub $_->{name} {
($_->{fk}->[1]->{class}\->select('where \"$_->{fk}->[1]->{pk}->[0]->{name}\" = ?', \$_[0]->$_->{key}))[0];
}
END_PERL
+
+ # Add the experimental update method
+ if ( $table->{create} and $params{x_update} ) {
+ my @pk = map { $_->{name} } @{$table->{pk}};
+ my $wsql = join ' and ', map { "\"$_\" = ?" } @pk;
+ my $wattr = join ', ', map { "\$self->$_" } @pk;
+ my $set = $array
+ ? '$self->set( $_ => $set{$_} ) foreach keys %set;'
+ : '$self->{$_} = $set{$_} foreach keys %set;';
+ $code .= <<"END_PERL";
+
+### EXPERIMENTAL
+sub update {
+ my \$self = shift;
+ my \%set = \@_;
+ my \$rows = $pkg->do(
+ 'update $table->{qname} set ' .
+ join( ', ', map { "\\"\$_\\" = ?" } keys \%set ) .
+ ' where $wsql',
+ {}, values \%set, $wattr,
+ );
+ unless ( \$rows == 1 ) {
+ die "Expected to update 1 row, actually updated \$rows";
+ }
+ $set
+ return 1;
+}
+END_PERL
+ }
+
}
}
$dbh->disconnect;
@@ -648,12 +710,12 @@
local $@;
if ( $^P and $^V >= 5.008009 ) {
local $^P = $^P | 0x800;
- eval $code;
+ eval($code);
die $@ if $@;
} elsif ( $DEBUG ) {
dval($code);
} else {
- eval $code;
+ eval($code);
die $@ if $@;
}
@@ -730,7 +792,7 @@
tables => [ 'table1', 'table2' ],
cleanup => 'VACUUM',
prune => 1,
- );
+ };
=head1 DESCRIPTION
Modified: trunk/liborlite-perl/t/08_prune.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/08_prune.pl?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/t/08_prune.pl (original)
+++ trunk/liborlite-perl/t/08_prune.pl Tue Nov 30 17:16:50 2010
@@ -4,7 +4,7 @@
use strict;
-our $VERSION = '1.45';
+our $VERSION = '1.46';
unless ( $ORLite::VERSION eq $VERSION ) {
die('Failed to load correct ORLite version');
Modified: trunk/liborlite-perl/t/17_cache.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/17_cache.t?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/t/17_cache.t (original)
+++ trunk/liborlite-perl/t/17_cache.t Tue Nov 30 17:16:50 2010
@@ -14,7 +14,7 @@
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 } );
+my $cached = catfile( qw{ t Foo-Bar-1-23-ORLite-1-46-user_version-2.pm } );
clear($cached);
ok( ! -e $cached, 'Cache file does not initially exist' );
Modified: trunk/liborlite-perl/t/lib/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/lib/Test.pm?rev=65418&op=diff
==============================================================================
--- trunk/liborlite-perl/t/lib/Test.pm (original)
+++ trunk/liborlite-perl/t/lib/Test.pm Tue Nov 30 17:16:50 2010
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
- $VERSION = '1.45';
+ $VERSION = '1.46';
@ISA = 'Exporter';
@EXPORT = qw{ test_db connect_ok create_ok };
}
More information about the Pkg-perl-cvs-commits
mailing list