[Summary view] [Print] [Text view]

   1  package DBI::ProfileDumper;
   2  use strict;
   3  
   4  =head1 NAME
   5  
   6  DBI::ProfileDumper - profile DBI usage and output data to a file
   7  
   8  =head1 SYNOPSIS
   9  
  10  To profile an existing program using DBI::ProfileDumper, set the
  11  DBI_PROFILE environment variable and run your program as usual.  For
  12  example, using bash:
  13  
  14    DBI_PROFILE=2/DBI::ProfileDumper program.pl
  15  
  16  Then analyze the generated file (F<dbi.prof>) with L<dbiprof|dbiprof>:
  17  
  18    dbiprof
  19  
  20  You can also activate DBI::ProfileDumper from within your code:
  21  
  22    use DBI;
  23  
  24    # profile with default path (2) and output file (dbi.prof)
  25    $dbh->{Profile} = "!Statement/DBI::ProfileDumper";
  26  
  27    # same thing, spelled out
  28    $dbh->{Profile} = "!Statement/DBI::ProfileDumper/File:dbi.prof";
  29  
  30    # another way to say it
  31    use DBI::ProfileDumper;
  32    $dbh->{Profile} = DBI::ProfileDumper->new(
  33                          Path => [ '!Statement' ]
  34                          File => 'dbi.prof' );
  35  
  36    # using a custom path
  37    $dbh->{Profile} = DBI::ProfileDumper->new(
  38        Path => [ "foo", "bar" ],
  39        File => 'dbi.prof',
  40    );
  41  
  42  
  43  =head1 DESCRIPTION
  44  
  45  DBI::ProfileDumper is a subclass of L<DBI::Profile|DBI::Profile> which
  46  dumps profile data to disk instead of printing a summary to your
  47  screen.  You can then use L<dbiprof|dbiprof> to analyze the data in
  48  a number of interesting ways, or you can roll your own analysis using
  49  L<DBI::ProfileData|DBI::ProfileData>.
  50  
  51  B<NOTE:> For Apache/mod_perl applications, use
  52  L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.
  53  
  54  =head1 USAGE
  55  
  56  One way to use this module is just to enable it in your C<$dbh>:
  57  
  58    $dbh->{Profile} = "1/DBI::ProfileDumper";
  59  
  60  This will write out profile data by statement into a file called
  61  F<dbi.prof>.  If you want to modify either of these properties, you
  62  can construct the DBI::ProfileDumper object yourself:
  63  
  64    use DBI::ProfileDumper;
  65    $dbh->{Profile} = DBI::ProfileDumper->new(
  66        Path => [ '!Statement' ],
  67        File => 'dbi.prof'
  68    );
  69  
  70  The C<Path> option takes the same values as in
  71  L<DBI::Profile>.  The C<File> option gives the name of the
  72  file where results will be collected.  If it already exists it will be
  73  overwritten.
  74  
  75  You can also activate this module by setting the DBI_PROFILE
  76  environment variable:
  77  
  78    $ENV{DBI_PROFILE} = "!Statement/DBI::ProfileDumper";
  79  
  80  This will cause all DBI handles to share the same profiling object.
  81  
  82  =head1 METHODS
  83  
  84  The following methods are available to be called using the profile
  85  object.  You can get access to the profile object from the Profile key
  86  in any DBI handle:
  87  
  88    my $profile = $dbh->{Profile};
  89  
  90  =head2 flush_to_disk
  91  
  92    $profile->flush_to_disk()
  93  
  94  Flushes all collected profile data to disk and empties the Data hash.  Returns
  95  the filename writen to.  If no profile data has been collected then the file is
  96  not written and flush_to_disk() returns undef.
  97  
  98  The file is locked while it's being written. A process 'consuming' the files
  99  while they're being written to, should rename the file first, then lock it,
 100  then read it, then close and delete it. The C<DeleteFiles> option to
 101  L<DBI::ProfileData> does the right thing.
 102  
 103  This method may be called multiple times during a program run.
 104  
 105  =head2 empty
 106  
 107    $profile->empty()
 108  
 109  Clears the Data hash without writing to disk.
 110  
 111  =head2 filename
 112  
 113    $filename = $profile->filename();
 114  
 115  Get or set the filename.
 116  
 117  The filename can be specified as a CODE reference, in which case the referenced
 118  code should return the filename to be used. The code will be called with the
 119  profile object as its first argument.
 120  
 121  =head1 DATA FORMAT
 122  
 123  The data format written by DBI::ProfileDumper starts with a header
 124  containing the version number of the module used to generate it.  Then
 125  a block of variable declarations describes the profile.  After two
 126  newlines, the profile data forms the body of the file.  For example:
 127  
 128    DBI::ProfileDumper 2.003762
 129    Path = [ '!Statement', '!MethodName' ]
 130    Program = t/42profile_data.t
 131  
 132    + 1 SELECT name FROM users WHERE id = ?
 133    + 2 prepare
 134    = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
 135    + 2 execute
 136    1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
 137    + 2 fetchrow_hashref
 138    = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
 139    + 1 UPDATE users SET name = ? WHERE id = ?
 140    + 2 prepare
 141    = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
 142    + 2 execute
 143    = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
 144  
 145  The lines beginning with C<+> signs signify keys.  The number after
 146  the C<+> sign shows the nesting level of the key.  Lines beginning
 147  with C<=> are the actual profile data, in the same order as
 148  in DBI::Profile.
 149  
 150  Note that the same path may be present multiple times in the data file
 151  since C<format()> may be called more than once.  When read by
 152  DBI::ProfileData the data points will be merged to produce a single
 153  data set for each distinct path.
 154  
 155  The key strings are transformed in three ways.  First, all backslashes
 156  are doubled.  Then all newlines and carriage-returns are transformed
 157  into C<\n> and C<\r> respectively.  Finally, any NULL bytes (C<\0>)
 158  are entirely removed.  When DBI::ProfileData reads the file the first
 159  two transformations will be reversed, but NULL bytes will not be
 160  restored.
 161  
 162  =head1 AUTHOR
 163  
 164  Sam Tregar <sam@tregar.com>
 165  
 166  =head1 COPYRIGHT AND LICENSE
 167  
 168  Copyright (C) 2002 Sam Tregar
 169  
 170  This program is free software; you can redistribute it and/or modify
 171  it under the same terms as Perl 5 itself.
 172  
 173  =cut
 174  
 175  # inherit from DBI::Profile
 176  use DBI::Profile;
 177  
 178  our @ISA = ("DBI::Profile");
 179  
 180  our $VERSION = sprintf("2.%06d", q$Revision: 9894 $ =~ /(\d+)/o);
 181  
 182  use Carp qw(croak);
 183  use Fcntl qw(:flock);
 184  use Symbol;
 185  
 186  my $HAS_FLOCK = (defined $ENV{DBI_PROFILE_FLOCK})
 187      ? $ENV{DBI_PROFILE_FLOCK}
 188      : do { local $@; eval { flock STDOUT, 0; 1 } };
 189  
 190  my $program_header;
 191  
 192  
 193  # validate params and setup default
 194  sub new {
 195      my $pkg = shift;
 196      my $self = $pkg->SUPER::new(
 197          LockFile => $HAS_FLOCK,
 198          @_,
 199      );
 200  
 201      # provide a default filename
 202      $self->filename("dbi.prof") unless $self->filename;
 203  
 204      return $self;
 205  }
 206  
 207  
 208  # get/set filename to use
 209  sub filename {
 210      my $self = shift;
 211      $self->{File} = shift if @_;
 212      my $filename = $self->{File};
 213      $filename = $filename->($self) if ref($filename) eq 'CODE';
 214      return $filename;
 215  }
 216  
 217  
 218  # flush available data to disk
 219  sub flush_to_disk {
 220      my $self = shift;
 221      my $class = ref $self;
 222      my $filename = $self->filename;
 223      my $data = $self->{Data};
 224  
 225      if (1) { # make an option
 226          if (not $data or ref $data eq 'HASH' && !%$data) {
 227              DBI->trace_msg("flush_to_disk skipped for empty profile\n",0) if $self->{Trace};
 228              return undef;
 229          }
 230      }
 231  
 232      my $fh = gensym;
 233      if (($self->{_wrote_header}||'') eq $filename) {
 234          # append more data to the file
 235          # XXX assumes that Path hasn't changed
 236          open($fh, ">>", $filename) 
 237            or croak("Unable to open '$filename' for $class output: $!");
 238      } else {
 239          # create new file (or overwrite existing)
 240          open($fh, ">", $filename) 
 241            or croak("Unable to open '$filename' for $class output: $!");
 242      }
 243      # lock the file (before checking size and writing the header)
 244      flock($fh, LOCK_EX) if $self->{LockFile};
 245      # write header if file is empty - typically because we just opened it
 246      # in '>' mode, or perhaps we used '>>' but the file had been truncated externally.
 247      if (-s $fh == 0) {
 248          DBI->trace_msg("flush_to_disk wrote header to $filename\n",0) if $self->{Trace};
 249          $self->write_header($fh);
 250          $self->{_wrote_header} = $filename;
 251      }
 252  
 253      my $lines = $self->write_data($fh, $self->{Data}, 1);
 254      DBI->trace_msg("flush_to_disk wrote $lines lines to $filename\n",0) if $self->{Trace};
 255  
 256      close($fh)  # unlocks the file
 257          or croak("Error closing '$filename': $!");
 258  
 259      $self->empty();
 260  
 261  
 262      return $filename;
 263  }
 264  
 265  
 266  # write header to a filehandle
 267  sub write_header {
 268      my ($self, $fh) = @_;
 269  
 270      # isolate us against globals which effect print
 271      local($\, $,);
 272  
 273      # $self->VERSION can return undef during global destruction
 274      my $version = $self->VERSION || $VERSION;
 275  
 276      # module name and version number
 277      print $fh ref($self)." $version\n";
 278  
 279      # print out Path (may contain CODE refs etc)
 280      my @path_words = map { escape_key($_) } @{ $self->{Path} || [] };
 281      print $fh "Path = [ ", join(', ', @path_words), " ]\n";
 282  
 283      # print out $0 and @ARGV
 284      if (!$program_header) {
 285          # XXX should really quote as well as escape
 286          $program_header = "Program = "
 287              . join(" ", map { escape_key($_) } $0, @ARGV)
 288              . "\n";
 289      }
 290      print $fh $program_header;
 291  
 292      # all done
 293      print $fh "\n";
 294  }
 295  
 296  
 297  # write data in the proscribed format
 298  sub write_data {
 299      my ($self, $fh, $data, $level) = @_;
 300  
 301      # XXX it's valid for $data to be an ARRAY ref, i.e., Path is empty.
 302      # produce an empty profile for invalid $data
 303      return 0 unless $data and UNIVERSAL::isa($data,'HASH');
 304      
 305      # isolate us against globals which affect print
 306      local ($\, $,);
 307  
 308      my $lines = 0;
 309      while (my ($key, $value) = each(%$data)) {
 310          # output a key
 311          print $fh "+ $level ". escape_key($key). "\n";
 312          if (UNIVERSAL::isa($value,'ARRAY')) {
 313              # output a data set for a leaf node
 314              print $fh "= ".join(' ', @$value)."\n";
 315              $lines += 1;
 316          } else {
 317              # recurse through keys - this could be rewritten to use a
 318              # stack for some small performance gain
 319              $lines += $self->write_data($fh, $value, $level + 1);
 320          }
 321      }
 322      return $lines;
 323  }
 324  
 325  
 326  # escape a key for output
 327  sub escape_key {
 328      my $key = shift;
 329      $key =~ s!\\!\\\\!g;
 330      $key =~ s!\n!\\n!g;
 331      $key =~ s!\r!\\r!g;
 332      $key =~ s!\0!!g;
 333      return $key;
 334  }
 335  
 336  
 337  # flush data to disk when profile object goes out of scope
 338  sub on_destroy {
 339      shift->flush_to_disk();
 340  }
 341  
 342  1;