r51458 - in /branches/upstream/librose-db-perl/current: Changes META.yml lib/Rose/DB.pm lib/Rose/DB/Oracle.pm lib/Rose/DB/Pg.pm t/informix.t t/mysql.t t/oracle.t t/pg.t t/subclass-informix.t t/subclass-mysql.t t/subclass-oracle.t t/subclass-pg.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun Jan 24 17:34:37 UTC 2010
Author: jawnsy-guest
Date: Sun Jan 24 17:34:32 2010
New Revision: 51458
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=51458
Log:
[svn-upgrade] Integrating new upstream version, librose-db-perl (0.757)
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/Oracle.pm
branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm
branches/upstream/librose-db-perl/current/t/informix.t
branches/upstream/librose-db-perl/current/t/mysql.t
branches/upstream/librose-db-perl/current/t/oracle.t
branches/upstream/librose-db-perl/current/t/pg.t
branches/upstream/librose-db-perl/current/t/subclass-informix.t
branches/upstream/librose-db-perl/current/t/subclass-mysql.t
branches/upstream/librose-db-perl/current/t/subclass-oracle.t
branches/upstream/librose-db-perl/current/t/subclass-pg.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=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/Changes (original)
+++ branches/upstream/librose-db-perl/current/Changes Sun Jan 24 17:34:32 2010
@@ -1,3 +1,7 @@
+0.757 (01.23.2010) - John Siracusa <siracusa at gmail.com>
+
+ * Support for Rose::DB::Object 0.786.
+
0.756 (12.31.2009) - John Siracusa <siracusa at gmail.com>
* Support for Rose::DB::Object 0.785.
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=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/META.yml (original)
+++ branches/upstream/librose-db-perl/current/META.yml Sun Jan 24 17:34:32 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Rose-DB
-version: 0.756
+version: 0.757
abstract: ~
author: []
license: perl
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=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB.pm Sun Jan 24 17:34:32 2010
@@ -20,7 +20,7 @@
our $Error;
-our $VERSION = '0.756';
+our $VERSION = '0.757';
our $Debug = 0;
@@ -2157,6 +2157,22 @@
return undef;
}
+sub current_value_in_sequence
+{
+ my($self, $seq) = @_;
+ $self->error("Don't know how to select current value in sequence '$seq' " .
+ "for database driver " . $self->driver);
+ return undef;
+}
+
+sub sequence_exists
+{
+ my($self, $seq) = @_;
+ $self->error("Don't know how to tell if sequence '$seq' exists " .
+ "for database driver " . $self->driver);
+ return undef;
+}
+
sub auto_sequence_name { undef }
sub supports_multi_column_count_distinct { 1 }
@@ -2168,9 +2184,13 @@
sub likes_redundant_join_conditions { 0 }
sub likes_lowercase_table_names { 0 }
+sub likes_uppercase_table_names { 0 }
sub likes_lowercase_schema_names { 0 }
+sub likes_uppercase_schema_names { 0 }
sub likes_lowercase_catalog_names { 0 }
+sub likes_uppercase_catalog_names { 0 }
sub likes_lowercase_sequence_names { 0 }
+sub likes_uppercase_sequence_names { 0 }
sub likes_implicit_joins { 0 }
sub supports_schema { 0 }
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm?rev=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm Sun Jan 24 17:34:32 2010
@@ -2,13 +2,14 @@
use strict;
+use Carp();
use SQL::ReservedWords::Oracle();
use Rose::DB;
our $Debug = 0;
-our $VERSION = '0.756';
+our $VERSION = '0.757';
use Rose::Class::MakeMethods::Generic
(
@@ -80,15 +81,14 @@
sub auto_sequence_name
{
my($self, %args) = @_;
- my($table) = $args{'table'};
-
+
+ my($table) = $args{'table'};
Carp::croak 'Missing table argument' unless(defined $table);
my($column) = $args{'column'};
-
Carp::croak 'Missing column argument' unless(defined $column);
- return lc "${table}_${column}_seq";
+ return uc "${table}_${column}_SEQ";
}
sub build_dsn
@@ -127,6 +127,13 @@
}
sub dbi_driver { 'Oracle' }
+
+sub likes_uppercase_table_names { 1 }
+sub likes_uppercase_schema_names { 1 }
+sub likes_uppercase_catalog_names { 1 }
+sub likes_uppercase_sequence_names { 1 }
+
+sub insertid_param { '' }
sub list_tables
{
@@ -169,11 +176,11 @@
sub next_value_in_sequence
{
- my($self, $seq) = @_;
+ my($self, $sequence_name) = @_;
my $dbh = $self->dbh or return undef;
- my($error, $id);
+ my($error, $value);
TRY:
{
@@ -181,12 +188,11 @@
eval
{
- my($sth) = $dbh->prepare("SELECT $seq.nextval FROM dual");
-
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 1;
+ my $sth = $dbh->prepare("SELECT $sequence_name.NEXTVAL FROM DUAL");
$sth->execute;
-
- $id = ${$sth->fetch}[0];
-
+ $value = ${$sth->fetch}[0];
$sth->finish;
};
@@ -195,11 +201,133 @@
if($error)
{
- $self->error("Could not get the next value in the sequence '$seq' - $error");
+ $self->error("Could not get the next value in the sequence $sequence_name - $error");
return undef;
}
- return $id;
+ return $value;
+}
+
+# Tried to execute a CURRVAL command on a sequence before the
+# NEXTVAL command was executed at least once.
+use constant ORA_08002 => 8002;
+
+sub current_value_in_sequence
+{
+ my($self, $sequence_name) = @_;
+
+ my $dbh = $self->dbh or return undef;
+
+ my($error, $value);
+
+ TRY:
+ {
+ local $@;
+
+ eval
+ {
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 1;
+ my $sth = $dbh->prepare("SELECT $sequence_name.CURRVAL FROM DUAL");
+
+ $sth->execute;
+
+ $value = ${$sth->fetch}[0];
+
+ $sth->finish;
+ };
+
+ $error = $@;
+ }
+
+ if($error)
+ {
+ if(DBI->err == ORA_08002)
+ {
+ if(defined $self->next_value_in_sequence($sequence_name))
+ {
+ return $self->current_value_in_sequence($sequence_name);
+ }
+ }
+
+ $self->error("Could not get the current value in the sequence $sequence_name - $error");
+ return undef;
+ }
+
+ return $value;
+}
+
+# Sequence does not exist, or the user does not have the required
+# privilege to perform this operation.
+use constant ORA_02289 => 2289;
+
+sub sequence_exists
+{
+ my($self, $sequence_name) = @_;
+
+ my $dbh = $self->dbh or return undef;
+
+ my $error;
+
+ TRY:
+ {
+ local $@;
+
+ eval
+ {
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 1;
+ my $sth = $dbh->prepare("SELECT $sequence_name.CURRVAL FROM DUAL");
+ $sth->execute;
+ $sth->fetch;
+ $sth->finish;
+ };
+
+ $error = $@;
+ }
+
+ if($error)
+ {
+ my $dbi_error = DBI->err;
+
+ if($dbi_error == ORA_08002)
+ {
+ if(defined $self->next_value_in_sequence($sequence_name))
+ {
+ return $self->sequence_exists($sequence_name);
+ }
+ }
+ elsif($dbi_error == ORA_02289)
+ {
+ return 0;
+ }
+
+ $self->error("Could not check if sequence $sequence_name exists - $error");
+ return undef;
+ }
+
+ return 1;
+}
+
+sub parse_dbi_column_info_default
+{
+ my($self, $default, $col_info) = @_;
+
+ # For some reason, given a default value like this:
+ #
+ # MYCOLUMN VARCHAR(128) DEFAULT 'foo' NOT NULL
+ #
+ # DBD::Oracle hands back a COLUMN_DEF value of:
+ #
+ # $col_info->{'COLUMN_DEF'} = "'foo' "; # WTF?
+ #
+ # I have no idea why. Anyway, we just want the value beteen the quotes.
+
+ return undef unless (defined $default);
+
+ $default =~ s/^\s*'(.+)'\s*$/$1/;
+
+ return $default;
}
*is_reserved_word = \&SQL::ReservedWords::Oracle::is_reserved;
@@ -207,13 +335,41 @@
sub quote_identifier_for_sequence
{
my($self, $catalog, $schema, $table) = @_;
- return join('.', grep { defined } ($schema, $table));
-}
+ return join('.', map { uc } grep { defined } ($schema, $table));
+}
+
+# sub auto_quote_column_name
+# {
+# my($self, $name) = @_;
+#
+# if($name =~ /[^\w#]/ || $self->is_reserved_word($name))
+# {
+# return $self->quote_column_name($name, @_);
+# }
+#
+# return $name;
+# }
sub supports_schema { 1 }
sub max_column_name_length { 30 }
sub max_column_alias_length { 30 }
+
+sub quote_column_name
+{
+ my $name = uc $_[1];
+ $name =~ s/"/""/g;
+ return qq("$name");
+}
+
+sub quote_table_name
+{
+ my $name = uc $_[1];
+ $name =~ s/"/""/g;
+ return qq("$name");
+}
+
+sub quote_identifier { uc shift->Rose::DB::quote_identifier(@_) }
sub primary_key_column_names
{
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=51458&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 Sun Jan 24 17:34:32 2010
@@ -8,7 +8,7 @@
use Rose::DB;
-our $VERSION = '0.786';
+our $VERSION = '0.786'; # overshot version number, freeze until caught up
our $Debug = 0;
@@ -271,11 +271,11 @@
sub next_value_in_sequence
{
- my($self, $seq) = @_;
+ my($self, $sequence_name) = @_;
my $dbh = $self->dbh or return undef;
- my($id, $error);
+ my($value, $error);
TRY:
{
@@ -283,9 +283,11 @@
eval
{
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 1;
my $sth = $dbh->prepare(qq(SELECT nextval(?)));
- $sth->execute($seq);
- $id = ${$sth->fetchrow_arrayref}[0];
+ $sth->execute($sequence_name);
+ $value = ${$sth->fetchrow_arrayref}[0];
};
$error = $@;
@@ -293,12 +295,48 @@
if($error)
{
- $self->error("Could not get the next value in the sequence '$seq' - $error");
+ $self->error("Could not get the next value in the sequence '$sequence_name' - $error");
return undef;
}
- return $id;
-}
+ return $value;
+}
+
+sub current_value_in_sequence
+{
+ my($self, $sequence_name) = @_;
+
+ my $dbh = $self->dbh or return undef;
+
+ my($value, $error);
+
+ TRY:
+ {
+ local $@;
+
+ eval
+ {
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 1;
+ my $name = $dbh->quote_identifier($sequence_name);
+ my $sth = $dbh->prepare(qq(SELECT last_value FROM $name));
+ $sth->execute;
+ $value = ${$sth->fetchrow_arrayref}[0];
+ };
+
+ $error = $@;
+ }
+
+ if($error)
+ {
+ $self->error("Could not get the current value in the sequence '$sequence_name' - $error");
+ return undef;
+ }
+
+ return $value;
+}
+
+sub sequence_exists { defined shift->current_value_in_sequence(@_) ? 1 : 0 }
sub use_auto_sequence_name { 1 }
@@ -314,9 +352,6 @@
return lc "${table}_${column}_seq";
}
-
-#our %Reserved_Words = map { $_ => 1 } qw(role cast user);
-#sub is_reserved_word { $Reserved_Words{lc $_[1]} }
*is_reserved_word = \&SQL::ReservedWords::PostgreSQL::is_reserved;
@@ -371,7 +406,6 @@
$auto_seq = "$schema.$auto_seq" if($schema);
}
- # If the sequence name
no warnings 'uninitialized';
if(lc $seq eq lc $auto_seq)
{
@@ -404,6 +438,10 @@
$col_info->{'TIME_SCALE'} = $1 || 0;
}
elsif($type_name eq 'double precision')
+ {
+ $col_info->{'COLUMN_SIZE'} = undef;
+ }
+ elsif($type_name eq 'money')
{
$col_info->{'COLUMN_SIZE'} = undef;
}
Modified: branches/upstream/librose-db-perl/current/t/informix.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/informix.t?rev=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/informix.t (original)
+++ branches/upstream/librose-db-perl/current/t/informix.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 135);
+ Test::More->import(tests => 134);
}
}
@@ -208,7 +208,7 @@
SKIP:
{
eval { $db->connect };
- skip("Could not connect to db 'test', 'informix' - $@", 38) if($@);
+ skip("Could not connect to db 'test', 'informix' - $@", 37) if($@);
$dbh = $db->dbh;
is($db->domain, 'test', "domain()");
@@ -300,8 +300,6 @@
is($db->autocommit + 0, 0, 'autocommit() 4');
is($dbh->{'AutoCommit'} + 0, 0, 'autocommit() 5');
- ok(!defined $db->auto_sequence_name(table => 'foo.goo', column => 'bar'), 'auto_sequence_name()');
-
my $dbh_copy = $db->retain_dbh;
$db->disconnect;
Modified: branches/upstream/librose-db-perl/current/t/mysql.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/mysql.t?rev=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/mysql.t (original)
+++ branches/upstream/librose-db-perl/current/t/mysql.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 146);
+ Test::More->import(tests => 145);
}
}
@@ -133,7 +133,7 @@
{
unless(have_db('mysql'))
{
- skip("MySQL connection tests", 77);
+ skip("MySQL connection tests", 76);
}
eval { $db->connect };
@@ -156,31 +156,31 @@
if($db->database_version >= 5_000_003)
{
- is($db->format_bitfield($db->parse_bitfield('1010')),
- q(b'1010'), "format_bitfield() 1");
-
- is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
- q(b'1010'), "format_bitfield() 2");
-
- is($db->format_bitfield($db->parse_bitfield(2), 4),
- q(b'0010'), "format_bitfield() 3");
-
- is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
- q(b'1010'), "format_bitfield() 4");
+ is($db->format_bitfield($db->parse_bitfield('1010')),
+ q(b'1010'), "format_bitfield() 1");
+
+ is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
+ q(b'1010'), "format_bitfield() 2");
+
+ is($db->format_bitfield($db->parse_bitfield(2), 4),
+ q(b'0010'), "format_bitfield() 3");
+
+ is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
+ q(b'1010'), "format_bitfield() 4");
}
else
{
- is($db->format_bitfield($db->parse_bitfield('1010')),
- q(10), "format_bitfield() 1");
-
- is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
- q(10), "format_bitfield() 2");
-
- is($db->format_bitfield($db->parse_bitfield(2), 4),
- q(2), "format_bitfield() 3");
-
- is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
- q(10), "format_bitfield() 4");
+ is($db->format_bitfield($db->parse_bitfield('1010')),
+ q(10), "format_bitfield() 1");
+
+ is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
+ q(10), "format_bitfield() 2");
+
+ is($db->format_bitfield($db->parse_bitfield(2), 4),
+ q(2), "format_bitfield() 3");
+
+ is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
+ q(10), "format_bitfield() 4");
}
#is($db->autocommit + 0, $dbh->{'AutoCommit'} + 0, 'autocommit() 1');
@@ -194,8 +194,6 @@
is($db->autocommit + 0, 0, 'autocommit() 4');
is($dbh->{'AutoCommit'} + 0, 0, 'autocommit() 5');
-
- ok(!defined $db->auto_sequence_name(table => 'foo.goo', column => 'bar'), 'auto_sequence_name()');
my $dbh_copy = $db->retain_dbh;
Modified: branches/upstream/librose-db-perl/current/t/oracle.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/oracle.t?rev=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/oracle.t (original)
+++ branches/upstream/librose-db-perl/current/t/oracle.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 59);
+ Test::More->import(tests => 68);
}
}
@@ -62,12 +62,16 @@
is($db->format_boolean($db->parse_boolean($val)), 'f', "format_boolean ($val)");
}
+is($db->auto_quote_column_name('foo_bar_123'), 'foo_bar_123', 'auto_quote_column_name 1');
+is($db->auto_quote_column_name('claim#'), '"CLAIM#"', 'auto_quote_column_name 2');
+is($db->auto_quote_column_name('foo-bar'), '"FOO-BAR"', 'auto_quote_column_name 3');
+
my $dbh;
eval { $dbh = $db->dbh };
SKIP:
{
- skip("Could not connect to db - $@", 9) if($@);
+ skip("Could not connect to db - $@", 16) if($@);
ok($dbh, 'dbh() 1');
@@ -81,6 +85,26 @@
{
is($db2->$field(), $db->$field(), "$field()");
}
+
+ SEQUENCE_PREP:
+ {
+ my $dbh = $db->dbh;
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 0;
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
+ }
+
+ $dbh->do('CREATE SEQUENCE rose_db_sequence_test MINVALUE 5');
+
+ ok($db->sequence_exists('rose_db_sequence_test'), 'sequence_exists 1');
+ ok(!$db->sequence_exists('rose_db_sequence_testx'), 'sequence_exists 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 5, 'current_value_in_sequence 1');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 6, 'next_value_in_sequence 1');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 6, 'current_value_in_sequence 2');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 7, 'next_value_in_sequence 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 7, 'current_value_in_sequence 3');
+
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
$db->disconnect;
$db2->disconnect;
@@ -113,7 +137,7 @@
$db = Rose::DB->new;
eval { $db->connect };
- skip("Could not connect to db 'test', 'oracle' - $@", 11) if($@);
+ skip("Could not connect to db 'test', 'oracle' - $@", 10) if($@);
$dbh = $db->dbh;
is($db->domain, 'test', "domain()");
@@ -137,8 +161,6 @@
is($db->autocommit + 0, 0, 'autocommit() 4');
is($dbh->{'AutoCommit'} + 0, 0, 'autocommit() 5');
- is($db->auto_sequence_name(table => 'foo', column => 'bar'), 'foo_bar_seq', 'auto_sequence_name()');
-
my $dbh_copy = $db->retain_dbh;
$db->disconnect;
@@ -183,15 +205,3 @@
);
is(Rose::DB->new('dsn4')->dsn, 'dbi:Oracle:sid=somedb;host=somehost;port=someport', 'dsn 4');
-
-sub lookup_ip
-{
- my($name) = shift || return 0;
-
- my $address = (gethostbyname($name))[4] or return 0;
-
- my @octets = unpack("CCCC", $address);
-
- return 0 unless($name && @octets);
- return join('.', @octets), "\n";
-}
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=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/pg.t (original)
+++ branches/upstream/librose-db-perl/current/t/pg.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 306);
+ Test::More->import(tests => 313);
}
}
@@ -34,7 +34,7 @@
SKIP:
{
- skip("Could not connect to db - $@", 11) unless(have_db('pg'));
+ skip("Could not connect to db - $@", 15) unless(have_db('pg'));
my $dbh = $db->dbh;
@@ -57,6 +57,25 @@
ok($db->pg_enable_utf8 && $db->dbh->{'pg_enable_utf8'}, 'pg_enable_utf8 true');
+ SEQUENCE_PREP:
+ {
+ my $dbh = $db->dbh;
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 0;
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
+ }
+
+ $dbh->do('CREATE SEQUENCE rose_db_sequence_test MINVALUE 5');
+
+ ok($db->sequence_exists('rose_db_sequence_test'), 'sequence_exists 1');
+ ok(!$db->sequence_exists('rose_db_sequence_testx'), 'sequence_exists 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 5, 'current_value_in_sequence 1');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 5, 'next_value_in_sequence 1');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 5, 'current_value_in_sequence 2');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 6, 'next_value_in_sequence 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 6, 'current_value_in_sequence 3');
+
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
$db->disconnect;
$db2->disconnect;
}
@@ -366,7 +385,7 @@
{
unless(have_db('pg'))
{
- skip('pg tests', 43);
+ skip('pg tests', 46);
}
eval { $db->connect };
Modified: branches/upstream/librose-db-perl/current/t/subclass-informix.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/subclass-informix.t?rev=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-informix.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-informix.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 135);
+ Test::More->import(tests => 134);
}
}
@@ -208,7 +208,7 @@
SKIP:
{
eval { $db->connect };
- skip("Could not connect to db 'test', 'informix' - $@", 38) if($@);
+ skip("Could not connect to db 'test', 'informix' - $@", 37) if($@);
$dbh = $db->dbh;
is($db->domain, 'test', "domain()");
@@ -300,8 +300,6 @@
is($db->autocommit + 0, 0, 'autocommit() 4');
is($dbh->{'AutoCommit'} + 0, 0, 'autocommit() 5');
- ok(!defined $db->auto_sequence_name(table => 'foo.goo', column => 'bar'), 'auto_sequence_name()');
-
my $dbh_copy = $db->retain_dbh;
$db->disconnect;
Modified: branches/upstream/librose-db-perl/current/t/subclass-mysql.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/subclass-mysql.t?rev=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-mysql.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-mysql.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 146);
+ Test::More->import(tests => 145);
}
}
@@ -133,7 +133,7 @@
{
unless(have_db('mysql'))
{
- skip("MySQL connection tests", 77);
+ skip("MySQL connection tests", 76);
}
eval { $db->connect };
@@ -156,31 +156,31 @@
if($db->database_version >= 5_000_003)
{
- is($db->format_bitfield($db->parse_bitfield('1010')),
- q(b'1010'), "format_bitfield() 1");
-
- is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
- q(b'1010'), "format_bitfield() 2");
-
- is($db->format_bitfield($db->parse_bitfield(2), 4),
- q(b'0010'), "format_bitfield() 3");
-
- is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
- q(b'1010'), "format_bitfield() 4");
+ is($db->format_bitfield($db->parse_bitfield('1010')),
+ q(b'1010'), "format_bitfield() 1");
+
+ is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
+ q(b'1010'), "format_bitfield() 2");
+
+ is($db->format_bitfield($db->parse_bitfield(2), 4),
+ q(b'0010'), "format_bitfield() 3");
+
+ is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
+ q(b'1010'), "format_bitfield() 4");
}
else
{
- is($db->format_bitfield($db->parse_bitfield('1010')),
- q(10), "format_bitfield() 1");
-
- is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
- q(10), "format_bitfield() 2");
-
- is($db->format_bitfield($db->parse_bitfield(2), 4),
- q(2), "format_bitfield() 3");
-
- is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
- q(10), "format_bitfield() 4");
+ is($db->format_bitfield($db->parse_bitfield('1010')),
+ q(10), "format_bitfield() 1");
+
+ is($db->format_bitfield($db->parse_bitfield(q(B'1010'))),
+ q(10), "format_bitfield() 2");
+
+ is($db->format_bitfield($db->parse_bitfield(2), 4),
+ q(2), "format_bitfield() 3");
+
+ is($db->format_bitfield($db->parse_bitfield('0xA'), 4),
+ q(10), "format_bitfield() 4");
}
#is($db->autocommit + 0, $dbh->{'AutoCommit'} + 0, 'autocommit() 1');
@@ -194,8 +194,6 @@
is($db->autocommit + 0, 0, 'autocommit() 4');
is($dbh->{'AutoCommit'} + 0, 0, 'autocommit() 5');
-
- ok(!defined $db->auto_sequence_name(table => 'foo.goo', column => 'bar'), 'auto_sequence_name()');
my $dbh_copy = $db->retain_dbh;
Modified: branches/upstream/librose-db-perl/current/t/subclass-oracle.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/t/subclass-oracle.t?rev=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-oracle.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-oracle.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 59);
+ Test::More->import(tests => 68);
}
}
@@ -62,12 +62,16 @@
is($db->format_boolean($db->parse_boolean($val)), 'f', "format_boolean ($val)");
}
+is($db->auto_quote_column_name('foo_bar_123'), 'foo_bar_123', 'auto_quote_column_name 1');
+is($db->auto_quote_column_name('claim#'), '"CLAIM#"', 'auto_quote_column_name 2');
+is($db->auto_quote_column_name('foo-bar'), '"FOO-BAR"', 'auto_quote_column_name 3');
+
my $dbh;
eval { $dbh = $db->dbh };
SKIP:
{
- skip("Could not connect to db - $@", 9) if($@);
+ skip("Could not connect to db - $@", 16) if($@);
ok($dbh, 'dbh() 1');
@@ -81,6 +85,26 @@
{
is($db2->$field(), $db->$field(), "$field()");
}
+
+ SEQUENCE_PREP:
+ {
+ my $dbh = $db->dbh;
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 0;
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
+ }
+
+ $dbh->do('CREATE SEQUENCE rose_db_sequence_test MINVALUE 5');
+
+ ok($db->sequence_exists('rose_db_sequence_test'), 'sequence_exists 1');
+ ok(!$db->sequence_exists('rose_db_sequence_testx'), 'sequence_exists 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 5, 'current_value_in_sequence 1');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 6, 'next_value_in_sequence 1');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 6, 'current_value_in_sequence 2');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 7, 'next_value_in_sequence 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 7, 'current_value_in_sequence 3');
+
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
$db->disconnect;
$db2->disconnect;
@@ -113,7 +137,7 @@
$db = My::DB2->new;
eval { $db->connect };
- skip("Could not connect to db 'test', 'oracle' - $@", 11) if($@);
+ skip("Could not connect to db 'test', 'oracle' - $@", 10) if($@);
$dbh = $db->dbh;
is($db->domain, 'test', "domain()");
@@ -137,8 +161,6 @@
is($db->autocommit + 0, 0, 'autocommit() 4');
is($dbh->{'AutoCommit'} + 0, 0, 'autocommit() 5');
- is($db->auto_sequence_name(table => 'foo', column => 'bar'), 'foo_bar_seq', 'auto_sequence_name()');
-
my $dbh_copy = $db->retain_dbh;
$db->disconnect;
@@ -183,15 +205,3 @@
);
is(My::DB2->new('dsn4')->dsn, 'dbi:Oracle:sid=somedb;host=somehost;port=someport', 'dsn 4');
-
-sub lookup_ip
-{
- my($name) = shift || return 0;
-
- my $address = (gethostbyname($name))[4] or return 0;
-
- my @octets = unpack("CCCC", $address);
-
- return 0 unless($name && @octets);
- return join('.', @octets), "\n";
-}
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=51458&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-pg.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-pg.t Sun Jan 24 17:34:32 2010
@@ -15,7 +15,7 @@
}
else
{
- Test::More->import(tests => 306);
+ Test::More->import(tests => 313);
}
}
@@ -34,7 +34,7 @@
SKIP:
{
- skip("Could not connect to db - $@", 11) unless(have_db('pg'));
+ skip("Could not connect to db - $@", 15) unless(have_db('pg'));
my $dbh = $db->dbh;
@@ -57,6 +57,25 @@
ok($db->pg_enable_utf8 && $db->dbh->{'pg_enable_utf8'}, 'pg_enable_utf8 true');
+ SEQUENCE_PREP:
+ {
+ my $dbh = $db->dbh;
+ local $dbh->{'PrintError'} = 0;
+ local $dbh->{'RaiseError'} = 0;
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
+ }
+
+ $dbh->do('CREATE SEQUENCE rose_db_sequence_test MINVALUE 5');
+
+ ok($db->sequence_exists('rose_db_sequence_test'), 'sequence_exists 1');
+ ok(!$db->sequence_exists('rose_db_sequence_testx'), 'sequence_exists 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 5, 'current_value_in_sequence 1');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 5, 'next_value_in_sequence 1');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 5, 'current_value_in_sequence 2');
+ is($db->next_value_in_sequence('rose_db_sequence_test'), 6, 'next_value_in_sequence 2');
+ is($db->current_value_in_sequence('rose_db_sequence_test'), 6, 'current_value_in_sequence 3');
+
+ $dbh->do('DROP SEQUENCE rose_db_sequence_test');
$db->disconnect;
$db2->disconnect;
}
@@ -366,7 +385,7 @@
{
unless(have_db('pg'))
{
- skip('pg tests', 43);
+ skip('pg tests', 46);
}
eval { $db->connect };
More information about the Pkg-perl-cvs-commits
mailing list