Author: timbo
Date: Tue May 22 15:40:19 2007
New Revision: 9593
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
dbi/trunk/lib/DBI/Profile.pm
dbi/trunk/lib/DBI/ProfileDumper.pm
dbi/trunk/lib/DBI/ProfileDumper/Apache.pm
dbi/trunk/t/40profile.t
Log:
Added support for !Time and !Time~N to DBI::Profile Path.
DBI::ProfileDumper changes:
Lock the data file while writing.
DBI::ProfileDumper::Apache changes:
Added Quiet=>1 to avoid write to STDERR in flush_to_disk().
Added/updated docs for both DBI::ProfileDumper && ::Apache.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue May 22 15:40:19 2007
@@ -8,10 +8,6 @@
Assorted TODO notes:
-Add to profile Path for 'self clocking' sample periods:
- !Time - integer unix time GMT
- !TimeN - integer(time/N)*N
-
Add count of identical frozen_request (plus sum(results size)) to Gofer status
Highlight those seen before.
@@ -30,7 +26,6 @@
or piggyback on skip_connect_check
could also remember which attr have been returned to us
so not bother FETCHing them (unless pedantic)
-Refactor http transport like the others re timeout
Call method on transport failure so transport can cleanup/reset it it wants
prepare(...,{ Err=>\my $isolated_err, ...})
@@ -42,7 +37,21 @@
=head2 Changes in DBI 1.57 (svn rev XXX), XX May 2007
- Fixed unused var warning thanks to JDHEDDEN.
+ Fixed unused var compiler warning thanks to JDHEDDEN.
+
+ Added support for !Time and !Time~N to DBI::Profile Path.
+
+ DBI::ProfileDumper changes:
+ Use full natural precision (was using %.6f).
+ Optimized flush_to_disk().
+ Lock the data file while writing.
+ Added $profile->filename method.
+ Enabled filename to be a code ref for dynamic names.
+ DBI::ProfileDumper::Apache changes:
+ Added Quiet=>1 to avoid write to STDERR in flush_to_disk().
+ Enable DBI_PROFILE_APACHE_LOG_DIR for mod_perl 1 as well as 2.
+ Added parent pid to default data file name.
+ Added/updated docs for both DBI::ProfileDumper && ::Apache.
=head2 Changes in DBI 1.56 (svn rev 9561), 13th May 2007
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Tue May 22 15:40:19 2007
@@ -2452,6 +2452,17 @@
else if (p[1] == 'C' && strEQ(p, "!Caller2")) {
dest_node = _profile_next_node(dest_node, log_where(0,
0, "", "", 1, 1, 0));
}
+ else if (p[1] == 'T' && (strEQ(p, "!Time") || strnEQ(p,
"!Time~", 6))) {
+ char timebuf[20];
+ int factor = 1;
+ if (p[5] == '~') {
+ factor = atoi(&p[6]);
+ if (factor == 0) /* sanity check to avoid div by
zero error */
+ factor = 3600;
+ }
+ sprintf(timebuf, "%ld",
((long)(dbi_time()/factor))*factor);
+ dest_node = _profile_next_node(dest_node, timebuf);
+ }
else {
warn("Unknown ! element in DBI::Profile Path: %s", p);
dest_node = _profile_next_node(dest_node, p);
Modified: dbi/trunk/lib/DBI/Profile.pm
==============================================================================
--- dbi/trunk/lib/DBI/Profile.pm (original)
+++ dbi/trunk/lib/DBI/Profile.pm Tue May 22 15:40:19 2007
@@ -220,11 +220,14 @@
The Path value is a reference to an array. Each element controls the
value to use at the corresponding level of the profile Data tree.
-The elements of Path array can be one of the following types:
+If the value of Path is anything other than an array reference,
+it is treated as if it was:
-=over 4
+ [ '!Statement' ]
+
+The elements of Path array can be one of the following types:
-=item Special Constant
+=head3 Special Constant
B<!Statement>
@@ -283,7 +286,22 @@
Same as !Caller2 above except that only the filenames are included, not the
line number.
-=item Code Reference
+B<!Time>
+
+Use the current value of time(). Rarely used. See the more useful C<!Time~N>
below.
+
+B<!Time~N>
+
+Where C<N> is an integer. Use the current value of time() but with reduced
precision.
+The value used is determined in this way:
+
+ int( time() / N ) * N
+
+This is a useful way to segregate a profile into time slots. For example:
+
+ [ '!Time~60', '!Statement' ]
+
+=head3 Code Reference
The subroutine is passed the handle it was called on and the DBI method name.
The current Statement is in $_. The statement string should not be modified,
@@ -295,7 +313,7 @@
in the returned list. That can be useful when you want to only profile
statements that match a certain pattern, or only profile certain methods.
-=item Subroutine Specifier
+=head3 Subroutine Specifier
A Path element that begins with 'C<&>' is treated as the name of a subroutine
in the DBI::ProfileSubs namespace and replaced with the corresponding code
reference.
@@ -307,33 +325,24 @@
C<'&norm_std_n3'>. That's a very handy subroutine when profiling code that
doesn't use placeholders. See L<DBI::ProfileSubs> for more information.
-=item Attribute Specifier
+=head3 Attribute Specifier
A string enclosed in braces, such as 'C<{Username}>', specifies that the
current
value of the corresponding database handle attribute should be used at that
point in the Path.
-=item Reference to a Scalar
+=head3 Reference to a Scalar
Specifies that the current value of the referenced scalar be used at that point
in the Path. This provides an efficient way to get 'contextual' values into
your profile.
-=item Other Values
+=head3 Other Values
Any other values are stringified and used literally.
(References, and values that begin with punctuation characters are reserved.)
-=back
-
-Only the first 100 elements in Path are used.
-
-If the value of Path is anything other than an array reference,
-it is treated as if it was:
-
- [ DBI::Profile::!Statement ]
-
=head1 REPORTING
Modified: dbi/trunk/lib/DBI/ProfileDumper.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileDumper.pm (original)
+++ dbi/trunk/lib/DBI/ProfileDumper.pm Tue May 22 15:40:19 2007
@@ -22,10 +22,10 @@
use DBI;
# profile with default path (2) and output file (dbi.prof)
- $dbh->{Profile} = "2/DBI::ProfileDumper";
+ $dbh->{Profile} = "!Statement/DBI::ProfileDumper";
# same thing, spelled out
- $dbh->{Profile} = "2/DBI::ProfileDumper/File:dbi.prof";
+ $dbh->{Profile} = "!Statement/DBI::ProfileDumper/File:dbi.prof";
# another way to say it
use DBI::Profile;
@@ -94,6 +94,10 @@
Flushes all collected profile data to disk and empties the Data hash.
This method may be called multiple times during a program run.
+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.
+
=head2 empty
$profile->empty()
@@ -173,6 +177,7 @@
our @ISA = ("DBI::Profile");
use Carp qw(croak);
+use Fcntl qw(:flock);
use Symbol;
my $program_header;
@@ -206,22 +211,29 @@
my $filename = $self->filename;
my $fh = gensym;
- if ($self->{_wrote_header}) {
+ if (($self->{_wrote_header}||'') eq $filename) {
# append more data to the file
# XXX assumes that Path hasn't changed
open($fh, ">>$filename")
or croak("Unable to open '$filename' for profile output: $!");
} else {
- # create new file (overwrite existing) and write the header
+ # create new file (overwrite existing)
open($fh, ">$filename")
or croak("Unable to open '$filename' for profile output: $!");
+ }
+ # lock the file (before checking size and writing the header)
+ flock($fh, LOCK_EX);
+ # write header if file is empty - typically because we just opened it
+ # in '>' mode, or perhaps we used '>>' but the file had been truncated
externally.
+ if (-s $fh == 0) {
$self->write_header($fh);
- $self->{_wrote_header} = 1;
+ $self->{_wrote_header} = $filename;
}
$self->write_data($fh, $self->{Data}, 1);
- close($fh) or croak("Error closing '$filename': $!");
+ close($fh) # unlocks the file
+ or croak("Error closing '$filename': $!");
$self->empty();
}
Modified: dbi/trunk/lib/DBI/ProfileDumper/Apache.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileDumper/Apache.pm (original)
+++ dbi/trunk/lib/DBI/ProfileDumper/Apache.pm Tue May 22 15:40:19 2007
@@ -72,7 +72,27 @@
=head3 Naming the files
-XXX
+The default file name is inherited from L<DBI::ProfileDumper> via the
+filename() method, but DBI::ProfileDumper::Apache appends the parent pid and
+the current pid, separated by dots, to that name.
+
+=head3 Silencing the log
+
+By default a message is written to STDERR (i.e., the apache error_log file)
+when flush_to_disk() is called (either explicitly, or implicitly via DESTROY).
+
+That's usually very useful. If you don't want the log message you can silence
+it by setting the C<Quiet> attribute true.
+
+ PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache/Quiet:1
+
+ $dbh->{Profile} = "!Statement/DBI::ProfileDumper/Quiet:1";
+
+ $dbh->{Profile} = DBI::ProfileDumper->new(
+ Path => [ '!Statement' ]
+ Quiet => 1
+ );
+
=head2 GATHERING PROFILE DATA
@@ -96,7 +116,7 @@
Once you've made some code changes, you're ready to start again.
First, delete the old profile data files:
- rm /usr/local/apache/logs/dbi.prof.
+ rm /usr/local/apache/logs/dbi.prof.*
Then restart your server and get back to work.
@@ -136,12 +156,20 @@
use constant MP2 => ($ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION}
== 2) ? 1 : 0;
-# Override flush_to_disk() to setup File just in time for output.
-# Overriding new() would work unless the user creates a DBI handle
-# during server startup, in which case all the children would try to
-# write to the same file.
-sub flush_to_disk {
- my $self = shift;
+
+sub filename {
+ my $filename = shift->SUPER::filename(@_);
+ # to be able to identify groups of profile files from the same set of
+ # apache processes, we include the parent pid in the file name
+ # as well as the pid.
+ my $parent_pid = getppid();
+ my $path = $self->fileabspath();
+ return File::Spec->catfile($path, "$filename.$parent_pid.$$");
+}
+
+
+sub fileabspath {
+ my ($self) = @_;
# setup File per process
my $path;
@@ -149,28 +177,28 @@
$path = $ENV{DBI_PROFILE_APACHE_LOG_DIR};
}
else {
+ # can't cache, at least not during startup
+ my $subdir = "logs";
if (MP2) {
require Apache2::RequestUtil;
require Apache2::ServerUtil;
- $path =
Apache2::ServerUtil::server_root_relative(Apache2::RequestUtil->request()->pool,
"logs/")
+ $path =
Apache2::ServerUtil::server_root_relative(Apache2::RequestUtil->request()->pool,
$subdir)
}
else {
require Apache;
- $path = Apache->server_root_relative("logs/");
+ $path = Apache->server_root_relative($subdir);
}
}
+ return $path;
+}
- # to be able to identify groups of profile files from the same set of
- # apache processes, we include the parent pid in the file name.
- my $parent_pid = getppid();
- my $filename = $self->filename();
- local $self->{File} = File::Spec->catfile($path,
"$filename.$parent_pid.$$");
+sub flush_to_disk {
+ my $self = shift;
- print STDERR "DBI::ProfileDumper::Apache writing to $self->{File}\n"
+ printf STDERR ref($self)." writing to %s\n", $self->filename();
unless $self->{Quiet};
- # write out to disk
return $self->SUPER::flush_to_disk(@_);
}
Modified: dbi/trunk/t/40profile.t
==============================================================================
--- dbi/trunk/t/40profile.t (original)
+++ dbi/trunk/t/40profile.t Tue May 22 15:40:19 2007
@@ -22,7 +22,7 @@
# tie methods (STORE/FETCH etc) get called different number of times
plan skip_all => "test results assume perl >= 5.8.2"
if $] <= 5.008001;
- plan tests => 51;
+ plan tests => 52;
}
$Data::Dumper::Indent = 1;
@@ -232,6 +232,8 @@
} => 'DBI::Profile';
+print "testing '!File', '!Caller' and their variants in Path\n";
+
$dbh->{Profile}->{Path} = [ '!File', '!File2', '!Caller', '!Caller2' ];
$dbh->{Profile}->{Data} = undef;
@@ -255,6 +257,26 @@
};
+print "testing '!Time' and variants in Path\n";
+
+undef $sth;
+my $factor = 100_000; # ~27 hours
+$dbh->{Profile}->{Path} = [ '!Time', "!Time~$factor", '!MethodName' ];
+$dbh->{Profile}->{Data} = undef;
+
+$t1 = time()+1; 1 while time() < $t1; # spin till new second starts
+$sth = $dbh->prepare("select name from .");
+$t2 = int($t1/$factor)*$factor;
+
+$tmp = sanitize_profile_data_nodes($dbh->{Profile}{Data});
+#warn Dumper($tmp);
+is_deeply $tmp, {
+ $t1 => { $t2 => { prepare => [ 1, 0, 0, 0, 0, 0, 0 ] }}
+}, "!Time and !Time~$factor should work";
+
+
+print "testing &norm_std_n3 in Path\n";
+
$dbh->{Profile} = '&norm_std_n3'; # assign as string to get magic
is_deeply $dbh->{Profile}{Path}, [
\&DBI::ProfileSubs::norm_std_n3
@@ -266,7 +288,7 @@
#warn Dumper($tmp);
is_deeply $tmp, {
'insert into foo<N> (a,b) values (<N>,"<S>")' => [ 1, '2', '2', '2', '2',
'100000000', '100000000' ]
-};
+}, '&norm_std_n3 should normalize statement';
#
-----------------------------------------------------------------------------------