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';
 
 
 # 
-----------------------------------------------------------------------------------

Reply via email to