r38245 - in /trunk/libdbi-perl: Changes DBI.pm DBI.xs Driver.xst MANIFEST META.yml TASKS.pod TODO_gofer.txt debian/changelog 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:50:18 UTC 2009
Author: jawnsy-guest
Date: Thu Jun 18 23:50:13 2009
New Revision: 38245
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38245
Log:
New upstream release
-> Various bug fixes, especially for DBD::File
Added:
trunk/libdbi-perl/TODO_gofer.txt
Modified:
trunk/libdbi-perl/Changes
trunk/libdbi-perl/DBI.pm
trunk/libdbi-perl/DBI.xs
trunk/libdbi-perl/Driver.xst
trunk/libdbi-perl/MANIFEST
trunk/libdbi-perl/META.yml
trunk/libdbi-perl/TASKS.pod
trunk/libdbi-perl/debian/changelog
trunk/libdbi-perl/lib/DBD/File.pm
trunk/libdbi-perl/lib/DBI/ProxyServer.pm
trunk/libdbi-perl/t/40profile.t
trunk/libdbi-perl/t/41prof_dump.t
trunk/libdbi-perl/t/42prof_data.t
trunk/libdbi-perl/t/72childhandles.t
trunk/libdbi-perl/t/80proxy.t
trunk/libdbi-perl/t/85gofer.t
Modified: trunk/libdbi-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/Changes?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/Changes (original)
+++ trunk/libdbi-perl/Changes Thu Jun 18 23:50:13 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: trunk/libdbi-perl/DBI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/DBI.pm?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/DBI.pm (original)
+++ trunk/libdbi-perl/DBI.pm Thu Jun 18 23:50:13 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: trunk/libdbi-perl/DBI.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/DBI.xs?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/DBI.xs (original)
+++ trunk/libdbi-perl/DBI.xs Thu Jun 18 23:50:13 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: trunk/libdbi-perl/Driver.xst
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/Driver.xst?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/Driver.xst (original)
+++ trunk/libdbi-perl/Driver.xst Thu Jun 18 23:50:13 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: trunk/libdbi-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/MANIFEST?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/MANIFEST (original)
+++ trunk/libdbi-perl/MANIFEST Thu Jun 18 23:50:13 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: trunk/libdbi-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/META.yml?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/META.yml (original)
+++ trunk/libdbi-perl/META.yml Thu Jun 18 23:50:13 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: trunk/libdbi-perl/TASKS.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/TASKS.pod?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/TASKS.pod (original)
+++ trunk/libdbi-perl/TASKS.pod Thu Jun 18 23:50:13 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: trunk/libdbi-perl/TODO_gofer.txt
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/TODO_gofer.txt?rev=38245&op=file
==============================================================================
--- trunk/libdbi-perl/TODO_gofer.txt (added)
+++ trunk/libdbi-perl/TODO_gofer.txt Thu Jun 18 23:50:13 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: trunk/libdbi-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/debian/changelog?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/debian/changelog (original)
+++ trunk/libdbi-perl/debian/changelog Thu Jun 18 23:50:13 2009
@@ -1,8 +1,12 @@
-libdbi-perl (1.608-2) UNRELEASED; urgency=low
-
+libdbi-perl (1.609-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ -> Various bug fixes, especially for DBD::File
+
+ [ Nathan Handler ]
* debian/watch: Update to ignore development releases.
- -- Nathan Handler <nhandler at ubuntu.com> Sat, 06 Jun 2009 01:33:45 +0000
+ -- Jonathan Yu <frequency at cpan.org> Thu, 18 Jun 2009 15:46:27 -0400
libdbi-perl (1.608-1) unstable; urgency=low
Modified: trunk/libdbi-perl/lib/DBD/File.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/lib/DBD/File.pm?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/lib/DBD/File.pm (original)
+++ trunk/libdbi-perl/lib/DBD/File.pm Thu Jun 18 23:50:13 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: trunk/libdbi-perl/lib/DBI/ProxyServer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/lib/DBI/ProxyServer.pm?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/lib/DBI/ProxyServer.pm (original)
+++ trunk/libdbi-perl/lib/DBI/ProxyServer.pm Thu Jun 18 23:50:13 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: trunk/libdbi-perl/t/40profile.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/t/40profile.t?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/t/40profile.t (original)
+++ trunk/libdbi-perl/t/40profile.t Thu Jun 18 23:50:13 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: trunk/libdbi-perl/t/41prof_dump.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/t/41prof_dump.t?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/t/41prof_dump.t (original)
+++ trunk/libdbi-perl/t/41prof_dump.t Thu Jun 18 23:50:13 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: trunk/libdbi-perl/t/42prof_data.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/t/42prof_data.t?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/t/42prof_data.t (original)
+++ trunk/libdbi-perl/t/42prof_data.t Thu Jun 18 23:50:13 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: trunk/libdbi-perl/t/72childhandles.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/t/72childhandles.t?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/t/72childhandles.t (original)
+++ trunk/libdbi-perl/t/72childhandles.t Thu Jun 18 23:50:13 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: trunk/libdbi-perl/t/80proxy.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/t/80proxy.t?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/t/80proxy.t (original)
+++ trunk/libdbi-perl/t/80proxy.t Thu Jun 18 23:50:13 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: trunk/libdbi-perl/t/85gofer.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbi-perl/t/85gofer.t?rev=38245&op=diff
==============================================================================
--- trunk/libdbi-perl/t/85gofer.t (original)
+++ trunk/libdbi-perl/t/85gofer.t Thu Jun 18 23:50:13 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