Author: timbo
Date: Tue Nov 29 11:51:00 2005
New Revision: 2286
Modified:
dbi/trunk/Changes
dbi/trunk/MANIFEST
dbi/trunk/META.yml
dbi/trunk/Makefile.PL
dbi/trunk/lib/DBI/ProfileData.pm
dbi/trunk/t/42prof_data.t
Log:
Fixed warning options for gcc
Added Filter mechanism to DBI::ProfileData
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue Nov 29 11:51:00 2005
@@ -27,6 +27,10 @@ DBI::Changes - List of significant chang
Changed "use DBI" to only set $DBI::connect_via if not already set.
Changed docs to clarify pre-method clearing of err values.
+ Added ability for DBI::ProfileData to edit profile path on loading.
+ This enables aggregation of different SQL statements into the same
+ profile node - very handy when not using placeholders or when working
+ multiple separate tables for the same thing (ie logtable_2005_11_28)
Added $sth->{ParamTypes} specification thanks to Dean Arnold.
Added $h->{Callbacks} attribute to enable code hooks to be invoked
when certain methods are called. For example:
Modified: dbi/trunk/MANIFEST
==============================================================================
--- dbi/trunk/MANIFEST (original)
+++ dbi/trunk/MANIFEST Tue Nov 29 11:51:00 2005
@@ -59,6 +59,7 @@ t/30subclass.t
t/40profile.t
t/41prof_dump.t
t/42prof_data.t
+t/43profenv.t
t/50dbm.t
t/60preparse.t
t/70callbacks.t
Modified: dbi/trunk/META.yml
==============================================================================
--- dbi/trunk/META.yml (original)
+++ dbi/trunk/META.yml Tue Nov 29 11:51:00 2005
@@ -1,10 +1,11 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: DBI
-version: 1.48
+version: 1.49
version_from: DBI.pm
installdirs: site
requires:
+ Storable: 1
Test::Simple: 0.4
distribution_type: module
Modified: dbi/trunk/Makefile.PL
==============================================================================
--- dbi/trunk/Makefile.PL (original)
+++ dbi/trunk/Makefile.PL Tue Nov 29 11:51:00 2005
@@ -141,13 +141,15 @@ $opts{CAPI} = 'TRUE' if $Config{archname
if (my $gccversion = $Config{gccversion}) { # ask gcc to be more pedantic
warn "WARNING: Your GNU C $gccversion compiler is very old. Please upgrade
it and rebuild perl.\n"
- if $gccversion =~ m/^(1|2\.[1-8])/;
- $opts{CCFLAGS} .= ' -W -Wall -Wpointer-arith -Wmissing-noreturn
-Wbad-function-cast';
+ if $gccversion =~ m/^\D*(1|2\.[1-8])/;
+ $gccversion =~ s/[^\d\.]//g; # just a number please
+ $opts{CCFLAGS} .= ' -W -Wall -Wpointer-arith -Wbad-function-cast';
$opts{CCFLAGS} .= ' -Wno-comment -Wno-sign-compare -Wno-cast-qual';
- $opts{CCFLAGS} .= ' -Wdisabled-optimization' if $gccversion ge "3.0";
- if (0 && $is_developer && $::opt_g) {
+ $opts{CCFLAGS} .= ' -Wdisabled-optimization -Wmissing-noreturn
-Wno-unused-parameter'
+ if $gccversion ge "3.0";
+ if ($is_developer && $::opt_g) {
$opts{CCFLAGS} .= ' -DPERL_GCC_PEDANTIC -ansi -pedantic' if
$gccversion ge "3.0";
- $opts{CCFLAGS} .= ' -Wmissing-prototypes'; # noisy due to XS_* funcs
+ $opts{CCFLAGS} .= ' -Wmissing-prototypes';
}
}
@@ -296,13 +298,13 @@ config :: $(changes_pm) $(roadmap_pm)
$(NOECHO) $(NOOP)
$(changes_pm): Changes
- $(NOECHO) $(MKPATH) $(inst_libdbi)
- $(NOECHO) $(RM_F) $(changes_pm)
+ $(MKPATH) $(inst_libdbi)
+ $(RM_F) $(changes_pm)
$(CP) Changes $(changes_pm)
$(roadmap_pm): Roadmap.pod
- $(NOECHO) $(MKPATH) $(inst_libdbi)
- $(NOECHO) $(RM_F) $(roadmap_pm)
+ $(MKPATH) $(inst_libdbi)
+ $(RM_F) $(roadmap_pm)
$(CP) Roadmap.pod $(roadmap_pm)
';
Modified: dbi/trunk/lib/DBI/ProfileData.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileData.pm (original)
+++ dbi/trunk/lib/DBI/ProfileData.pm Tue Nov 29 11:51:00 2005
@@ -91,6 +91,8 @@ sub PATH () { 7 };
=item $prof = DBI::ProfileData->new(File => "dbi.prof")
+=item $prof = DBI::ProfileData->new(File => "dbi.prof", Filter => sub { ... })
+
=item $prof = DBI::ProfileData->new(Files => [ "dbi.prof.1", "dbi.prof.2" ])
Creates a a new DBI::ProfileData object. Takes either a single file
@@ -98,12 +100,43 @@ through the File option or a list of Fil
multiple files are specified then the header data from the first file
is used.
+The C<Filter> parameter can be used to supply a code reference that can
+manipulate the profile data as it is being read. This is most useful for
+editing SQL statements so that slightly different statements in the raw data
+will be merged and aggregated in the loaded data. For example:
+
+ Filter => sub {
+ my ($path_ref, $data_ref) = @_;
+ s/foo = '.*?'/foo = '...'/ for @$path_ref;
+ }
+
+Here's an example that performs some normalization on the SQL. It converts all
+numbers to C<N> and all quoted strings to C<S>. It can also convert digits to
+N within names. Finally, it summarizes long "IN (...)" clauses.
+
+It's aggressive and simplistic, but it's often sufficient, and serves as an
+example that you can tailor to suit your own needs:
+
+ Filter => sub {
+ my ($path_ref, $data_ref) = @_;
+ local $_ = $path_ref->[0]; # whichever element contains the SQL Statement
+ s/\b\d+\b/N/g; # 42 -> N
+ s/\b0x[0-9A-Fa-f]+\b/N/g; # 0xFE -> N
+ s/'.*?'/'S'/g; # single quoted strings (doesn't handle
escapes)
+ s/".*?"/"S"/g; # double quoted strings (doesn't handle
escapes)
+ # convert names like log_20001231 into log_NNNNNNNN, controlled by
$opt{n}
+ s/([a-z_]+)(\d{$opt{n},})/$1.('N' x length($2))/ieg if $opt{n};
+ # abbreviate massive "in (...)" statements and similar
+ s!(([NS],){100,})!sprintf("$2,{repeated %d times}",length($1)/2)!eg;
+ }
+
=cut
sub new {
my $pkg = shift;
my $self = {
Files => [ "dbi.prof" ],
+ Filter => undef,
_header => {},
_nodes => [],
_node_lookup => {},
@@ -164,6 +197,7 @@ sub _read_body {
my ($self, $fh, $filename) = @_;
my $nodes = $self->{_nodes};
my $lookup = $self->{_node_lookup};
+ my $filter = $self->{Filter};
# build up node array
my @path = ("");
@@ -197,6 +231,11 @@ sub _read_body {
# no data?
croak("Invalid data syntax format in $filename line $.: $_")
unless @data;
+ # hook to enable pre-processing of the data - such as mangling SQL
+ # so that slightly different statements get treated as the same
+ # and so merged in the results
+ $filter->([EMAIL PROTECTED], [EMAIL PROTECTED]) if $filter;
+
# elements of @path can't have NULLs in them, so this
# forms a unique string per @path. If there's some way I
# can get this without arbitrarily stripping out a
Modified: dbi/trunk/t/42prof_data.t
==============================================================================
--- dbi/trunk/t/42prof_data.t (original)
+++ dbi/trunk/t/42prof_data.t Tue Nov 29 11:51:00 2005
@@ -11,7 +11,7 @@ BEGIN {
plan skip_all => 'profiling not supported for DBI::PurePerl';
}
else {
- plan tests => 32;
+ plan tests => 33;
}
}
@@ -28,6 +28,7 @@ isa_ok( $dbh, 'DBI::db', 'Created connec
# do a little work
foreach (1,2,3) {
+ $dbh->do("set dummy=$_");
my $sth = $dbh->prepare($sql);
isa_ok( $sth, 'DBI::st', 'Created handle' );
for my $loop (1..20) {
@@ -45,7 +46,10 @@ undef $dbh;
ok(-s "dbi.prof", "Profile written to disk, non-zero size" );
# load up
-my $prof = DBI::ProfileData->new();
+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' );
@@ -83,9 +87,13 @@ ok($clone->count == 1);
# take a look through Data
my $Data = $prof->Data;
+print "SQL: $_\n" for keys %$Data;
ok(exists($Data->{$sql}));
ok(exists($Data->{$sql}{execute}));
+# did the Filter convert set dummy=1 (etc) into set dummy=N?
+ok(exists($Data->{"set dummy=N"}));
+
# test escaping of \n and \r in keys
$dbh = DBI->connect("dbi:ExampleP:", '', '',
{ RaiseError=>1, Profile=>"6/DBI::ProfileDumper" });
