#
-# Version: 1.0
+# Version: 1.01
# Jeff Lathan
# Kerry Clendinning
#
# Deja.com, 10-1999
# Michael G Schwern, 11-1999
#
+# Current maintainer: Ivan Kohler <ivan-dbix-profile@420.am>
# Copyright (c) 1999,2000 Jeff Lathan, Kerry Clendinning. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# 11-4-1999
# 1.0 Added ability to trace executes, chosen by an environment variable
# Added capability of saving everything to a log file
-#
+# 1.01 Added sprintf patch, MANIFEST and Changes files, and kludge to get
+# along with DBIx::ContextualFetch
#
# This package provides an easy way to profile your DBI-based application.
=head1 NAME
DBIx::Profile - DBI query profiler
- Version 1.0
+ Version 1.01
Copyright (c) 1999,2000 Jeff Lathan, Kerry Clendinning.
All rights reserved.
use DBI;
$dbh->printProfile();
+ #or to use with things like like to be the DBI root class themselves:
+ # (Class::DBI / Ima::DBI uses DBIx::ContextualFetch)
+ use DBIx::Profile ( RootClass=>'DBIx::ContextualFetch' );
+
=head1 DESCRIPTION
DBIx::Profile is a quick and easy, and mostly transparent, profiler
If this is not called before disconnect, disconnect will call
printProfile.
+ sprintProfile
+ $profile = $dbh->sprintPRofile();
+
+ Returns the data collected.
+
setLogFile
$dbh->setLogFile("ProfileOutput.txt");
Aaron Lee, aaron@pointx.org
Michael G Schwern, schwern@pobox.com
+ Current maintainer: Ivan Kohler <ivan-dbix-profile@420.am>
+
=head1 SEE ALSO
L<perl(1)>, L<DBI>
=cut
-#
-# For CPAN and Makefile.PL
-#
-$VERSION = '1.0';
+package DBIx::Profile;
+use strict;
+use vars qw(@ISA $VERSION);
use DBI;
-package DBIx::Profile;
+$VERSION = '1.01';
+
+@ISA = qw(DBI);
# Store DBI's original connect & disconnect then replace it with ours.
{
*_DBI_connect = DBI->can('connect');
*DBI::connect = \&connect;
}
-
-use strict;
-use vars qw(@ISA);
-
-@ISA = qw(DBI);
#
# Make DBI aware of us.
$DBIx::Profile::DBIXTRACE = 1;
}
+sub import {
+ my( $self, %opt ) = @_;
+ if ( $opt{RootClass} ) {
+ eval "use $opt{RootClass}";
+ #*_DBI_connect = UNIVERSAL::can( $opt{'RootClass'}, 'connect' );
+ #*DBI::connect = \&connect;
+ unshift @DBIx::Profile::ISA, $opt{RootClass};
+ unshift @DBIx::Profile::db::ISA, $opt{RootClass}. '::db';
+ unshift @DBIx::Profile::st::ISA, $opt{RootClass}. '::st';
+ #__PACKAGE__->init_rootclass;
+ }
+}
+
sub connect {
my $self = shift;
my $result = __PACKAGE__->_DBI_connect(@_);
# JEFF - The printing and the print code is kinda (er... very) ugly!
#
+#like printProfile, except returns the results instead of printing them.
+sub sprintProfile {
+ my $self = shift;
+ $self->printProfile({'sprint'=>1});
+}
+
sub printProfile {
my $self = shift;
+ my $args = shift;
my %result;
my $total = 0;
no integer;
$result{$total} = $text;
} # each query
+ my $results;
foreach my $qry (sort stripsort keys %result) {
- if ($DBIx::Profile::DBIXFILE eq "" ) {
+ if ( $args->{'sprint'} ) {
+ $results .= $result{$qry} . "\n";
+ } elsif ($DBIx::Profile::DBIXFILE eq "" ) {
warn $result{$qry} . "\n";
} else {
print $DBIx::Profile::DBIXFILEHANDLE $result{$qry} . "\n";
}
}
+
+ return $results if $args->{'sprint'};
}
sub stripsort {