Parent Directory
| 
Revision Log
updated timing to use $Enabled and $Logfile constants.
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.9 2004/05/13 18:28:42 gage 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 # Enable timing 28 $WeBWorK::Timing::Enable = 1; 29 30 # Log to a file instead of STDERR 31 $WeBWorK::Timing::Logfile = "/path/to/timing.log"; 32 33 my $timer = WeBWorK::Timing->new("do some processesing"); 34 $timer->start; 35 do_some_processing(); 36 $timer->continue(" 37 do_some_more_processing(); 38 $timer->stop; 39 $timer->save; 40 41 my $timer0 = WeBWorK::Timing->new("main task"); 42 my $timer1 = WeBWorK::Timing->new("subtask 1"); 43 my $timer2 = WeBWorK::Timing->new("subtask 1"); 44 45 $timer0->start; 46 $timer1->start; 47 sub_task(1); 48 $timer1->stop; 49 $timer2->start; 50 sub_task(2); 51 $timer2->stop; 52 $timer0->stop; 53 54 # timing data is saved when objects go out of scope 55 56 =cut 57 58 use strict; 59 use warnings; 60 use Time::HiRes qw(gettimeofday tv_interval); 61 62 our $TASK_COUNT = 0; # number of tasks processed in this child process 63 64 ################################################################################ 65 66 =head1 CONFIGURATION VARIABLES 67 68 =over 69 70 =item $Enabled 71 72 If true, timing messages will be output. If false, they will be ignored. 73 74 =cut 75 76 our $Enabled = 0 unless defined $Enabled; 77 78 =item $Logfile 79 80 If non-empty, timing output will be sent to the file named rather than STDERR. 81 82 =cut 83 84 our $Logfile = "" unless defined $Logfile; 85 86 =back 87 88 =cut 89 90 ################################################################################ 91 92 =head1 CONSTRUCTOR 93 94 =over 95 96 =item new($task) 97 98 C<new> creates a new timing object, with the task given in $task. 99 100 =cut 101 102 sub new { 103 my ($invocant, $task) = @_; 104 my $self = { 105 id => $TASK_COUNT++, 106 task => $task, 107 ctime => scalar gettimeofday(), 108 saved => 0, 109 }; 110 return bless $self, ref $invocant || $invocant 111 } 112 113 =back 114 115 =cut 116 117 ################################################################################ 118 119 =head1 METHODS 120 121 =over 122 123 =item start(), begin() 124 125 Marks the current time as the start time for the task. 126 127 =cut 128 129 sub start { 130 my ($self) = @_; 131 $self->{start} = gettimeofday(); 132 } 133 134 sub begin { shift->start(@_); } 135 136 =item continue($data) 137 138 Stores the current time as an intermediate time, associated with the string 139 given in $data. 140 141 =cut 142 143 sub continue { 144 my ($self, $data) = @_; 145 push @{$self->{steps}}, [ scalar gettimeofday(), $data ]; 146 } 147 148 =item stop(), finish(), end() 149 150 Marks the current time as the stop time for the task. 151 152 =cut 153 154 sub stop { 155 my ($self) = @_; 156 $self->{stop} = gettimeofday(); 157 } 158 159 sub finish { shift->stop(@_); } 160 sub end { shift->stop(@_); } 161 162 =item save() 163 164 Writes the timing data for this task to the standard error stream. If save is 165 not called explicitly, it is called when the object goes out of scope. 166 167 =cut 168 169 sub save { 170 my ($self) = @_; 171 172 if ($Enabled) { 173 my $fh; 174 if ($Logfile ne "") { 175 if (open my $tmpFH, ">>", $Logfile) { 176 $fh = $tmpFH; 177 } else { 178 warn "Failed to open timing log '$Logfile' in append mode: $!"; 179 $fh = *STDERR; 180 } 181 } else { 182 $fh = *STDERR; 183 } 184 185 my $id = $self->{id}; 186 my $task = $self->{task}; 187 my $now = gettimeofday(); 188 189 my $diff = sprintf("%.6f", 0); 190 if ($self->{start}) { 191 my $start = sprintf("%.6f", $self->{start}); 192 print $fh "TIMING $$ $id $start ($diff) $task: START\n"; 193 } else { 194 my $ctime = sprintf("%.6f", $self->{ctime}); 195 print $fh "TIMING $$ $id $ctime ($diff) $task: START (assumed)\n"; 196 } 197 198 if ($self->{steps}) { 199 my @steps = @{$self->{steps}}; 200 foreach my $step (@steps) { 201 my ($time, $data) = @$step; 202 $time = sprintf("%.6f", $time); 203 my $start = sprintf("%.6f", $self->{start}); 204 my $diff = sprintf("%.6f", $time-$start); 205 print $fh "TIMING $$ $id $time ($diff) $task: $data\n"; 206 } 207 } 208 209 if ($self->{stop}) { 210 my $stop = sprintf("%.6f", $self->{stop}); 211 my $start = sprintf("%.6f", $self->{start}); 212 my $diff = sprintf("%.6f", $stop-$start); 213 print $fh "TIMING $$ $id $stop ($diff) $task: END\n"; 214 } else { 215 $now = sprintf("%.6f", $now); 216 my $start = sprintf("%.6f", $self->{start}); 217 my $diff = sprintf("%.6f", $now-$start); 218 print $fh "TIMING $$ $id $now ($diff) $task: END (assumed)\n"; 219 } 220 } 221 222 $self->{saved} = 1; 223 } 224 225 sub DESTROY { 226 my ($self) = shift; 227 228 $self->save unless $self->{saved}; 229 } 230 231 =back 232 233 =cut 234 235 ################################################################################ 236 237 =head1 AUTHOR 238 239 Written by Sam Hathaway, sh002i (at) math.rochester.edu. 240 241 =head1 SEE ALSO 242 243 The F<timing> utility can be used to parse and sort log output. 244 245 =cut 246 247 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |