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

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork-modperl/lib/WeBWorK/Timing.pm,v 1.8 2003/12/09 01:12:30 sh002i Exp $
    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 
   60 #our $TIMING_LOG = '/home/gage/webwork/webwork-modperl/logs/timing.log';
   61 =head1 CONSTRUCTOR
   62 
   63 =over
   64 
   65 =item new($task)
   66 
   67 C<new> creates a new timing object, with the task given in $task.
   68 
   69 =back
   70 
   71 =cut
   72 
   73 sub new {
   74   my ($invocant, $task) = @_;
   75   my $self = {
   76     id    => $TASK_COUNT++,
   77     task  => $task,
   78     ctime => scalar gettimeofday(),
   79     saved => 0,
   80   };
   81   return bless $self, ref $invocant || $invocant
   82 }
   83 
   84 =head1 METHODS
   85 
   86 =over
   87 
   88 =item start(), begin()
   89 
   90 Marks the current time as the start time for the task.
   91 
   92 =cut
   93 
   94 sub start {
   95   my ($self) = @_;
   96   $self->{start} = gettimeofday();
   97 }
   98 
   99 sub begin { shift->start(@_); }
  100 
  101 =item continue($data)
  102 
  103 Stores the current time as an intermediate time, associated with the string
  104 given in $data.
  105 
  106 =cut
  107 
  108 sub continue {
  109   my ($self, $data) = @_;
  110   push @{$self->{steps}}, [ scalar gettimeofday(), $data ];
  111 }
  112 
  113 =item stop(), finish(), end()
  114 
  115 Marks the current time as the stop time for the task.
  116 
  117 =cut
  118 
  119 sub stop {
  120   my ($self) = @_;
  121   $self->{stop} = gettimeofday();
  122 }
  123 
  124 sub finish { shift->stop(@_); }
  125 sub end    { shift->stop(@_); }
  126 
  127 =item save()
  128 
  129 Writes the timing data for this task to the standard error stream. If save is
  130 not called explicitly, it is called when the object goes out of scope.
  131 
  132 =cut
  133 
  134 sub save {
  135   my ($self) = @_;
  136   local(*TIMING);
  137   if ($TIMING_LOG =~ /\S/) {
  138     open(TIMING, ">>$TIMING_LOG") || die "Can't open timing log: $TIMING_LOG";
  139   } else {
  140     *TIMING = *STDERR;
  141   }
  142 
  143   my $id = $self->{id};
  144   my $task = $self->{task};
  145   my $now = gettimeofday();
  146 
  147   my $diff = sprintf("%.6f", 0);
  148   if ($self->{start}) {
  149     my $start = sprintf("%.6f", $self->{start});
  150     print TIMING "TIMING $$ $id $start ($diff) $task: START\n";
  151   } else {
  152     my $ctime = sprintf("%.6f", $self->{ctime});
  153     print TIMING "TIMING $$ $id $ctime ($diff) $task: START (assumed)\n";
  154   }
  155 
  156   if ($self->{steps}) {
  157     my @steps = @{$self->{steps}};
  158     foreach my $step (@steps) {
  159       my ($time, $data) = @$step;
  160       $time = sprintf("%.6f", $time);
  161       my $start = sprintf("%.6f", $self->{start});
  162       my $diff  = sprintf("%.6f", $time-$start);
  163       print TIMING "TIMING $$ $id $time ($diff) $task: $data\n";
  164     }
  165   }
  166 
  167   if ($self->{stop}) {
  168     my $stop = sprintf("%.6f", $self->{stop});
  169     my $start = sprintf("%.6f", $self->{start});
  170     my $diff  = sprintf("%.6f", $stop-$start);
  171     print TIMING "TIMING $$ $id $stop ($diff) $task: END\n";
  172   } else {
  173     $now = sprintf("%.6f", $now);
  174     my $start = sprintf("%.6f", $self->{start});
  175     my $diff  = sprintf("%.6f", $now-$start);
  176     print TIMING "TIMING $$ $id $now ($diff) $task: END (assumed)\n";
  177   }
  178 
  179   $self->{saved} = 1;
  180 }
  181 
  182 sub DESTROY {
  183   my ($self) = shift;
  184 
  185   $self->save unless $self->{saved};
  186 }
  187 
  188 =head1 AUTHOR
  189 
  190 Written by Sam Hathaway, sh002i (at) math.rochester.edu.
  191 
  192 =head1 BUGS
  193 
  194 Currently outputs to STDERR instead of something more graceful.
  195 
  196 =head1 SEE ALSO
  197 
  198 The F<timing> utility can be used to parse and sort log output.
  199 
  200 =cut
  201 
  202 1;