[Summary view] [Print] [Text view]

   1  package DBI::ProfileDumper::Apache;
   2  
   3  use strict;
   4  
   5  =head1 NAME
   6  
   7  DBI::ProfileDumper::Apache - capture DBI profiling data from Apache/mod_perl
   8  
   9  =head1 SYNOPSIS
  10  
  11  Add this line to your F<httpd.conf>:
  12  
  13    PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
  14  
  15  (If you're using mod_perl2, see L</When using mod_perl2> for some additional notes.)
  16  
  17  Then restart your server.  Access the code you wish to test using a
  18  web browser, then shutdown your server.  This will create a set of
  19  F<dbi.prof.*> files in your Apache log directory.
  20  
  21  Get a profiling report with L<dbiprof|dbiprof>:
  22  
  23    dbiprof /path/to/your/apache/logs/dbi.prof.*
  24  
  25  When you're ready to perform another profiling run, delete the old files and start again.
  26  
  27  =head1 DESCRIPTION
  28  
  29  This module interfaces DBI::ProfileDumper to Apache/mod_perl.  Using
  30  this module you can collect profiling data from mod_perl applications.
  31  It works by creating a DBI::ProfileDumper data file for each Apache
  32  process.  These files are created in your Apache log directory.  You
  33  can then use the dbiprof utility to analyze the profile files.
  34  
  35  =head1 USAGE
  36  
  37  =head2 LOADING THE MODULE
  38  
  39  The easiest way to use this module is just to set the DBI_PROFILE
  40  environment variable in your F<httpd.conf>:
  41  
  42    PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
  43  
  44  The DBI will look after loading and using the module when the first DBI handle
  45  is created.
  46  
  47  It's also possible to use this module by setting the Profile attribute
  48  of any DBI handle:
  49  
  50    $dbh->{Profile} = "2/DBI::ProfileDumper::Apache";
  51  
  52  See L<DBI::ProfileDumper> for more possibilities, and L<DBI::Profile> for full
  53  details of the DBI's profiling mechanism.
  54  
  55  =head2 WRITING PROFILE DATA
  56  
  57  The profile data files will be written to your Apache log directory by default.
  58  
  59  The user that the httpd processes run as will need write access to the
  60  directory.  So, for example, if you're running the child httpds as user 'nobody'
  61  and using chronolog to write to the logs directory, then you'll need to change
  62  the default.
  63  
  64  You can change the destination directory either by secifying a C<Dir> value
  65  when creating the profile (like C<File> in the L<DBI::ProfileDumper> docs),
  66  or you can use the C<DBI_PROFILE_APACHE_LOG_DIR> env var to change that. For example:
  67  
  68    PerlSetEnv DBI_PROFILE_APACHE_LOG_DIR /server_root/logs
  69  
  70  =head3 When using mod_perl2
  71  
  72  Under mod_perl2 you'll need to either set the C<DBI_PROFILE_APACHE_LOG_DIR> env var,
  73  or enable the mod_perl2 C<GlobalRequest> option, like this:
  74  
  75    PerlOptions +GlobalRequest
  76  
  77  to the global config section you're about test with DBI::ProfileDumper::Apache.
  78  If you don't do one of those then you'll see messages in your error_log similar to:
  79  
  80    DBI::ProfileDumper::Apache on_destroy failed: Global $r object is not available. Set:
  81      PerlOptions +GlobalRequest in httpd.conf at ..../DBI/ProfileDumper/Apache.pm line 144
  82  
  83  =head3 Naming the files
  84  
  85  The default file name is inherited from L<DBI::ProfileDumper> via the
  86  filename() method, but DBI::ProfileDumper::Apache appends the parent pid and
  87  the current pid, separated by dots, to that name.
  88  
  89  =head3 Silencing the log
  90  
  91  By default a message is written to STDERR (i.e., the apache error_log file)
  92  when flush_to_disk() is called (either explicitly, or implicitly via DESTROY).
  93  
  94  That's usually very useful. If you don't want the log message you can silence
  95  it by setting the C<Quiet> attribute true.
  96  
  97    PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache/Quiet:1
  98  
  99    $dbh->{Profile} = "!Statement/DBI::ProfileDumper/Quiet:1";
 100  
 101    $dbh->{Profile} = DBI::ProfileDumper->new(
 102        Path => [ '!Statement' ]
 103        Quiet => 1
 104    );
 105  
 106  
 107  =head2 GATHERING PROFILE DATA
 108  
 109  Once you have the module loaded, use your application as you normally
 110  would.  Stop the webserver when your tests are complete.  Profile data
 111  files will be produced when Apache exits and you'll see something like
 112  this in your error_log:
 113  
 114    DBI::ProfileDumper::Apache writing to /usr/local/apache/logs/dbi.prof.2604.2619
 115  
 116  Now you can use dbiprof to examine the data:
 117  
 118    dbiprof /usr/local/apache/logs/dbi.prof.2604.*
 119  
 120  By passing dbiprof a list of all generated files, dbiprof will
 121  automatically merge them into one result set.  You can also pass
 122  dbiprof sorting and querying options, see L<dbiprof> for details.
 123  
 124  =head2 CLEANING UP
 125  
 126  Once you've made some code changes, you're ready to start again.
 127  First, delete the old profile data files:
 128  
 129    rm /usr/local/apache/logs/dbi.prof.*
 130  
 131  Then restart your server and get back to work.
 132  
 133  =head1 OTHER ISSUES
 134  
 135  =head2 Memory usage
 136  
 137  DBI::Profile can use a lot of memory for very active applications because it
 138  collects profiling data in memory for each distinct query run.
 139  Calling C<flush_to_disk()> will write the current data to disk and free the
 140  memory it's using. For example:
 141  
 142    $dbh->{Profile}->flush_to_disk() if $dbh->{Profile};
 143  
 144  or, rather than flush every time, you could flush less often:
 145  
 146    $dbh->{Profile}->flush_to_disk()
 147      if $dbh->{Profile} and ++$i % 100;
 148  
 149  =head1 AUTHOR
 150  
 151  Sam Tregar <sam@tregar.com>
 152  
 153  =head1 COPYRIGHT AND LICENSE
 154  
 155  Copyright (C) 2002 Sam Tregar
 156  
 157  This program is free software; you can redistribute it and/or modify
 158  it under the same terms as Perl 5 itself.
 159  
 160  =cut
 161  
 162  our $VERSION = sprintf("2.%06d", q$Revision: 9618 $ =~ /(\d+)/o);
 163  
 164  our @ISA = qw(DBI::ProfileDumper);
 165  
 166  use DBI::ProfileDumper;
 167  use File::Spec;
 168  
 169  my $parent_pid = $$; # init to pid because we are currently the parent of the children-to-be
 170  
 171  use constant MP2 => ($ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} == 2) ? 1 : 0;
 172  
 173  my $apache_server;
 174  my $server_root_dir;
 175  
 176  if (MP2) {
 177      require Apache2::Const;
 178      Apache2::Const->import(-compile => qw(OK DECLINED));
 179      require Apache2::ServerUtil;
 180      $apache_server = Apache2::ServerUtil->server;
 181      $server_root_dir = Apache2::ServerUtil::server_root();
 182  }
 183  else {
 184      require Apache;
 185      require Apache::Constants;
 186      Apache::Constants->import(qw(OK DECLINED));
 187      $apache_server = "Apache";
 188      $server_root_dir = eval { Apache->server_root_relative('') } || "/tmp";
 189  }
 190  
 191  
 192  if (UNIVERSAL::can($apache_server, "push_handlers")) {
 193      $apache_server->push_handlers(PerlChildInitHandler => sub {
 194          $parent_pid = getppid();
 195          #warn "PerlChildInitHandler pid$$ has ppid $parent_pid";
 196          OK();
 197      });
 198  }
 199  
 200  sub dirname {
 201      my $self = shift;
 202      return $self->{Dir} if $self->{Dir};
 203      $self->{Dir} ||= $ENV{DBI_PROFILE_APACHE_LOG_DIR};
 204      return $self->{Dir} || File::Spec->catdir($server_root_dir, "logs");
 205  }
 206  
 207  sub filename {
 208      my $self = shift;
 209      my $filename = $self->SUPER::filename(@_);
 210      # to be able to identify groups of profile files from the same set of
 211      # apache processes, we include the parent pid in the file name
 212      # as well as the pid.
 213      $filename .= ".$parent_pid.$$";
 214      return $filename if File::Spec->file_name_is_absolute($filename);
 215      return File::Spec->catfile($self->dirname, $filename);
 216  }
 217  
 218  
 219  sub flush_to_disk {
 220      my $self = shift;
 221  
 222      my $filename = $self->SUPER::flush_to_disk(@_);
 223  
 224      print STDERR ref($self)." pid$$ written to $filename\n"
 225          if $filename && not $self->{Quiet};
 226  
 227      return $filename;
 228  }
 229  
 230  1;