>>>>> "Barry" == Barry Robison <[EMAIL PROTECTED]> writes:

Barry> On Wed, Nov 24, 1999 at 07:31:36AM -0800, Randal L. Schwartz wrote:
>> 
>> I also added a DBILogger that logs CPU times, so I can see which pages
>> on my system are burning the most CPU, and even tell which hosts suck
>> down the most CPU in a day.  mod_perl rules!
>> 

Barry> Would you be willing to share that? Sounds handy!

OK, here it is so far, although it's a work in progress.  I derived it
mostly from the code in the modperl book.  By the way, logging $r->uri
does NOT show as much info as logging the middle part of
$r->the_request, and I couldn't see any easy way to do it except how
I've done it here.  The fields "wall, cpuuser, cpusys, cpucuser,
cpucsys" have the delta outputs from "time" and "times", so I can even
see wall-clock for each request from start to finish as well as CPU,
and I also *should* be able to see mod_cgi's child usage, but I can't
(see other message...).

    package Stonehenge::DBILog;
    use strict;

    ## usage: PerlInitHandler Stonehenge::DBILog

    use vars qw($VERSION);
    $VERSION = (qw$Revision: 1.4 $ )[-1];

    use Apache::Constants qw(OK DECLINED);
    use DBI ();
    use Apache::Util qw(ht_time);
    use Apache::Log;            # DEBUG

    my $DSN = 'dbi:mysql:merlyn_httpd';
    my $DB_TABLE = 'requests';
    my $DB_AUTH = 'YourUser:YourPassword'; # :-)

    my @FIELDS =
      qw(when host method url user referer browser status bytes
         wall cpuuser cpusys cpucuser cpucsys);
    my $INSERT =
      "INSERT INTO $DB_TABLE (".
      (join ",", @FIELDS).
      ") VALUES(".
      (join ",", ("?") x @FIELDS).
      ")";

    =for SQL

    create table requests (
      when datetime not null,
      host varchar(255) not null,
      method varchar(8) not null,
      url varchar(255) not null,
      user varchar(50),
      referer varchar(255),
      browser varchar(255),
      status smallint(3) default 0,
      bytes int(8),
      wall smallint(5),
      cpuuser float(8),
      cpusys float(8),
      cpucuser float(8),
      cpucsys float(8)
    );

    =cut

    sub handler {
      use Stonehenge::Reload; goto &handler if Stonehenge::Reload->reload_me;

      my $r = shift;
      return DECLINED unless $r->is_initial_req;

      my @times = (time, times);        # closure

      $r->push_handlers
        (PerlLogHandler =>
         sub {
           ## delta these times:
           @times = map { $_ - shift @times } time, times;

           my $orig = shift;
           my $r = $orig->last;

           my @data =
             (
              ht_time($orig->request_time, '%Y-%m-%d %H:%M:%S', 0),
              $r->get_remote_host,
              $r->method,
              # $orig->uri,
              ($r->the_request =~ /^\S+\s+(\S+)/)[0],
              $r->connection->user,
              $r->header_in('Referer'),
              $r->header_in('User-agent'),
              $orig->status,
              $r->bytes_sent,
              @times,
             );

           ## $r->log->warn(map "[$_]", @data); # DEBUG

           eval {
             my $dbh = DBI->connect($DSN, (split ':', $DB_AUTH),
                                   { RaiseError => 1 });
             my $sth = $dbh->prepare($INSERT);
             $sth->execute(@data);
             $sth->finish;
             $dbh->disconnect;
           };
           if ($@) {
             $r->log->error("dbi: $@");
           }

           return DECLINED;
         });

      return DECLINED;
    }

    1;



-- 
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<[EMAIL PROTECTED]> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!

Reply via email to