Author: timbo
Date: Wed Jun 27 02:52:20 2007
New Revision: 9685
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/lib/DBI/ProfileData.pm
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/03handle.t
Log:
Unescape headers lines from data file in DBI/ProfileData.pm
Fix PurePerl to return undef for ChildHandles if weaken not available.
Fix t/03handle.t to skip some tests if ChildHandles not available.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Wed Jun 27 02:52:20 2007
@@ -37,6 +37,12 @@
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 XXX), XXth June 2007
+
+ Fixed DBI::ProfileData to unescape headers lines read from data file.
+ Fixed DBI::PurePerl to return undef for ChildHandles if weaken not available.
+ Fixed t/03handle.t to skip some tests if ChildHandles not available.
+
=head2 Changes in DBI 1.58 (svn rev 9678), 25th June 2007
Fixed code triggering fatal error in bleadperl, thanks to Steve Hay.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Wed Jun 27 02:52:20 2007
@@ -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
@@ -120,7 +120,7 @@
=head2 NOTES
-This is the DBI specification that corresponds to the DBI version 1.58
+This is the DBI specification that corresponds to the DBI version 1.59
($Revision$).
The DBI is evolving at a steady pace, so it's good to check that
Modified: dbi/trunk/lib/DBI/ProfileData.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileData.pm (original)
+++ dbi/trunk/lib/DBI/ProfileData.pm Wed Jun 27 02:52:20 2007
@@ -236,10 +236,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/(?<!\\)\\n/\n/g; # expand \n, unless it's a \\n
+ s/(?<!\\)\\r/\r/g; # expand \r, unless it's a \\r
+ s/\\\\/\\/g; # \\ to \
+ return $_;
+}
+
+
# reads the body of the profile data
sub _read_body {
my ($self, $fh, $filename) = @_;
@@ -249,20 +259,15 @@
# build up node array
my @path = ("");
- my (@data, $index, $key, $path_key);
+ my (@data, $path_key);
while (<$fh>) {
chomp;
if (/^\+\s+(\d+)\s?(.*)/) {
# it's a key
- ($key, $index) = ($2, $1 - 1);
-
- # unmangle key
- $key =~ s/(?<!\\)\\n/\n/g; # expand \n, unless it's a \\n
- $key =~ s/(?<!\\)\\r/\r/g; # expand \r, unless it's a \\r
- $key =~ s/\\\\/\\/g; # \\ to \
+ my ($key, $index) = ($2, $1 - 1);
$#path = $index; # truncate path to new length
- $path[$index] = $key; # place new key at end
+ $path[$index] = unescape_key($key); # place new key at end
}
elsif (s/^=\s+//) {
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Wed Jun 27 02:52:20 2007
@@ -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');
Modified: dbi/trunk/t/03handle.t
==============================================================================
--- dbi/trunk/t/03handle.t (original)
+++ dbi/trunk/t/03handle.t Wed Jun 27 02:52:20 2007
@@ -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';
