955 lines
32 KiB
Perl
955 lines
32 KiB
Perl
package DBI::Profile;
|
|
|
|
=head1 NAME
|
|
|
|
DBI::Profile - Performance profiling and benchmarking for the DBI
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
The easiest way to enable DBI profiling is to set the DBI_PROFILE
|
|
environment variable to 2 and then run your code as usual:
|
|
|
|
DBI_PROFILE=2 prog.pl
|
|
|
|
This will profile your program and then output a textual summary
|
|
grouped by query when the program exits. You can also enable profiling by
|
|
setting the Profile attribute of any DBI handle:
|
|
|
|
$dbh->{Profile} = 2;
|
|
|
|
Then the summary will be printed when the handle is destroyed.
|
|
|
|
Many other values apart from are possible - see L<"ENABLING A PROFILE"> below.
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The DBI::Profile module provides a simple interface to collect and
|
|
report performance and benchmarking data from the DBI.
|
|
|
|
For a more elaborate interface, suitable for larger programs, see
|
|
L<DBI::ProfileDumper|DBI::ProfileDumper> and L<dbiprof|dbiprof>.
|
|
For Apache/mod_perl applications see
|
|
L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.
|
|
|
|
=head1 OVERVIEW
|
|
|
|
Performance data collection for the DBI is built around several
|
|
concepts which are important to understand clearly.
|
|
|
|
=over 4
|
|
|
|
=item Method Dispatch
|
|
|
|
Every method call on a DBI handle passes through a single 'dispatch'
|
|
function which manages all the common aspects of DBI method calls,
|
|
such as handling the RaiseError attribute.
|
|
|
|
=item Data Collection
|
|
|
|
If profiling is enabled for a handle then the dispatch code takes
|
|
a high-resolution timestamp soon after it is entered. Then, after
|
|
calling the appropriate method and just before returning, it takes
|
|
another high-resolution timestamp and calls a function to record
|
|
the information. That function is passed the two timestamps
|
|
plus the DBI handle and the name of the method that was called.
|
|
That data about a single DBI method call is called a I<profile sample>.
|
|
|
|
=item Data Filtering
|
|
|
|
If the method call was invoked by the DBI or by a driver then the call is
|
|
ignored for profiling because the time spent will be accounted for by the
|
|
original 'outermost' call for your code.
|
|
|
|
For example, the calls that the selectrow_arrayref() method makes
|
|
to prepare() and execute() etc. are not counted individually
|
|
because the time spent in those methods is going to be allocated
|
|
to the selectrow_arrayref() method when it returns. If this was not
|
|
done then it would be very easy to double count time spent inside
|
|
the DBI.
|
|
|
|
=item Data Storage Tree
|
|
|
|
The profile data is accumulated as 'leaves on a tree'. The 'path' through the
|
|
branches of the tree to a particular leaf is determined dynamically for each sample.
|
|
This is a key feature of DBI profiling.
|
|
|
|
For each profiled method call the DBI walks along the Path and uses each value
|
|
in the Path to step into and grow the Data tree.
|
|
|
|
For example, if the Path is
|
|
|
|
[ 'foo', 'bar', 'baz' ]
|
|
|
|
then the new profile sample data will be I<merged> into the tree at
|
|
|
|
$h->{Profile}->{Data}->{foo}->{bar}->{baz}
|
|
|
|
But it's not very useful to merge all the call data into one leaf node (except
|
|
to get an overall 'time spent inside the DBI' total). It's more common to want
|
|
the Path to include dynamic values such as the current statement text and/or
|
|
the name of the method called to show what the time spent inside the DBI was for.
|
|
|
|
The Path can contain some 'magic cookie' values that are automatically replaced
|
|
by corresponding dynamic values when they're used. These magic cookies always
|
|
start with a punctuation character.
|
|
|
|
For example a value of 'C<!MethodName>' in the Path causes the corresponding
|
|
entry in the Data to be the name of the method that was called.
|
|
For example, if the Path was:
|
|
|
|
[ 'foo', '!MethodName', 'bar' ]
|
|
|
|
and the selectall_arrayref() method was called, then the profile sample data
|
|
for that call will be merged into the tree at:
|
|
|
|
$h->{Profile}->{Data}->{foo}->{selectall_arrayref}->{bar}
|
|
|
|
=item Profile Data
|
|
|
|
Profile data is stored at the 'leaves' of the tree as references
|
|
to an array of numeric values. For example:
|
|
|
|
[
|
|
106, # 0: count of samples at this node
|
|
0.0312958955764771, # 1: total duration
|
|
0.000490069389343262, # 2: first duration
|
|
0.000176072120666504, # 3: shortest duration
|
|
0.00140702724456787, # 4: longest duration
|
|
1023115819.83019, # 5: time of first sample
|
|
1023115819.86576, # 6: time of last sample
|
|
]
|
|
|
|
After the first sample, later samples always update elements 0, 1, and 6, and
|
|
may update 3 or 4 depending on the duration of the sampled call.
|
|
|
|
=back
|
|
|
|
=head1 ENABLING A PROFILE
|
|
|
|
Profiling is enabled for a handle by assigning to the Profile
|
|
attribute. For example:
|
|
|
|
$h->{Profile} = DBI::Profile->new();
|
|
|
|
The Profile attribute holds a blessed reference to a hash object
|
|
that contains the profile data and attributes relating to it.
|
|
|
|
The class the Profile object is blessed into is expected to
|
|
provide at least a DESTROY method which will dump the profile data
|
|
to the DBI trace file handle (STDERR by default).
|
|
|
|
All these examples have the same effect as each other:
|
|
|
|
$h->{Profile} = 0;
|
|
$h->{Profile} = "/DBI::Profile";
|
|
$h->{Profile} = DBI::Profile->new();
|
|
$h->{Profile} = {};
|
|
$h->{Profile} = { Path => [] };
|
|
|
|
Similarly, these examples have the same effect as each other:
|
|
|
|
$h->{Profile} = 6;
|
|
$h->{Profile} = "6/DBI::Profile";
|
|
$h->{Profile} = "!Statement:!MethodName/DBI::Profile";
|
|
$h->{Profile} = { Path => [ '!Statement', '!MethodName' ] };
|
|
|
|
If a non-blessed hash reference is given then the DBI::Profile
|
|
module is automatically C<require>'d and the reference is blessed
|
|
into that class.
|
|
|
|
If a string is given then it is processed like this:
|
|
|
|
($path, $module, $args) = split /\//, $string, 3
|
|
|
|
@path = split /:/, $path
|
|
@args = split /:/, $args
|
|
|
|
eval "require $module" if $module
|
|
$module ||= "DBI::Profile"
|
|
|
|
$module->new( Path => \@Path, @args )
|
|
|
|
So the first value is used to select the Path to be used (see below).
|
|
The second value, if present, is used as the name of a module which
|
|
will be loaded and it's C<new> method called. If not present it
|
|
defaults to DBI::Profile. Any other values are passed as arguments
|
|
to the C<new> method. For example: "C<2/DBIx::OtherProfile/Foo:42>".
|
|
|
|
Numbers can be used as a shorthand way to enable common Path values.
|
|
The simplest way to explain how the values are interpreted is to show the code:
|
|
|
|
push @Path, "DBI" if $path_elem & 0x01;
|
|
push @Path, "!Statement" if $path_elem & 0x02;
|
|
push @Path, "!MethodName" if $path_elem & 0x04;
|
|
push @Path, "!MethodClass" if $path_elem & 0x08;
|
|
push @Path, "!Caller2" if $path_elem & 0x10;
|
|
|
|
So "2" is the same as "!Statement" and "6" (2+4) is the same as
|
|
"!Statement:!Method". Those are the two most commonly used values. Using a
|
|
negative number will reverse the path. Thus "-6" will group by method name then
|
|
statement.
|
|
|
|
The splitting and parsing of string values assigned to the Profile
|
|
attribute may seem a little odd, but there's a good reason for it.
|
|
Remember that attributes can be embedded in the Data Source Name
|
|
string which can be passed in to a script as a parameter. For
|
|
example:
|
|
|
|
dbi:DriverName(Profile=>2):dbname
|
|
dbi:DriverName(Profile=>{Username}:!Statement/MyProfiler/Foo:42):dbname
|
|
|
|
And also, if the C<DBI_PROFILE> environment variable is set then
|
|
The DBI arranges for every driver handle to share the same profile
|
|
object. When perl exits a single profile summary will be generated
|
|
that reflects (as nearly as practical) the total use of the DBI by
|
|
the application.
|
|
|
|
|
|
=head1 THE PROFILE OBJECT
|
|
|
|
The DBI core expects the Profile attribute value to be a hash
|
|
reference and if the following values don't exist it will create
|
|
them as needed:
|
|
|
|
=head2 Data
|
|
|
|
A reference to a hash containing the collected profile data.
|
|
|
|
=head2 Path
|
|
|
|
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.
|
|
|
|
If the value of Path is anything other than an array reference,
|
|
it is treated as if it was:
|
|
|
|
[ '!Statement' ]
|
|
|
|
The elements of Path array can be one of the following types:
|
|
|
|
=head3 Special Constant
|
|
|
|
B<!Statement>
|
|
|
|
Use the current Statement text. Typically that's the value of the Statement
|
|
attribute for the handle the method was called with. Some methods, like
|
|
commit() and rollback(), are unrelated to a particular statement. For those
|
|
methods !Statement records an empty string.
|
|
|
|
For statement handles this is always simply the string that was
|
|
given to prepare() when the handle was created. For database handles
|
|
this is the statement that was last prepared or executed on that
|
|
database handle. That can lead to a little 'fuzzyness' because, for
|
|
example, calls to the quote() method to build a new statement will
|
|
typically be associated with the previous statement. In practice
|
|
this isn't a significant issue and the dynamic Path mechanism can
|
|
be used to setup your own rules.
|
|
|
|
B<!MethodName>
|
|
|
|
Use the name of the DBI method that the profile sample relates to.
|
|
|
|
B<!MethodClass>
|
|
|
|
Use the fully qualified name of the DBI method, including
|
|
the package, that the profile sample relates to. This shows you
|
|
where the method was implemented. For example:
|
|
|
|
'DBD::_::db::selectrow_arrayref' =>
|
|
0.022902s
|
|
'DBD::mysql::db::selectrow_arrayref' =>
|
|
2.244521s / 99 = 0.022445s avg (first 0.022813s, min 0.022051s, max 0.028932s)
|
|
|
|
The "DBD::_::db::selectrow_arrayref" shows that the driver has
|
|
inherited the selectrow_arrayref method provided by the DBI.
|
|
|
|
But you'll note that there is only one call to
|
|
DBD::_::db::selectrow_arrayref but another 99 to
|
|
DBD::mysql::db::selectrow_arrayref. Currently the first
|
|
call doesn't record the true location. That may change.
|
|
|
|
B<!Caller>
|
|
|
|
Use a string showing the filename and line number of the code calling the method.
|
|
|
|
B<!Caller2>
|
|
|
|
Use a string showing the filename and line number of the code calling the
|
|
method, as for !Caller, but also include filename and line number of the code
|
|
that called that. Calls from DBI:: and DBD:: packages are skipped.
|
|
|
|
B<!File>
|
|
|
|
Same as !Caller above except that only the filename is included, not the line number.
|
|
|
|
B<!File2>
|
|
|
|
Same as !Caller2 above except that only the filenames are included, not the line number.
|
|
|
|
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,
|
|
so most subs start with C<local $_ = $_;>.
|
|
|
|
The list of values it returns is used at that point in the Profile Path.
|
|
Any undefined values are treated as the string "C<undef>".
|
|
|
|
The sub can 'veto' (reject) a profile sample by including a reference to undef
|
|
(C<\undef>) 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.
|
|
|
|
=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.
|
|
|
|
Currently this only works when the Path is specified by the C<DBI_PROFILE>
|
|
environment variable.
|
|
|
|
Also, currently, the only subroutine in the DBI::ProfileSubs namespace is
|
|
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.
|
|
|
|
=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.
|
|
|
|
=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.
|
|
|
|
=head3 Other Values
|
|
|
|
Any other values are stringified and used literally.
|
|
|
|
(References, and values that begin with punctuation characters are reserved.)
|
|
|
|
|
|
=head1 REPORTING
|
|
|
|
=head2 Report Format
|
|
|
|
The current accumulated profile data can be formatted and output using
|
|
|
|
print $h->{Profile}->format;
|
|
|
|
To discard the profile data and start collecting fresh data
|
|
you can do:
|
|
|
|
$h->{Profile}->{Data} = undef;
|
|
|
|
|
|
The default results format looks like this:
|
|
|
|
DBI::Profile: 0.001015s 42.7% (5 calls) programname @ YYYY-MM-DD HH:MM:SS
|
|
'' =>
|
|
0.000024s / 2 = 0.000012s avg (first 0.000015s, min 0.000009s, max 0.000015s)
|
|
'SELECT mode,size,name FROM table' =>
|
|
0.000991s / 3 = 0.000330s avg (first 0.000678s, min 0.000009s, max 0.000678s)
|
|
|
|
Which shows the total time spent inside the DBI, with a count of
|
|
the total number of method calls and the name of the script being
|
|
run, then a formatted version of the profile data tree.
|
|
|
|
If the results are being formatted when the perl process is exiting
|
|
(which is usually the case when the DBI_PROFILE environment variable
|
|
is used) then the percentage of time the process spent inside the
|
|
DBI is also shown. If the process is not exiting then the percentage is
|
|
calculated using the time between the first and last call to the DBI.
|
|
|
|
In the example above the paths in the tree are only one level deep and
|
|
use the Statement text as the value (that's the default behaviour).
|
|
|
|
The merged profile data at the 'leaves' of the tree are presented
|
|
as total time spent, count, average time spent (which is simply total
|
|
time divided by the count), then the time spent on the first call,
|
|
the time spent on the fastest call, and finally the time spent on
|
|
the slowest call.
|
|
|
|
The 'avg', 'first', 'min' and 'max' times are not particularly
|
|
useful when the profile data path only contains the statement text.
|
|
Here's an extract of a more detailed example using both statement
|
|
text and method name in the path:
|
|
|
|
'SELECT mode,size,name FROM table' =>
|
|
'FETCH' =>
|
|
0.000076s
|
|
'fetchrow_hashref' =>
|
|
0.036203s / 108 = 0.000335s avg (first 0.000490s, min 0.000152s, max 0.002786s)
|
|
|
|
Here you can see the 'avg', 'first', 'min' and 'max' for the
|
|
108 calls to fetchrow_hashref() become rather more interesting.
|
|
Also the data for FETCH just shows a time value because it was only
|
|
called once.
|
|
|
|
Currently the profile data is output sorted by branch names. That
|
|
may change in a later version so the leaf nodes are sorted by total
|
|
time per leaf node.
|
|
|
|
|
|
=head2 Report Destination
|
|
|
|
The default method of reporting is for the DESTROY method of the
|
|
Profile object to format the results and write them using:
|
|
|
|
DBI->trace_msg($results, 0); # see $ON_DESTROY_DUMP below
|
|
|
|
to write them to the DBI trace() filehandle (which defaults to
|
|
STDERR). To direct the DBI trace filehandle to write to a file
|
|
without enabling tracing the trace() method can be called with a
|
|
trace level of 0. For example:
|
|
|
|
DBI->trace(0, $filename);
|
|
|
|
The same effect can be achieved without changing the code by
|
|
setting the C<DBI_TRACE> environment variable to C<0=filename>.
|
|
|
|
The $DBI::Profile::ON_DESTROY_DUMP variable holds a code ref
|
|
that's called to perform the output of the formatted results.
|
|
The default value is:
|
|
|
|
$ON_DESTROY_DUMP = sub { DBI->trace_msg($results, 0) };
|
|
|
|
Apart from making it easy to send the dump elsewhere, it can also
|
|
be useful as a simple way to disable dumping results.
|
|
|
|
=head1 CHILD HANDLES
|
|
|
|
Child handles inherit a reference to the Profile attribute value
|
|
of their parent. So if profiling is enabled for a database handle
|
|
then by default the statement handles created from it all contribute
|
|
to the same merged profile data tree.
|
|
|
|
|
|
=head1 PROFILE OBJECT METHODS
|
|
|
|
=head2 format
|
|
|
|
See L</REPORTING>.
|
|
|
|
=head2 as_node_path_list
|
|
|
|
@ary = $dbh->{Profile}->as_node_path_list();
|
|
@ary = $dbh->{Profile}->as_node_path_list($node, $path);
|
|
|
|
Returns the collected data ($dbh->{Profile}{Data}) restructured into a list of
|
|
array refs, one for each leaf node in the Data tree. This 'flat' structure is
|
|
often much simpler for applications to work with.
|
|
|
|
The first element of each array ref is a reference to the leaf node.
|
|
The remaining elements are the 'path' through the data tree to that node.
|
|
|
|
For example, given a data tree like this:
|
|
|
|
{key1a}{key2a}[node1]
|
|
{key1a}{key2b}[node2]
|
|
{key1b}{key2a}{key3a}[node3]
|
|
|
|
The as_node_path_list() method will return this list:
|
|
|
|
[ [node1], 'key1a', 'key2a' ]
|
|
[ [node2], 'key1a', 'key2b' ]
|
|
[ [node3], 'key1b', 'key2a', 'key3a' ]
|
|
|
|
The nodes are ordered by key, depth-first.
|
|
|
|
The $node argument can be used to focus on a sub-tree.
|
|
If not specified it defaults to $dbh->{Profile}{Data}.
|
|
|
|
The $path argument can be used to specify a list of path elements that will be
|
|
added to each element of the returned list. If not specified it defaults to a
|
|
ref to an empty array.
|
|
|
|
=head2 as_text
|
|
|
|
@txt = $dbh->{Profile}->as_text();
|
|
$txt = $dbh->{Profile}->as_text({
|
|
node => undef,
|
|
path => [],
|
|
separator => " > ",
|
|
format => '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";
|
|
sortsub => sub { ... },
|
|
);
|
|
|
|
Returns the collected data ($dbh->{Profile}{Data}) reformatted into a list of formatted strings.
|
|
In scalar context the list is returned as a single concatenated string.
|
|
|
|
A hashref can be used to pass in arguments, the default values are shown in the example above.
|
|
|
|
The C<node> and <path> arguments are passed to as_node_path_list().
|
|
|
|
The C<separator> argument is used to join the elements of the path for each leaf node.
|
|
|
|
The C<sortsub> argument is used to pass in a ref to a sub that will order the list.
|
|
The subroutine will be passed a reference to the array returned by
|
|
as_node_path_list() and should sort the contents of the array in place.
|
|
The return value from the sub is ignored. For example, to sort the nodes by the
|
|
second level key you could use:
|
|
|
|
sortsub => sub { my $ary=shift; @$ary = sort { $a->[2] cmp $b->[2] } @$ary }
|
|
|
|
The C<format> argument is a C<sprintf> format string that specifies the format
|
|
to use for each leaf node. It uses the explicit format parameter index
|
|
mechanism to specify which of the arguments should appear where in the string.
|
|
The arguments to sprintf are:
|
|
|
|
1: path to node, joined with the separator
|
|
2: average duration (total duration/count)
|
|
(3 thru 9 are currently unused)
|
|
10: count
|
|
11: total duration
|
|
12: first duration
|
|
13: smallest duration
|
|
14: largest duration
|
|
15: time of first call
|
|
16: time of first call
|
|
|
|
=head1 CUSTOM DATA MANIPULATION
|
|
|
|
Recall that C<< $h->{Profile}->{Data} >> is a reference to the collected data.
|
|
Either to a 'leaf' array (when the Path is empty, i.e., DBI_PROFILE env var is 1),
|
|
or a reference to hash containing values that are either further hash
|
|
references or leaf array references.
|
|
|
|
Sometimes it's useful to be able to summarise some or all of the collected data.
|
|
The dbi_profile_merge_nodes() function can be used to merge leaf node values.
|
|
|
|
=head2 dbi_profile_merge_nodes
|
|
|
|
use DBI qw(dbi_profile_merge_nodes);
|
|
|
|
$time_in_dbi = dbi_profile_merge_nodes(my $totals=[], @$leaves);
|
|
|
|
Merges profile data node. Given a reference to a destination array, and zero or
|
|
more references to profile data, merges the profile data into the destination array.
|
|
For example:
|
|
|
|
$time_in_dbi = dbi_profile_merge_nodes(
|
|
my $totals=[],
|
|
[ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
|
|
[ 15, 0.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ],
|
|
);
|
|
|
|
$totals will then contain
|
|
|
|
[ 25, 0.93, 0.11, 0.01, 0.23, 1023110000, 1023110010 ]
|
|
|
|
and $time_in_dbi will be 0.93;
|
|
|
|
The second argument need not be just leaf nodes. If given a reference to a hash
|
|
then the hash is recursively searched for leaf nodes and all those found
|
|
are merged.
|
|
|
|
For example, to get the time spent 'inside' the DBI during an http request,
|
|
your logging code run at the end of the request (i.e. mod_perl LogHandler)
|
|
could use:
|
|
|
|
my $time_in_dbi = 0;
|
|
if (my $Profile = $dbh->{Profile}) { # if DBI profiling is enabled
|
|
$time_in_dbi = dbi_profile_merge_nodes(my $total=[], $Profile->{Data});
|
|
$Profile->{Data} = {}; # reset the profile data
|
|
}
|
|
|
|
If profiling has been enabled then $time_in_dbi will hold the time spent inside
|
|
the DBI for that handle (and any other handles that share the same profile data)
|
|
since the last request.
|
|
|
|
Prior to DBI 1.56 the dbi_profile_merge_nodes() function was called dbi_profile_merge().
|
|
That name still exists as an alias.
|
|
|
|
=head1 CUSTOM DATA COLLECTION
|
|
|
|
=head2 Using The Path Attribute
|
|
|
|
XXX example to be added later using a selectall_arrayref call
|
|
XXX nested inside a fetch loop where the first column of the
|
|
XXX outer loop is bound to the profile Path using
|
|
XXX bind_column(1, \${ $dbh->{Profile}->{Path}->[0] })
|
|
XXX so you end up with separate profiles for each loop
|
|
XXX (patches welcome to add this to the docs :)
|
|
|
|
=head2 Adding Your Own Samples
|
|
|
|
The dbi_profile() function can be used to add extra sample data
|
|
into the profile data tree. For example:
|
|
|
|
use DBI;
|
|
use DBI::Profile (dbi_profile dbi_time);
|
|
|
|
my $t1 = dbi_time(); # floating point high-resolution time
|
|
|
|
... execute code you want to profile here ...
|
|
|
|
my $t2 = dbi_time();
|
|
dbi_profile($h, $statement, $method, $t1, $t2);
|
|
|
|
The $h parameter is the handle the extra profile sample should be
|
|
associated with. The $statement parameter is the string to use where
|
|
the Path specifies !Statement. If $statement is undef
|
|
then $h->{Statement} will be used. Similarly $method is the string
|
|
to use if the Path specifies !MethodName. There is no
|
|
default value for $method.
|
|
|
|
The $h->{Profile}{Path} attribute is processed by dbi_profile() in
|
|
the usual way.
|
|
|
|
The $h parameter is usually a DBI handle but it can also be a reference to a
|
|
hash, in which case the dbi_profile() acts on each defined value in the hash.
|
|
This is an efficient way to update multiple profiles with a single sample,
|
|
and is used by the L<DashProfiler> module.
|
|
|
|
=head1 SUBCLASSING
|
|
|
|
Alternate profile modules must subclass DBI::Profile to help ensure
|
|
they work with future versions of the DBI.
|
|
|
|
|
|
=head1 CAVEATS
|
|
|
|
Applications which generate many different statement strings
|
|
(typically because they don't use placeholders) and profile with
|
|
!Statement in the Path (the default) will consume memory
|
|
in the Profile Data structure for each statement. Use a code ref
|
|
in the Path to return an edited (simplified) form of the statement.
|
|
|
|
If a method throws an exception itself (not via RaiseError) then
|
|
it won't be counted in the profile.
|
|
|
|
If a HandleError subroutine throws an exception (rather than returning
|
|
0 and letting RaiseError do it) then the method call won't be counted
|
|
in the profile.
|
|
|
|
Time spent in DESTROY is added to the profile of the parent handle.
|
|
|
|
Time spent in DBI->*() methods is not counted. The time spent in
|
|
the driver connect method, $drh->connect(), when it's called by
|
|
DBI->connect is counted if the DBI_PROFILE environment variable is set.
|
|
|
|
Time spent fetching tied variables, $DBI::errstr, is counted.
|
|
|
|
Time spent in FETCH for $h->{Profile} is not counted, so getting the profile
|
|
data doesn't alter it.
|
|
|
|
DBI::PurePerl does not support profiling (though it could in theory).
|
|
|
|
For asynchronous queries, time spent while the query is running on the
|
|
backend is not counted.
|
|
|
|
A few platforms don't support the gettimeofday() high resolution
|
|
time function used by the DBI (and available via the dbi_time() function).
|
|
In which case you'll get integer resolution time which is mostly useless.
|
|
|
|
On Windows platforms the dbi_time() function is limited to millisecond
|
|
resolution. Which isn't sufficiently fine for our needs, but still
|
|
much better than integer resolution. This limited resolution means
|
|
that fast method calls will often register as taking 0 time. And
|
|
timings in general will have much more 'jitter' depending on where
|
|
within the 'current millisecond' the start and end timing was taken.
|
|
|
|
This documentation could be more clear. Probably needs to be reordered
|
|
to start with several examples and build from there. Trying to
|
|
explain the concepts first seems painful and to lead to just as
|
|
many forward references. (Patches welcome!)
|
|
|
|
=cut
|
|
|
|
|
|
use strict;
|
|
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
|
|
use Exporter ();
|
|
use UNIVERSAL ();
|
|
use Carp;
|
|
|
|
use DBI qw(dbi_time dbi_profile dbi_profile_merge_nodes dbi_profile_merge);
|
|
|
|
$VERSION = "2.015065";
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(
|
|
DBIprofile_Statement
|
|
DBIprofile_MethodName
|
|
DBIprofile_MethodClass
|
|
dbi_profile
|
|
dbi_profile_merge_nodes
|
|
dbi_profile_merge
|
|
dbi_time
|
|
);
|
|
@EXPORT_OK = qw(
|
|
format_profile_thingy
|
|
);
|
|
|
|
use constant DBIprofile_Statement => '!Statement';
|
|
use constant DBIprofile_MethodName => '!MethodName';
|
|
use constant DBIprofile_MethodClass => '!MethodClass';
|
|
|
|
our $ON_DESTROY_DUMP = sub { DBI->trace_msg(shift, 0) };
|
|
our $ON_FLUSH_DUMP = sub { DBI->trace_msg(shift, 0) };
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $profile = { @_ };
|
|
return bless $profile => $class;
|
|
}
|
|
|
|
|
|
sub _auto_new {
|
|
my $class = shift;
|
|
my ($arg) = @_;
|
|
|
|
# This sub is called by DBI internals when a non-hash-ref is
|
|
# assigned to the Profile attribute. For example
|
|
# dbi:mysql(RaiseError=>1,Profile=>!Statement:!MethodName/DBIx::MyProfile/arg1:arg2):dbname
|
|
# This sub works out what to do and returns a suitable hash ref.
|
|
|
|
$arg =~ s/^DBI::/2\/DBI::/
|
|
and carp "Automatically changed old-style DBI::Profile specification to $arg";
|
|
|
|
# it's a path/module/k1:v1:k2:v2:... list
|
|
my ($path, $package, $args) = split /\//, $arg, 3;
|
|
my @args = (defined $args) ? split(/:/, $args, -1) : ();
|
|
my @Path;
|
|
|
|
for my $element (split /:/, $path) {
|
|
if (DBI::looks_like_number($element)) {
|
|
my $reverse = ($element < 0) ? ($element=-$element, 1) : 0;
|
|
my @p;
|
|
# a single "DBI" is special-cased in format()
|
|
push @p, "DBI" if $element & 0x01;
|
|
push @p, DBIprofile_Statement if $element & 0x02;
|
|
push @p, DBIprofile_MethodName if $element & 0x04;
|
|
push @p, DBIprofile_MethodClass if $element & 0x08;
|
|
push @p, '!Caller2' if $element & 0x10;
|
|
push @Path, ($reverse ? reverse @p : @p);
|
|
}
|
|
elsif ($element =~ m/^&(\w.*)/) {
|
|
my $name = "DBI::ProfileSubs::$1"; # capture $1 early
|
|
require DBI::ProfileSubs;
|
|
my $code = do { no strict; *{$name}{CODE} };
|
|
if (defined $code) {
|
|
push @Path, $code;
|
|
}
|
|
else {
|
|
warn "$name: subroutine not found\n";
|
|
push @Path, $element;
|
|
}
|
|
}
|
|
else {
|
|
push @Path, $element;
|
|
}
|
|
}
|
|
|
|
eval "require $package" if $package; # silently ignores errors
|
|
$package ||= $class;
|
|
|
|
return $package->new(Path => \@Path, @args);
|
|
}
|
|
|
|
|
|
sub empty { # empty out profile data
|
|
my $self = shift;
|
|
DBI->trace_msg("profile data discarded\n",0) if $self->{Trace};
|
|
$self->{Data} = undef;
|
|
}
|
|
|
|
sub filename { # baseclass method, see DBI::ProfileDumper
|
|
return undef;
|
|
}
|
|
|
|
sub flush_to_disk { # baseclass method, see DBI::ProfileDumper & DashProfiler::Core
|
|
my $self = shift;
|
|
return unless $ON_FLUSH_DUMP;
|
|
return unless $self->{Data};
|
|
my $detail = $self->format();
|
|
$ON_FLUSH_DUMP->($detail) if $detail;
|
|
}
|
|
|
|
|
|
sub as_node_path_list {
|
|
my ($self, $node, $path) = @_;
|
|
# convert the tree into an array of arrays
|
|
# from
|
|
# {key1a}{key2a}[node1]
|
|
# {key1a}{key2b}[node2]
|
|
# {key1b}{key2a}{key3a}[node3]
|
|
# to
|
|
# [ [node1], 'key1a', 'key2a' ]
|
|
# [ [node2], 'key1a', 'key2b' ]
|
|
# [ [node3], 'key1b', 'key2a', 'key3a' ]
|
|
|
|
$node ||= $self->{Data} or return;
|
|
$path ||= [];
|
|
if (ref $node eq 'HASH') { # recurse
|
|
$path = [ @$path, undef ];
|
|
return map {
|
|
$path->[-1] = $_;
|
|
($node->{$_}) ? $self->as_node_path_list($node->{$_}, $path) : ()
|
|
} sort keys %$node;
|
|
}
|
|
return [ $node, @$path ];
|
|
}
|
|
|
|
|
|
sub as_text {
|
|
my ($self, $args_ref) = @_;
|
|
my $separator = $args_ref->{separator} || " > ";
|
|
my $format_path_element = $args_ref->{format_path_element}
|
|
|| "%s"; # or e.g., " key%2$d='%s'"
|
|
my $format = $args_ref->{format}
|
|
|| '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";
|
|
|
|
my @node_path_list = $self->as_node_path_list(undef, $args_ref->{path});
|
|
|
|
$args_ref->{sortsub}->(\@node_path_list) if $args_ref->{sortsub};
|
|
|
|
my $eval = "qr/".quotemeta($separator)."/";
|
|
my $separator_re = eval($eval) || quotemeta($separator);
|
|
#warn "[$eval] = [$separator_re]";
|
|
my @text;
|
|
my @spare_slots = (undef) x 7;
|
|
for my $node_path (@node_path_list) {
|
|
my ($node, @path) = @$node_path;
|
|
my $idx = 0;
|
|
for (@path) {
|
|
s/[\r\n]+/ /g;
|
|
s/$separator_re/ /g;
|
|
++$idx;
|
|
if ($format_path_element eq "%s") {
|
|
$_ = sprintf $format_path_element, $_;
|
|
} else {
|
|
$_ = sprintf $format_path_element, $_, $idx;
|
|
}
|
|
}
|
|
push @text, sprintf $format,
|
|
join($separator, @path), # 1=path
|
|
($node->[0] ? $node->[1]/$node->[0] : 0), # 2=avg
|
|
@spare_slots,
|
|
@$node; # 10=count, 11=dur, 12=first_dur, 13=min, 14=max, 15=first_called, 16=last_called
|
|
}
|
|
return @text if wantarray;
|
|
return join "", @text;
|
|
}
|
|
|
|
|
|
sub format {
|
|
my $self = shift;
|
|
my $class = ref($self) || $self;
|
|
|
|
my $prologue = "$class: ";
|
|
my $detail = $self->format_profile_thingy(
|
|
$self->{Data}, 0, " ",
|
|
my $path = [],
|
|
my $leaves = [],
|
|
)."\n";
|
|
|
|
if (@$leaves) {
|
|
dbi_profile_merge_nodes(my $totals=[], @$leaves);
|
|
my ($count, $time_in_dbi, undef, undef, undef, $t1, $t2) = @$totals;
|
|
(my $progname = $0) =~ s:.*/::;
|
|
if ($count) {
|
|
$prologue .= sprintf "%fs ", $time_in_dbi;
|
|
my $perl_time = ($DBI::PERL_ENDING) ? time() - $^T : $t2-$t1;
|
|
$prologue .= sprintf "%.2f%% ", $time_in_dbi/$perl_time*100 if $perl_time;
|
|
my @lt = localtime(time);
|
|
my $ts = sprintf "%d-%02d-%02d %02d:%02d:%02d",
|
|
1900+$lt[5], $lt[4]+1, @lt[3,2,1,0];
|
|
$prologue .= sprintf "(%d calls) $progname \@ $ts\n", $count;
|
|
}
|
|
if (@$leaves == 1 && ref($self->{Data}) eq 'HASH' && $self->{Data}->{DBI}) {
|
|
$detail = ""; # hide the "DBI" from DBI_PROFILE=1
|
|
}
|
|
}
|
|
return ($prologue, $detail) if wantarray;
|
|
return $prologue.$detail;
|
|
}
|
|
|
|
|
|
sub format_profile_leaf {
|
|
my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
|
|
croak "format_profile_leaf called on non-leaf ($thingy)"
|
|
unless UNIVERSAL::isa($thingy,'ARRAY');
|
|
|
|
push @$leaves, $thingy if $leaves;
|
|
my ($count, $total_time, $first_time, $min, $max, $first_called, $last_called) = @$thingy;
|
|
return sprintf "%s%fs\n", ($pad x $depth), $total_time
|
|
if $count <= 1;
|
|
return sprintf "%s%fs / %d = %fs avg (first %fs, min %fs, max %fs)\n",
|
|
($pad x $depth), $total_time, $count, $count ? $total_time/$count : 0,
|
|
$first_time, $min, $max;
|
|
}
|
|
|
|
|
|
sub format_profile_branch {
|
|
my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
|
|
croak "format_profile_branch called on non-branch ($thingy)"
|
|
unless UNIVERSAL::isa($thingy,'HASH');
|
|
my @chunk;
|
|
my @keys = sort keys %$thingy;
|
|
while ( @keys ) {
|
|
my $k = shift @keys;
|
|
my $v = $thingy->{$k};
|
|
push @$path, $k;
|
|
push @chunk, sprintf "%s'%s' =>\n%s",
|
|
($pad x $depth), $k,
|
|
$self->format_profile_thingy($v, $depth+1, $pad, $path, $leaves);
|
|
pop @$path;
|
|
}
|
|
return join "", @chunk;
|
|
}
|
|
|
|
|
|
sub format_profile_thingy {
|
|
my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
|
|
return "undef" if not defined $thingy;
|
|
return $self->format_profile_leaf( $thingy, $depth, $pad, $path, $leaves)
|
|
if UNIVERSAL::isa($thingy,'ARRAY');
|
|
return $self->format_profile_branch($thingy, $depth, $pad, $path, $leaves)
|
|
if UNIVERSAL::isa($thingy,'HASH');
|
|
return "$thingy\n";
|
|
}
|
|
|
|
|
|
sub on_destroy {
|
|
my $self = shift;
|
|
return unless $ON_DESTROY_DUMP;
|
|
return unless $self->{Data};
|
|
my $detail = $self->format();
|
|
$ON_DESTROY_DUMP->($detail) if $detail;
|
|
$self->{Data} = undef;
|
|
}
|
|
|
|
sub DESTROY {
|
|
my $self = shift;
|
|
local $@;
|
|
DBI->trace_msg("profile data DESTROY\n",0)
|
|
if (($self->{Trace}||0) >= 2);
|
|
eval { $self->on_destroy };
|
|
if ($@) {
|
|
chomp $@;
|
|
my $class = ref($self) || $self;
|
|
DBI->trace_msg("$class on_destroy failed: $@", 0);
|
|
}
|
|
}
|
|
|
|
1;
|
|
|