| Subject: | ProfileDumper vs -l (with patch) |
ProfileDumper does not protect itself against the setting of globals
which effect print, that is $\ and $,. This results in extra newlines
in the profile dump and dbiprof gets confused.
The attached patch isolates ProfileDumper from this.
| Subject: | profile_dumper.patch |
Auto-merging (0, 27417) /local/DBI to /vendor/DBI (base /vendor/DBI:27414).
U t/41prof_dump.t
U lib/DBI/ProfileDumper.pm
==== Patch <-> level 1
Source: 9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBI:27417
Target: 9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBI:27414
Log:
r27415@windhund: schwern | 2007-02-16 13:47:48 -0500
Local copy of DBI
r27416@windhund: schwern | 2007-02-16 14:29:13 -0500
Isolate ProfileDumper from changes to globals which effect print such as
when you're using -l
r27417@windhund: schwern | 2007-02-16 14:33:39 -0500
Oops, $/ isn't a print thing.
=== t/41prof_dump.t
==================================================================
--- t/41prof_dump.t (revision 27414)
+++ t/41prof_dump.t (patch - level 1)
@@ -1,5 +1,7 @@
-#!perl -w
+#!perl -lw
+# Use -l to ensure ProfileDumper is isolated from changes to $/ and $\ and such
+
use strict;
#
@@ -15,7 +17,7 @@
plan skip_all => 'profiling not supported for DBI::PurePerl';
}
else {
- plan tests => 12;
+ plan tests => 15;
}
}
@@ -57,19 +59,24 @@
ok( -s "dbi.prof", 'Profile is on disk and nonzero size' );
open(PROF, "dbi.prof") or die $!;
-my $prof = join('', <PROF>);
+my @prof = <PROF>;
close PROF;
# has a header?
-ok( $prof =~ /^DBI::ProfileDumper\s+([\d.]+)/, 'Found a version number' );
+ok( $prof[0] =~ /^DBI::ProfileDumper\s+([\d.]+)/, 'Found a version number' );
# Can't use like() because we need $1
# version matches VERSION? (DBI::ProfileDumper uses $self->VERSION so
# it's a stringified version object that looks like N.N.N)
is( $1, DBI::ProfileDumper->VERSION, 'Version numbers match' );
+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($prof, qr/\+\s+1\s+\Q$sql\E/m);
+like(join('', @prof), qr/\+\s+1\s+\Q$sql\E/m);
# unlink("dbi.prof"); # now done by 'make clean'
=== lib/DBI/ProfileDumper.pm
==================================================================
--- lib/DBI/ProfileDumper.pm (revision 27414)
+++ lib/DBI/ProfileDumper.pm (patch - level 1)
@@ -201,12 +201,22 @@
shift->{Data} = {};
}
+sub _print {
+ my($fh) = shift;
+
+ # isolate us against globals which effect print
+ local($\, $,);
+
+ print $fh @_;
+}
+
+
# write header to a filehandle
sub write_header {
my ($self, $fh) = @_;
# module name and version number
- print $fh ref($self), " ", $self->VERSION, "\n";
+ _print $fh, ref($self), " ", $self->VERSION, "\n";
# print out Path
my @path_words;
@@ -215,15 +225,15 @@
push @path_words, $_;
}
}
- print $fh "Path = [ ", join(', ', @path_words), " ]\n";
+ _print $fh, "Path = [ ", join(', ', @path_words), " ]\n";
# print out $0 and @ARGV
- print $fh "Program = $0";
- print $fh " ", join(", ", @ARGV) if @ARGV;
- print $fh "\n";
+ _print $fh, "Program = $0";
+ _print $fh, " ", join(", ", @ARGV) if @ARGV;
+ _print $fh, "\n";
# all done
- print $fh "\n";
+ _print $fh, "\n";
}
# write data in the proscribed format
@@ -235,10 +245,10 @@
while (my ($key, $value) = each(%$data)) {
# output a key
- print $fh "+ ", $level, " ", quote_key($key), "\n";
+ _print $fh, "+ ", $level, " ", quote_key($key), "\n";
if (UNIVERSAL::isa($value,'ARRAY')) {
# output a data set for a leaf node
- printf $fh "= %4d %.6f %.6f %.6f %.6f %.6f %.6f\n", @$value;
+ _print $fh, sprintf "= %4d %.6f %.6f %.6f %.6f %.6f %.6f\n", @$value;
} else {
# recurse through keys - this could be rewritten to use a
# stack for some small performance gain
==== BEGIN SVK PATCH BLOCK ====
Version: svk v2.0.0 (darwin)
eJyNld9v40QQx/NaC/EG0kk8DFef0uiSq9c/45SGgI5yJxBX7tcDbS9ar9exr443eJ32qvOhtkJC
CBAP/CHHAwIhwf/G7Dop7dGjFznJ2jPzmdndr2e3yocbI1IPh1ZtEqt+8PizwWCbViy9Qdza9Gse
Z5UoTa/O+QHPTafOxcR064JOOVqlmJdMDSpaTnilBhnb59VwSBDXb3CfaMQSq6kRrUQhzVDjx1XJ
uUlqfxTUI0ddY5OEteRo0dhxyQ8ymYkCy7ADlwTogv4E48WMF+NSiOrMZKtoq2a5kHys8ArpKX/b
xCnpgDgrOcOajvBppUnLaO3oXuKIE8+iC666TG+R6DyRYA0NyFlWmGQ5V87VuktmpUjG8Xw6u1Xp
oq7k2Q1PW+lslh+NK/6sinleUZ3Dseu+HzmO61Kb2P0otjzH60csJL6bJP2IJpHphCFuxhet1k/X
fn7r2unT453WyfbKSeu7xydf/dk6vfn97PjkUevLH++svj/jZQ69/NAwVuGR5DiESgAv5LzksI3F
41xuY/m8hEziJXJa8RiSUkyBpbSYcKkCzHWgRQzmrv6Tc5Z6IzV12IQPtu/f2xpuGHqqoG42VLKU
SqCQchrz8kND7K+BqQJ2rL082+fLO7LXha/L509QTemuvLmJ390d9bP3ogvtLTHHbFWKWLS3Oxvn
OPYebH4DUwwtxaSk00X02u6Dm51XYhsHFW5kEuNJF0wLXRYGmCopc9mGjq4cx2wfI2kF/NkMNw7X
Y58fqfVBXMkNPYGnIivW2u0u6HXojNzzSm0U0uymF8XMdzxqR27s0sAJSZ+xKLGCMIxYnHhn+vIu
EWqghLp+++O7WshXiss9g/kXxGq7S876hT2/NZvqxFeCvf9Vra/myQPH7nt+wAj3LOpECXOsgDIv
SogdeCwyXbvfqPavt/9+zzytWy9ftI7nrWcvn//QOtn6tT4+edI67fz2Lt698/udX1rftv+YyHkE
41mZFRU8N1amR2tmknZQdDLNkmrDWDFWVpeihTkKbkKzQlYwyUVEcwmHacZS4EmCEwGNMVZywWi+
Zu6iCLodjWj4SIbReMN4YYzPHnTPDeG6EiHm3oHrXWi2H0WkBIDPx4eijGUHvWBvt7iOQgL8rDZJ
QcyRYel3Z/TR/U8fa+NF9kKLm+iH0f+xn+XEf7w0pQNZ0owuCThfBM1ziEXBX/V6zUSlHieXSlpv
dWTxIGGuHyaeTeOAxiQKAjuMiRtEPGFUd1aHkBpKpStvdJgVcYrv4wBAsvSQlwXUYFtW0LPsHvGB
OAM3GLh96FmeZRnwudojYGJ2BNhjULZGQ/KvJrkDOxwQZ0m6uxDHxVb3ant7vV50rwMqDbTxAo7E
vF0qqWXFBHvpoqzgTcpynIETLsu6J2ayq7pqJot2hY2ySValyL1l4Pr1hkO7Nm27OXQf6pNzMHhU
ZAe8lDS/4dd4bivh4VmGByrezOdZrLZrXQtc94zFa206fh2yft+zwrjHQ+L2LJdYvcgirBeFnmP5
xMWOxIcdu34tmNTrB7yIRXmO7L4p2fScN/Ib/Fv8QJf+DxOyusA=
==== END SVK PATCH BLOCK ====