View of /trunk/webwork2/lib/WeBWorK/Timing.pm

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