INN commit: trunk/scripts (innreport.in)
INN Commit
Russ_Allbery at isc.org
Mon Nov 17 13:48:49 UTC 2008
Date: Monday, November 17, 2008 @ 05:48:49
Author: iulius
Revision: 8166
Patch from Alexander Bartolich. Many thanks to him!
Function EscapeHTML sanitizes input from log files by replacing special
characters (especially non-ASCII characters) with HTML-entities.
Split EvalExpr into parts:
PrepareEval takes an expression from innreport.conf (a string), substitutes
variable names and pseudo-functions, compiles the code to an anonymous
subroutine, and returns it together with references to enclosure variables.
EvalExpr and EvalHash call a subroutine compiled by PrepareEval.
All three functions provide diagnostic output (and throw an exception
on errors) if $DEBUG is true.
All expression evolution is now done through PrepareEval.
Functions ComputeTotal and ComputeTotalDouble now use a cache.
The performance gain is insignificant, but if $DEBUG is true then
modifications of the input parameter (a hash) can be detected.
New Perl function Divide0 is available to innreport.conf as
"div0". It returns 0 if one of the divisors is 0.
At the moment expressions in innreport.conf throw lots of
division-by-zero exceptions, so it is not possible to run
innreport if $DEBUG is true.
Modified:
trunk/scripts/innreport.in
--------------+
innreport.in | 368 +++++++++++++++++++++++++++++++++++----------------------
1 file changed, 227 insertions(+), 141 deletions(-)
Modified: innreport.in
===================================================================
--- innreport.in 2008-11-17 12:00:49 UTC (rev 8165)
+++ innreport.in 2008-11-17 13:48:49 UTC (rev 8166)
@@ -11,7 +11,8 @@
# Copyright (c) 1996-2001, Fabien Tassin <fta at sofaraway.org>.
#
# Checkpoints tracking was improved by Jim Dutton in 2006.
-# XHTML 1.1 conformance added by Alexander Bartolich in 2008.
+# Lots of improvements and XHTML 1.1 conformance added
+# by Alexander Bartolich in 2008.
#
##########################################################################
#
@@ -91,6 +92,7 @@
# to this file.
use strict;
+use Carp qw(confess);
## Do you want to create a Web page. Pick DO or DONT.
my $HTML = "DO";
@@ -99,7 +101,7 @@
my $GRAPH = "DO";
## Directory for the Web pages (used only if the previous line is active)
-my $HTML_dir = "$INN::Config::pathhttp";
+my $HTML_dir = $INN::Config::pathhttp;
## Directory for the pictures (need HTML support) in the file space
my $IMG_dir = "$HTML_dir/pics";
@@ -143,7 +145,7 @@
## THERE'S NOTHING TO CHANGE AFTER THIS LINE ##
###############################################
-my $version = "3.0.5";
+my $version = "3.1.0";
my %output; # content of the configuration file.
my $DEBUG = 0; # set to 1 to verify the structure/content of the conf file.
my $start_time = time;
@@ -355,6 +357,13 @@
eval $s; # initialization
die "Can't find/load $CLASS.pm : $@\n" if $@;
+my $collectFunc;
+{
+ my $s = '*{$' . $CLASS . '::{"collect"}}{"CODE"}';
+ $collectFunc = eval $s;
+ confess "eval($s) raises $@" if ($@ || !defined($s));
+}
+
my $save_line = <>;
$_ = $save_line;
local $^W = 0 if $] < 5.004; # to avoid a warning for each '+=' first use.
@@ -380,7 +389,7 @@
}
# skip empty lines
- next LINE if $_ eq '';
+ next LINE if length($_) == 0;
my $res;
my ($day, $hour, $prog, $left) =
@@ -440,11 +449,7 @@
$prog_size{$prog} += $size;
# The "heart" of the tool.
- {
- no strict;
- next LINE if
- &{$CLASS."::collect"} ($day, $hour, $prog, $res, $left, $CASE_SENSITIVE);
- }
+ next LINE if &$collectFunc($day, $hour, $prog, $res, $left, $CASE_SENSITIVE);
$unrecognize[$unrecognize_max] = $_
unless $unrecognize_max > $MAX_UNRECOGNIZED
@@ -457,11 +462,14 @@
&{$CLASS . "::adjust"} ($first_date, $last_date);
}
-$| = 1;
+# man perlvar
+# $| ... If set to nonzero, forces a flush right away and after
+# every write or print on the currently selected output channel.
+$| = $DEBUG;
die "no data. Abort.\n" unless $total_line;
-my $sec_glob = &ConvDate ("$last_date") - &ConvDate ("$first_date");
+my $sec_glob = &ConvDate($last_date) - &ConvDate($first_date);
unless ($sec_glob) {
print "WARNING: bad date (\"$last_date\" or \"$first_date\")\n" .
" Please, contact the author of innreport.\n";
@@ -567,7 +575,11 @@
# Compare 2 dates (+hour)
sub DateCompare {
# ex: "May 12 06" for May 12, 6:00am
+
+ # $[ ... The index of the first element in an array, and of the first
+ # character in a substring. Default is 0.
local $[ = 0;
+
# The 2 dates are near. The range is less than a few days that's why we
# can cheat to determine the order. It is only important if one date
# is in January and the other in December.
@@ -589,41 +601,25 @@
# Convert: seconds to hh:mm:ss
-sub second2time {
- my $temp;
- my $t = shift;
- # Hours
- $temp = sprintf "%02d", $t / 3600;
- my $chaine = "$temp:";
- $t %= 3600;
- # Min
- $temp = sprintf "%02d", $t / 60;
- $chaine .= "$temp:";
- $t %= 60;
- # Sec
- $chaine .= sprintf "%02d", $t;
- return $chaine;
+sub second2time($) {
+ my $sec = shift;
+ my $hour = $sec / 3600;
+ $sec %= 3600;
+ my $min = $sec / 60;
+ $sec %= 60;
+ return sprintf '%02d:%02d:%02d', $hour, $min, $sec;
}
# Convert: milliseconds to hh:mm:ss:mm
-sub ms2time {
- my $temp;
- my $t = shift;
- # Hours
- $temp = sprintf "%02d", $t / 3600000;
- my $chaine = "$temp:";
- $t %= 3600000;
- # Min
- $temp = sprintf "%02d", $t / 60000;
- $chaine .= "$temp:";
- $t %= 60000;
- # Sec
- $temp = sprintf "%02d", $t / 1000;
- $chaine .= "$temp.";
- $t %= 1000;
- # Millisec
- $chaine .= sprintf "%03d", $t;
- return $chaine;
+sub ms2time($) {
+ my $ms = shift;
+ my $hour = $ms / 3600000;
+ $ms %= 3600000;
+ my $min = $ms / 60000;
+ $ms %= 60000;
+ my $sec = $ms / 1000;
+ $ms %= 1000;
+ return sprintf '%02d:%02d:%02d.%03d', $hour, $min, $sec, $ms;
}
# Rotate the archive files..
@@ -697,28 +693,53 @@
$lb <=> $la;
}
-sub ComputeTotal {
- my $h = shift;
+my %ComputeTotalCache;
+sub ComputeTotal($) {
+ my $h = shift || confess;
+
+ my $cached = $ComputeTotalCache{$h};
+ if (defined($cached) && !$DEBUG) { return $cached; }
+
my $total = 0;
- my $key;
- foreach $key (keys (%$h)) {
- $total += $$h{$key};
+ while(my ($key, $value) = each %$h) {
+ confess $key unless(defined($value));
+ $total += $value;
}
- $total;
+ if (defined($cached) && $cached != $total)
+ { confess "ComputeTotal mismatch $cached != $total"; }
+ return $ComputeTotalCache{$h} = $total;
}
-sub ComputeTotalDouble {
- my $h = shift;
+my %ComputeTotalDouble;
+sub ComputeTotalDouble($) {
+ my $h = shift || confess;
+
+ my $cached = $ComputeTotalCache{$h};
+ if (defined($cached) && !$DEBUG) { return $cached; }
+
my $total = 0;
- my ($key1, $key2);
- foreach $key1 (keys (%$h)) {
- foreach $key2 (keys (%{$$h{$key1}})) {
- $total += ${$$h{$key1}}{$key2};
+ while(my ($key1, $value1) = each %$h) {
+ confess $key1 unless(defined($value1));
+ while(my ($key2, $value2) = each %$value1) {
+ confess $key2 unless(defined($value2));
+ $total += $value2;
}
}
- $total;
+ if (defined($cached) && $cached != $total)
+ { confess "ComputeTotalDouble mismatch $cached != $total"; }
+ return $ComputeTotalDouble{$h} = $total;
}
+sub EscapeHTML($) {
+ my $v = shift;
+ confess unless(defined($v));
+ $v =~ s/&/\&/g;
+ $v =~ s/</\</g;
+ $v =~ s/>/\>/g;
+ $v =~ s/([\x{7F}-\x{FFFF}])/sprintf('&#%d;', ord($1))/eg;
+ return $v;
+}
+
sub GetHTMLHeader($) {
my $title = shift;
@@ -737,7 +758,6 @@
my $style_sheet = '';
my $css_url = $output{'default'}{'html_css_url'};
if (defined($css_url)) {
-printf STDERR "css_url [%s]\n", $css_url;
$css_url = &GetValue($css_url);
$style_sheet = <<EOF;
<link rel="stylesheet" type="text/css" media="all" href="$css_url"/>
@@ -903,7 +923,7 @@
}
# make an index for archive pages
-sub Make_Index {
+sub Make_Index($$$$) {
my ($rep, $index, $filename, $data) = @_;
my %output = %$data;
@@ -1078,7 +1098,7 @@
my $xmax = shift; # width
my $n = shift; # Number of hash code tables
- no strict;
+ use strict;
my ($i, $k, $t);
my @val;
for $i (0 .. $n - 1) {
@@ -1310,11 +1330,11 @@
$ymax;
}
-sub Histo {
+sub Histo($$$$$$$$) {
my ($filename, $title, $xmax, $factor,
$labelx, $labely, $val1, $labels1) = @_;
- no strict;
+ use strict;
my $max = 0;
my $ymax = 300;
my $nb = 0;
@@ -1933,10 +1953,7 @@
print HTML "<ul>\n";
foreach $k (@{$$h{'_order_'}}) {
next if $k =~ m/^(default|index)$/;
- my ($data) = $$h{$k}{'data'} =~ m/^\"\s*(.*?)\s*\"$/o;
- $data =~ s/^\%/\%$CLASS\:\:/ unless $data eq '%prog_type';
- my %data;
- { local $^W = 0; no strict; %data = eval $data }
+ my $r_data = EvalHash( $h->{$k}{'data'} );
my ($string) = $$h{$k}{'title'} =~ m/^\"\s*(.*?)\s*\"$/o;
$string =~ s/\s*:$//o;
my $want = 1;
@@ -1944,7 +1961,9 @@
($want) = $$h{$k}{'skip'} =~ m/^\"?\s*(.*?)\s*\"?$/o
if defined $$h{$k}{'skip'};
$want = $want eq 'true' ? 0 : 1;
- print HTML "<li><a href=\"#$k\">$string</a></li>\n" if %data && $want;
+ if (%$r_data && $want) {
+ printf HTML "<li><a href=\"#%s\">%s</a></li>\n", $k, $string;
+ }
}
print HTML "</ul>\n";
}
@@ -1971,10 +1990,7 @@
chomp $unrecognize[$l]; # sometimes, the last line need a CR
print "$unrecognize[$l]\n"; # so, we always add one
if ($HTML && $WANT_HTML_UNKNOWN) {
- $unrecognize[$l] =~ s/&/\&/g;
- $unrecognize[$l] =~ s/</\</g;
- $unrecognize[$l] =~ s/>/\>/g;
- print HTML $unrecognize[$l], "<br/>\n";
+ print HTML EscapeHTML($unrecognize[$l]), "<br/>\n";
}
}
print "\n";
@@ -2032,26 +2048,17 @@
my $TOP_TEXT = defined $output{$report}{'top_text'} ?
$output{$report}{'top_text'} : $TOP;
- my (%h, %d, $h);
+ my (%h, $r_data, @keys, $h);
{
my $t = $output{$report}{'data'} ||
die "Error in section $report. Need a 'data' field.\n";
- $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
- $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
- %d = eval $t;
- return unless %d; # nothing to report. exit.
- return unless keys (%d); # nothing to report. exit.
+ $r_data = EvalHash($t);
+ @keys = keys (%$r_data);
+ return unless @keys; # nothing to report. exit.
}
{
- my $t = defined $output{$report}{'sort'} ? $output{$report}{'sort'} :
- "\$a cmp \$b";
- $t =~ s/\n/ /smog;
- $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
- $t =~ s/([\$\%\@])/$1${CLASS}\:\:/go;
- $t =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|num)/$1$2/go;
- $t =~ s/\{\$${CLASS}\:\:(a|b)\}/\{\$$1\}/go;
- $t =~ s/\$${CLASS}\:\:(a|b)/\$$1/go;
- $h = $t;
+ my $t = $output{$report}{'sort'};
+ ( $h ) = defined($t) ? PrepareEval($t) : sub { $a cmp $b };
}
if ($HTML) {
@@ -2116,15 +2123,15 @@
my $done;
if ($DOUBLE) {
my $num_d = 0;
- foreach $key1 (sort keys (%d)) {
+ foreach $key1 (sort @keys) {
$done = 0;
$num = 0;
$num_d++;
$s = '';
$html = '';
my @res;
- foreach $key2 (sort {$d{$key1}{$b} <=> $d{$key1}{$a}}
- keys (%{$d{$key1}})) {
+ foreach $key2 (sort {$r_data->{$key1}{$b} <=> $r_data->{$key1}{$a}}
+ keys (%{$r_data->{$key1}})) {
my $first = 0;
$num++;
foreach $i (@{$output{$report}{'column'}}) {
@@ -2165,7 +2172,7 @@
# Hardcoded colspan=3 works for "Miscellaneous innd statistics:".
$html .= "<td class=\"ir-primaryKey\" align=\"left\" colspan=\"3\">";
- $html .= sprintf($v1, $r);
+ $html .= sprintf($v1, EscapeHTML($r));
$html .= "</td></tr>\n<tr><td></td>";
}
}
@@ -2176,10 +2183,10 @@
$s .= sprintf $v1 . " ", $r;
}
if ($HTML && $whtml) {
- $html .= $numbering ? "<td></td>" : '' if $first == 1;
+ $html .= $numbering ? '<td></td>' : '' if $first == 1;
$v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
my $temp = $first > 1 ? "right" : "left";
- $html .= sprintf "<td align=\"$temp\">$v1</td>", $r;
+ $html .= sprintf "<td align=\"%s\">$v1</td>", $temp, EscapeHTML($r);
}
}
$done = 1 if $p;
@@ -2212,11 +2219,11 @@
(defined ($$i{'format'}) ? $$i{'format'} : "%s");
$v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
my $r = $first == 1 ? $num : $res[$first];
- $s .= sprintf $v1 . " ", $r;
+ $s .= sprintf $v1 . ' ', $r;
if ($HTML) {
my $temp = $first > 1 ? 'align="right"' : 'class="ir-totalColumn"';
$v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
- $html .= sprintf "<td $temp>$v1</td>", $r;
+ $html .= sprintf "<td %s>$v1</td>", $temp, EscapeHTML($r);
}
$first++;
}
@@ -2257,7 +2264,7 @@
$temp .= ' colspan="2"' if $numbering && !$first;
$v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
$html .= $first == 1 ? "<td></td>" :
- sprintf "<td $temp>$v1</td>", $r;
+ sprintf "<td %s>$v1</td>", $temp, EscapeHTML($r);
}
$first++;
}
@@ -2272,10 +2279,9 @@
}
}
else {
- # foreach $key (sort { local $^W = 0; no strict; eval $h } (keys (%d)))
- foreach $key ((eval "sort {local \$^W = 0; no strict; $h} (keys (%d))")) {
+ foreach $key (sort $h @keys) {
next unless defined $key;
- next unless defined $d{$key}; # to avoid problems after some undef()
+ next unless defined $r_data->{$key}; # to avoid problems after some undef()
$num++;
next unless $num <= $TOP_HTML || $TOP_HTML == -1 ||
$num <= $TOP_TEXT || $TOP_TEXT == -1;
@@ -2300,10 +2306,14 @@
$s .= sprintf $v1 . " ", $r
if $wtext && (($num <= $TOP_TEXT) || ($TOP_TEXT == -1));
if ($HTML && $whtml && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
+
+ # substitute full fledged "%s" specifiers (alignment, width
+ # and precision) with a plain "%s"
$v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
+
$html .= "<th align=\"center\">$num</th>" if $numbering && !$first;
my $temp = $first ? "right" : "left";
- $html .= sprintf "<td align=\"$temp\">$v1</td>", $r;
+ $html .= sprintf "<td align=\"$temp\">$v1</td>", EscapeHTML($r);
}
$first++;
}
@@ -2343,7 +2353,7 @@
$v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
my $temp = $first ? 'align="right"' : 'class="ir-totalColumn"';
$temp .= ' colspan="2"' if $numbering && !$first;
- $html .= sprintf "<td $temp>$v1</td>", $r;
+ $html .= sprintf "<td $temp>$v1</td>", EscapeHTML($r);
}
$first++;
}
@@ -2366,11 +2376,7 @@
my $j;
foreach $j (@{${${$output{$report}{'graph'}}[$i]}{'data'}}) {
$num++;
- my ($h) = $$j{'value'} =~ m/^\"\s*(.*?)\s*\"$/o;
- my %hh;
- $h =~ s/^\%/\%$CLASS\:\:/ unless $h eq '%prog_type';
- { local $^W = 0; no strict; %hh = eval $h }
- push @values, \%hh;
+ push @values, EvalHash( $j->{'value'} );
my ($t) = $$j{'name'} =~ m/^\"\s*(.*?)\s*\"$/o;
push @labels, $t;
$t = $$j{'color'} ||
@@ -2395,7 +2401,6 @@
print HTML "src=\"$IMG_pth$report$s.$GD_FORMAT\"/></div>\n";
}
elsif ($type eq 'histo') {
- my (%values, %labels);
my $factor =
${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'factor'}
|| die "Error in section $report section 'graph'. " .
@@ -2418,24 +2423,25 @@
"No 'value' specified for " .
${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'name'} .
".\n";
- $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
- $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
- { local $^W = 0; no strict; %labels = eval $t }
+ my $r_labels = EvalHash( $t );
$t = ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'value'} ||
die "Error in section $report section 'graph'. " .
"No 'value' specified for " .
${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'} .
".\n";
- $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
- $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
- { local $^W = 0; no strict; %values = eval $t }
+ my $r_values = EvalHash( $t );
my $s = ($i ? $i : '') . $suffix;
{
my $r;
close HTML;
+ #
+ # 6th argument of function Histo is a reference to a hash,
+ # but it is modified, so pass it a copy
+ #
+ my %values = %$r_values;
$r = &Histo ("$IMG_dir/$report$s.$GD_FORMAT", $title, $xmax,
- $factor, $labelx, $labely, \%values, \%labels);
+ $factor, $labelx, $labely, \%values, $r_labels);
open (HTML, ">> $HTML_output") ||
die "Error: cant open $HTML_output\n";
if ($r) {
@@ -2454,47 +2460,127 @@
"Invalid 'type' value.\n"
}
$i++;
- print HTML "<p/>\n";
}
}
}
close HTML if $HTML;
}
-sub EvalExpr {
- my $v = shift;
- my ($key, $num, $key1) = @_;
+sub PrepareEval($;$) {
+ my $string = shift;
+ my $double = shift;
+
+ # reduce white space (including line feeds) to single space
+ $string =~ s/\s+/ /smog;
+
+ # remove surrounding double quotes, if any
+ $string =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+
+ # convert "%innd_his" to "%innreport_inn::innd_his"
+ $string =~ s/([\$\%\@])([^{\s\d])/$1${CLASS}\:\:$2/og;
+
+ # However, a few variables are defined through the enclosure.
+ # $a and $b are provided by function sort.
+ # So convert "%innreport_inn::prog_type" back to "%prog_type"
+ $string =~ s/([\$\%\@])${CLASS}\:\:(
+ a|
+ b|
+ key\d*|
+ num|
+ prog_size|
+ prog_type|
+ sec_glob
+ )\b/$1$2/xog;
+
+ # If expression consists of a single hash then just return a
+ # reference to it.
+
+ if ($string !~ s/^\%/\\%/) {
+
+ # otherwise convert pseudo-functions to real Perl code
+
+ my %Func = (
+ 'bytes' => '&NiceByte(',
+ 'div0' => '&Divide0(',
+ 'time_ms' => '&ms2time(',
+ 'time' => '&second2time(',
+ 'total%' => (
+ $double ? '&ComputeTotalDouble(\\%' : '&ComputeTotal(\\%'
+ )
+ );
+
+ my $i = 0;
+ do {
+ if ($DEBUG) { printf STDERR "PrepareEval %d [%s]\n", $i++, $string; }
+ } while(
+ $string =~ s/ (^|[^&\w]) ([a-z][a-z_0-9]+) \s* \( \s* (%)?
+ /$1 . $Func{$2 . ($3||'')}
+ /xoge
+ );
+ }
+
+ if ($DEBUG) { printf STDERR "PrepareEval - [%s]\n", $string; }
+
+ # These variables are provided to the function inside the closure.
+ # PrepareEval returns references to these variables.
+ my $sub;
+ my $num;
+ my $key;
+ my $key1;
my $key2;
- $v =~ s/\n/ /smog;
- $v =~ s/^\"(.*?)\"$/$1/o;
- if ($key1) {
- $key2 = $key;
- $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotalDouble\(\\%/og;
- }
- else {
- $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotal\(\\%/og;
- # $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%([^\)]*)\)/$1&ComputeTotal\("$2"\)/og;
- }
- $v =~ s/([^a-zA-Z_\-]?)bytes\s*\(\s*/$1&NiceByte\(/og;
- $v =~ s/([^a-zA-Z_\-]?)time\s*\(\s*/$1&second2time\(/og;
- $v =~ s/([^a-zA-Z_\-]?)time_ms\s*\(\s*/$1&ms2time\(/og;
- # $v =~ s/([\$\%\@])/$1${CLASS}\:\:/og;
- $v =~ s/([\$\%\@])([^{\s\d])/$1${CLASS}\:\:$2/og;
- $v =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|sec_glob|num)/$1$2/og;
+ # man perlvar
+ # $^W ... The current value of the warning switch, initially
+ # true if -w was used.
+ { local $^W = $DEBUG; $sub = eval "sub { $string; }"; }
+ if ($@) { confess "PrepareEval($string) raises $@"; }
+
+ return ( $sub, \$num, \$key, \$key1, \$key2 );
+}
+
+sub EvalHash($) {
+ my $v = shift;
+ my ( $sub ) = PrepareEval($v);
+
+ my $result;
+ eval { local $^W = $DEBUG; $result = &$sub(); };
+ if ($@ && $DEBUG) { confess "EvalHash($v) raises $@"; }
+ if (ref($result) ne 'HASH')
+ { confess "EvalHash($v) does not return reference to hash."; }
+ return $result;
+}
+
+sub EvalExpr {
+ my ( $v, $key, $num, $key1 ) = @_;
+ my ( $sub, $r_num, $r_key, $r_key1, $r_key2 ) = PrepareEval($v, $key1);
+
+ $$r_num = $num;
+ $$r_key = $key;
+ $$r_key1 = $key1;
+ $$r_key2 = $key1 ? $key : undef;
+
my $r;
- # eval { local $^W = 0; no strict; ($r) = eval $v; };
- eval " local \$^W = 0; no strict; (\$r) = $v; ";
- $r = 0 unless defined $r;
- $r;
+ eval { local $^W = $DEBUG; ($r) = &$sub(); };
+ if ($@ && $DEBUG) { confess "EvalExpr($v) raises $@"; }
+ return ($r || 0);
}
-sub NiceByte {
- my $size = shift;
- my $t;
+sub Divide0(@)
+{
+ my $dividend = shift;
+ return 0 unless $dividend;
- $size = 0 unless defined $size;
- $t = $size / 1024 / 1024 / 1024 > 1 ?
+ for my $divisor(@_)
+ {
+ return 0 unless $divisor;
+ $dividend /= $divisor;
+ }
+ return $dividend;
+}
+
+sub NiceByte(;$) {
+ my $size = shift() || 0;
+ my $t = $size / 1024 / 1024 / 1024 > 1 ?
sprintf "%.1f GB", $size / 1024 / 1024 / 1024 :
($size / 1024 / 1024 > 1 ? sprintf "%.1f MB", $size / 1024 / 1024 :
sprintf "%.1f KB", $size / 1024);
More information about the inn-committers
mailing list