r38243 - in /branches/upstream/libdbi-perl/current: Changes DBI.pm DBI.xs Driver.xst MANIFEST META.yml TASKS.pod TODO_gofer.txt lib/DBD/File.pm lib/DBI/ProxyServer.pm t/40profile.t t/41prof_dump.t t/42prof_data.t t/72childhandles.t t/80proxy.t t/85gofer.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Thu Jun 18 23:45:38 UTC 2009


Author: jawnsy-guest
Date: Thu Jun 18 23:45:33 2009
New Revision: 38243

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38243
Log:
[svn-upgrade] Integrating new upstream version, libdbi-perl (1.609)

Added:
    branches/upstream/libdbi-perl/current/TODO_gofer.txt
Modified:
    branches/upstream/libdbi-perl/current/Changes
    branches/upstream/libdbi-perl/current/DBI.pm
    branches/upstream/libdbi-perl/current/DBI.xs
    branches/upstream/libdbi-perl/current/Driver.xst
    branches/upstream/libdbi-perl/current/MANIFEST
    branches/upstream/libdbi-perl/current/META.yml
    branches/upstream/libdbi-perl/current/TASKS.pod
    branches/upstream/libdbi-perl/current/lib/DBD/File.pm
    branches/upstream/libdbi-perl/current/lib/DBI/ProxyServer.pm
    branches/upstream/libdbi-perl/current/t/40profile.t
    branches/upstream/libdbi-perl/current/t/41prof_dump.t
    branches/upstream/libdbi-perl/current/t/42prof_data.t
    branches/upstream/libdbi-perl/current/t/72childhandles.t
    branches/upstream/libdbi-perl/current/t/80proxy.t
    branches/upstream/libdbi-perl/current/t/85gofer.t

Modified: branches/upstream/libdbi-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/Changes?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/Changes (original)
+++ branches/upstream/libdbi-perl/current/Changes Thu Jun 18 23:45:33 2009
@@ -2,57 +2,26 @@
 
 DBI::Changes - List of significant changes to the DBI
 
-(As of $Date: 2009-05-05 12:10:59 +0100 (Tue, 05 May 2009) $ $Revision: 12742 $)
+(As of $Date: 2009-06-08 11:07:26 +0100 (Mon, 08 Jun 2009) $ $Revision: 12816 $)
 
 =cut
 
-Assorted TODO notes:
-
-General:
-    Protect trace_msg from SIGPIPE?
-    prepare(...,{ Err=>\my $isolated_err, ...})
-    Add trace modules that just records the last N trace messages into an array
-    and prepends them to any error message.
-    Document DBI_PROFILE_FLOCK and LockFile attrib in DBI::ProfileData and DBI::ProfileDumper
-Performance:
-    Move _new_sth to DBI::db::_new_sth (leave alias) and implement in C
-        Or call _new_child and move to DBI::common?
-    Implement FETCH_many() in C
-
-Gofer TODOs:
-
-Add server-side caching.
-    combine these:
-        my $request = $transport->thaw_request( $frozen_request, $serializer );
-        my $response = $executor->execute_request( $request );
-        my $frozen_response = $transport->freeze_response($response, $serializer);
-    into single method that first checks the cache and updates it if appropriate.
-    Different serializations will have different caches
-
-Add DBI::Gofer::Serialiser::MIME / Base64
-Add DBI::Gofer::Serialiser::JSON
-
-Gofer - allow dbh attrib changes after connect?
-    note them and pass in request as STORE method calls
-    but then gofer server need to reset them to restore dbh to original state
-    Or, change the attr in the connect() call, but that risks
-    bloating the number of cache dbh in the server.
-Gofer request flags for:
-    - return current executor stats as an attribute - handy for tests
-    - will accept streamed resultsets
-Add attr-passthru to prepare()? ie for gofer cache control & ReadOnly
-Define and document terminology for client and server ends
-Document user/passwd issues at the various levels of the gofer stack
-    Remove "Password" from connect attr if the same as $password arg
-Extract policy settings by parsing the pod
-Policy for dbh attr FETCH (ie example_driver_path)
-    or piggyback on skip_connect_check
-    could also remember which attr have been returned to us
-    so not bother FETCHing them (unless pedantic)
-Call method on transport failure so transport can cleanup/reset if it wants
-Gofer: gearman - need to disable coallesing for non-idempotent requests
-
-Add high-res time for windows - via Time::HiRes glob replace dbi_time().
+=head2 Changes in DBI 1.609 (svn r12816) 8th June 2009
+
+  Fixes to DBD::File (H.Merijn Brand)
+    added f_schema attribute
+    table names case sensitive when quoted, insensitive when unquoted
+    workaround a bug in SQL::Statement (temporary fix) related
+      to the "You passed x parameters where y required" error
+
+  Added ImplementorClass and Name info to the "Issuing rollback() due to
+    DESTROY without explicit disconnect" warning to identify the handle.
+    Applies to compiled drivers when they are recompiled.
+  Added DBI->visit_handles($coderef) method.
+  Added $h->visit_child_handles($coderef) method.
+  Added docs for column_info()'s COLUMN_DEF value.
+  Clarified docs on stickyness of data type via bind_param().
+  Clarified docs on stickyness of data type via bind_col().
 
 =head2 Changes in DBI 1.608 (svn r12742) 5th May 2009
 

Modified: branches/upstream/libdbi-perl/current/DBI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/DBI.pm?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/DBI.pm (original)
+++ branches/upstream/libdbi-perl/current/DBI.pm Thu Jun 18 23:45:33 2009
@@ -1,7 +1,7 @@
-# $Id: DBI.pm 12742 2009-05-05 11:10:59Z timbo $
+# $Id: DBI.pm 12812 2009-06-05 22:34:47Z timbo $
 # vim: ts=8:sw=4:noet
 #
-# Copyright (c) 1994-2008  Tim Bunce  Ireland
+# Copyright (c) 1994-2009  Tim Bunce  Ireland
 #
 # See COPYRIGHT section in pod text below for usage and distribution rights.
 #
@@ -9,7 +9,7 @@
 require 5.006_00;
 
 BEGIN {
-$DBI::VERSION = "1.608"; # ==> ALSO update the version in the pod text below!
+$DBI::VERSION = "1.609"; # ==> ALSO update the version in the pod text below!
 }
 
 =head1 NAME
@@ -121,8 +121,8 @@
 
 =head2 NOTES
 
-This is the DBI specification that corresponds to the DBI version 1.608
-($Revision: 12742 $).
+This is the DBI specification that corresponds to the DBI version 1.609
+($Revision: 12812 $).
 
 The DBI is evolving at a steady pace, so it's good to check that
 you have the latest copy.
@@ -399,6 +399,7 @@
 	trace_msg	=> { U =>[2,3,'$message_text [, $min_level ]' ],	O=>0x0004, T=>8 },
 	swap_inner_handle => { U =>[2,3,'$h [, $allow_reparent ]'] },
         private_attribute_info => { },
+        visit_child_handles => { U => [2,3,'$coderef [, $info ]'], O=>0x0404, T=>4 },
     },
     dr => {		# Database Driver Interface
 	'connect'  =>	{ U =>[1,5,'[$db [,$user [,$passwd [,\%attr]]]]'], H=>3, O=>0x8000 },
@@ -532,6 +533,18 @@
     $driver ||= $ENV{DBI_DRIVER} || '';
     $attr_hash = { split /\s*=>?\s*|\s*,\s*/, $attr, -1 } if $attr;
     return ($scheme, $driver, $attr, $attr_hash, $dsn);
+}
+
+sub visit_handles {
+    my ($class, $code, $outer_info) = @_;
+    $outer_info = {} if not defined $outer_info;
+    my %drh = DBI->installed_drivers;
+    for my $h (values %drh) {
+	my $child_info = $code->($h, $outer_info)
+	    or next;
+	$h->visit_child_handles($code, $child_info);
+    }
+    return $outer_info;
 }
 
 
@@ -1399,6 +1412,17 @@
         return undef;
     }
 
+    sub visit_child_handles {
+	my ($h, $code, $info) = @_;
+	$info = {} if not defined $info;
+	for my $ch (@{ $h->{ChildHandles} || []}) {
+	    next unless $ch;
+	    my $child_info = $code->($ch, $info)
+		or next;
+	    $ch->visit_child_handles($code, $child_info);
+	}
+	return $info;
+    }
 }
 
 
@@ -2860,6 +2884,31 @@
 tracing facilities.
 
 
+=head3 C<visit_handles>
+
+  DBI->visit_handles( $coderef );
+  DBI->visit_handles( $coderef, $info );
+
+Where $coderef is a reference to a subroutine and $info is an arbitrary value
+which, if undefined, defaults to a reference to an empty hash. Returns $info.
+
+For each installed driver handle, if any, $coderef is invoked as:
+
+  $coderef->($driver_handle, $info);
+
+If the execution of $coderef returns a true value then L</visit_child_handles>
+is called on that child handle and passed the returned value as $info.
+
+For example:
+
+  my $info = $dbh->{Driver}->visit_child_handles(sub {
+      my ($h, $info) = @_;
+      ++$info->{ $h->{Type} }; # count types of handles (dr/db/st)
+      return $info; # visit kids
+  });
+
+See also L</visit_child_handles>.
+
 
 =head2 DBI Utility Functions
 
@@ -3327,6 +3376,32 @@
             dbh1o -> dbh2i
             sthAo -> sthBi(dbh2i)
 
+=head3 C<visit_child_handles>
+
+  $h->visit_child_handles( $coderef );
+  $h->visit_child_handles( $coderef, $info );
+
+Where $coderef is a reference to a subroutine and $info is an arbitrary value
+which, if undefined, defaults to a reference to an empty hash. Returns $info.
+
+For each child handle of $h, if any, $coderef is invoked as:
+
+  $coderef->($child_handle, $info);
+
+If the execution of $coderef returns a true value then C<visit_child_handles>
+is called on that child handle and passed the returned value as $info.
+
+For example:
+
+  # count database connections with names (DSN) matching a pattern
+  my $connections = 0;
+  $dbh->{Driver}->visit_child_handles(sub {
+      my ($h, $info) = @_;
+      ++$connections if $h->{Name} =~ /foo/;
+      return 0; # don't visit kids
+  })
+
+See also L</visit_handles>.
 
 =head1 ATTRIBUTES COMMON TO ALL HANDLES
 
@@ -4611,7 +4686,23 @@
 
 B<REMARKS>: A description of the column.
 
-B<COLUMN_DEF>: The default value of the column.
+B<COLUMN_DEF>: The default value of the column, in a format that can be used
+directly in an SQL statement.
+
+Note that this may be an expression and not simply the text used for the
+default value in the original CREATE TABLE statement. For example, given:
+
+    col1 char(30) default current_user    -- a 'function'
+    col2 char(30) default 'string'        -- a string literal
+
+where "current_user" is the name of a function, the corresponding C<COLUMN_DEF>
+values would be:
+
+    Database        col1                     col2
+    --------        ----                     ----
+    Oracle:         current_user             'string'
+    Postgres:       "current_user"()         'string'::text
+    MS SQL:         (user_name())            ('string')
 
 B<SQL_DATA_TYPE>: The SQL data type.
 
@@ -5474,11 +5565,10 @@
 
 See L</"DBI Constants"> for more information.
 
-The data type for a placeholder cannot be changed after the first
-C<bind_param> call. In fact the whole \%attr parameter is 'sticky'
-in the sense that a driver only needs to consider the \%attr parameter
-for the first call, for a given $sth and parameter. After that the driver
-may ignore the \%attr parameter for that placeholder.
+The data type is 'sticky' in that bind values passed to execute() are bound
+with the data type specified by earlier bind_param() calls, if any.
+Portable applications should not rely on being able to change the data type
+after the first C<bind_param> call.
 
 Perl only has string and number scalar data types. All database types
 that aren't numbers are bound as strings and must be in a format the
@@ -6133,7 +6223,7 @@
 native formatting the database would normally use.
 
 There's no $var_to_bind in that example to emphasize the point
-that bind_col() works on the underlying column value and not just
+that bind_col() works on the underlying column and not just
 a particular bound variable.
 
 As a short-cut for the common case, the data type can be passed
@@ -6152,10 +6242,9 @@
 
 See L</"DBI Constants"> for more information.
 
-The data type for a bind variable cannot be changed after the first
-C<bind_col> call. In fact the whole \%attr parameter is 'sticky'
-in the sense that a driver only needs to consider the \%attr parameter
-for the first call for a given $sth and column.
+Few drivers support specifying a data type via a C<bind_col> call (most will
+simply ignore the data type). Fewer still allow the data type to be altered
+once set.
 
 The TYPE attribute for bind_col() was first specified in DBI 1.41.
 
@@ -7543,11 +7632,11 @@
 
 =head1 COPYRIGHT
 
-The DBI module is Copyright (c) 1994-2008 Tim Bunce. Ireland.
+The DBI module is Copyright (c) 1994-2009 Tim Bunce. Ireland.
 All rights reserved.
 
 You may distribute under the terms of either the GNU General Public
-License or the Artistic License, as specified in the Perl README file.
+License or the Artistic License, as specified in the Perl 5.10.0 README file.
 
 =head1 SUPPORT / WARRANTY
 

Modified: branches/upstream/libdbi-perl/current/DBI.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/DBI.xs?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/DBI.xs (original)
+++ branches/upstream/libdbi-perl/current/DBI.xs Thu Jun 18 23:45:33 2009
@@ -1,6 +1,6 @@
 /* vim: ts=8:sw=4
  *
- * $Id: DBI.xs 12559 2009-03-02 11:14:07Z timbo $
+ * $Id: DBI.xs 12810 2009-06-05 22:13:00Z timbo $
  *
  * Copyright (c) 1994-2003  Tim Bunce  Ireland.
  *
@@ -111,7 +111,7 @@
 #define IMA_NO_TAINT_IN   	0x0010	/* don't check for tainted args	*/
 #define IMA_NO_TAINT_OUT   	0x0020	/* don't taint results		*/
 #define IMA_COPY_UP_STMT   	0x0040	/* copy sth Statement to dbh	*/
-#define IMA_END_WORK	   	0x0080	/* set on commit & rollback	*/
+#define IMA_END_WORK	   	0x0080	/* method is commit or rollback	*/
 #define IMA_STUB		0x0100	/* donothing eg $dbh->connected */
 #define IMA_CLEAR_STMT   	0x0200	/* clear Statement before call	*/
 #define IMA_UNRELATED_TO_STMT	0x0400	/* profile as empty Statement	*/

Modified: branches/upstream/libdbi-perl/current/Driver.xst
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/Driver.xst?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/Driver.xst (original)
+++ branches/upstream/libdbi-perl/current/Driver.xst Thu Jun 18 23:45:33 2009
@@ -1,4 +1,4 @@
-#  $Id: Driver.xst 11723 2008-09-02 10:09:51Z mjevans $
+#  $Id: Driver.xst 12816 2009-06-08 10:07:26Z timbo $
 #  Copyright (c) 1997-2002  Tim Bunce  Ireland
 #  Copyright (c) 2002       Jonathan Leffler
 #
@@ -366,16 +366,16 @@
                     This will be harmless if the application has issued a commit,
                     XXX Could add an attribute flag to indicate that the driver
                     doesn't have this problem. Patches welcome.
-                    XXX or could just move the DBIc_is(imp_dbh, DBIcf_Executed) test
-                    to cover the rollback as well. That just needs sanity checking
-                    that DBIcf_Executed is set by any/all possible way to execute a
-                    statement that might start a transaction.
                 */
                 if (DBIc_WARN(imp_dbh)
                 &&  DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
                 && (!dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
-                )
-                     warn("Issuing rollback() for database handle being DESTROY'd without explicit disconnect()");
+                ) {
+                    warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
+                        SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
+                        SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
+                    );
+                }
                 dbd_db_rollback(dbh, imp_dbh);                  /* ROLLBACK! */
             }
             dbd_db_disconnect(dbh, imp_dbh);

Modified: branches/upstream/libdbi-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/MANIFEST?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/MANIFEST (original)
+++ branches/upstream/libdbi-perl/current/MANIFEST Thu Jun 18 23:45:33 2009
@@ -11,6 +11,7 @@
 Roadmap.pod			Planned changes and enhancements for the DBI
 TASKS.pod                       Want to help? These things need doing...
 TODO_2005.txt			Old (but still mostly relevant) occasional random notes about what's missing
+TODO_gofer.txt                  To-do notes related to gofer
 dbd_xsh.h			Prototypes for standard Driver.xst interface
 dbi_sql.h			Definitions based on SQL CLI / ODBC (#inc'd by DBIXS.h)
 dbipport.h			Perl portability macros (from Devel::PPort)

Modified: branches/upstream/libdbi-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/META.yml?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/META.yml (original)
+++ branches/upstream/libdbi-perl/current/META.yml Thu Jun 18 23:45:33 2009
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                DBI
-version:             1.608
+version:             1.609
 abstract:            Database independent interface for Perl
 license:             perl
 author:              

Modified: branches/upstream/libdbi-perl/current/TASKS.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/TASKS.pod?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/TASKS.pod (original)
+++ branches/upstream/libdbi-perl/current/TASKS.pod Thu Jun 18 23:45:33 2009
@@ -33,4 +33,23 @@
 Naturally I'll offer direction and guidance on any you want to tackle.
 I've also got a few that could be entered into rt.cpan.org.
 
+=head2 Others
+
+General:
+
+    Protect trace_msg from SIGPIPE?
+    prepare(...,{ Err=>\my $isolated_err, ...})
+    Add trace module that just records the last N trace messages into an array
+        and prepends them to any error message to provide context for the error.
+    Document DBI_PROFILE_FLOCK and LockFile attrib in DBI::ProfileData and DBI::ProfileDumper
+
+Performance:
+
+    Move _new_sth to DBI::db::_new_sth (leave alias) and implement in C
+        Or call _new_child and move to DBI::common?
+
+    Implement FETCH_many() in C
+
+    Add high-res dbi_time for windows - via Time::HiRes glob replace dbi_time()?
+
 =cut

Added: branches/upstream/libdbi-perl/current/TODO_gofer.txt
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/TODO_gofer.txt?rev=38243&op=file
==============================================================================
--- branches/upstream/libdbi-perl/current/TODO_gofer.txt (added)
+++ branches/upstream/libdbi-perl/current/TODO_gofer.txt Thu Jun 18 23:45:33 2009
@@ -1,0 +1,56 @@
+Gofer TODOs:
+
+DBD::Gofer and http transport changes
+add comparisons with other proxies to gofer docs (see notes)
+    http://code.google.com/p/mod-ndb/
+    http://code.nytimes.com/projects/dbslayer
+update gofer pdf in distribution
+talk about multiple statements in single sql for gofer
+inbalance between two calls to _store_response_in_cache
+    - the call in transmit_request doesn't have the response_needs_retransmit logic
+
+Add server-side caching.
+    combine these:
+        my $request = $transport->thaw_request( $frozen_request, $serializer );
+        my $response = $executor->execute_request( $request );
+        my $frozen_response = $transport->freeze_response($response, $serializer);
+    into single method that first checks the cache and updates it if appropriate.
+    Different serializations will have different caches
+
+Add DBI::Gofer::Serialiser::MIME / Base64
+Add DBI::Gofer::Serialiser::JSON
+
+Gofer - allow dbh attrib changes after connect?
+    note them and pass in request as STORE method calls
+    but then gofer server need to reset them to restore dbh to original state
+    Or, change the attr in the connect() call, but that risks
+    bloating the number of cache dbh in the server.
+Gofer request flags for:
+    - return current executor stats as an attribute - handy for tests
+    - will accept streamed resultsets
+Add attr-passthru to prepare()? ie for gofer cache control & ReadOnly
+Define and document termind that first checks the cache and updates it if appropriate.
+    Different serializations will have different caches
+
+Add DBI::Gofer::Serialiser::MIME / Base64
+Add DBI::Gofer::Serialiser::JSON
+
+Gofer - allow dbh attrib changes after connect?
+    note them and pass in request as STORE method calls
+    but then gofer server need to reset them to restore dbh to original state
+    Or, change the attr in the connect() call, but that risks
+    bloating the number of cache dbh in the server.
+Gofer request flags for: 
+    - return current executor stats as an attribute - handy for tests
+    - will accept streamed resultsets
+Add attr-passthru to prepare()? ie for gofer cache control & ReadOnly
+Define and document terminology for client and server ends
+Document user/passwd issues at the various levels of the gofer stack
+    Remove "Password" from connect attr if the same as $password arg
+Extract policy settings by parsing the pod
+Policy for dbh attr FETCH (ie example_driver_path)
+    or piggyback on skip_connect_check
+    could also remember which attr have been returned to us
+    so not bother FETCHing them (unless pedantic)
+Call method on transport failure so transport can cleanup/reset if it wants
+Gofer: gearman - need to disable coallesing for non-idempotent requests

Modified: branches/upstream/libdbi-perl/current/lib/DBD/File.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/lib/DBD/File.pm?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/lib/DBD/File.pm (original)
+++ branches/upstream/libdbi-perl/current/lib/DBD/File.pm Thu Jun 18 23:45:33 2009
@@ -33,7 +33,7 @@
 
 use vars qw( @ISA $VERSION $drh $valid_attrs );
 
-$VERSION = "0.36";
+$VERSION = "0.37";
 
 $drh = undef;		# holds driver handle(s) once initialised
 
@@ -74,12 +74,9 @@
 
 sub file2table
 {
-    my ($data, $dir, $file, $file_is_tab) = @_;
+    my ($data, $dir, $file, $file_is_tab, $quoted) = @_;
 
     $file eq "." || $file eq ".."	and return;
-
-    # Fully Qualified File Name
-    my $fqfn = File::Spec->catfile ($dir, $file);
 
     my ($ext, $req) = ("", 0, 0);
     if ($data->{f_ext}) {
@@ -90,8 +87,17 @@
 	}
 
     (my $tbl = $file) =~ s/$ext$//i;
-
-    $file_is_tab && $file !~ m/$ext$/i and $fqfn .= $ext;
+    $file_is_tab and $file = "$tbl$ext";
+
+    # Fully Qualified File Name
+    my $fqfn;
+    unless ($quoted) { # table names are case insensitive in SQL
+	local *DIR;
+	opendir DIR, $dir;
+	my @f = grep { lc $_ eq lc $file } readdir DIR;
+	@f == 1 and $file = $f[0];
+	}
+    $fqfn = File::Spec->catfile ($dir, $file);
 
     $file = $fqfn;
     if ($ext) {
@@ -149,10 +155,11 @@
 		}
 	    }
         $this->{f_valid_attrs} = {
-	    f_version	=> 1,  # DBD::File version
-	    f_dir	=> 1,  # base directory
-	    f_ext	=> "", # file extension
-	    f_tables	=> 1,  # base directory
+	    f_version	=> 1, # DBD::File version
+	    f_dir	=> 1, # base directory
+	    f_ext	=> 1, # file extension
+	    f_schema	=> 1, # schema name
+	    f_tables	=> 1, # base directory
 	    };
         $this->{sql_valid_attrs} = {
 	    sql_handler           => 1, # Nano or S:S
@@ -346,7 +353,7 @@
 		return $dbh->set_err ($DBI::stderr, "No such directory '$value'")
 	    }
 	if ($attrib eq "f_ext") {
-	    $value eq "" || $value =~ m{^\.\w+(?:/[iIrR]*)?$}
+	    $value eq "" || $value =~ m{^\.\w+(?:/[rR]*)?$}
 		or carp "'$value' doesn't look like a valid file extension attribute\n";
 	    }
 	$dbh->{$attrib} = $value;
@@ -417,10 +424,12 @@
 	    }
 
 	my ($file, @tables, %names);
-	my $user = eval { getpwuid ((stat _)[4]) };
+	my $schema = exists $dbh->{f_schema}
+	    ? $dbh->{f_schema}
+	    : eval { getpwuid ((stat $dir)[4]) };
 	while (defined ($file = readdir ($dirh))) {
-	    my $tbl = DBD::File::file2table ($dbh, $dir, $file, 0) or next;
-	    push @tables, [ undef, $user, $tbl, "TABLE", undef ];
+	    my $tbl = DBD::File::file2table ($dbh, $dir, $file, 0, 0) or next;
+	    push @tables, [ undef, $schema, $tbl, "TABLE", undef ];
 	    }
 	unless (closedir $dirh) {
 	    $dbh->set_err ($DBI::stderr, "Cannot close directory $dir: $!");
@@ -541,13 +550,24 @@
 
     $sth->finish;
     my $stmt = $sth->{f_stmt};
-    unless ((my $req_prm = scalar($stmt->params())) == (my $nparm = @$params)) {
-	$sth->set_err ($DBI::stderr,
-	    "You passed $nparm parameters where $req_prm required");
-	return;
-	}
-    my $result = eval { $stmt->execute ($sth, $params); };
-    $@ and return $sth->set_err ($DBI::stderr, $@);
+    unless ($sth->{f_params_checked}++) {
+	# bug in SQL::Statement 1.20 and below causes breakage
+	# on all but the first call
+	unless ((my $req_prm = $stmt->params ()) == (my $nparm = @$params)) {
+	    my $msg = "You passed $nparm parameters where $req_prm required";
+	    $sth->set_err ($DBI::stderr, $msg);
+	    return;
+	    }
+	}
+    my @err;
+    my $result = eval {
+	local $SIG{__WARN__} = sub { push @err, @_ };
+	$stmt->execute ($sth, $params);
+	};
+    if ($@ || @err) {
+	$sth->set_err ($DBI::stderr, $@ || $err[0]);
+	return undef;
+	}
 
     if ($stmt->{NUM_OF_FIELDS}) {    # is a SELECT statement
 	$sth->STORE (Active => 1);
@@ -658,7 +678,8 @@
 sub get_file_name ($$$)
 {
     my ($self, $data, $table) = @_;
-    $table =~ s/^\"//;    # handle quoted identifiers
+    my $quoted = 0;
+    $table =~ s/^\"// and $quoted = 1;    # handle quoted identifiers
     $table =~ s/\"$//;
     my $file = $table;
     if (    $file !~ m/^$open_table_re/o
@@ -666,7 +687,8 @@
 	and $file !~ m{^[a-z]\:}    # drive letter
 	) {
 	exists $data->{Database}{f_map}{$table} or
-	    DBD::File::file2table ($data->{Database}, $data->{Database}{f_dir}, $file, 1);
+	    DBD::File::file2table ($data->{Database},
+		$data->{Database}{f_dir}, $file, 1, $quoted);
 	$file = $data->{Database}{f_map}{$table} || undef;
 	}
     return ($table, $file);
@@ -697,12 +719,10 @@
     $fh and binmode $fh;
     if ($locking and $fh) {
 	if ($lockMode) {
-	    flock $fh, 2 or
-		croak "Cannot obtain exclusive lock on $file: $!";
+	    flock $fh, 2 or croak "Cannot obtain exclusive lock on $file: $!";
 	    }
 	else {
-	    flock $fh, 1 or
-		croak "Cannot obtain shared lock on $file: $!";
+	    flock $fh, 1 or croak "Cannot obtain shared lock on $file: $!";
 	    }
 	}
     my $columns = {};
@@ -871,6 +891,34 @@
 In this case the extension is required, and all filenames that do not match
 are ignored.
 
+=item f_schema
+
+This will set the schema name. Default is the owner of the folder in which
+the table file resides.  C<undef> is allowed.
+
+    my $dbh = DBI->connect ("dbi:CSV:", "", "", {
+        f_schema => undef,
+        f_dir    => "data",
+        f_ext    => ".csv/r",
+        }) or die $DBI::errstr;
+
+The effect is that when you get table names from DBI, you can force all
+tables into the same (or no) schema:
+
+    my @tables $dbh->tables ();
+
+    # no f_schema
+    "merijn".foo
+    "merijn".bar
+
+    # f_schema => "dbi"
+    "dbi".foo
+    "dbi".bar
+
+    # f_schema => undef
+    foo
+    bar
+
 =back
 
 =head2 Driver private methods
@@ -913,7 +961,7 @@
 
 =back
 
-=head1 AUTHOR 
+=head1 AUTHOR
 
 This module is currently maintained by
 

Modified: branches/upstream/libdbi-perl/current/lib/DBI/ProxyServer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/lib/DBI/ProxyServer.pm?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/lib/DBI/ProxyServer.pm (original)
+++ branches/upstream/libdbi-perl/current/lib/DBI/ProxyServer.pm Thu Jun 18 23:45:33 2009
@@ -531,6 +531,13 @@
 
 =back
 
+=head1 SHUTDOWN
+
+DBI::ProxyServer is built on L<RPC::PlServer> which is, in turn, built on L<Net::Daemon>.
+
+You should refer to L<Net::Daemon> for how to shutdown the server, except that
+you can't because it's not currently documented there (as of v0.43).
+The bottom-line is that it seems that there's no support for graceful shutdown.
 
 =head1 CONFIGURATION FILE
 

Modified: branches/upstream/libdbi-perl/current/t/40profile.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/t/40profile.t?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/t/40profile.t (original)
+++ branches/upstream/libdbi-perl/current/t/40profile.t Thu Jun 18 23:45:33 2009
@@ -19,9 +19,18 @@
 BEGIN {
     plan skip_all => "profiling not supported for DBI::PurePerl"
         if $DBI::PurePerl;
+
     # tie methods (STORE/FETCH etc) get called different number of times
     plan skip_all => "test results assume perl >= 5.8.2"
         if $] <= 5.008001;
+
+    # clock instability on xen systems is a reasonably common cause of failure
+    # http://www.nntp.perl.org/group/perl.cpan.testers/2009/05/msg3828158.html
+    # so we'll skip automated testing on those systems
+    plan skip_all => "skipping profile tests on xen (due to clock instability)"
+        if $Config{osvers} =~ /xen/ # eg 2.6.18-4-xen-amd64
+        and $ENV{AUTOMATED_TESTING};
+
     plan tests => 60;
 }
 

Modified: branches/upstream/libdbi-perl/current/t/41prof_dump.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/t/41prof_dump.t?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/t/41prof_dump.t (original)
+++ branches/upstream/libdbi-perl/current/t/41prof_dump.t Thu Jun 18 23:45:33 2009
@@ -10,16 +10,21 @@
 # 
 
 use DBI;
-
+use Config;
 use Test::More;
 
 BEGIN {
-    if ($DBI::PurePerl) {
-        plan skip_all => 'profiling not supported for DBI::PurePerl';
-    }
-    else {
-        plan tests => 15;
-    }
+    plan skip_all => 'profiling not supported for DBI::PurePerl'
+        if $DBI::PurePerl;
+
+    # clock instability on xen systems is a reasonably common cause of failure
+    # http://www.nntp.perl.org/group/perl.cpan.testers/2009/05/msg3828158.html
+    # so we'll skip automated testing on those systems
+    plan skip_all => "skipping profile tests on xen (due to clock instability)"
+        if $Config{osvers} =~ /xen/ # eg 2.6.18-4-xen-amd64
+        and $ENV{AUTOMATED_TESTING};
+
+    plan tests => 15;
 }
 
 BEGIN {

Modified: branches/upstream/libdbi-perl/current/t/42prof_data.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/t/42prof_data.t?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/t/42prof_data.t (original)
+++ branches/upstream/libdbi-perl/current/t/42prof_data.t Thu Jun 18 23:45:33 2009
@@ -4,16 +4,21 @@
 use strict;
 
 use DBI;
-
+use Config;
 use Test::More;
 
 BEGIN {
-    if ($DBI::PurePerl) {
-        plan skip_all => 'profiling not supported for DBI::PurePerl';
-    }
-    else {
-        plan tests => 31;
-    }
+    plan skip_all => 'profiling not supported for DBI::PurePerl'
+        if $DBI::PurePerl;
+
+    # clock instability on xen systems is a reasonably common cause of failure
+    # http://www.nntp.perl.org/group/perl.cpan.testers/2009/05/msg3828158.html
+    # so we'll skip automated testing on those systems
+    plan skip_all => "skipping profile tests on xen (due to clock instability)"
+        if $Config{osvers} =~ /xen/ # eg 2.6.18-4-xen-amd64
+        and $ENV{AUTOMATED_TESTING};
+
+    plan tests => 31;
 }
 
 BEGIN {

Modified: branches/upstream/libdbi-perl/current/t/72childhandles.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/t/72childhandles.t?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/t/72childhandles.t (original)
+++ branches/upstream/libdbi-perl/current/t/72childhandles.t Thu Jun 18 23:45:33 2009
@@ -23,7 +23,7 @@
     exit 0;
 }
 
-plan tests => 14;
+plan tests => 16;
 
 my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||'') =~ /^dbi:Gofer.*transport=/i;
 
@@ -101,6 +101,38 @@
 my @live = grep { defined $_ } @$handles;
 is scalar @live, 0, "handles should be gone now";
 
+# test visit_child_handles
+{
+    my $info;
+    my $visitor = sub {
+        my ($h, $info) = @_;
+        my $type = $h->{Type};
+        ++$info->{ $type }{ ($type eq 'st') ? $h->{Statement} : $h->{Name} };
+        return $info;
+    };
+    DBI->visit_handles($visitor, $info = {});
+    is_deeply $info, {
+        'dr' => {
+            'ExampleP' => 1,
+            ($using_dbd_gofer) ? (Gofer => 1) : ()
+        },
+        'db' => { '' => 1 },
+    };
+
+    my $sth1 = $dbh->prepare('SELECT name FROM t');
+    my $sth2 = $dbh->prepare('SELECT name FROM t');
+    DBI->visit_handles($visitor, $info = {});
+    is_deeply $info, {
+        'dr' => {
+            'ExampleP' => 1,
+            ($using_dbd_gofer) ? (Gofer => 1) : ()
+        },
+        'db' => { '' => 1 },
+        'st' => { 'SELECT name FROM t' => 2 }
+    };
+
+}
+
 # test that the childhandle array does not grow uncontrollably
 SKIP: {
     skip "slow tests avoided when using DBD::Gofer", 2 if $using_dbd_gofer;

Modified: branches/upstream/libdbi-perl/current/t/80proxy.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/t/80proxy.t?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/t/80proxy.t (original)
+++ branches/upstream/libdbi-perl/current/t/80proxy.t Thu Jun 18 23:45:33 2009
@@ -109,7 +109,7 @@
 	($dbitracelevel >= 2 ? ('--debug') : ()),
 	'--mode=single',
 	'--logfile=STDERR',
-	'--timeout=60'
+	'--timeout=90'
     );
     warn " starting test dbiproxy process: @child_args\n" if DBI->trace(0);
     ($handle, $port) = Net::Daemon::Test->Child($numTests, @child_args);

Modified: branches/upstream/libdbi-perl/current/t/85gofer.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdbi-perl/current/t/85gofer.t?rev=38243&op=diff
==============================================================================
--- branches/upstream/libdbi-perl/current/t/85gofer.t (original)
+++ branches/upstream/libdbi-perl/current/t/85gofer.t Thu Jun 18 23:45:33 2009
@@ -46,7 +46,7 @@
 }
 my $remote_driver_dsn = "dbm_type=$opt_dbm;lockfile=0";
 my $remote_dsn = "dbi:DBM:$remote_driver_dsn";
-my $timeout = 90; # for slow/overloaded systems (incl virtual machines with low priority)
+my $timeout = 120; # for slow/overloaded systems (incl virtual machines with low priority)
 
 plan 'no_plan';
 




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