r44812 - in /branches/upstream/librose-db-perl/current: ./ lib/Rose/ lib/Rose/DB/ lib/Rose/DB/Registry/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Sep 25 14:37:50 UTC 2009
Author: jawnsy-guest
Date: Fri Sep 25 14:37:21 2009
New Revision: 44812
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44812
Log:
[svn-upgrade] Integrating new upstream version, librose-db-perl (0.754)
Modified:
branches/upstream/librose-db-perl/current/Changes
branches/upstream/librose-db-perl/current/META.yml
branches/upstream/librose-db-perl/current/lib/Rose/DB.pm
branches/upstream/librose-db-perl/current/lib/Rose/DB/Cache.pm
branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm
branches/upstream/librose-db-perl/current/lib/Rose/DB/Registry/Entry.pm
branches/upstream/librose-db-perl/current/t/00-warning.t
branches/upstream/librose-db-perl/current/t/basic.t
branches/upstream/librose-db-perl/current/t/db_cache.t
branches/upstream/librose-db-perl/current/t/list-tables.t
branches/upstream/librose-db-perl/current/t/pg.t
branches/upstream/librose-db-perl/current/t/pk-columns.t
branches/upstream/librose-db-perl/current/t/setup.t
branches/upstream/librose-db-perl/current/t/subclass-basic.t
branches/upstream/librose-db-perl/current/t/subclass-list-tables.t
branches/upstream/librose-db-perl/current/t/subclass-pg.t
branches/upstream/librose-db-perl/current/t/subclass-trx.t
branches/upstream/librose-db-perl/current/t/test-lib.pl
branches/upstream/librose-db-perl/current/t/trx.t
Modified: branches/upstream/librose-db-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/Changes?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/Changes (original)
+++ branches/upstream/librose-db-perl/current/Changes Fri Sep 25 14:37:21 2009
@@ -1,3 +1,8 @@
+0.754 (09.14.2009) - John Siracusa <siracusa at gmail.com>
+
+ * Removed outdated warning about Oracle support.
+ * Clarified the return value and error handling for do_transaction().
+
0.753 (07.09.2009) - John Siracusa <siracusa at gmail.com>
* Detect enum-like columns in PostgreSQL. (RT 46214)
Modified: branches/upstream/librose-db-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/META.yml?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/META.yml (original)
+++ branches/upstream/librose-db-perl/current/META.yml Fri Sep 25 14:37:21 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Rose-DB
-version: 0.753
+version: 0.754
abstract: ~
author: []
license: perl
@@ -33,7 +33,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.52
+generated_by: ExtUtils::MakeMaker version 6.54
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB.pm?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB.pm Fri Sep 25 14:37:21 2009
@@ -20,7 +20,7 @@
our $Error;
-our $VERSION = '0.753';
+our $VERSION = '0.754';
our $Debug = 0;
@@ -1130,6 +1130,8 @@
my $dbh = $self->dbh or return undef;
+ local $@;
+
eval
{
local $dbh->{'RaiseError'} = 1;
@@ -1140,7 +1142,7 @@
if($@)
{
- my $error = "do_transaction() failed - $@";
+ my $error = ref $@ ? $@ : "do_transaction() failed - $@";
if($self->rollback)
{
@@ -2172,12 +2174,12 @@
# The getpwuid() function is often(?) unimplemented in perl on Windows.
eval { $username = lc getpwuid($<) };
-
+
unless($@)
{
$rosedb_devinit = "Rose::DB::Devel::Init::$username";
eval qq(require $rosedb_devinit);
-
+
if($@)
{
eval { do $rosedb_devinit };
@@ -2215,7 +2217,7 @@
unless($YAML_Class)
{
eval { require YAML::Syck };
-
+
if($@)
{
require YAML;
@@ -2427,8 +2429,7 @@
DBD::mysql (MySQL)
DBD::SQLite (SQLite)
DBD::Informix (Informix)
-
-Oracle (L<DBD::Oracle>) is mostly supported, but some features may not yet work correctly.
+ DBD::Oracle (Oracle)
L<Rose::DB> will attempt to service an unsupported database using a L<generic|Rose::DB::Generic> implementation that may or may not work. Support for more drivers may be added in the future. Patches are welcome.
@@ -3053,6 +3054,8 @@
$dbh->do("UPDATE acct SET bal = bal + $amt WHERE id = $id2");
},
100, 5, 9) or warn "Transfer failed: ", $db->error;
+
+If the CODE block threw an exception or the transaction could not be started and committed successfully, then undef is returned and the exception thrown is available in the L<error|/error> attribute. Otherwise, a true value is returned.
=item B<error [MSG]>
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/Cache.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB/Cache.pm?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB/Cache.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB/Cache.pm Fri Sep 25 14:37:21 2009
@@ -143,7 +143,7 @@
{
$Debug && warn "Refusing to cache $db during apache server start-up ",
"because use_cache_during_apache_startup is false";
-
+
return $db;
}
}
@@ -207,7 +207,7 @@
sub apache_has_started
{
my($class) = shift;
-
+
if(@_)
{
return $Apache_Has_Started = $_[0] ? 1 : 0;
@@ -219,7 +219,7 @@
{
return $Apache_Has_Started = $MP2_Is_Child;
}
-
+
if(MOD_PERL_1)
{
return $Apache_Has_Started = $Apache::Server::Starting;
@@ -293,7 +293,7 @@
}
my $r;
-
+
eval { $r = Apache2::RequestUtil->request };
if($@)
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm Fri Sep 25 14:37:21 2009
@@ -77,7 +77,7 @@
{
#my($self, $sth, $obj) = @_;
- # Postgres demands that the primary key column not be in the insert
+ # PostgreSQL demands that the primary key column not be in the insert
# statement at all in order for it to auto-generate a value. The
# insert SQL will need to be modified to make this work for
# Rose::DB::Object...
@@ -451,7 +451,7 @@
{
my $default = $1;
- # Single quotes are backslash-escaped, but Postgres 8.1 and
+ # Single quotes are backslash-escaped, but PostgreSQL 8.1 and
# later uses doubled quotes '' instead. Strangely, I see
# doubled quotes in 8.0.x as well...
if($pg_vers >= 80000 && index($default, q('')) > 0)
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/Registry/Entry.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB/Registry/Entry.pm?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB/Registry/Entry.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB/Registry/Entry.pm Fri Sep 25 14:37:21 2009
@@ -16,7 +16,7 @@
#
our %Attrs;
-
+
BEGIN
{
our %Attrs =
@@ -78,7 +78,7 @@
sub _attrs
{
my(%args) = @_;
-
+
my $type = $args{'type'};
# Type filter first
@@ -110,9 +110,9 @@
sub _attr_method_specs
{
my $attrs = _attrs(@_);
-
+
my @specs;
-
+
foreach my $attr (@$attrs)
{
next if(exists $Attrs{$attr}{'make_method'} && !$Attrs{$attr}{'make_method'});
@@ -126,7 +126,7 @@
push(@specs, $attr);
}
}
-
+
return wantarray ? @specs : \@specs;
}
@@ -181,7 +181,7 @@
next unless(defined $value);
$dump{$attr} = $value;
}
-
+
foreach my $attr (_attrs(type => 'hash'), _attrs(type => 'array'))
{
my $value = $self->$attr();
Modified: branches/upstream/librose-db-perl/current/t/00-warning.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/00-warning.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/00-warning.t (original)
+++ branches/upstream/librose-db-perl/current/t/00-warning.t Fri Sep 25 14:37:21 2009
@@ -21,7 +21,7 @@
## these values, set the following environment variables before running tests.
## (The current values are shown in parentheses.)
##
-## Postgres:
+## PostgreSQL:
##
## RDBO_PG_DSN (@{[ nvl('RDBO_PG_DSN', 'dbi:Pg:dbname=test;host=localhost') ]})
## RDBO_PG_USER (@{[ nvl('RDBO_PG_USER', 'postgres') ]})
Modified: branches/upstream/librose-db-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/basic.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/basic.t (original)
+++ branches/upstream/librose-db-perl/current/t/basic.t Fri Sep 25 14:37:21 2009
@@ -470,7 +470,7 @@
);
my $dbh = $db->dbh;
-
+
is($db->dsn, "dbi:SQLite:dbname=$Bin/sqlite.db", 'dsn preservation 1');
$db = Rose::DB->new
@@ -481,7 +481,7 @@
);
$dbh = $db->dbh;
-
+
is($db->dsn, "dbi:SQLite:dbname=$Bin/sqlitex.db", 'dsn preservation 2');
unlink("$Bin/sqlite.db");
@@ -510,7 +510,7 @@
{
push(@entry, $attr => $i++ % 2);
}
-
+
foreach my $attr (sort(Rose::DB::Registry::Entry::_attrs(type => 'hash')))
{
push(@entry, $attr => { $i++ => $i++ });
@@ -530,7 +530,7 @@
if(have_db('mysql'))
{
my %mysql_entry = map { $_ => $dump->{$_} } grep { /^mysql_/ } keys %$dump;
-
+
Rose::DB->register_db(
domain => 'abc',
type => 'def',
Modified: branches/upstream/librose-db-perl/current/t/db_cache.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/db_cache.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/db_cache.t (original)
+++ branches/upstream/librose-db-perl/current/t/db_cache.t Fri Sep 25 14:37:21 2009
@@ -38,7 +38,7 @@
ok($db2 = Rose::DB->new_or_cached(), "new_or_cached 3 - $db_type");
is($db->dbh, $db2->dbh, "new_or_cached dbh check - $db_type");
-
+
is_deeply([ sort Rose::DB->db_cache->db_cache_keys ],
[ sort map { $_->key } Rose::DB->db_cache->db_cache_entries ],
"db_cache_entries, db_cache_keys - $db_type");
Modified: branches/upstream/librose-db-perl/current/t/list-tables.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/list-tables.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/list-tables.t (original)
+++ branches/upstream/librose-db-perl/current/t/list-tables.t Fri Sep 25 14:37:21 2009
@@ -86,7 +86,7 @@
our %Have;
#
- # Postgres
+ # PostgreSQL
#
my $dbh;
@@ -686,7 +686,7 @@
if($Have{'pg'})
{
- # Postgres
+ # PostgreSQL
my $dbh = Rose::DB->new('pg_admin')->retain_dbh()
or die Rose::DB->error;
Modified: branches/upstream/librose-db-perl/current/t/pg.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/pg.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/pg.t (original)
+++ branches/upstream/librose-db-perl/current/t/pg.t Fri Sep 25 14:37:21 2009
@@ -52,9 +52,9 @@
}
ok(!$db->pg_enable_utf8, 'pg_enable_utf8 false');
-
+
$db->pg_enable_utf8(1);
-
+
ok($db->pg_enable_utf8 && $db->dbh->{'pg_enable_utf8'}, 'pg_enable_utf8 true');
$db->disconnect;
Modified: branches/upstream/librose-db-perl/current/t/pk-columns.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/pk-columns.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/pk-columns.t (original)
+++ branches/upstream/librose-db-perl/current/t/pk-columns.t Fri Sep 25 14:37:21 2009
@@ -126,7 +126,7 @@
BEGIN
{
#
- # Postgres
+ # PostgreSQL
#
if(my $dbh = get_dbh('pg_admin'))
Modified: branches/upstream/librose-db-perl/current/t/setup.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/setup.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/setup.t (original)
+++ branches/upstream/librose-db-perl/current/t/setup.t Fri Sep 25 14:37:21 2009
@@ -13,7 +13,7 @@
if($@)
{
eval { require YAML };
-
+
plan(skip_all => 'YAML or YAML::Syck required for setup tests') if($@);
}
Modified: branches/upstream/librose-db-perl/current/t/subclass-basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/subclass-basic.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-basic.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-basic.t Fri Sep 25 14:37:21 2009
@@ -470,7 +470,7 @@
);
my $dbh = $db->dbh;
-
+
is($db->dsn, "dbi:SQLite:dbname=$Bin/sqlite.db", 'dsn preservation 1');
$db = My::DB2->new
@@ -481,7 +481,7 @@
);
$dbh = $db->dbh;
-
+
is($db->dsn, "dbi:SQLite:dbname=$Bin/sqlitex.db", 'dsn preservation 2');
unlink("$Bin/sqlite.db");
@@ -510,7 +510,7 @@
{
push(@entry, $attr => $i++ % 2);
}
-
+
foreach my $attr (sort(Rose::DB::Registry::Entry::_attrs(type => 'hash')))
{
push(@entry, $attr => { $i++ => $i++ });
@@ -530,7 +530,7 @@
if(have_db('mysql'))
{
my %mysql_entry = map { $_ => $dump->{$_} } grep { /^mysql_/ } keys %$dump;
-
+
My::DB2->register_db(
domain => 'abc',
type => 'def',
Modified: branches/upstream/librose-db-perl/current/t/subclass-list-tables.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/subclass-list-tables.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-list-tables.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-list-tables.t Fri Sep 25 14:37:21 2009
@@ -86,7 +86,7 @@
our %Have;
#
- # Postgres
+ # PostgreSQL
#
my $dbh;
@@ -686,7 +686,7 @@
if($Have{'pg'})
{
- # Postgres
+ # PostgreSQL
my $dbh = My::DB2->new('pg_admin')->retain_dbh()
or die My::DB2->error;
Modified: branches/upstream/librose-db-perl/current/t/subclass-pg.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/subclass-pg.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-pg.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-pg.t Fri Sep 25 14:37:21 2009
@@ -52,9 +52,9 @@
}
ok(!$db->pg_enable_utf8, 'pg_enable_utf8 false');
-
+
$db->pg_enable_utf8(1);
-
+
ok($db->pg_enable_utf8 && $db->dbh->{'pg_enable_utf8'}, 'pg_enable_utf8 true');
$db->disconnect;
Modified: branches/upstream/librose-db-perl/current/t/subclass-trx.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/subclass-trx.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-trx.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-trx.t Fri Sep 25 14:37:21 2009
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 72;
+use Test::More tests => 74;
BEGIN
{
@@ -15,12 +15,12 @@
My::DB2->default_domain('test');
#
-# Postgres
+# PostgreSQL
#
SKIP: foreach my $db_type ('pg')
{
- skip("Postgres tests", 21) unless($HAVE_PG);
+ skip("PostgreSQL tests", 23) unless($HAVE_PG);
My::DB2->default_type($db_type);
@@ -72,7 +72,7 @@
$version =~ s/^(\d+)\.(\d+)\.(\d+)$/sprintf("$1.%03d%03d", $2, $3)/e; # lame conversion of three-part version number
# This broke in DBD::Pg 1.47, and 1.44-6 are broken in other ways
# so only run these tests with 1.43 or earlier, or 1.48 or later.
- skip('DBD::Pg 1.43-7 bug?', 5) if($version > 1.43 && $version < 1.48);
+ skip('DBD::Pg 1.43-7 bug?', 7) if($version > 1.43 && $version < 1.48);
ok($db->begin_work, "begin_work() 3 - $db_type");
@@ -99,6 +99,13 @@
my $count = $sth->fetchrow_array;
is($count, 4, "do_transaction() 3 - $db_type");
+
+ is($db->do_transaction(sub
+ {
+ die bless { msg => 'Test' }, 'My::Exception';
+ }), undef, "do_transaction() exception 1 - $db_type");
+
+ is(ref $db->error, 'My::Exception', "do_transaction() exception 1 - $db_type");
}
}
@@ -293,7 +300,7 @@
BEGIN
{
#
- # Postgres
+ # PostgreSQL
#
my $dbh;
@@ -449,7 +456,7 @@
if($HAVE_PG)
{
- # Postgres
+ # PostgreSQL
my $dbh = My::DB2->new('pg_admin')->retain_dbh()
or die My::DB2->error;
Modified: branches/upstream/librose-db-perl/current/t/test-lib.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/test-lib.pl?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/test-lib.pl (original)
+++ branches/upstream/librose-db-perl/current/t/test-lib.pl Fri Sep 25 14:37:21 2009
@@ -11,7 +11,7 @@
Rose::DB->default_domain('test');
#
- # Postgres
+ # PostgreSQL
#
# Main
Modified: branches/upstream/librose-db-perl/current/t/trx.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/trx.t?rev=44812&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/trx.t (original)
+++ branches/upstream/librose-db-perl/current/t/trx.t Fri Sep 25 14:37:21 2009
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 72;
+use Test::More tests => 74;
BEGIN
{
@@ -15,12 +15,12 @@
Rose::DB->default_domain('test');
#
-# Postgres
+# PostgreSQL
#
SKIP: foreach my $db_type ('pg')
{
- skip("Postgres tests", 21) unless($HAVE_PG);
+ skip("PostgreSQL tests", 23) unless($HAVE_PG);
Rose::DB->default_type($db_type);
@@ -72,7 +72,7 @@
$version =~ s/^(\d+)\.(\d+)\.(\d+)$/sprintf("$1.%03d%03d", $2, $3)/e; # lame conversion of three-part version number
# This broke in DBD::Pg 1.47, and 1.44-6 are broken in other ways
# so only run these tests with 1.43 or earlier, or 1.48 or later.
- skip('DBD::Pg 1.43-7 bug?', 5) if($version > 1.43 && $version < 1.48);
+ skip('DBD::Pg 1.43-7 bug?', 7) if($version > 1.43 && $version < 1.48);
ok($db->begin_work, "begin_work() 3 - $db_type");
@@ -99,6 +99,13 @@
my $count = $sth->fetchrow_array;
is($count, 4, "do_transaction() 3 - $db_type");
+
+ is($db->do_transaction(sub
+ {
+ die bless { msg => 'Test' }, 'My::Exception';
+ }), undef, "do_transaction() exception 1 - $db_type");
+
+ is(ref $db->error, 'My::Exception', "do_transaction() exception 1 - $db_type");
}
}
@@ -293,7 +300,7 @@
BEGIN
{
#
- # Postgres
+ # PostgreSQL
#
my $dbh;
@@ -449,7 +456,7 @@
if($HAVE_PG)
{
- # Postgres
+ # PostgreSQL
my $dbh = Rose::DB->new('pg_admin')->retain_dbh()
or die Rose::DB->error;
More information about the Pkg-perl-cvs-commits
mailing list