Hello community,
here is the log from the commit of package perl-DBI
checked in at Mon Oct 8 12:26:57 CEST 2007.
--------
--- perl-DBI/perl-DBI.changes 2007-07-03 08:59:38.000000000 +0200
+++ /mounts/work_src_done/STABLE/perl-DBI/perl-DBI.changes 2007-10-08 10:22:15.000000000 +0200
@@ -1,0 +2,7 @@
+Mon Oct 8 10:21:26 CEST 2007 - anicka@suse.cz
+
+- update to 1.59
+ * Added check_response_sub to DBI::Gofer::Execute
+ * bugfixes. test fixes
+
+-------------------------------------------------------------------
Old:
----
DBI-1.58.tar.bz2
perl-DBI-1.58-dbis.diff
New:
----
DBI-1.59.tar.bz2
perl-DBI-1.59-dbis.diff
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-DBI.spec ++++++
--- /var/tmp/diff_new_pack.QT4849/_old 2007-10-08 12:26:49.000000000 +0200
+++ /var/tmp/diff_new_pack.QT4849/_new 2007-10-08 12:26:49.000000000 +0200
@@ -1,5 +1,5 @@
#
-# spec file for package perl-DBI (Version 1.58)
+# spec file for package perl-DBI (Version 1.59)
#
# Copyright (c) 2007 SUSE LINUX Products GmbH, Nuernberg, Germany.
# This file and all modifications and additions to the pristine
@@ -12,16 +12,16 @@
Name: perl-DBI
BuildRequires: perl-Curses
-Version: 1.58
+Version: 1.59
Release: 1
Requires: perl = %{perl_version}
Requires: perl-PlRPC
Provides: perl_dbi DBI
Obsoletes: perl_dbi
-Autoreqprov: on
+AutoReqProv: on
Group: Development/Libraries/Perl
License: GPL v2 or later
-URL: http://cpan.org/modules/by-module/DBI/
+Url: http://cpan.org/modules/by-module/DBI/
Summary: The Perl Database Interface
Source: DBI-%{version}.tar.bz2
Patch: %{name}-%{version}-dbis.diff
@@ -51,7 +51,6 @@
%install
%perl_make_install
%perl_process_packlist
-rm $RPM_BUILD_ROOT/%{perl_vendorarch}/goferperf.pl
%clean
rm -rf $RPM_BUILD_ROOT
@@ -71,8 +70,11 @@
%{perl_vendorarch}/dbixs_rev.pl
%{_bindir}/*
/var/adm/perl-modules/%{name}
-
%changelog
+* Mon Oct 08 2007 - anicka@suse.cz
+- update to 1.59
+ * Added check_response_sub to DBI::Gofer::Execute
+ * bugfixes. test fixes
* Tue Jul 03 2007 - anicka@suse.cz
- update to 1.58
* Fixed code triggering fatal error in bleadperl
++++++ DBI-1.58.tar.bz2 -> DBI-1.59.tar.bz2 ++++++
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/Changes new/DBI-1.59/Changes
--- old/DBI-1.58/Changes 2007-06-25 23:49:05.000000000 +0200
+++ new/DBI-1.59/Changes 2007-08-23 15:39:13.000000000 +0200
@@ -2,23 +2,33 @@
DBI::Changes - List of significant changes to the DBI
-(As of $Date: 2007-06-25 22:49:03 +0100 (Mon, 25 Jun 2007) $ $Revision: 9678 $)
+(As of $Date: 2007-08-23 14:39:12 +0100 (Thu, 23 Aug 2007) $ $Revision: 9874 $)
=cut
Assorted TODO notes:
Protect trace_msg from SIGPIPE?
+prepare(...,{ Err=>\my $isolated_err, ...})
+Move _new_sth to DBI::db::_new_sth (leave alias) and implement in C
+Implement FETCH_many() in C
+Or call _new_child and move to DBI::common?
+Add trace modules that just records the last N trace messages into an array
+and prepends them to any error message.
-Add count of identical frozen_request (plus sum(results size)) to Gofer status
-Highlight those seen before.
+Gofo TODOs:
+Add count of identical frozen_request (plus sum(results size)) to Gofer status
+ Highlight those seen before.
Move post-request cleanup into separate method and enable hooks so
it can be done after the response has been sent
-
+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:
return current executor stats as an attribute - handy for tests
- only fetch one result set - handy for Sybase/MSSQL users
will accept streamed resultsets
Add attr-passthru to prepare()? ie for gofer cache control & ReadOnly
Terminology for client and server ends
@@ -28,14 +38,22 @@
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 it it wants
+Call method on transport failure so transport can cleanup/reset if it wants
+Gofer: gearman - need to disable coallesing for non-idempotent requests
-prepare(...,{ Err=>\my $isolated_err, ...})
-Move _new_sth to DBI::db::_new_sth (leave alias) and implement in C
-Implement FETCH_many() in C
-Or call _new_child and move to DBI::common?
-Add trace modules that just records the last N trace messages into an array
-and prepends them to any error message.
+=head2 Changes in DBI 1.59 (svn rev 9874), 23rd August 2007
+
+ Fixed DBI::ProfileData to unescape headers lines read from data file.
+ Fixed DBI::ProfileData to not clobber $_, thanks to Alexey Tourbin.
+ Fixed DBI::SQL::Nano to not clobber $_, thanks to Alexey Tourbin.
+ Fixed DBI::PurePerl to return undef for ChildHandles if weaken not available.
+ Fixed DBD::Proxy disconnect error thanks to Philip Dye.
+ Fixed DBD::Gofer::Transport::Base bug (typo) in timeout code.
+ Fixed DBD::Proxy rows method thanks to Philip Dye.
+ Fixed dbiprof compile errors, thanks to Alexey Tourbin.
+ Fixed t/03handle.t to skip some tests if ChildHandles not available.
+
+ Added check_response_sub to DBI::Gofer::Execute
=head2 Changes in DBI 1.58 (svn rev 9678), 25th June 2007
@@ -466,7 +484,7 @@
Changed DBI::Profile header to include the date and time.
Added DBI->parse_dsn($dsn) method.
- Added warning if build directory path contains whitespace.
+ Added warning if build directory path contains white space.
Added docs for parse_trace_flags() and parse_trace_flag().
Removed "may change" warnings from the docs for table_info(),
primary_key_info(), and foreign_key_info() methods.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/dbilogstrip.PL new/DBI-1.59/dbilogstrip.PL
--- old/DBI-1.58/dbilogstrip.PL 2007-04-18 13:40:46.000000000 +0200
+++ new/DBI-1.59/dbilogstrip.PL 2007-08-23 14:17:13.000000000 +0200
@@ -66,4 +66,6 @@
}
chmod 0755, $file;
print "Extracted $file from ",__FILE__," with variable substitutions.\n";
+# syntax check resulting file, but only for developers
+exit 1 if system($^X, '-wc', '-Mblib', $file) != 0 && -d ".svn";
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/DBI.pm new/DBI-1.59/DBI.pm
--- old/DBI-1.58/DBI.pm 2007-06-25 23:49:05.000000000 +0200
+++ new/DBI-1.59/DBI.pm 2007-08-23 13:33:12.000000000 +0200
@@ -1,4 +1,4 @@
-# $Id: DBI.pm 9678 2007-06-25 21:49:03Z timbo $
+# $Id: DBI.pm 9872 2007-08-23 11:33:10Z timbo $
# vim: ts=8:sw=4
#
# Copyright (c) 1994-2007 Tim Bunce Ireland
@@ -9,7 +9,7 @@
require 5.006_00;
BEGIN {
-$DBI::VERSION = "1.58"; # ==> ALSO update the version in the pod text below!
+$DBI::VERSION = "1.59"; # ==> ALSO update the version in the pod text below!
}
=head1 NAME
@@ -83,8 +83,12 @@
=head2 GETTING HELP
If you have questions about DBI, or DBD driver modules, you can get
-help from the I mailing list. You can get help
-on subscribing and using the list by emailing I.
+help from the I mailing list. You don't have to subscribe
+to the list in order to post, though I'd recommend it. You can get help on
+subscribing and using the list by emailing I.
+
+I don't recommend the DBI cpanform (at http://www.cpanforum.com/dist/DBI)
+because relatively few people read it compared with dbi-users@perl.org.
To help you make the best use of the dbi-users mailing list,
and any other lists or forums you may use, I I<strongly>
@@ -120,8 +124,8 @@
=head2 NOTES
-This is the DBI specification that corresponds to the DBI version 1.58
-($Revision: 9678 $).
+This is the DBI specification that corresponds to the DBI version 1.59
+($Revision: 9872 $).
The DBI is evolving at a steady pace, so it's good to check that
you have the latest copy.
@@ -348,6 +352,7 @@
tmplss_ => { class => 'DBD::TemplateSS', },
tuber_ => { class => 'DBD::Tuber', },
uni_ => { class => 'DBD::Unify', },
+ vt_ => { class => 'DBD::Vt', },
wmi_ => { class => 'DBD::WMI', },
x_ => { }, # for private use
xbase_ => { class => 'DBD::XBase', },
@@ -3400,14 +3405,13 @@
sub show_child_handles {
my ($h, $level) = @_;
- $level ||= 0;
printf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h;
show_child_handles($_, $level + 1)
for (grep { defined } @{$h->{ChildHandles}});
}
my %drivers = DBI->installed_drivers();
- show_child_handles($_) for (values %drivers);
+ show_child_handles($_, 0) for (values %drivers);
=head3 C<CompatMode> (boolean, inherited)
@@ -6209,6 +6213,9 @@
statement, like SELECT. Typically the attribute will be C<undef>
in these situations.
+For drivers which support stored procedures and multiple result sets
+(see L) these attributes relate to the I<current> result set.
+
See also L</finish> to learn more about the effect it
may have on some attributes.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/dbiprof.PL new/DBI-1.59/dbiprof.PL
--- old/DBI-1.58/dbiprof.PL 2007-06-05 13:36:42.000000000 +0200
+++ new/DBI-1.59/dbiprof.PL 2007-08-23 15:39:13.000000000 +0200
@@ -7,7 +7,7 @@
use strict;
-my $VERSION = sprintf("1.%06d", q$Revision: 9628 $ =~ /(\d+)/o);
+my $VERSION = sprintf("1.%06d", q$Revision: 9874 $ =~ /(\d+)/o);
use Data::Dumper;
use DBI::ProfileData;
@@ -32,6 +32,7 @@
'match=s' => \%match,
'exclude=s' => \%exclude,
'case-sensitive' => \$case_sensitive,
+ 'delete!' => \my $opt_delete,
) or exit usage();
sub usage {
@@ -64,7 +65,7 @@
# instantiate ProfileData object
my $prof = eval {
- $prof = DBI::ProfileData->new(
+ DBI::ProfileData->new(
Files => \@files,
DeleteFiles => $opt_delete,
);
@@ -280,3 +281,7 @@
}
chmod 0755, $file;
print "Extracted $file from ",__FILE__," with variable substitutions.\n";
+
+# syntax check resulting file, but only for developers
+exit 1 if system($^X, '-wc', '-Mblib', $file) != 0 && -d ".svn";
+
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/dbiproxy.PL new/DBI-1.59/dbiproxy.PL
--- old/DBI-1.58/dbiproxy.PL 2007-05-09 15:05:28.000000000 +0200
+++ new/DBI-1.59/dbiproxy.PL 2007-08-23 15:39:14.000000000 +0200
@@ -7,7 +7,7 @@
use strict;
-my $VERSION = sprintf("1.%06d", q$Revision: 9530 $ =~ /(\d+)/o);
+my $VERSION = sprintf("1.%06d", q$Revision: 9874 $ =~ /(\d+)/o);
my $arg_test = shift(@ARGV) if $ARGV[0] eq '--test';
$ENV{DBI_TRACE} = shift(@ARGV) || 2 if $ARGV[0] =~ s/^--dbitrace=?//;
@@ -202,3 +202,8 @@
}
chmod 0755, $file;
print "Extracted $file from ",__FILE__," with variable substitutions.\n";
+
+# syntax check resulting file, but only for developers
+exit 1 if system($^X, '-wc', '-Mblib', $file) != 0 && -d ".svn";
+
+
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/DBI.xs new/DBI-1.59/DBI.xs
--- old/DBI-1.58/DBI.xs 2007-06-21 23:40:03.000000000 +0200
+++ new/DBI-1.59/DBI.xs 2007-08-22 21:58:43.000000000 +0200
@@ -1,6 +1,6 @@
/* vim: ts=8:sw=4
*
- * $Id: DBI.xs 9668 2007-06-21 21:40:01Z timbo $
+ * $Id: DBI.xs 9871 2007-08-22 19:58:42Z timbo $
*
* Copyright (c) 1994-2003 Tim Bunce Ireland.
*
@@ -2331,9 +2331,10 @@
if (!DBIc_has(imp_xxh, DBIcf_Profile))
return &sv_undef;
- method_pv = (SvTYPE(method)==SVt_PVCV)
- ? GvNAME(CvGV(method))
- : (isGV(method) ? GvNAME(method) : SvPV_nolen(method));
+ method_pv = (SvTYPE(method)==SVt_PVCV) ? GvNAME(CvGV(method))
+ : isGV(method) ? GvNAME(method)
+ : SvOK(method) ? SvPV_nolen(method)
+ : "";
/* we don't profile DESTROY during global destruction */
if (dirty && instr(method_pv, "DESTROY"))
@@ -2586,7 +2587,7 @@
}
if (!SvROK(increment) || SvTYPE(SvRV(increment)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes: increment not an array or hash ref");
+ croak("dbi_profile_merge_nodes: increment %s not an array or hash ref", neatsvpv(increment,0));
i_av = (AV*)SvRV(increment);
tmp = *av_fetch(d_av, DBIprof_COUNT, 1);
@@ -3204,8 +3205,8 @@
else
PerlIO_printf(logfp,"(%s", neatsvpv(st1,0));
if (items >= 3)
- PerlIO_printf(logfp," %s", neatsvpv(st2,0));
- PerlIO_printf(logfp,"%s)", (items > 3) ? " ..." : "");
+ PerlIO_printf(logfp,", %s", neatsvpv(st2,0));
+ PerlIO_printf(logfp,"%s)", (items > 3) ? ", ..." : "");
}
if (gimme & G_ARRAY)
@@ -4193,7 +4194,7 @@
CODE:
{
if (!SvROK(dest) || SvTYPE(SvRV(dest)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes(%s,...) not an array reference", neatsvpv(dest,0));
+ croak("dbi_profile_merge_nodes(%s,...) destination is not an array reference", neatsvpv(dest,0));
if (items <= 1) {
(void)cv; /* avoid unused var warnings */
(void)ix;
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/dbixs_rev.h new/DBI-1.59/dbixs_rev.h
--- old/DBI-1.58/dbixs_rev.h 2007-06-18 16:22:05.000000000 +0200
+++ new/DBI-1.59/dbixs_rev.h 2007-07-16 13:10:43.000000000 +0200
@@ -1 +1,2 @@
-#define DBIXS_REVISION 9659
+/* Mon Jul 16 12:10:43 2007 */
+#define DBIXS_REVISION 9743
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/dbixs_rev.pl new/DBI-1.59/dbixs_rev.pl
--- old/DBI-1.58/dbixs_rev.pl 2007-06-11 14:46:25.000000000 +0200
+++ new/DBI-1.59/dbixs_rev.pl 2007-07-16 13:04:58.000000000 +0200
@@ -1,42 +1,51 @@
#!perl -w
use strict;
-my $file = "dbixs_rev.h";
-my $svnversion = `svnversion -n`;
+my $dbixs_rev_file = "dbixs_rev.h";
+
my $is_make_dist;
+my $svnversion;
-if ($svnversion eq 'exported') {
+if (is_dbi_svn_dir(".")) {
+ $svnversion = `svnversion -n`;
+}
+elsif (is_dbi_svn_dir("..")) {
+ # presumably we're in a subdirectory because the user is doing a 'make dist'
$svnversion = `svnversion -n ..`;
- if (-f "../MANIFEST.SKIP") {
- # presumably we're in a subdirectory because the user is doing a 'make dist'
- $is_make_dist = 1;
- }
- else {
- # presumably we're being run by an end-user because their file timestamps
- # got messed up
- print "Skipping regeneration of $file\n";
- utime(time(), time(), $file); # update modification time
- exit 0;
- }
+ $is_make_dist = 1;
+}
+else {
+ # presumably we're being run by an end-user because their file timestamps
+ # got messed up
+ print "Skipping regeneration of $dbixs_rev_file\n";
+ utime(time(), time(), $dbixs_rev_file); # update modification time
+ exit 0;
}
my @warn;
die "Neither current directory nor parent directory are an svn working copy\n"
unless $svnversion and $svnversion =~ m/^\d+/;
-push @warn, "Mixed revision working copy"
- if $svnversion =~ s/:\d+//;
+push @warn, "Mixed revision working copy ($svnversion:$1)"
+ if $svnversion =~ s/:(\d+)//;
push @warn, "Code modified since last checkin"
if $svnversion =~ s/[MS]+$//;
-warn "$file warning: $_\n" for @warn;
+warn "$dbixs_rev_file warning: $_\n" for @warn;
die "$0 failed\n" if $is_make_dist && @warn;
-write_header($file, DBIXS_REVISION => $svnversion, \@warn);
+write_header($dbixs_rev_file, DBIXS_REVISION => $svnversion, \@warn);
sub write_header {
my ($file, $macro, $version, $comments_ref) = @_;
open my $fh, ">$file" or die "Can't open $file: $!\n";
+ unshift @$comments_ref, scalar localtime(time);
print $fh "/* $_ */\n" for @$comments_ref;
print $fh "#define $macro $version\n";
close $fh or die "Error closing $file: $!\n";
print "Wrote $macro $version to $file\n";
}
+
+sub is_dbi_svn_dir {
+ my ($dir) = @_;
+ return (-d "$dir/.svn" && -f "$dir/MANIFEST.SKIP");
+}
+
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/goferperf.pl new/DBI-1.59/goferperf.pl
--- old/DBI-1.58/goferperf.pl 2007-03-13 17:31:46.000000000 +0100
+++ new/DBI-1.59/goferperf.pl 1970-01-01 01:00:00.000000000 +0100
@@ -1,142 +0,0 @@
-#!perl -w
-# vim:sw=4:ts=8
-$|=1;
-
-use strict;
-use warnings;
-
-use Cwd;
-use Time::HiRes qw(time);
-use Data::Dumper;
-use Getopt::Long;
-
-use DBI;
-
-GetOptions(
- 'c|count=i' => \(my $opt_count = 100),
- 'dsn=s' => \(my $opt_dsn),
- 'timeout=i' => \(my $opt_timeout = 10),
- 'p|policy=s' => \(my $opt_policy = "pedantic,classic,rush"),
-) or exit 1;
-
-if ($ENV{DBI_AUTOPROXY}) {
- # this means we have DBD::Gofer => DBD::Gofer => DBD::DBM!
- # rather than disable it we let it run because we're twisted
- # and because it helps find more bugs (though debugging can be painful)
- warn "\n$0 is running with DBI_AUTOPROXY enabled ($ENV{DBI_AUTOPROXY})\n";
-}
-
-# ensure subprocess (for pipeone and stream transport) will use the same modules as us, ie ./blib
-local $ENV{PERL5LIB} = join ":", @INC;
-
-my %durations;
-my $username = eval { getpwuid($>) } || ''; # fails on windows
-my $can_ssh = ($username && $username eq 'timbo' && -d '.svn');
-my $perl = "$^X"; # ensure sameperl and our blib (note two spaces)
- # ensure blib (note two spaces)
- $perl .= sprintf " -Mblib=%s/blib", getcwd() if $ENV{PERL5LIB} =~ m{/blib/};
-
-my %trials = (
- null => {},
- null_ha => { DBI => "DBIx::HA" },
- pipeone => { perl=>$perl, timeout=>$opt_timeout },
- stream => { perl=>$perl, timeout=>$opt_timeout },
- stream_ssh => ($can_ssh)
- ? { perl=>$perl, timeout=>$opt_timeout, url => "ssh:$username\@localhost" }
- : undef,
- http => { url => "http://localhost:8001/gofer" },
-);
-
-# to get baseline for comparisons
-run_tests('no', {}, 'no');
-
-for my $trial (@ARGV) {
- (my $transport = $trial) =~ s/_.*//;
- my $trans_attr = $trials{$trial} or do {
- warn "No trial '$trial' defined - skipped";
- next;
- };
-
- for my $policy_name (split /\s*,\s*/, $opt_policy) {
- eval { run_tests($transport, $trans_attr, $policy_name) };
- warn $@ if $@;
- }
-}
-
-while ( my ($activity, $stats_hash) = each %durations ) {
- print "\n";
- $stats_hash->{'~baseline~'} = delete $stats_hash->{"no+no"};
- for my $perf_tag (reverse sort keys %$stats_hash) {
- my $dur = $stats_hash->{$perf_tag};
- printf " %6s %-16s: %.6fsec (%5d/sec)",
- $activity, $perf_tag, $dur/$opt_count, $opt_count/$dur;
- my $baseline_dur = $stats_hash->{'~baseline~'};
- printf " %+6.2fms", (($dur-$baseline_dur)/$opt_count)*1000
- unless $perf_tag eq '~baseline~';
- print "\n";
- }
-}
-
-
-sub run_tests {
- my ($transport, $trans_attr, $policy_name) = @_;
-
- my $connect_attr = delete $trans_attr->{connect_attr} || {};
- my $DBI = delete $trans_attr->{DBI} || "DBI";
- _load_class($DBI) if $DBI ne "DBI";
-
- my $test_run_tag = "Testing $transport transport with $policy_name policy @{[ %$connect_attr ]}";
- print "\n$test_run_tag\n";
-
- my $dsn = $opt_dsn || $trans_attr->{dsn} || "dbi:NullP:";
- if ($policy_name ne 'no') {
- my $driver_dsn = "transport=$transport;policy=$policy_name";
- $driver_dsn .= join ";", '', map { "$_=$trans_attr->{$_}" } keys %$trans_attr
- if %$trans_attr;
- $dsn = "dbi:Gofer:$driver_dsn;dsn=$dsn";
- }
- print " $dsn\n";
-
- my $dbh = $DBI->connect($dsn, undef, undef, { %$connect_attr, RaiseError => 1 } );
-
- $dbh->do("DROP TABLE IF EXISTS fruit");
- $dbh->do("CREATE TABLE fruit (dKey INT, dVal VARCHAR(10))");
- my $ins_sth = $dbh->prepare("INSERT INTO fruit VALUES (?,?)");
- $ins_sth->execute(1, 'apples');
- $ins_sth->execute(2, 'oranges');
- $ins_sth->execute(3, 'lemons');
- $ins_sth->execute(4, 'limes');
-
- my $start = time();
- $dbh->selectall_arrayref("SELECT dKey, dVal FROM fruit")
- for (1000..1000+$opt_count);
- $durations{select}{"$transport+$policy_name"} = time() - $start;
-
- # insert some rows in to get a (*very* rough) idea of overheads
- $start = time();
- $ins_sth->execute($_, 'speed')
- for (1000..1000+$opt_count);
- $durations{insert}{"$transport+$policy_name"} = time() - $start;
-
- $dbh->do("DROP TABLE fruit");
- $dbh->disconnect;
-}
-
-sub get_policy {
- my ($policy_class) = @_;
- $policy_class = "DBD::Gofer::Policy::$policy_class" unless $policy_class =~ /::/;
- _load_class($policy_class) or die $@;
- return $policy_class->new();
-}
-
-sub _load_class { # return true or false+$@
- my $class = shift;
- (my $pm = $class) =~ s{::}{/}g;
- $pm .= ".pm";
- return 1 if eval { require $pm };
- delete $INC{$pm}; # shouldn't be needed (perl bug?) and assigning undef isn't enough
- undef; # error in $@
-}
-
-
-1;
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBD/Gofer/Transport/Base.pm new/DBI-1.59/lib/DBD/Gofer/Transport/Base.pm
--- old/DBI-1.58/lib/DBD/Gofer/Transport/Base.pm 2007-05-13 17:45:15.000000000 +0200
+++ new/DBI-1.59/lib/DBD/Gofer/Transport/Base.pm 2007-08-22 18:32:33.000000000 +0200
@@ -1,6 +1,6 @@
package DBD::Gofer::Transport::Base;
-# $Id: Base.pm 9560 2007-05-13 15:45:04Z timbo $
+# $Id: Base.pm 9866 2007-08-22 16:32:32Z timbo $
#
# Copyright (c) 2007, Tim Bunce, Ireland
#
@@ -12,7 +12,7 @@
use base qw(DBI::Gofer::Transport::Base);
-our $VERSION = sprintf("0.%06d", q$Revision: 9560 $ =~ /(\d+)/o);
+our $VERSION = sprintf("0.%06d", q$Revision: 9866 $ =~ /(\d+)/o);
__PACKAGE__->mk_accessors(qw(
trace
@@ -58,7 +58,7 @@
if ($@) {
return $self->transport_timedout("transmit_request", $to)
if $@ eq "TIMEOUT\n";
- return self->new_response({ err => 1, errstr => $@ });
+ return $self->new_response({ err => 1, errstr => $@ });
}
return $response;
@@ -135,7 +135,7 @@
if (not defined $retry) {
my $errstr = $response->errstr || '';
- $retry = 1 if $errstr =~ m/fake error induced by DBI_GOFER_RANDOM/;
+ $retry = 1 if $errstr =~ m/induced by DBI_GOFER_RANDOM/;
}
if (not defined $retry) {
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBD/Gofer/Transport/null.pm new/DBI-1.59/lib/DBD/Gofer/Transport/null.pm
--- old/DBI-1.58/lib/DBD/Gofer/Transport/null.pm 2007-05-13 17:45:15.000000000 +0200
+++ new/DBI-1.59/lib/DBD/Gofer/Transport/null.pm 2007-08-23 15:37:16.000000000 +0200
@@ -1,6 +1,6 @@
package DBD::Gofer::Transport::null;
-# $Id: null.pm 9560 2007-05-13 15:45:04Z timbo $
+# $Id: null.pm 9873 2007-08-23 13:37:05Z timbo $
#
# Copyright (c) 2007, Tim Bunce, Ireland
#
@@ -14,7 +14,7 @@
use DBI::Gofer::Execute;
-our $VERSION = sprintf("0.%06d", q$Revision: 9560 $ =~ /(\d+)/o);
+our $VERSION = sprintf("0.%06d", q$Revision: 9873 $ =~ /(\d+)/o);
__PACKAGE__->mk_accessors(qw(
pending_response
@@ -32,7 +32,7 @@
# the request is magically transported over to ... ourselves
# ...
- my $response = $executor->execute_request( $self->thaw_request($frozen_request,1) );
+ my $response = $executor->execute_request( $self->thaw_request($frozen_request, undef, 1) );
# put response 'on the shelf' ready for receive_response()
$self->pending_response( $response );
@@ -46,7 +46,7 @@
my $response = $self->pending_response;
- my $frozen_response = $self->freeze_response($response,1);
+ my $frozen_response = $self->freeze_response($response, undef, 1);
# ...
# the response is magically transported back to ... ourselves
@@ -60,7 +60,7 @@
__END__
=head1 NAME
-
+
DBD::Gofer::Transport::null - DBD::Gofer client transport for testing
=head1 SYNOPSIS
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBD/Proxy.pm new/DBI-1.59/lib/DBD/Proxy.pm
--- old/DBI-1.58/lib/DBD/Proxy.pm 2006-09-27 00:24:34.000000000 +0200
+++ new/DBI-1.59/lib/DBD/Proxy.pm 2007-08-22 22:05:26.000000000 +0200
@@ -306,10 +306,12 @@
# Drop database connection at remote end
my $rdbh = $dbh->{'proxy_dbh'};
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- eval { $rdbh->disconnect() };
- DBD::Proxy::proxy_set_err($dbh, $@) if $@;
+ if ( $rdbh ) {
+ local $SIG{__DIE__} = 'DEFAULT';
+ local $@;
+ eval { $rdbh->disconnect() } ;
+ DBD::Proxy::proxy_set_err($dbh, $@) if $@;
+ }
# Close TCP connect to remote
# XXX possibly best left till DESTROY? Add a config attribute to choose?
@@ -510,6 +512,7 @@
# new execute, so delete any cached rows from previous execute
undef $sth->{'proxy_data'};
+ undef $sth->{'proxy_rows'};
my $rsth = $sth->{proxy_sth};
my $dbh = $sth->FETCH('Database');
@@ -590,6 +593,8 @@
my $data = $sth->{'proxy_data'};
+ $sth->{'proxy_rows'} = 0 unless defined $sth->{'proxy_rows'};
+
if(!$data || !@$data) {
return undef unless $sth->SUPER::FETCH('Active');
@@ -613,13 +618,14 @@
my $row = shift @$data;
$sth->SUPER::STORE(Active => 0) if ( $sth->{proxy_cache_only} and !@$data );
+ $sth->{'proxy_rows'}++;
return $sth->_set_fbav($row);
}
*fetchrow_arrayref = \&fetch;
sub rows ($) {
- my($sth) = @_;
- $sth->{'proxy_rows'};
+ my $rows = shift->{'proxy_rows'};
+ return (defined $rows) ? $rows : -1;
}
sub finish ($) {
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBI/Gofer/Execute.pm new/DBI-1.59/lib/DBI/Gofer/Execute.pm
--- old/DBI-1.58/lib/DBI/Gofer/Execute.pm 2007-06-21 23:40:03.000000000 +0200
+++ new/DBI-1.59/lib/DBI/Gofer/Execute.pm 2007-08-23 15:34:27.000000000 +0200
@@ -1,6 +1,6 @@
package DBI::Gofer::Execute;
-# $Id: Execute.pm 9668 2007-06-21 21:40:01Z timbo $
+# $Id: Execute.pm 9847 2007-08-16 19:08:08Z timbo $
#
# Copyright (c) 2007, Tim Bunce, Ireland
#
@@ -16,7 +16,7 @@
use base qw(DBI::Util::_accessor);
-our $VERSION = sprintf("0.%06d", q$Revision: 9668 $ =~ /(\d+)/o);
+our $VERSION = sprintf("0.%06d", q$Revision: 9847 $ =~ /(\d+)/o);
our @all_dbh_methods = sort map { keys %$_ } $DBI::DBI_methods{db}, $DBI::DBI_methods{common};
our %all_dbh_methods = map { $_ => DBD::_::db->can($_) } @all_dbh_methods;
@@ -41,6 +41,7 @@
forced_connect_attributes => {},
track_recent => 1,
check_request_sub => sub {},
+ check_response_sub => sub {},
forced_single_resultset => 1,
max_cached_dbh_per_drh => 1,
max_cached_sth_per_dbh => 1,
@@ -286,6 +287,12 @@
: $self->execute_dbh_request($request);
};
$response ||= $self->new_response_with_err(undef, $@, $current_dbh);
+
+ if (my $check_response_sub = $self->check_response_sub) {
+ eval { $check_response_sub->($response, $self, $request) };
+ warn "check_response_sub failed: $@" if $@;
+ }
+
undef $current_dbh;
$response->warnings(\@warnings) if @warnings;
@@ -301,7 +308,7 @@
my $dbh;
my $rv_ref = eval {
$dbh = $self->_connect($request);
- my $args = $request->dbh_method_call; # [ 'method_name', @args ]
+ my $args = $request->dbh_method_call; # [ wantarray, 'method_name', @args ]
my $wantarray = shift @$args;
my $meth = shift @$args;
$stats->{method_calls_dbh}->{$meth}++;
@@ -610,7 +617,7 @@
#no warnings 'uninitialized';
#warn "_mk_rand_callback($fail_percent:$fail_modrate, $delay_percent:$delay_modrate): seqn=$seqn fail=$fail delay=$delay";
if ($delay) {
- my $msg = "DBI_GOFER_RANDOM delaying execution of $method by $delay_duration seconds\n";
+ my $msg = "DBI_GOFER_RANDOM delaying execution of $method() by $delay_duration seconds\n";
# Note what's happening in a trace message. If the delay percent is an odd
# number then use warn() so it's sent back to the client
($delay_percent % 2 == 0) ? $h->trace_msg($msg) : warn($msg);
@@ -618,7 +625,7 @@
}
if ($fail) {
undef $_; # tell DBI to not call the method
- return $h->set_err(1, "fake error induced by DBI_GOFER_RANDOM env var");
+ return $h->set_err(1, "fake error from $method method induced by DBI_GOFER_RANDOM env var ($fail_percent%)");
}
return;
}
@@ -626,7 +633,7 @@
sub update_stats {
- my ($self, $request, $response, $frozen_request, $frozen_response, $time_received) = @_;
+ my ($self, $request, $response, $frozen_request, $frozen_response, $time_received, $meta) = @_;
my $stats = $self->{stats};
$stats->{frozen_request_max_bytes} = length($frozen_request)
@@ -641,6 +648,7 @@
response => $frozen_response,
time_received => $time_received,
duration => dbi_time()-$time_received,
+ ($meta) ? (meta => $meta) : (), # for any other info
};
shift @$recent_requests if @$recent_requests > $track_recent;
}
@@ -678,7 +686,7 @@
=head2 check_request_sub
If defined, it must be a reference to a subroutine that will 'check' the request.
-It is pass the request object and the executor as its only arguments.
+It is passed the request object and the executor as its only arguments.
The subroutine can either return the original request object or die with a
suitable error message (which will be turned into a Gofer response).
@@ -686,6 +694,15 @@
It can also construct and return a new request that should be executed instead
of the original request.
+=head2 check_response_sub
+
+If defined, it must be a reference to a subroutine that will 'check' the response.
+It is passed the response object, the executor, and the request object.
+The return value is ignored, though the sub may alter the response object.
+
+This mechanism can be used to, for example, terminate the service if specific
+database errors are seen.
+
=head2 forced_connect_dsn
If set, this DSN is always used instead of the one in the request.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBI/Gofer/Transport/Base.pm new/DBI-1.59/lib/DBI/Gofer/Transport/Base.pm
--- old/DBI-1.58/lib/DBI/Gofer/Transport/Base.pm 2007-05-13 17:45:16.000000000 +0200
+++ new/DBI-1.59/lib/DBI/Gofer/Transport/Base.pm 2007-08-23 15:34:27.000000000 +0200
@@ -1,6 +1,6 @@
package DBI::Gofer::Transport::Base;
-# $Id: Base.pm 9560 2007-05-13 15:45:04Z timbo $
+# $Id: Base.pm 9847 2007-08-16 19:08:08Z timbo $
#
# Copyright (c) 2007, Tim Bunce, Ireland
#
@@ -12,7 +12,7 @@
use base qw(DBI::Util::_accessor);
-our $VERSION = sprintf("0.%06d", q$Revision: 9560 $ =~ /(\d+)/o);
+our $VERSION = sprintf("0.%06d", q$Revision: 9847 $ =~ /(\d+)/o);
__PACKAGE__->mk_accessors(qw(
@@ -28,43 +28,75 @@
sub new {
my ($class, $args) = @_;
$args->{trace} ||= $class->_init_trace;
- $args->{serializer_obj} ||= DBI::Gofer::Serializer->new();
+ $args->{serializer_obj} ||= DBI::Gofer::Serializer::Storable->new();
my $self = bless {}, $class;
$self->$_( $args->{$_} ) for keys %$args;
$self->trace_msg("$class->new({ @{[ %$args ]} })\n") if $self->trace;
return $self;
}
-{ package DBI::Gofer::Serializer;
+{ package DBI::Gofer::Serializer::Storable;
# a very minimal subset of Data::Serializer
use Storable qw(nfreeze thaw);
sub new {
return bless {} => shift;
}
- sub serializer {
+ sub serialize {
my $self = shift;
local $Storable::forgive_me = 1; # for CODE refs etc
return nfreeze(shift);
}
- sub deserializer {
+ sub deserialize {
my $self = shift;
return thaw(shift);
}
}
+{ package DBI::Gofer::Serializer::DataDumper;
+ # a very minimal subset of Data::Serializer
+ require Data::Dumper;
+ sub new {
+ local $Data::Dumper::Indent = 1;
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Useqq = 0; # enabling this disables xs
+ local $Data::Dumper::Sortkeys = 1;
+ local $Data::Dumper::Quotekeys = 0;
+ local $Data::Dumper::Deparse = 0;
+ local $Data::Dumper::Purity = 0;
+ return bless {
+ dumper => Data::Dumper->new([], undef),
+ } => shift;
+ }
+ sub serialize {
+ my $dumper = shift->{dumper};
+ local $Data::Dumper::Indent = 1;
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Useqq = 0; # enabling this disables xs
+ local $Data::Dumper::Sortkeys = 1;
+ local $Data::Dumper::Quotekeys = 0;
+ local $Data::Dumper::Deparse = 0;
+ local $Data::Dumper::Purity = 0;
+ return Data::Dumper::Dumper(shift);
+ }
+ sub deserialize {
+ Carp::croak("deserialize not supported for ".__PACKAGE__);
+ }
+}
+
my $packet_header_text = "GoFER1:";
-my $packet_header_regex = qr/^GoFER(\d):/;
+my $packet_header_regex = qr/^GoFER(\d+):/;
sub _freeze_data {
- my ($self, $data, $skip_trace) = @_;
+ my ($self, $data, $serializer, $skip_trace) = @_;
my $frozen = eval {
$self->_dump("freezing $self->{trace} ".ref($data), $data)
if !$skip_trace and $self->trace;
local $data->{meta}; # don't include _meta in serialization
- my $data = $self->{serializer_obj}->serializer($data);
+ $serializer ||= $self->{serializer_obj};
+ my $data = $serializer->serialize($data);
$packet_header_text . $data;
};
@@ -80,14 +112,15 @@
sub _thaw_data {
- my ($self, $frozen_data, $skip_trace) = @_;
+ my ($self, $frozen_data, $serializer, $skip_trace) = @_;
my $data;
eval {
# check for and extract our gofer header and the info it contains
$frozen_data =~ s/$packet_header_regex//o
or die "does not have gofer header\n";
my ($t_version) = $1;
- $data = $self->{serializer_obj}->deserializer($frozen_data)
+ $serializer ||= $self->{serializer_obj};
+ $data = $serializer->deserialize($frozen_data)
and $data->{_transport}{version} = $t_version;
};
if ($@) {
@@ -115,7 +148,7 @@
require Data::Dumper;
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Useqq = 1;
+ local $Data::Dumper::Useqq = 0;
local $Data::Dumper::Sortkeys = 1;
local $Data::Dumper::Quotekeys = 0;
local $Data::Dumper::Deparse = 0;
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBI/ProfileData.pm new/DBI-1.59/lib/DBI/ProfileData.pm
--- old/DBI-1.58/lib/DBI/ProfileData.pm 2007-06-07 18:46:11.000000000 +0200
+++ new/DBI-1.59/lib/DBI/ProfileData.pm 2007-07-16 15:07:01.000000000 +0200
@@ -70,7 +70,7 @@
=cut
-our $VERSION = sprintf("2.%06d", q$Revision: 9632 $ =~ /(\d+)/o);
+our $VERSION = sprintf("2.%06d", q$Revision: 9744 $ =~ /(\d+)/o);
use Carp qw(croak);
use Symbol;
@@ -229,6 +229,7 @@
$self->{_profiler} = $first if $keep;
# collect variables from the header
+ local $_;
while (<$fh>) {
chomp;
last unless length $_;
@@ -236,10 +237,20 @@
or croak("Syntax error in header in $filename line $.: $_");
# XXX should compare new with existing (from previous file)
# and warn if they differ (diferent program or path)
- $self->{_header}{$1} = $2 if $keep;
+ $self->{_header}{$1} = unescape_key($2) if $keep;
}
}
+
+sub unescape_key { # inverse of escape_key() in DBI::ProfileDumper
+ local $_ = shift;
+ s/(?) {
chomp;
if (/^\+\s+(\d+)\s?(.*)/) {
# it's a key
- ($key, $index) = ($2, $1 - 1);
-
- # unmangle key
- $key =~ s/(? '!MethodName';
use constant DBIprofile_MethodClass => '!MethodClass';
-$ON_DESTROY_DUMP = sub { DBI->trace_msg(shift, 0) };
+our $ON_DESTROY_DUMP = sub { DBI->trace_msg(shift, 0) };
+our $ON_FLUSH_DUMP = sub { DBI->trace_msg(shift, 0) };
sub new {
my $class = shift;
@@ -767,8 +768,12 @@
return undef;
}
-sub flush_to_disk { # baseclass method, see DBI::ProfileDumper
- return undef;
+sub flush_to_disk { # baseclass method, see DBI::ProfileDumper & DashProfiler::Core
+ my $self = shift;
+ return unless $ON_FLUSH_DUMP;
+ return unless $self->{Data};
+ my $detail = $self->format();
+ $ON_FLUSH_DUMP->($detail) if $detail;
}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBI/PurePerl.pm new/DBI-1.59/lib/DBI/PurePerl.pm
--- old/DBI-1.58/lib/DBI/PurePerl.pm 2007-05-01 13:03:42.000000000 +0200
+++ new/DBI-1.59/lib/DBI/PurePerl.pm 2007-06-27 11:52:21.000000000 +0200
@@ -28,7 +28,7 @@
} unless defined &utf8::is_utf8;
$DBI::PurePerl = $ENV{DBI_PUREPERL} || 1;
-$DBI::PurePerl::VERSION = sprintf("2.%06d", q$Revision: 9478 $ =~ /(\d+)/o);
+$DBI::PurePerl::VERSION = sprintf("2.%06d", q$Revision: 9685 $ =~ /(\d+)/o);
$DBI::neat_maxlen ||= 400;
@@ -740,7 +740,7 @@
return ($h->FETCH('TaintIn') && $h->FETCH('TaintOut')) if $key eq'Taint';
return (1==0) if $is_flag_attribute{$key}; # return perl-style sv_no, not undef
return $DBI::dbi_debug if $key eq 'TraceLevel';
- return [] if $key eq 'ChildHandles';
+ return [] if $key eq 'ChildHandles' && $HAS_WEAKEN;
if ($key eq 'Type') {
return "dr" if $h->isa('DBI::dr');
return "db" if $h->isa('DBI::db');
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/lib/DBI/SQL/Nano.pm new/DBI-1.59/lib/DBI/SQL/Nano.pm
--- old/DBI-1.58/lib/DBI/SQL/Nano.pm 2007-02-06 12:26:03.000000000 +0100
+++ new/DBI-1.59/lib/DBI/SQL/Nano.pm 2007-07-16 15:07:01.000000000 +0200
@@ -22,7 +22,7 @@
require DBI; # for looks_like_number()
use vars qw( $VERSION $versions );
BEGIN {
- $VERSION = sprintf("1.%06d", q$Revision: 8696 $ =~ /(\d+)/o);
+ $VERSION = sprintf("1.%06d", q$Revision: 9744 $ =~ /(\d+)/o);
$versions->{nano_version} = $VERSION;
if ($ENV{DBI_SQL_NANO} || !eval { require "SQL/Statement.pm" }) {
@@ -133,7 +133,7 @@
return \@col_defs;
}
sub parse_comma_list {[map{clean_parse_str($_)} split(',',shift)]}
-sub clean_parse_str { $_ = shift; s/\(//;s/\)//;s/^\s+//; s/\s+$//; $_; }
+sub clean_parse_str { local $_ = shift; s/\(//;s/\)//;s/^\s+//; s/\s+$//; $_; }
sub parse_values_list {
my($self,$str) = @_;
[map{$self->parse_value(clean_parse_str($_))}split(',',$str)]
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/Makefile.PL new/DBI-1.59/Makefile.PL
--- old/DBI-1.58/Makefile.PL 2007-06-11 14:49:29.000000000 +0200
+++ new/DBI-1.59/Makefile.PL 2007-06-28 15:12:27.000000000 +0200
@@ -1,6 +1,6 @@
# -*- perl -*-
#
-# $Id: Makefile.PL 9637 2007-06-11 12:49:27Z timbo $
+# $Id: Makefile.PL 9689 2007-06-28 13:12:22Z timbo $
#
# Copyright (c) 1994-2006 Tim Bunce Ireland
#
@@ -322,6 +322,12 @@
$(RM_F) $(roadmap_pm)
$(CP) Roadmap.pod $(roadmap_pm)
+faq:
+ : checkin any local changes not already checked in before overwriting
+ svn commit --message "dbi.tiddlyspot.com FAQ update" dbi.tiddlyspot.com.html
+ wget --ignore-length --output-document=dbi.tiddlyspot.com.html --timestamping http://dbi.tiddlyspot.com/download
+ svn commit --message "dbi.tiddlyspot.com FAQ update" dbi.tiddlyspot.com.html
+
checkkeywords:
$(RM_RF) blib
find . -type f \( -name .svn -prune -o -name \*.pm -o -name \*.PL -o -name \*.pl \) \
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/MANIFEST new/DBI-1.59/MANIFEST
--- old/DBI-1.58/MANIFEST 2007-06-11 14:46:59.000000000 +0200
+++ new/DBI-1.59/MANIFEST 2007-08-16 16:25:53.000000000 +0200
@@ -62,7 +62,6 @@
lib/DBI/Util/_accessor.pm A cut-down version of Class::Accessor::Fast
lib/DBI/W32ODBC.pm An experimental DBI emulation layer for Win32::ODBC
lib/Win32/DBIODBC.pm An experimental Win32::ODBC emulation layer for DBI
-goferperf.pl A performance test utility for DBD::Gofer
t/01basics.t
t/02dbidrv.t
t/03handle.t
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/META.yml new/DBI-1.59/META.yml
--- old/DBI-1.58/META.yml 2007-06-25 23:50:23.000000000 +0200
+++ new/DBI-1.59/META.yml 2007-08-23 15:41:04.000000000 +0200
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: DBI
-version: 1.58
+version: 1.59
version_from: DBI.pm
installdirs: site
requires:
@@ -11,4 +11,4 @@
Test::Simple: 0.4
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+generated_by: ExtUtils::MakeMaker version 6.17
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/t/03handle.t new/DBI-1.59/t/03handle.t
--- old/DBI-1.58/t/03handle.t 2007-04-30 14:53:03.000000000 +0200
+++ new/DBI-1.59/t/03handle.t 2007-06-26 23:37:35.000000000 +0200
@@ -272,10 +272,6 @@
SKIP: {
skip "take_imp_data test not supported under DBD::Gofer", 19 if $using_dbd_gofer;
- # XXX because we use Kids, ActiveKids and ChildHandles in the tests
- # if PurePerl supported those then we'd be able to run these tests
-# skip "take_imp_data test not supported under DBI::PurePerl", 19 if $DBI::PurePerl;
-
my $dbh = DBI->connect("dbi:$driver:", '', '');
isa_ok($dbh, "DBI::db");
my $drh = $dbh->{Driver}; # (re)get drh here so tests can work using_dbd_gofer
@@ -292,6 +288,9 @@
unless $DBI::PurePerl && pass();
my $ChildHandles = $dbh->{ChildHandles};
+
+ skip "take_imp_data test needs weakrefs", 15 if not $ChildHandles;
+
ok $ChildHandles, 'we need weakrefs for take_imp_data to work safely with child handles';
is @$ChildHandles, 3, 'should have 3 entries (implementation detail)';
is grep({ defined } @$ChildHandles), 2, 'should have 2 defined handles';
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/t/05thrclone.t new/DBI-1.59/t/05thrclone.t
--- old/DBI-1.58/t/05thrclone.t 2007-06-07 17:30:02.000000000 +0200
+++ new/DBI-1.59/t/05thrclone.t 2007-08-22 18:45:36.000000000 +0200
@@ -66,7 +66,9 @@
# load up the threads
my @thr;
-push @thr, threads_sub->create( \&testing ) foreach (1..$threads);
+push @thr, threads_sub->create( \&testing )
+ or die "thread->create failed ($!)"
+ foreach (1..$threads);
# join all the threads
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/t/40profile.t new/DBI-1.59/t/40profile.t
--- old/DBI-1.58/t/40profile.t 2007-06-22 10:11:31.000000000 +0200
+++ new/DBI-1.59/t/40profile.t 2007-08-22 18:51:06.000000000 +0200
@@ -282,11 +282,11 @@
print "testing '!Time' and variants in Path\n";
undef $sth;
-my $factor = 100_000; # ~27 hours
+my $factor = 1_000_000;
$dbh->{Profile}->{Path} = [ '!Time', "!Time~$factor", '!MethodName' ];
$dbh->{Profile}->{Data} = undef;
-$t1 = int(dbi_time())+1; 1 while int(dbi_time()) < $t1; # spin till new second starts
+$t1 = int(dbi_time())+1; 1 while int(dbi_time()-0.01) < $t1; # spin till just after second starts
$t2 = int($t1/$factor)*$factor;
$sth = $dbh->prepare("select name from .");
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/t/41prof_dump.t new/DBI-1.59/t/41prof_dump.t
--- old/DBI-1.58/t/41prof_dump.t 2007-06-15 23:49:16.000000000 +0200
+++ new/DBI-1.59/t/41prof_dump.t 2007-06-28 15:10:43.000000000 +0200
@@ -18,7 +18,7 @@
plan skip_all => 'profiling not supported for DBI::PurePerl';
}
else {
- plan tests => 16;
+ plan tests => 15;
}
}
@@ -59,6 +59,7 @@
# wrote the profile to disk?
ok( -s "dbi.prof", 'Profile is on disk and nonzero size' );
+# XXX We're breaking encapsulation here
open(PROF, "dbi.prof") or die $!;
my @prof = <PROF>;
close PROF;
@@ -76,8 +77,6 @@
like( $prof[1], qr{^Path\s+=\s+\[\s+\]}, 'Found the Path');
ok( $prof[2] =~ m{^Program\s+=\s+(\S+)}, 'Found the Program');
-is( $1, $0, 'Program matches' );
-
# check that expected key is there
like(join('', @prof), qr/\+\s+1\s+\Q$sql\E/m);
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/DBI-1.58/t/86gofer_fail.t new/DBI-1.59/t/86gofer_fail.t
--- old/DBI-1.58/t/86gofer_fail.t 2007-06-07 17:26:28.000000000 +0200
+++ new/DBI-1.59/t/86gofer_fail.t 2007-08-22 18:31:45.000000000 +0200
@@ -43,7 +43,7 @@
($fails, $dbh) = trial_impact("fail=100%,do", 10, "", sub { $_->do("set foo=1") });
is $fails, 100, 'should fail 100% of the time';
ok $@, '$@ should be set';
-like $@, '/fake error induced by DBI_GOFER_RANDOM/';
+like $@, '/fake error from do method induced by DBI_GOFER_RANDOM/';
ok $dbh->errstr, 'errstr should be set';
like $dbh->errstr, '/DBI_GOFER_RANDOM/', 'errstr should contain DBI_GOFER_RANDOM';
ok !$dbh->{go_response}->executed_flag_set, 'go_response executed flag should be false';
@@ -53,11 +53,11 @@
srand(42); # try to limit occasional failures (effect will vary by platform etc)
sub trial_impact {
- my ($spec, $count, $dsn_attr, $code) = @_;
+ my ($spec, $count, $dsn_attr, $code, $verbose) = @_;
local $ENV{DBI_GOFER_RANDOM} = $spec;
my $dbh = dbi_connect("policy=rush;$dsn_attr");
local $_ = $dbh;
- my $fail_percent = percentage_exceptions(200, $code);
+ my $fail_percent = percentage_exceptions(200, $code, $verbose);
return $fail_percent unless wantarray;
return ($fail_percent, $dbh);
}
@@ -150,15 +150,19 @@
}
sub percentage_exceptions {
- my ($count, $sub) = @_;
+ my ($count, $sub, $verbose) = @_;
my $i = $count;
my $exceptions = 0;
while ($i--) {
eval { $sub->() };
+ warn sprintf("percentage_exceptions $i: %s\n", $@|| $DBI::errstr || '') if $verbose;
if ($@) {
die "Unexpected failure: $@" unless $@ =~ /DBI_GOFER_RANDOM/;
++$exceptions;
}
}
+ warn sprintf "percentage_exceptions %f/%f*100 = %f\n",
+ $exceptions, $count, $exceptions/$count*100
+ if $verbose;
return $exceptions/$count*100;
}
++++++ perl-DBI-1.58-dbis.diff -> perl-DBI-1.59-dbis.diff ++++++
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Remember to have fun...
---------------------------------------------------------------------
To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org