r65729 - in /trunk/liborlite-perl: Changes MANIFEST META.yml debian/changelog lib/ORLite.pm t/08_prune.pl t/17_cache.t t/19_view.sql t/19_view.t t/lib/Test.pm

angelabad-guest at users.alioth.debian.org angelabad-guest at users.alioth.debian.org
Sat Dec 11 12:17:05 UTC 2010


Author: angelabad-guest
Date: Sat Dec 11 12:16:49 2010
New Revision: 65729

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=65729
Log:
New upstream release

Added:
    trunk/liborlite-perl/t/19_view.sql
      - copied unchanged from r65728, branches/upstream/liborlite-perl/current/t/19_view.sql
    trunk/liborlite-perl/t/19_view.t
      - copied unchanged from r65728, branches/upstream/liborlite-perl/current/t/19_view.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/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=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/Changes (original)
+++ trunk/liborlite-perl/Changes Sat Dec 11 12:16:49 2010
@@ -1,4 +1,7 @@
 Changes for Perl extension ORLite
+
+1.47 Wed 8 Dec 2010
+	- Adding readonly support for views (ADAMK)
 
 1.46 Tue 30 Nov 2010
 	- Bumped File::Path dependency to 2.08 to prevent test failures

Modified: trunk/liborlite-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/MANIFEST?rev=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/MANIFEST (original)
+++ trunk/liborlite-perl/MANIFEST Sat Dec 11 12:16:49 2010
@@ -40,6 +40,8 @@
 t/17_cache.t
 t/18_update.sql
 t/18_update.t
+t/19_view.sql
+t/19_view.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=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/META.yml (original)
+++ trunk/liborlite-perl/META.yml Sat Dec 11 12:16:49 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.46
+version: 1.47

Modified: trunk/liborlite-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/debian/changelog?rev=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/debian/changelog (original)
+++ trunk/liborlite-perl/debian/changelog Sat Dec 11 12:16:49 2010
@@ -1,3 +1,9 @@
+liborlite-perl (1.47-1) unstable; urgency=low
+
+  * New upstream release
+
+ -- Angel Abad <angelabad at gmail.com>  Sat, 11 Dec 2010 13:16:34 +0100
+
 liborlite-perl (1.46-1) unstable; urgency=low
 
   [ Ansgar Burchardt]

Modified: trunk/liborlite-perl/lib/ORLite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/lib/ORLite.pm?rev=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/lib/ORLite.pm (original)
+++ trunk/liborlite-perl/lib/ORLite.pm Sat Dec 11 12:16:49 2010
@@ -14,7 +14,7 @@
 
 use vars qw{$VERSION};
 BEGIN {
-	$VERSION = '1.46';
+	$VERSION = '1.47';
 }
 
 # Support for the 'prune' option
@@ -81,6 +81,9 @@
 	}
 	unless ( defined $params{tables} ) {
 		$params{tables} = 1;
+	}
+	unless ( defined $params{views} ) {
+		$params{views} = 0;
 	}
 	unless ( defined $params{x_update} ) {
 		$params{x_update} = 0;
@@ -169,11 +172,6 @@
 	my $cleanup    = $params{cleanup};
 	my $xsaccessor = $params{xsaccessor};
 	my $array      = $params{array};
-	my $xsclass    = $array ? 'Class::XSAccessor::Array' : 'Class::XSAccessor';
-	my $l          = $array ? '['  : '{';
-	my $r          = $array ? ']'  : '}';
-	my $slice      = $array ? '{}' : '{ Slice => {} }';
-	my $rowref     = $array ? 'arrayref' : 'hashref';
 
 	# Generate the support package code
 	my $code = <<"END_PERL";
@@ -355,8 +353,8 @@
 	if ( $params{tables} ) {
 		# Capture the raw schema table information
 		my $tables = $dbh->selectall_arrayref(
-			'select * from sqlite_master where name not like ? and type = ?',
-			{ Slice => {} }, 'sqlite_%', 'table',
+			'select * from sqlite_master where name not like ? and type in ( ?, ? )',
+			{ Slice => {} }, 'sqlite_%', 'table', 'view',
 		);
 		my %tindex = map { $_->{name} => $_ } @$tables;
 
@@ -379,8 +377,17 @@
 			# Convenience escaping for the column names
 			$_->{qname} = "\"$_->{name}\"" foreach @$columns;
 
+			# Track array vs hash implementation on a per-table
+			# basis so that we can force views to always be done
+			# array-wise (to compensate for some weird SQLite
+			# column quoting differences between tables and views
+			$table->{array} = $array;
+			if ( $table->{type} eq 'view' ) {
+				$table->{array} = 1;
+			}
+
 			# Generate the object keys for the columns
-			if ( $array ) {
+			if ( $table->{array} ) {
 				foreach my $i ( 0 .. $#$columns ) {
 					$columns->[$i]->{xs}    = $i;
 					$columns->[$i]->{key}   = "[$i]";
@@ -411,8 +418,9 @@
 
 			# Generate the new Perl fragments
 			$table->{pl_new} = join "\n", map {
-				$array ? "\t\t\$attr{$_->{name}},"
-				       : "\t\t$_->{name} => \$attr{$_->{name}},"
+				$table->{array}
+					? "\t\t\$attr{$_->{name}},"
+					: "\t\t$_->{name} => \$attr{$_->{name}},"
 			} @$columns;
 
 			$table->{pl_insert} = join "\n", map {
@@ -458,6 +466,9 @@
 		# Generate the per-table code
 		foreach my $table ( @$tables ) {
 			my @columns = @{$table->{columns}};
+			my $slice   = $table->{array}
+				? '{}'
+				: '{ Slice => {} }';
 
 			# Generate the elements in all packages
 			$code .= <<"END_PERL";
@@ -493,7 +504,7 @@
 END_PERL
 
 			# Handle different versions, because arrayref acts funny
-			if ( $array ) {
+			if ( $table->{array} ) {
 				$code .= <<"END_PERL";
 sub iterate {
 	my \$class = shift;
@@ -531,7 +542,7 @@
 
 			# Add the primary key based single object loader
 			if ( $table->{pks} ) {
-				if ( $array ) {
+				if ( $table->{array} ) {
 					$code .= <<"END_PERL";
 sub load {
 	my \$class = shift;
@@ -566,6 +577,8 @@
 
 			# Generate the elements for tables with primary keys
 			if ( $table->{create} ) {
+				my $l = $table->{array} ? '['  : '{';
+				my $r = $table->{array} ? ']'  : '}';
 				$code .= <<"END_PERL";
 sub new {
 	my \$class = shift;
@@ -610,7 +623,7 @@
 END_PERL
 			}
 
-			if ( $table->{create} and $array ) {
+			if ( $table->{create} and $table->{array} ) {
 				# Add an additional set method to avoid having
 				# the user have to enter manual positions.
 				$code .= <<"END_PERL";
@@ -628,7 +641,11 @@
 
 			# Generate the boring accessors
 			if ( $xsaccessor ) {
-				my $type = $table->{create} ? 'accessors' : 'getters';
+				my $type    = $table->{create} ? 'accessors' : 'getters';
+				my $xsclass = $table->{array}
+					? 'Class::XSAccessor::Array'
+					: 'Class::XSAccessor';
+
 				$code .= <<"END_PERL";
 use $xsclass 1.05 {
 	getters => {
@@ -657,7 +674,7 @@
 				my @pk    = map { $_->{name} } @{$table->{pk}};
 				my $wsql  = join ' and ', map { "\"$_\" = ?" } @pk;
 				my $wattr = join ', ',    map { "\$self->$_" } @pk;
-				my $set   = $array
+				my $set   = $table->{array}
 					? '$self->set( $_ => $set{$_} ) foreach keys %set;'
 					: '$self->{$_} = $set{$_} foreach keys %set;';
 				$code .= <<"END_PERL";
@@ -680,9 +697,22 @@
 }
 END_PERL
 			}
-
 		}
 	}
+
+	# Optionally generate the table classes
+	if ( $params{views} ) {
+		# Capture the raw schema table information
+		my $views = $dbh->selectall_arrayref(
+			'select * from sqlite_master where name not like ? and type = ?',
+			{ Slice => {} }, 'sqlite_%', 'view',
+		);
+		my %vindex = map { $_->{name} => $_ } @$views;
+
+		1;
+	}
+
+	# We are finished with it now
 	$dbh->disconnect;
 
 	# Add any custom code to the end

Modified: trunk/liborlite-perl/t/08_prune.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liborlite-perl/t/08_prune.pl?rev=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/t/08_prune.pl (original)
+++ trunk/liborlite-perl/t/08_prune.pl Sat Dec 11 12:16:49 2010
@@ -4,7 +4,7 @@
 
 use strict;
 
-our $VERSION = '1.46';
+our $VERSION = '1.47';
 
 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=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/t/17_cache.t (original)
+++ trunk/liborlite-perl/t/17_cache.t Sat Dec 11 12:16:49 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-46-user_version-2.pm } );
+my $cached = catfile( qw{ t Foo-Bar-1-23-ORLite-1-47-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=65729&op=diff
==============================================================================
--- trunk/liborlite-perl/t/lib/Test.pm (original)
+++ trunk/liborlite-perl/t/lib/Test.pm Sat Dec 11 12:16:49 2010
@@ -9,7 +9,7 @@
 
 use vars qw{$VERSION @ISA @EXPORT};
 BEGIN {
-	$VERSION = '1.46';
+	$VERSION = '1.47';
 	@ISA     = 'Exporter';
 	@EXPORT  = qw{ test_db connect_ok create_ok };
 }




More information about the Pkg-perl-cvs-commits mailing list