[PATCH] Two fixes for DBI::ProfileData

Index: lib/DBI/ProfileData.pm
===================================================================
RCS file: /usr/local/cvsroot/DBI-1.32/lib/DBI/ProfileData.pm,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 ProfileData.pm
--- lib/DBI/ProfileData.pm	2 Dec 2002 21:14:04 -0000	1.1.1.1
+++ lib/DBI/ProfileData.pm	2 Dec 2002 21:33:34 -0000
@@ -174,10 +174,10 @@
             # it's a key
             ($key, $index) = ($2, $1 - 1);
 
-            # unmangle key	XXX looks unsafe
-            $key =~ s/\\n/\n/g;
-            $key =~ s/\\r/\r/g;
-            $key =~ s/\\\\/\\/g;
+            # 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 \
 
             $#path = $index;      # truncate path to new length
             $path[$index] = $key; # place new key at end
Index: t/42prof_data.t
===================================================================
RCS file: /usr/local/cvsroot/DBI-1.32/t/42prof_data.t,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 42prof_data.t
--- t/42prof_data.t	2 Dec 2002 21:14:04 -0000	1.1.1.1
+++ t/42prof_data.t	2 Dec 2002 21:33:34 -0000
@@ -17,7 +17,7 @@
 }
 
 use Test;
-BEGIN { plan tests => 14; }
+BEGIN { plan tests => 18; }
 
 use Data::Dumper;
 $Data::Dumper::Indent = 1;
@@ -67,7 +67,11 @@
 my $clone = $prof->clone();
 $clone->sort(field => "count");
 ok($clone->exclude(key1 => $most->[7]));
-#ok($clone->nodes()->[0][0] != $most->[0]); # XXX fix me
+
+# compare keys of the new first element and the old one to make sure
+# exclude works
+ok($clone->nodes()->[0][7] ne $most->[7] &&
+   $clone->nodes()->[0][8] ne $most->[8]);
 
 # there can only be one
 $clone = $prof->clone();
@@ -79,6 +83,35 @@
 my $Data = $prof->Data;
 ok(exists($Data->{$sql}));
 ok(exists($Data->{$sql}{execute}));
+
+# test escaping of \n and \r in keys
+$dbh = DBI->connect("dbi:ExampleP:", '', '', 
+                    { RaiseError=>1, Profile=>"6/DBI::ProfileDumper" });
+
+my $sql2 = 'select size from . where name = "LITERAL: \r\n"';
+my $sql3 = "select size from . where name = \"EXPANDED: \r\n\"";
+
+# do a little work
+foreach (1,2,3) {
+  my $sth2 = $dbh->prepare($sql2);
+  $sth2->execute();
+  $sth2->fetchrow_hashref;
+  $sth2->finish;
+  my $sth3 = $dbh->prepare($sql3);
+  $sth3->execute();
+  $sth3->fetchrow_hashref;
+  $sth3->finish;
+}
+undef $dbh;
+
+# load dbi.prof
+$prof = DBI::ProfileData->new();
+ok($prof and ref $prof eq 'DBI::ProfileData');
+
+# make sure the keys didn't get garbled
+$Data = $prof->Data;
+ok(exists $Data->{$sql2});
+ok(exists $Data->{$sql3});
 
 # cleanup
 # unlink("dbi.prof"); # now done by 'make clean'

• [PATCH] Two fixes for DBI::ProfileData by Sam Tregar
• Re: [PATCH] Two fixes for DBI::ProfileData by Tim Bunce