sprintf patch and alternate root class kludge, MANIFEST and Changes files...
[DBIx-Profile.git] / Profile.pm
index 13f9d37..4e27a5c 100644 (file)
@@ -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. 
   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.
 {
@@ -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 {