View of /trunk/webwork-modperl/lib/WeBWorK/Timing.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::Timing;
   18 
   19 =head1 NAME
   20 
   21 WeBWorK::Timing - Log timing data.
   22 
   23 head1 SYNOPSIS
   24 
   25  use WeBWorK::Timing;
   26 
   27  my $timer = WeBWorK::Timing->new("do some processesing");
   28  $timer->start;
   29  do_some_processing();
   30  $timer->continue("
   31  do_some_more_processing();
   32  $timer->stop;
   33  $timer->save;
   34 
   35  my $timer0 = WeBWorK::Timing->new("main task");
   36  my $timer1 = WeBWorK::Timing->new("subtask 1");
   37  my $timer2 = WeBWorK::Timing->new("subtask 1");
   38 
   39  $timer0->start;
   40  $timer1->start;
   41  sub_task(1);
   42  $timer1->stop;
   43  $timer2->start;
   44  sub_task(2);
   45  $timer2->stop;
   46  $timer0->stop;
   47 
   48  # timing data is saved when objects go out of scope
   49 
   50 =cut
   51 
   52 use strict;
   53 use warnings;
   54 use Time::HiRes qw(gettimeofday tv_interval);
   55 
   56 our $TASK_COUNT = 0; # number of tasks processed in this child process
   57 # You can customize the output to go to some file besides STDERR (usually ErrorLog for Apache)
   58 our $TIMING_LOG = '';
   59 =head1 CONSTRUCTOR
   60 
   61 =over
   62 
   63 =item new($task)
   64 
   65 C<new> creates a new timing object, with the task given in $task.
   66 
   67 =back
   68 
   69 =cut
   70 
   71 sub new {
   72   my ($invocant, $task) = @_;
   73   my $self = {
   74     id    => $TASK_COUNT++,
   75     task  => $task,
   76     ctime => scalar gettimeofday(),
   77     saved => 0,
   78   };
   79   return bless $self, ref $invocant || $invocant
   80 }
   81 
   82 =head1 METHODS
   83 
   84 =over
   85 
   86 =item start(), begin()
   87 
   88 Marks the current time as the start time for the task.
   89 
   90 =cut
   91 
   92 sub start {
   93   my ($self) = @_;
   94   $self->{start} = gettimeofday();
   95 }
   96 
   97 sub begin { shift->start(@_); }
   98 
   99 =item continue($data)
  100 
  101 Stores the current time as an intermediate time, associated with the string
  102 given in $data.
  103 
  104 =cut
  105 
  106 sub continue {
  107   my ($self, $data) = @_;
  108   push @{$self->{steps}}, [ scalar gettimeofday(), $data ];
  109 }
  110 
  111 =item stop(), finish(), end()
  112 
  113 Marks the current time as the stop time for the task.
  114 
  115 =cut
  116 
  117 sub stop {
  118   my ($self) = @_;
  119   $self->{stop} = gettimeofday();
  120 }
  121 
  122 sub finish { shift->stop(@_); }
  123 sub end    { shift->stop(@_); }
  124 
  125 =item save()
  126 
  127 Writes the timing data for this task to the standard error stream. If save is
  128 not called explicitly, it is called when the object goes out of scope.
  129 
  130 =cut
  131 
  132 sub save {
  133   my ($self) = @_;
  134   local(*TIMING);
  135   if ($TIMING_LOG =~ /\S/) {
  136     open(TIMING, ">>$TIMING_LOG") || die "Can't open timing log: $TIMING_LOG";
  137   } else {
  138     *TIMING = *STDERR;
  139   }
  140 
  141   my $id = $self->{id};
  142   my $task = $self->{task};
  143   my $now = gettimeofday();
  144 
  145   my $diff = sprintf("%.6f", 0);
  146   if ($self->{start}) {
  147     my $start = sprintf("%.6f", $self->{start});
  148     print TIMING "TIMING $$ $id $start ($diff) $task: START\n";
  149   } else {
  150     my $ctime = sprintf("%.6f", $self->{ctime});
  151     print TIMING "TIMING $$ $id $ctime ($diff) $task: START (assumed)\n";
  152   }
  153 
  154   if ($self->{steps}) {
  155     my @steps = @{$self->{steps}};
  156     foreach my $step (@steps) {
  157       my ($time, $data) = @$step;
  158       $time = sprintf("%.6f", $time);
  159       my $start = sprintf("%.6f", $self->{start});
  160       my $diff  = sprintf("%.6f", $time-$start);
  161       print TIMING "TIMING $$ $id $time ($diff) $task: $data\n";
  162     }
  163   }
  164 
  165   if ($self->{stop}) {
  166     my $stop = sprintf("%.6f", $self->{stop});
  167     my $start = sprintf("%.6f", $self->{start});
  168     my $diff  = sprintf("%.6f", $stop-$start);
  169     print TIMING "TIMING $$ $id $stop ($diff) $task: END\n";
  170   } else {
  171     $now = sprintf("%.6f", $now);
  172     my $start = sprintf("%.6f", $self->{start});
  173     my $diff  = sprintf("%.6f", $now-$start);
  174     print TIMING "TIMING $$ $id $now ($diff) $task: END (assumed)\n";
  175   }
  176 
  177   $self->{saved} = 1;
  178 }
  179 
  180 sub DESTROY {
  181   my ($self) = shift;
  182 
  183   $self->save unless $self->{saved};
  184 }
  185 
  186 =head1 AUTHOR
  187 
  188 Written by Sam Hathaway, sh002i (at) math.rochester.edu.
  189 
  190 =head1 BUGS
  191 
  192 Currently outputs to STDERR instead of something more graceful.
  193 
  194 =head1 SEE ALSO
  195 
  196 The F<timing> utility can be used to parse and sort log output.
  197 
  198 =cut
  199 
  200 1;