r20512 - in /branches/upstream/librose-db-perl/current: Changes META.yml lib/Rose/DB.pm lib/Rose/DB/Pg.pm t/00-warning.t t/lib/My/FixUp.pm t/setup.t t/sqlite.t t/subclass-sqlite.t t/test-lib.pl

eloy at users.alioth.debian.org eloy at users.alioth.debian.org
Thu May 29 10:56:19 UTC 2008


Author: eloy
Date: Thu May 29 10:56:19 2008
New Revision: 20512

URL: http://svn.debian.org/wsvn/?sc=1&rev=20512
Log:
[svn-upgrade] Integrating new upstream version, librose-db-perl (0.744)

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/Pg.pm
    branches/upstream/librose-db-perl/current/t/00-warning.t
    branches/upstream/librose-db-perl/current/t/lib/My/FixUp.pm
    branches/upstream/librose-db-perl/current/t/setup.t
    branches/upstream/librose-db-perl/current/t/sqlite.t
    branches/upstream/librose-db-perl/current/t/subclass-sqlite.t
    branches/upstream/librose-db-perl/current/t/test-lib.pl

Modified: branches/upstream/librose-db-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/Changes?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/Changes (original)
+++ branches/upstream/librose-db-perl/current/Changes Thu May 29 10:56:19 2008
@@ -1,3 +1,10 @@
+0.744 (05.28.2008) - John Siracusa <siracusa at gmail.com>
+
+    * Added fixup() class method call to auto_load_fixups().
+      (Suggested by Justin Ellison)
+    * Skip the interactive part of the test suite when the
+      AUTOMATED_TESTING environment variable is set.
+
 0.743 (04.02.2008) - John Siracusa <siracusa at gmail.com>
 
     * Fixed some warnings and made nice with the CPAN version extractor.

Modified: branches/upstream/librose-db-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/META.yml?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/META.yml (original)
+++ branches/upstream/librose-db-perl/current/META.yml Thu May 29 10:56:19 2008
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                Rose-DB
-version:             0.743
+version:             0.744
 abstract:            ~
 license:             ~
 author:              ~

Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB.pm
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/lib/Rose/DB.pm?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB.pm Thu May 29 10:56:19 2008
@@ -20,7 +20,7 @@
 
 our $Error;
 
-our $VERSION = '0.743';
+our $VERSION = '0.744';
 
 our $Debug = 0;
 
@@ -2123,6 +2123,11 @@
     else
     {
       eval qq(require $rosedb_devinit);
+
+      if($rosedb_devinit->can('fixup'))
+      {
+        $rosedb_devinit->fixup($class);
+      }
     }
   }
 
@@ -2131,7 +2136,18 @@
     my $username = lc getpwuid($<);
     $rosedb_devinit = "Rose::DB::Devel::Init::$username";
     eval qq(require $rosedb_devinit);
-    eval { do $rosedb_devinit }  if($@);
+
+    if($@)
+    {
+      eval { do $rosedb_devinit };
+    }
+    else
+    {
+      if($rosedb_devinit->can('fixup'))
+      {
+        $rosedb_devinit->fixup($class);
+      }
+    }
   }
 }
 
@@ -2541,7 +2557,7 @@
 
 =head2 ROSEDB_DEVINIT
 
-The C<ROSEDB_DEVINIT> file or module is used during development, usually to set up data sources for a particular developer's database or project.  If the C<ROSEDB_DEVINIT> environment variable is set, it should be the name of a Perl module or file.
+The C<ROSEDB_DEVINIT> file or module is used during development, usually to set up data sources for a particular developer's database or project.  If the C<ROSEDB_DEVINIT> environment variable is set, it should be the name of a Perl module or file.  If it is a Perl module and that module has a C<fixup()> subroutine, it will be called as a class method after the module is loaded.
 
 If the C<ROSEDB_DEVINIT> environment variable is not set, or if the specified file does not exist or has errors, then it defaults to the package name C<Rose::DB::Devel::Init::username>, where "username" is the account name of the current user.
 

Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm?rev=20512&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 Thu May 29 10:56:19 2008
@@ -405,49 +405,49 @@
 {
   my($self, $string, $col_info) = @_;
 
-  UNDEF_OK: # Avoid undef string warnings
-  {
-    no warnings;
-    local $_ = $string;
-
-    my $pg_vers = $self->dbh->{'pg_server_version'};
-
-    # Example: q(B'00101'::"bit")
-    if(/^B'([01]+)'::(?:bit|"bit")$/ && $col_info->{'TYPE_NAME'} eq 'bit')
-    {
-      return $1;
-    }
-    # Example: 922337203685::bigint
-    elsif(/^(.+)::"?bigint"?$/i && $col_info->{'TYPE_NAME'} eq 'bigint')
-    {
-      return $1;
-    }
-    # Example: 'value'::character varying
-    # Example: ('now'::text)::timestamp(0)
-    elsif(/^\(*'(.*)'::.+$/)
-    {
-      my $default = $1;
-
-      # Single quotes are backslash-escaped, but Postgres 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)
-      {
-        $default =~ s/''/'/g;
-      }
-      elsif($pg_vers < 80100 && index($default, q(\')) > 0)
-      {
-        $default = $1;
-        $default =~ s/\\'/'/g;
-      }
-
-      return $default;
-    }
-    # Handle sequence-based defaults elsewhere
-    elsif(/^nextval\(/)
-    {
-      return undef;
-    }
+  no warnings 'uninitialized';
+  local $_ = $string;
+
+  my $pg_vers = $self->dbh->{'pg_server_version'};
+
+  # Example: q(B'00101'::"bit")
+  if(/^B'([01]+)'::(?:bit|"bit")$/ && $col_info->{'TYPE_NAME'} eq 'bit')
+  {
+    return $1;
+  }
+  # Example: 922337203685::bigint
+  elsif(/^(.+)::"?bigint"?$/i && $col_info->{'TYPE_NAME'} eq 'bigint')
+  {
+    return $1;
+  }
+  # TODO: http://rt.cpan.org/Ticket/Display.html?id=35462
+  # Example: '{foo,"\\"bar,",baz}'::text[]
+  # ...
+  # Example: 'value'::character varying
+  # Example: ('now'::text)::timestamp(0)
+  elsif(/^\(*'(.*)'::.+$/)
+  {
+    my $default = $1;
+
+    # Single quotes are backslash-escaped, but Postgres 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)
+    {
+      $default =~ s/''/'/g;
+    }
+    elsif($pg_vers < 80100 && index($default, q(\')) > 0)
+    {
+      $default = $1;
+      $default =~ s/\\'/'/g;
+    }
+
+    return $default;
+  }
+  # Handle sequence-based defaults elsewhere
+  elsif(/^nextval\(/)
+  {
+    return undef;
   }
 
   return $string;

Modified: branches/upstream/librose-db-perl/current/t/00-warning.t
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/t/00-warning.t?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/00-warning.t (original)
+++ branches/upstream/librose-db-perl/current/t/00-warning.t Thu May 29 10:56:19 2008
@@ -72,23 +72,26 @@
 EOF
 }
 
-my %old;
+unless($ENV{'AUTOMATED_TESTING'})
+{
+  my %old;
 
-$old{'ALRM'} = $SIG{'ALRM'} || 'DEFAULT';
+  $old{'ALRM'} = $SIG{'ALRM'} || 'DEFAULT';
 
-eval
-{
-  # Localize so I only have to restore in my catch block
-  local $SIG{'ALRM'} = sub { die 'alarm' };
-  alarm(60);
-  my $res = <STDIN>;
-  alarm(0);
-};
+  eval
+  {
+    # Localize so I only have to restore in my catch block
+    local $SIG{'ALRM'} = sub { die 'alarm' };
+    alarm(60);
+    my $res = <STDIN>;
+    alarm(0);
+  };
 
-if($@ =~ /alarm/)
-{
-  $SIG{'ALRM'} = $old{'ALRM'};
-}    
+  if($@ =~ /alarm/)
+  {
+    $SIG{'ALRM'} = $old{'ALRM'};
+  }
+}
 
 print "1..1\n",
       "ok 1\n";

Modified: branches/upstream/librose-db-perl/current/t/lib/My/FixUp.pm
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/t/lib/My/FixUp.pm?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/lib/My/FixUp.pm (original)
+++ branches/upstream/librose-db-perl/current/t/lib/My/FixUp.pm Thu May 29 10:56:19 2008
@@ -1,5 +1,14 @@
+package My::FixUp;
+
+sub fixup
+{
+  My::DB->modify_db(domain => 'otherdomain',
+                    type   => 'othertype',
+                    port   => 456);
+}
+
 My::DB->modify_db(domain => 'otherdomain',
                   type   => 'othertype',
-                  port   => 456);
+                  port   => 789);
 
 1;

Modified: branches/upstream/librose-db-perl/current/t/setup.t
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/t/setup.t?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/setup.t (original)
+++ branches/upstream/librose-db-perl/current/t/setup.t Thu May 29 10:56:19 2008
@@ -20,4 +20,12 @@
 $entry = My::DB->registry->entry(domain => 'otherdomain', type => 'othertype');
 
 is($entry->host, 'othervalue', 'ROSEDBRC 2');
-is($entry->port, '456', 'ROSEDB_DEVINIT 1');
+
+if($ENV{'ROSEDB_DEVINIT'} eq 'My::FixUp')
+{
+  is($entry->port, '456', 'ROSEDB_DEVINIT 1');
+}
+else
+{
+  is($entry->port, '789', 'ROSEDB_DEVINIT 1');
+}

Modified: branches/upstream/librose-db-perl/current/t/sqlite.t
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/t/sqlite.t?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/sqlite.t (original)
+++ branches/upstream/librose-db-perl/current/t/sqlite.t Thu May 29 10:56:19 2008
@@ -7,7 +7,11 @@
 BEGIN
 {
   require Test::More;
-  eval { require DBD::SQLite };
+  eval
+  {
+    local $^W = 0;
+    require DBD::SQLite;
+  };
 
   if($@ || $DBD::SQLite::VERSION < 1.08 || $ENV{'RDBO_NO_SQLITE'})
   {
@@ -172,9 +176,9 @@
 if((! -e '/tmp/rdbo_does_not_exist.db') || unlink('/tmp/rdbo_does_not_exist.db'))
 {
   $db = Rose::DB->new('nonesuch');
-  
+
   eval { $db->connect };
-  
+
   ok($@ =~ /^Refus/, 'nonesuch database');
 }
 else

Modified: branches/upstream/librose-db-perl/current/t/subclass-sqlite.t
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/t/subclass-sqlite.t?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/subclass-sqlite.t (original)
+++ branches/upstream/librose-db-perl/current/t/subclass-sqlite.t Thu May 29 10:56:19 2008
@@ -7,7 +7,11 @@
 BEGIN
 {
   require Test::More;
-  eval { require DBD::SQLite };
+  eval
+  {
+    local $^W = 0;
+    require DBD::SQLite;
+  };
 
   if($@ || $DBD::SQLite::VERSION < 1.08 || $ENV{'RDBO_NO_SQLITE'})
   {
@@ -172,9 +176,9 @@
 if((! -e '/tmp/rdbo_does_not_exist.db') || unlink('/tmp/rdbo_does_not_exist.db'))
 {
   $db = My::DB2->new('nonesuch');
-  
+
   eval { $db->connect };
-  
+
   ok($@ =~ /^Refus/, 'nonesuch database');
 }
 else

Modified: branches/upstream/librose-db-perl/current/t/test-lib.pl
URL: http://svn.debian.org/wsvn/branches/upstream/librose-db-perl/current/t/test-lib.pl?rev=20512&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/t/test-lib.pl (original)
+++ branches/upstream/librose-db-perl/current/t/test-lib.pl Thu May 29 10:56:19 2008
@@ -177,7 +177,11 @@
   # SQLite
   #
 
-  eval { require DBD::SQLite };
+  eval
+  {
+    local $^W = 0;
+    require DBD::SQLite;
+  };
 
   my $version = $DBD::SQLite::VERSION || 0;
 




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