Back to home page
Get LXR Cross Referencer at SourceForge.net. Fast, secure and Free Open Source software downloads

LXR self cross-referenced (under SQLite)

 
 

    


File indexing completed on 2017-05-02 17:45:25

0001 #!/usr/bin/perl -T
0002 ######################################################################
0003 #
0004 # perf --   Dump performance data for this tree
0005 #
0006 #   André J. Littoz <ajlittoz@users.sourceforge.net>
0007 #
0008 #
0009 # This program is free software; you can redistribute it and/or modify
0010 # it under the terms of the GNU General Public License as published by
0011 # the Free Software Foundation; either version 2 of the License, or
0012 # (at your option) any later version.
0013 #
0014 # This program is distributed in the hope that it will be useful,
0015 # but WITHOUT ANY WARRANTY; without even the implied warranty of
0016 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
0017 # GNU General Public License for more details.
0018 #
0019 # You should have received a copy of the GNU General Public License
0020 # along with this program; if not, write to the Free Software
0021 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
0022 #
0023 ######################################################################
0024 
0025 use strict;
0026 use lib do { $0 =~ m{(.*)/} ? "$1/lib" : 'lib' };  # if LXR modules are in ./lib
0027 
0028 =head1 perf script
0029 
0030 This script displays genxref's performance statistics for the various
0031 versions of the tree.
0032 
0033 =cut
0034 
0035 use LXR::Common;
0036 use LXR::Template;
0037 
0038 my $totalserialtime;
0039 my $totalelapsed;
0040 my $inprogress;
0041 
0042 =head2 C<duration ($start, $end)>
0043 
0044 Function C<duration> returns a human-readable string for the
0045 time difference between its arguments.
0046 
0047 =over
0048 
0049 =item 1
0050 
0051 C<$start>
0052 
0053 an I<integer> containing the number of seconds since the epoch for
0054 the beginning of the interval
0055 
0056 =item 2
0057 
0058 C<$end>
0059 
0060 an I<integer> containing the number of seconds since the epoch for
0061 the end of the interval
0062 
0063 =back
0064 
0065 If the end date is negative, an error occurred during the interval.
0066 
0067 If the start date is negative, the step was skipped.
0068 
0069 =cut
0070 
0071 sub duration {
0072     my ($start, $end) = @_;
0073     my ($flag, $seconds, $minutes);
0074 
0075     if (! defined($start)) {
0076         return '<em>skipped</em>'
0077     }
0078     if (0 == $end) {
0079         if (-2 == $inprogress) {
0080             return '<em>in progress</em>';
0081         }
0082         if (0 != $start) {
0083             return '<span class=error>crashed</span>&nbsp;';
0084         }
0085     }
0086     if (0 > $end) {
0087         $end = -$end;
0088         $flag = '<strong class=error>*</strong>&nbsp;';
0089     }
0090     $end -= $start;
0091     $seconds = $end % 60;
0092     $end = ($end - $seconds) / 60;
0093     $minutes = $end % 60;
0094     $end = ($end - $minutes) / 60;
0095     return $flag . sprintf('%d:%2.2d:%2.2d', $end, $minutes, $seconds);
0096 }
0097 
0098 
0099 =head2 C<rowclass ($templ, $line)>
0100 
0101 Function C<rowclass> is the "$variable" substitution function
0102 for C<lineclass>.
0103 It returns a CSS class name depending on line parity.
0104 
0105 =over
0106 
0107 =item 1
0108 
0109 C<$templ>
0110 
0111 a I<string> containing the template (empty for a "variable")
0112 
0113 =item 2
0114 
0115 C<$line>
0116 
0117 an I<integer> containing the line number of the display
0118 
0119 =back
0120 
0121 =cut
0122 
0123 sub rowclass {
0124     my ($templ, $line) = @_;
0125     return ((($line - 1) / 3) % 2) ? 'perfrow2' : 'perfrow1';
0126 }
0127 
0128 
0129 =head2 C<onelineexpand ($temp, $reindex, @versions)>
0130 
0131 Function C<onelineexpand> is a "$function" substitution function.
0132 It returns its template expanded for every line matching its
0133 second argument.
0134 
0135 =over
0136 
0137 =item 1
0138 
0139 C<$templ>
0140 
0141 a I<string> containing the template
0142 
0143 =item 2
0144 
0145 C<$reindex>
0146 
0147 the full reindex flag as 0 or 1 to select the proper values
0148 
0149 =item 3
0150 
0151 C<@versions>
0152 
0153 an I<array> containing the versions (release-ids) for which
0154 performance data must be edited.
0155 
0156 =back
0157 
0158 It fetches performance data for the elements of its second argument.
0159 
0160 =cut
0161 
0162 sub onelineexpand {
0163     my ($templ, $reindex, @versions) = @_;
0164     my $direx = '';
0165     my $line  = 1;
0166     my $releaseid;
0167     my ($purgestart, $purgeend);
0168     my ($textstart, $textend);
0169     my ($dclstart, $dclend);
0170     my ($refstart, $refend);
0171     my $onestep;
0172     my $steptotal;
0173     my $crashed;
0174     my $stepterm;
0175 
0176     foreach $releaseid (@versions) {
0177         ($purgestart, $purgeend) = $index->getperformance($releaseid, $reindex, 'P');
0178         ($textstart, $textend) = $index->getperformance($releaseid, $reindex, 'T');
0179         ($dclstart, $dclend) = $index->getperformance($releaseid, $reindex, 'D');
0180         ($refstart, $refend) = $index->getperformance($releaseid, $reindex, 'U');
0181         $steptotal = 0;
0182         $crashed = 0;
0183 #       if (defined($purgestart)) {
0184             $onestep = $purgeend - $purgestart;
0185             $steptotal += $onestep if 0 < $onestep;
0186             $crashed = 1 if 0 > $purgeend;
0187 #       }
0188         if (defined $textstart) {
0189             $onestep = $textend - $textstart;
0190             $steptotal += $onestep if 0 < $onestep;
0191             $crashed = 1 if 0 > $textend;
0192         }
0193         if (defined $dclstart) {
0194             $onestep = $dclend - $dclstart;
0195             $steptotal += $onestep if 0 < $onestep;
0196             $crashed = 1 if 0 > $dclend;
0197         }
0198         if (defined $refstart) {
0199             $onestep = $refend - $refstart;
0200             $steptotal += $onestep if 0 < $onestep;
0201             $crashed = 1 if 0 > $refend;
0202         }
0203         if ($crashed) {
0204             $steptotal = -1;
0205             $stepterm = -1;
0206         } else {
0207             $totalserialtime += $steptotal;
0208             $stepterm = $textend>$refend ? $textend : $refend;
0209             $stepterm = 0 if ! defined $stepterm;
0210         }
0211             if (0 < $stepterm) {
0212             $totalelapsed += $stepterm - $purgestart;
0213         }
0214         $direx .= expandtemplate
0215             (   $templ
0216             ,   ( 'lineclass' => sub { rowclass(@_, $line++) }
0217                 , 'perfversion' => sub { $releaseid }
0218                 , 'perfdate' => sub { _edittime($purgestart) }
0219                 , 'perfpurge' => sub { duration($purgestart, $purgeend) }
0220                 , 'preffreetext' => sub { duration($textstart, $textend) }
0221                 , 'perfdefn'=> sub { duration($dclstart, $dclend) }
0222                 , 'perfrefs' => sub { duration($refstart, $refend) }
0223                 , 'perftotal' => sub { duration(0, $steptotal) }
0224                 , 'perfelapsed' => sub { duration($purgestart, $stepterm) }
0225                 )
0226             );
0227     }
0228     return $direx;
0229 }
0230 
0231 
0232 =head2 C<perfdataexpand ($templ, $reindex)>
0233 
0234 Function C<perfdataexpand> is a "$function" substitution function
0235 for C<perffull>.
0236 It returns its template argument expanded for every line in the DB selection.
0237 
0238 =over
0239 
0240 =item 1
0241 
0242 C<$templ>
0243 
0244 a I<string> containing the template
0245 
0246 =item 2
0247 
0248 C<$reindex>
0249 
0250 the full reindex flag as 0 or 1 to select the proper values
0251 
0252 =back
0253 
0254 It fetches versions involved in purgeing indexations.
0255 
0256 The "line" is expanded by a common procedure.
0257 
0258 =cut
0259 
0260 sub perfdataexpand {
0261     my ($templ, $reindex) = @_;
0262     my $direx = '';
0263     my @versions;
0264     my $releaseid;
0265     my @perfdata;
0266 
0267     $index->{'times_versions'} =
0268         $index->{dbh}->prepare
0269             ( 'select releaseid from '.$config->{'dbprefix'}.'times'
0270               . ' where reindex = '.$reindex
0271               . ' and stepname = \'D\''
0272               . ' order by releaseid desc'
0273             );
0274     $index->{'times_versions'}->execute();
0275     while (($releaseid) = $index->{'times_versions'}->fetchrow_array()) {
0276         push(@versions, $releaseid) unless $releaseid eq ''
0277     }
0278     $index->{'times_versions'} = undef;
0279     $totalserialtime = 0;
0280     return onelineexpand($templ, $reindex, @versions);
0281 }
0282 
0283 
0284 =head2 C<perffpurgeexpand ($templ)>
0285 
0286 Function C<perffpurgeexpand> is a "$function" substitution function
0287 for C<perffullpurge>.
0288 It returns its template argument expanded for the line
0289 corresponding to a full purge (column C<releaseid> is a I<null> string).
0290 
0291 =over
0292 
0293 =item 1
0294 
0295 C<$templ>
0296 
0297 a I<string> containing the template
0298 
0299 =back
0300 
0301 It fetches the I<null> version used to store full purge timing.
0302 
0303 The "line" is expanded by a common procedure.
0304 
0305 =cut
0306 
0307 sub perffpurgeexpand {
0308     my ($templ) = @_;
0309     my $direx = '';
0310     my @versions;
0311     my $releaseid;
0312     my @perfdata;
0313 
0314     $index->{'times_versions'} =
0315         $index->{dbh}->prepare
0316             ( 'select releaseid from '.$config->{'dbprefix'}.'times'
0317               . ' where releaseid = \'\' and reindex = 1'
0318             );
0319     $index->{'times_versions'}->execute();
0320     if (($releaseid) = $index->{'times_versions'}->fetchrow_array()) {
0321         push(@versions, $releaseid)
0322     }
0323     $index->{'times_versions'} = undef;
0324     $totalserialtime = 0;
0325     return onelineexpand($templ, 1, @versions);
0326 }
0327 
0328 
0329 =head2 C<getserial ()> and C<getelapsed ()>
0330 
0331 These helper functions work around random adverse effect caused by a possible
0332 optimisation in I<mod_perl>.
0333 Transferring correct computed value of C<$totalserialtime> or C<$totalelapsed>
0334 to anonymous C<sub>s requires I<late binding>.
0335 It looks like sometimes I<early binding> is used, leading to the variables
0336 initial value instead of fetching the current value.
0337 
0338 Replacing reference to the variables by a function seems to cure the problem.
0339 
0340 =cut
0341 
0342 sub getserial {
0343     $totalserialtime
0344 }
0345 
0346 sub getelapsed {
0347     $totalelapsed
0348 }
0349 
0350 
0351 =head2 Script entry point
0352 
0353 Selects the correct header and footer, retrieves the C<'htmlperf'> template
0354 and launches template expansion.
0355 
0356 The script does not use any query argument, however they are managed as usual
0357 which allows to switch to other scripts with variables set as desired.
0358 
0359 =cut
0360 
0361 my $templ;
0362 my $errorsig = "<!-- ! -->";
0363 
0364 httpinit();
0365 ($inprogress) = indexstate('perf');
0366 if (-2 == $inprogress) {
0367     print 'Cache-Control: no-cache', "\n";  # special header for "monitoring" perf
0368 }
0369 std_http_headers();
0370 makeheader('perf', (-2 == $inprogress ? 'perfrefresh' : 'perf'));
0371 $templ = gettemplate    ( 'htmlperf'
0372                         , $errorsig
0373                         );
0374 if ($templ =~ m/^$errorsig/) {
0375     die "Performance dump not available without 'htmlperf' template\n";
0376 }
0377 $totalserialtime = 0;
0378 $totalelapsed = 0;
0379 print(expandtemplate
0380         ( $templ
0381         ,   ( 'perffull' => sub { perfdataexpand(@_, 1) }
0382             , 'perfinc' => sub { perfdataexpand(@_, 0) }
0383             , 'perffullpurge' => sub { perffpurgeexpand(@_) }
0384             , 'perftotal' => sub {
0385                     if (0 < $totalserialtime) {
0386                         duration(0, getserial())
0387                     } else {
0388                         '<em>not available</em>'
0389                     }
0390                                     }
0391             , 'perfelapsed' => sub {
0392                     if (0 < $totalelapsed) {
0393                         duration(0, getelapsed())
0394                     } else {
0395                         '<em>not available</em>'
0396                     }
0397                                     }
0398             )
0399         )
0400 );
0401 makefooter('perf');
0402 httpclean;