Author: timbo
Date: Mon Mar 27 01:32:36 2006
New Revision: 3719
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
dbi/trunk/lib/DBD/ExampleP.pm
dbi/trunk/lib/DBI/Profile.pm
dbi/trunk/t/40profile.t
Log:
Added ability for DBI::Profile Path to specify attribute names.
Added Username as a known attribute for fetching (to silence warning if not
set).
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Mon Mar 27 01:32:36 2006
@@ -29,6 +29,7 @@
Added 'fetch array of hash refs' example to selectall_arrayref
docs thanks to Tom Schindl.
Added reference to $DBI::neat_maxlen in TRACING section of docs.
+ Added ability for DBI::Profile Path to specify attribute names.
=head2 Changes in DBI 1.50 (svn rev 2307), 13 December 2005
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Mon Mar 27 01:32:36 2006
@@ -1971,13 +1971,15 @@
svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE);
if (svp)
valuesv = newSVsv(*svp); /* take copy to mortalize */
- else if (!( (*key=='H' && strEQ(key, "HandleError"))
+ else /* warn unless it's known attribute name */
+ if ( !( (*key=='H' && strEQ(key, "HandleError"))
|| (*key=='H' && strEQ(key, "HandleSetErr"))
|| (*key=='S' && strEQ(key, "Statement"))
|| (*key=='P' && strEQ(key, "ParamValues"))
|| (*key=='P' && strEQ(key, "Profile"))
|| (*key=='C' && strEQ(key, "CursorName"))
|| (*key=='C' && strEQ(key, "Callbacks"))
+ || (*key=='U' && strEQ(key, "Username"))
|| !isUPPER(*key) /* dbd_*, private_* etc */
))
warn("Can't get %s->{%s}: unrecognised attribute
name",neatsvpv(h,0),key);
@@ -2192,7 +2194,7 @@
static void
dbi_profile(SV *h, imp_xxh_t *imp_xxh, const char *statement, SV *method,
double t1, double t2)
{
-#define DBIprof_MAX_PATH_ELEM 9 /* STATEMENT->$Statement->$method */
+#define DBIprof_MAX_PATH_ELEM 100
#define DBIprof_COUNT 0
#define DBIprof_TOTAL_TIME 1
#define DBIprof_FIRST_TIME 2
@@ -2205,7 +2207,8 @@
double ti = t2 - t1;
const char *path[DBIprof_MAX_PATH_ELEM+1];
int idx = -1;
- STRLEN lna;
+ HV *dbh_outer_hv = NULL;
+ HV *dbh_inner_hv = NULL;
SV *profile;
SV *tmp;
AV *av;
@@ -2214,9 +2217,6 @@
const int call_depth = DBIc_CALL_DEPTH(imp_xxh);
const int parent_call_depth = DBIc_PARENT_COM(imp_xxh) ?
DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh)) : 0;
/* Only count calls originating from the application code */
- /* *MAY* be made configurable later */
- /* XXX BEWARE that if nested call profile data is merged */
- /* with the non-nested data then we'll get invalid results */
if (call_depth > 1 || parent_call_depth > 0)
return;
@@ -2238,65 +2238,103 @@
if (!statement) {
SV **psv = hv_fetch(h_hv, "Statement", 9, 0);
- statement = (psv && SvOK(*psv)) ? SvPV(*psv, lna) : "";
+ statement = (psv && SvOK(*psv)) ? SvPV_nolen(*psv) : "";
}
if (DBIc_DBISTATE(imp_xxh)->debug >= 4)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh), "dbi_profile %s %f %d %d q{%s}\n",
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh), "dbi_profile %s %f q{%s}\n",
neatsvpv((SvTYPE(method)==SVt_PVCV) ? (SV*)CvGV(method) :
method, 0),
- ti, call_depth, parent_call_depth, statement);
+ ti, statement);
idx = 0;
path[idx++] = "Data";
+
tmp = *hv_fetch((HV*)SvRV(profile), "Path", 4, 1);
- if (SvROK(tmp) && SvTYPE(SvRV(tmp))==SVt_PVCV) {
- /* call sub, use returned list of values as path */
- /* if no values returned then don't save data */
- path[idx++] = Nullch;
- }
- else if (SvROK(tmp) && SvTYPE(SvRV(tmp))==SVt_PVAV) {
+ if (SvROK(tmp) && SvTYPE(SvRV(tmp))==SVt_PVAV) {
int len;
av = (AV*)SvRV(tmp);
len = av_len(av); /* -1=empty, 0=one element */
+
for ( ;(idx-1) <= len && idx < DBIprof_MAX_PATH_ELEM; ++idx) {
SV *pathsv = AvARRAY(av)[idx-1];
- const char *p;
- switch(SvIOK(pathsv) ? SvIV(pathsv) : 0) {
- case -2100000001:
- p = statement;
- break;
- case -2100000002:
- p = (SvTYPE(method)==SVt_PVCV)
- ? GvNAME(CvGV(method))
- : (isGV(method) ? GvNAME(method) : SvPV(method,lna));
- break;
- case -2100000003:
- if (SvTYPE(method) == SVt_PVCV) {
- p = SvPV((SV*)CvGV(method), lna);
- }
- else if (isGV(method)) {
- /* just using SvPV(method,lna) sometimes causes an error:
*/
- /* "Can't coerce GLOB to string" so we use gv_efullname()
*/
- SV *tmpsv = sv_2mortal(newSVpv("",0));
- gv_efullname(tmpsv, (GV*)method);
- p = SvPV(tmpsv,lna);
+ const char *p = "?";
+
+ if (SvROK(tmp) && SvTYPE(SvRV(tmp))==SVt_PVCV) {
+ /* call sub, use returned list of values as path */
+ /* if no values returned then don't save data */
+ warn("code ref in Path");
+ p = Nullch;
+ }
+ else if (looks_like_number(pathsv)) {
+ /* numbers are special-cases */
+ switch(SvIV(pathsv)) { /* see lib/DBI/Profile.pm for magic
numbers */
+ case -2100000001: /* DBIprofile_Statement */
+ p = statement;
+ break;
+ case -2100000002: /* DBIprofile_MethodName */
+ p = (SvTYPE(method)==SVt_PVCV)
+ ? GvNAME(CvGV(method))
+ : (isGV(method) ? GvNAME(method) :
SvPV_nolen(method));
+ break;
+ case -2100000003: /* DBIprofile_MethodClass */
+ if (SvTYPE(method) == SVt_PVCV) {
+ p = SvPV_nolen((SV*)CvGV(method));
+ }
+ else if (isGV(method)) {
+ /* just using SvPV_nolen(method) sometimes causes an
error: */
+ /* "Can't coerce GLOB to string" so we use
gv_efullname() */
+ SV *tmpsv = sv_2mortal(newSVpv("",0));
+ gv_efullname(tmpsv, (GV*)method);
+ p = SvPV_nolen(tmpsv);
+ if (*p == '*') ++p; /* skip past leading '*' glob sigil
*/
+ }
+ else {
+ p = SvPV_nolen(method);
+ }
+ break;
+ default:
+ p = SvPV_nolen(pathsv);
+ break;
}
- else {
- p = SvPV(method,lna);
+ }
+ else if (SvOK(pathsv)) {
+ STRLEN len;
+ p = SvPV(pathsv,len);
+ if (p[0] == '{' && p[len-1] == '}') { /* treat as name of dbh
attribute to use */
+ SV **attr_svp;
+ if (!dbh_inner_hv) { /* cache dbh handles the first
time we need them */
+ imp_dbh_t *imp_dbh = (DBIc_TYPE(imp_xxh) <= DBIt_DB) ?
(imp_dbh_t*)imp_xxh : (imp_dbh_t*)DBIc_PARENT_COM(imp_xxh);
+ dbh_outer_hv = DBIc_MY_H(imp_dbh);
+ if (SvTYPE(dbh_outer_hv) != SVt_PVHV)
+ return; /* global destruction - bail */
+ dbh_inner_hv = (HV*)SvRV(dbih_inner((SV*)dbh_outer_hv,
"profile"));
+ if (SvTYPE(dbh_inner_hv) != SVt_PVHV)
+ return; /* global destruction - bail */
+ }
+ /* fetch from inner first, then outer if key doesn't exist
*/
+ /* (yes, this is an evil premature optimization) */
+ p += 1; len -= 2; /* ignore the braces */
+ if ((attr_svp = hv_fetch(dbh_inner_hv, p, len, 0)) == NULL)
{
+ /* try outer (tied) hash - for things like AutoCommit
*/
+ /* (will always return something even for unknowns)
*/
+ if ((attr_svp = hv_fetch(dbh_outer_hv, p, len, 0))) {
+ if (SvGMAGICAL(*attr_svp))
+ mg_get(*attr_svp); /* FETCH */
+ }
+ }
+ if (!attr_svp)
+ p -= 1; /* unignore the braces */
+ else if (!SvOK(*attr_svp))
+ p = "";
+ else if (!SvTRUE(*attr_svp) && SvPOK(*attr_svp) &&
SvNIOK(*attr_svp))
+ p = "0"; /* catch &sv_no style special case */
+ else
+ p = SvPV_nolen(*attr_svp);
}
- break;
- default:
- p = SvPV(pathsv,lna);
- break;
}
path[idx] = p;
}
}
- else if (SvOK(tmp)) {
- DBIc_set(imp_xxh, DBIcf_Profile, 0); /* disable */
- warn("Profile Path attribute isn't valid (%s)", neatsvpv(tmp,0));
- return;
- }
- else {
+ else { /* any bad Path value is treated as a Path of just Statement */
path[idx++] = statement;
}
path[idx++] = Nullch;
Modified: dbi/trunk/lib/DBD/ExampleP.pm
==============================================================================
--- dbi/trunk/lib/DBD/ExampleP.pm (original)
+++ dbi/trunk/lib/DBD/ExampleP.pm Mon Mar 27 01:32:36 2006
@@ -61,6 +61,7 @@
my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dbname });
$dbh->STORE('Active', 1);
$dbh->{examplep_get_info} = {};
+ $dbh->{Name} = $dbname;
return $outer;
}
Modified: dbi/trunk/lib/DBI/Profile.pm
==============================================================================
--- dbi/trunk/lib/DBI/Profile.pm (original)
+++ dbi/trunk/lib/DBI/Profile.pm Mon Mar 27 01:32:36 2006
@@ -21,7 +21,7 @@
=head1 DESCRIPTION
-DBI::Profile is new and experimental and subject to change.
+DBI::Profile is fairly new and subject to change.
The DBI::Profile module provides a simple interface to collect and
report performance and benchmarking data from the DBI.
@@ -219,49 +219,29 @@
=head2 Path
-The Path value is used to control where the profile for a method
-call will be merged into the collected profile data. Whenever
-profile data is to be stored the current value for Path is used.
+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 value can be one of:
+The elements of Path array can be one of the following types:
=over 4
-=item Array Reference
+=item Special Constant
-Each element of the array defines an element of the path to use to
-store the profile data into the C<Data> hash.
+B<DBIprofile_Statement>
-=item Undefined value (the default)
+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 DBIprofile_Statement records an empty string.
-Treated the same as C<[ $DBI::Profile::DBIprofile_Statement ]>.
+B<DBIprofile_MethodName>
-=item Subroutine Reference B<NOT YET IMPLEMENTED>
+Use the name of the DBI method that the profile sample relates to.
-The subroutine is passed the DBI method name and the handle it was
-called on. It should return a list of values to uses as the path.
-If it returns an empty list then the method call is not profiled.
+B<DBIprofile_MethodClass>
-=back
-
-The following 'magic cookie' values can be included in the Path and will be
-
-=over 4
-
-=item DBIprofile_Statement
-
-Replaced with the current value of the Statement attribute for the
-handle the method was called with. If that value is undefined then
-an empty string is used.
-
-=item DBIprofile_MethodName
-
-Replaced with the name of the DBI method that the profile sample
-relates to.
-
-=item DBIprofile_MethodClass
-
-Replaced with the fully qualified name of the DBI method, including
+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:
@@ -275,22 +255,44 @@
But you'll note that there is only one call to
DBD::_::db::selectrow_arrayref but another 99 to
-DBD::mysql::db::selectrow_arrayref. That's because after the first
-call Perl has cached the method to speed up method calls.
-You may also see some names begin with an asterix ('C<*>').
-Both of these effects are subject to change in later releases.
+DBD::mysql::db::selectrow_arrayref. Currently the first
+call Pern't record the true location. That may change.
+=item Code Reference
+
+Not yet implemented.
+
+The subroutine is passed the DBI method name and the handle it was called on.
+It should return a list of values to used at this point in the Path. If it
+returns an empty list then the method call is not profiled.
+
+=item 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 Other Values
+
+Any other values are stringified and used literally.
+
+(References, and values that begin with punctuation characters are reserved.)
=back
-Other magic cookie values may be added in the future.
+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::DBIprofile_Statement ]
=head1 REPORTING
=head2 Report Format
-The current profile data can be formatted and output using
+The current accumulated profile data can be formatted and output using
print $h->{Profile}->format;
Modified: dbi/trunk/t/40profile.t
==============================================================================
--- dbi/trunk/t/40profile.t (original)
+++ dbi/trunk/t/40profile.t Mon Mar 27 01:32:36 2006
@@ -26,7 +26,7 @@
}
use Test;
-BEGIN { plan tests => 64; }
+BEGIN { plan tests => 66 }
use Data::Dumper;
$Data::Dumper::Indent = 1;
@@ -162,12 +162,11 @@
# try a custom path
-$dbh = DBI->connect("dbi:ExampleP:", '', '',
- { RaiseError=>1,
- Profile=> { Path => [ 'foo',
- DBIprofile_Statement,
- DBIprofile_MethodName,
- 'bar' ]}});
+$dbh = DBI->connect("dbi:ExampleP:dbname", 'usrname', '', {
+ RaiseError=>1, Profile=> { Path => [
+ '{Username}', '{AutoCommit}', 'foo', '{bar}', DBIprofile_Statement,
DBIprofile_MethodName,
+ ] }
+});
ok(ref $dbh->{Profile}, "DBI::Profile");
ok(ref $dbh->{Profile}{Data}, 'HASH');
ok(ref $dbh->{Profile}{Path}, 'ARRAY');
@@ -178,22 +177,30 @@
$sth->execute();
while ( my $hash = $sth->fetchrow_hashref ) {}
+print Dumper($dbh->{Profile});
+
# check that the resulting tree fits the expected layout
$data = $dbh->{Profile}{Data};
ok($data);
-ok(exists $data->{foo});
-ok(exists $data->{foo}{$sql});
-ok(exists $data->{foo}{$sql}{prepare});
-ok(exists $data->{foo}{$sql}{execute});
-ok(exists $data->{foo}{$sql}{fetchrow_hashref});
-ok(exists $data->{foo}{$sql}{prepare}{bar});
-ok(ref $data->{foo}{$sql}{prepare}{bar}, 'ARRAY');
-ok(@{$data->{foo}{$sql}{prepare}{bar}} == 7);
+ok(exists $data->{usrname});
+ok(exists $data->{usrname}{1});
+ok(exists $data->{usrname}{1}{foo});
+ok(exists $data->{usrname}{1}{foo}{""});
+
+$data = $data->{usrname}{1}{foo}{""}; # $data now points deeper into the tree
+ok(exists $data->{$sql});
+ok(exists $data->{$sql}{prepare});
+ok(exists $data->{$sql}{execute});
+ok(exists $data->{$sql}{fetchrow_hashref});
+ok(ref $data->{$sql}{prepare}, 'ARRAY');
+ok(@{$data->{$sql}{prepare}} == 7);
my $t1 = DBI::dbi_time;
dbi_profile($dbh, "Hi, mom", "fetchhash_bang", $t1, $t1 + 1);
-ok(exists $data->{foo}{"Hi, mom"});
+ok(exists $data->{"Hi, mom"});
+
+print "dbi_profile_merge\n";
my $total_time = dbi_profile_merge(
my $totals=[],
[ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
@@ -213,8 +220,7 @@
ok("@$totals", "27.00 2.93 0.11 0.01 0.23 1023110000.00 1023110010.00");
ok($total_time, 2.93);
-# check that output went into the log file
DBI->trace(0, "STDOUT"); # close current log to flush it
-ok(-s $LOG_FILE);
+ok(-s $LOG_FILE); # check that output went into the log file
-1;
+exit 0;
