diff options
author | ivan <ivan> | 2004-09-28 01:23:28 +0000 |
---|---|---|
committer | ivan <ivan> | 2004-09-28 01:23:28 +0000 |
commit | 2b1b66f063003f81852be6481910d0211dfe72aa (patch) | |
tree | b6b2d5e5f2edb7ac05c1ca8ef001c29de1f0a6c1 /Profile.pm | |
parent | c2fa076a4e7ba0dcad67d8781921fc49ba46eda4 (diff) |
Diffstat (limited to 'Profile.pm')
-rw-r--r-- | Profile.pm | 62 |
1 files changed, 48 insertions, 14 deletions
@@ -1,5 +1,5 @@ # -# Version: 1.0 +# Version: 1.01 # Jeff Lathan # Kerry Clendinning # @@ -7,6 +7,7 @@ # 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 @@ -19,7 +20,8 @@ # 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. @@ -45,7 +47,7 @@ =head1 NAME DBIx::Profile - DBI query profiler - Version 1.0 + Version 1.01 Copyright (c) 1999,2000 Jeff Lathan, Kerry Clendinning. All rights reserved. @@ -59,6 +61,10 @@ 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 @@ -98,6 +104,11 @@ If this is not called before disconnect, disconnect will call printProfile. + sprintProfile + $profile = $dbh->sprintPRofile(); + + Returns the data collected. + setLogFile $dbh->setLogFile("ProfileOutput.txt"); @@ -111,20 +122,23 @@ 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. { @@ -132,11 +146,6 @@ package DBIx::Profile; *_DBI_connect = DBI->can('connect'); *DBI::connect = \&connect; } - -use strict; -use vars qw(@ISA); - -@ISA = qw(DBI); # # Make DBI aware of us. @@ -151,6 +160,19 @@ if ($ENV{DBIXPROFILETRACE}) { $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(@_); @@ -225,9 +247,16 @@ sub DESTROY { # 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; @@ -292,13 +321,18 @@ sub printProfile { $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 { |