Thanks, applied.
Tim.
On Mon, Dec 02, 2002 at 04:41:38PM -0500, Sam Tregar wrote:
> The attached patch fixes two bugs in my code spotted by Tim. First, the
> unescaping of keys with literal '\n' and '\r' in DBI::ProfileData was
> broken. Second, the broken test marked "XXX fix me" in t/42prof_data.t
> has been repaired. It was using the count field as an identifier for the
> record when it should have been using the key fields.
>
> -sam
>
> 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'
