Author: timbo
Date: Tue Jun 5 04:36:40 2007
New Revision: 9628
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/dbiprof.PL
dbi/trunk/lib/DBI/ProfileData.pm
dbi/trunk/lib/DBI/ProfileDumper.pm
dbi/trunk/t/42prof_data.t
dbi/trunk/t/86gofer_fail.t
Log:
Added extra trace info to connect_cached thanks to Walery Studennikov.
Added --delete option to dbiprof. Updated related docs.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue Jun 5 04:36:40 2007
@@ -46,6 +46,7 @@
Corrected timeout example in docs thanks to Egmont Koblinger.
Added support for !Time and !Time~N to DBI::Profile Path.
+ Added extra trace info to connect_cached thanks to Walery Studennikov.
DBI::ProfileDumper changes:
Don't write file if there's no profile data.
@@ -64,7 +65,7 @@
Locks the data files while reading.
Added ability to sort by Path elements.
dbiprof changes:
- Added --dumpnodes option.
+ Added --dumpnodes and --delete options.
Added/updated docs for both DBI::ProfileDumper && ::Apache.
=head2 Changes in DBI 1.56 (svn rev 9561), 13th May 2007
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Tue Jun 5 04:36:40 2007
@@ -1426,9 +1426,11 @@
my @attr_keys = $attr ? sort keys %$attr : ();
my $key = do { local $^W; # silence undef warnings
- join "~~", $dsn, $user||'', $auth||'', $attr ? (@attr_keys,@[EMAIL
PROTECTED]) : ()
+ join "~~", $dsn, $user, $auth, $attr ? (@attr_keys,@[EMAIL
PROTECTED]) : ()
};
my $dbh = $cache->{$key};
+ $drh->trace_msg(sprintf(" connect_cached: key '$key', cached dbh
$dbh\n", DBI::neat($key), DBI::neat($dbh)))
+ if $DBI::dbi_debug >= 4;
my $cb = $attr->{Callbacks}; # take care not to autovivify
if ($dbh && $dbh->FETCH('Active') && eval { $dbh->ping }) {
# If the caller has provided a callback then call it
Modified: dbi/trunk/dbiprof.PL
==============================================================================
--- dbi/trunk/dbiprof.PL (original)
+++ dbi/trunk/dbiprof.PL Tue Jun 5 04:36:40 2007
@@ -38,7 +38,7 @@
print <<EOS;
dbiprof [options] [files]
-Merges DBI profile data contain in files and prints a summary.
+Reads and merges DBI profile data from files and prints a summary.
files: defaults to $filename
@@ -50,6 +50,7 @@
-match=K=V for filtering, see docs
-exclude=K=V for filtering, see docs
-case_sensitive for -match and -exclude
+ -delete rename files before reading then delete afterwards
-version print version number and exit
-help print this help
@@ -62,8 +63,12 @@
# instantiate ProfileData object
-my $prof;
-eval { $prof = DBI::ProfileData->new(Files => [EMAIL PROTECTED]) };
+my $prof = eval {
+ $prof = DBI::ProfileData->new(
+ Files => [EMAIL PROTECTED],
+ DeleteFiles => $opt_delete,
+ );
+};
die "Unable to load profile data: [EMAIL PROTECTED]" if $@;
if (%match) { # handle matches
@@ -226,6 +231,11 @@
Using this option causes --match and --exclude to work
case-sensitively. Defaults to off.
+=item --delete
+
+Sets the C<DeleteFiles> option to L<DBI::ProfileData> which causes the
+files to be deleted after reading. See L<DBI::ProfileData> for more details.
+
=item --dumpnodes
Print the list of nodes in the form of a perl data structure.
Modified: dbi/trunk/lib/DBI/ProfileData.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileData.pm (original)
+++ dbi/trunk/lib/DBI/ProfileData.pm Tue Jun 5 04:36:40 2007
@@ -109,9 +109,13 @@
=head3 DeleteFiles
-If true, the files are deleted after being read. (Actually the files are
-renamed first which, together with locking, avoids problems if other
-applications are writing to the file.)
+If true, the files are deleted after being read.
+
+Actually the files are renamed with a C.deleteme> suffix before being read,
+and then, after reading all the files, they're all deleted together.
+
+The files are locked while being read which, combined with the rename, makes it
+safe to 'consume' files that are still being generated by
L<DBI::ProfileDumper>.
=head3 Filter
@@ -177,16 +181,21 @@
my $self = shift;
my $files = $self->{Files};
my $read_header = 0;
+ my @files_to_delete;
my $fh = gensym;
foreach (@$files) {
my $filename = $_;
+
if ($self->{DeleteFiles}) {
my $newfilename = $filename . ".deleteme";
+ # will clobber an existing $newfilename
rename($filename, $newfilename)
or croak "Can't rename($filename, $newfilename): $!";
+ warn 42;
$filename = $newfilename;
}
+
open($fh, "<", $filename)
or croak("Unable to read profile file '$filename': $!");
@@ -200,9 +209,11 @@
$self->_read_body($fh, $filename);
}
close($fh); # and release lock
- unlink $filename or warn "Can't delete '$filename': $!"
+
+ push @files_to_delete, $filename
if $self->{DeleteFiles};
}
+ unlink $_ or warn "Can't delete '$_': $!" for @files_to_delete;
# discard node_lookup now that all files are read
delete $self->{_node_lookup};
Modified: dbi/trunk/lib/DBI/ProfileDumper.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileDumper.pm (original)
+++ dbi/trunk/lib/DBI/ProfileDumper.pm Tue Jun 5 04:36:40 2007
@@ -92,12 +92,13 @@
$profile->flush_to_disk()
Flushes all collected profile data to disk and empties the Data hash. Returns
-the filename writen to. If there's no actual profile data then the file is not
-written and flush_to_disk() returns undef.
+the filename writen to. If no profile data has been collected then the file is
+not written and flush_to_disk() returns undef.
The file is locked while it's being written. A process 'consuming' the files
-while they're being written to, should lock the file before reading and then
-truncate() it before releasing the lock.
+while they're being written to, should rename the file first, then lock it,
+then read it, then close and delete it. The C<DeleteFiles> option to
+L<DBI::ProfileData> does the right thing.
This method may be called multiple times during a program run.
@@ -109,7 +110,6 @@
=head2 filename
- $profile->empty($filename)
$filename = $profile->filename();
Get or set the filename.
Modified: dbi/trunk/t/42prof_data.t
==============================================================================
--- dbi/trunk/t/42prof_data.t (original)
+++ dbi/trunk/t/42prof_data.t Tue Jun 5 04:36:40 2007
@@ -8,12 +8,12 @@
use Test::More;
BEGIN {
- if ($DBI::PurePerl) {
- plan skip_all => 'profiling not supported for DBI::PurePerl';
- }
- else {
- plan tests => 30;
- }
+ if ($DBI::PurePerl) {
+ plan skip_all => 'profiling not supported for DBI::PurePerl';
+ }
+ else {
+ plan tests => 31;
+ }
}
BEGIN {
@@ -46,10 +46,12 @@
ok(-s "dbi.prof", "Profile written to disk, non-zero size" );
# load up
-my $prof = DBI::ProfileData->new( Filter => sub {
- my ($path_ref, $data_ref) = @_;
- $path_ref->[0] =~ s/set dummy=\d/set dummy=N/;
-});
+my $prof = DBI::ProfileData->new(
+ Filter => sub {
+ my ($path_ref, $data_ref) = @_;
+ $path_ref->[0] =~ s/set dummy=\d/set dummy=N/;
+ },
+);
isa_ok( $prof, 'DBI::ProfileData' );
cmp_ok( $prof->count, '>=', 3, 'At least 3 profile data items' );
@@ -119,15 +121,15 @@
undef $dbh;
# load dbi.prof
-$prof = DBI::ProfileData->new();
+$prof = DBI::ProfileData->new( DeleteFiles => 1 );
isa_ok( $prof, 'DBI::ProfileData' );
+ok(not(-e "dbi.prof"), "file should be deleted when DeleteFiles set" );
+
+
# 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'
-
1;
Modified: dbi/trunk/t/86gofer_fail.t
==============================================================================
--- dbi/trunk/t/86gofer_fail.t (original)
+++ dbi/trunk/t/86gofer_fail.t Tue Jun 5 04:36:40 2007
@@ -100,7 +100,7 @@
ReadOnly => 0,
} );
between_ok precentage_exceptions(100, sub { $dbh_50r1rw->do("set foo=1") }),
- 35, 65, 'should fail ~50%, ie no retries';
+ 30, 70, 'should fail ~50%, ie no retries';
ok !$dbh_50r1rw->{go_transport}->meta->{request_retry_count},
'transport request_retry_count should be zero or undef';
