INN commit: trunk (4 files)
INN Commit
rra at isc.org
Tue Jul 5 18:30:57 UTC 2011
Date: Tuesday, July 5, 2011 @ 11:30:57
Author: iulius
Revision: 9216
add 'use strict' mode to cnfsheadconf, cnfsstat, innmail and procbatch
Clean up these Perl scripts.
Thanks to Florian Schlichting for this patch.
Modified:
trunk/frontends/cnfsheadconf.in
trunk/frontends/cnfsstat.in
trunk/innfeed/procbatch.in
trunk/scripts/innmail.in
---------------------------+
frontends/cnfsheadconf.in | 122 ++++++++++++++--------------
frontends/cnfsstat.in | 187 +++++++++++++++++++++-----------------------
innfeed/procbatch.in | 108 ++++++++++++-------------
scripts/innmail.in | 56 ++++++-------
4 files changed, 236 insertions(+), 237 deletions(-)
Modified: frontends/cnfsheadconf.in
===================================================================
--- frontends/cnfsheadconf.in 2011-07-05 18:27:40 UTC (rev 9215)
+++ frontends/cnfsheadconf.in 2011-07-05 18:30:57 UTC (rev 9216)
@@ -17,15 +17,15 @@
# cnfsheadconf is originally from cnfsstat 1999
# <kondou at nec.co.jp>
-use vars qw($opt_h $opt_w);
+use strict;
use Getopt::Long;
# Required for >32bit integers.
use Math::BigInt;
use Math::BigFloat;
-my($conffile) = "$INN::Config::pathetc/cycbuff.conf";
-my($storageconf) = "$INN::Config::pathetc/storage.conf";
+my $conffile = "$INN::Config::pathetc/cycbuff.conf";
+my $storageconf = "$INN::Config::pathetc/storage.conf";
# Hex to bigint conversion routine.
# bhex(HEXSTRING) returns BIGINT (with leading + chopped off).
@@ -80,7 +80,7 @@
}
sub usage {
- print <<_end_;
+ print <<"_end_";
Summary tool for cycbuff header manipulation
Usage:
@@ -94,45 +94,46 @@
exit(1);
}
-my(@line, %class, %metamode, %buff, %stor, $c, @buffers, $cycbuff);
+my (%buff, $cycbuff, $opt_w);
-my($gr, $cl, $min, $max, @storsort, $header_printed);
+GetOptions(
+ 'c=s' => \$cycbuff,
+ 'w' => \$opt_w,
+ 'h' => sub { usage() },
+);
-GetOptions("-c=s", \$cycbuff, "-w", "-h");
-
-&usage if $opt_h;
-
-unless (&read_cycbuffconf) {
+unless (read_cycbuffconf()) {
print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
exit (1);
}
-unless (&read_storageconf) {
+unless (read_storageconf()) {
print STDERR "No valid $storageconf.\n";
exit (1);
}
sub read_cycbuffconf {
- return 0 unless open (CONFFILE, $conffile);
+ my (@line, %class, %metamode);
+ return 0 unless open my $CONFFILE, '<', $conffile;
- while(<CONFFILE>) {
+ while (<$CONFFILE>) {
$_ =~ s/^\s*(.*?)\s*$/$1/;
# Read continuation lines.
while(/\\$/) {
chop;
- chop($next = <CONFFILE>);
+ chop (my $next = <$CONFFILE>);
$next =~ s/^\s*(.*?)\s*$/$1/;
$_ .= $next;
}
# \x23 below is #. Emacs perl-mode gets confused by the "comment".
- next if($_ =~ /^\s*$/ || $_ =~ /^\x23/);
- next if($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
+ next if ($_ =~ /^\s*$/ || $_ =~ /^\x23/);
+ next if ($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
if($_ =~ /^metacycbuff:/) {
@line = split(/:/, $_);
- if($class{$line[1]}) {
+ if ($class{$line[1]}) {
print STDERR "Class $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 0;
}
@@ -148,7 +149,7 @@
if ($_ =~ /^cycbuff/) {
@line = split(/:/, $_);
- if($buff{$line[1]}) {
+ if ($buff{$line[1]}) {
print STDERR "Buff $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 1;
}
@@ -158,24 +159,25 @@
print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
}
- close(CONFFILE);
+ close $CONFFILE;
return 1;
}
sub read_storageconf {
my $line = 0;
- return 0 unless open (STOR, $storageconf);
+ my %stor;
+ return 0 unless open my $STOR, '<', $storageconf;
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
# defaults
- %key = ("NEWSGROUPS" => "*",
- "SIZE" => "0,0");
+ my %key = ("NEWSGROUPS" => "*",
+ "SIZE" => "0,0");
if (/method\s+cnfs\s+\{/) {
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
last if /\}/;
@@ -198,10 +200,10 @@
} else {
$stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" .
"$key{'SIZE'}:$key{'OPTIONS'}";
- push(@storsort, $key{'OPTIONS'});
}
}
}
+ close $STOR;
return 1;
}
@@ -210,7 +212,7 @@
# If no cycbuff is specified, we check all of them and exit.
if (not defined $cycbuff) {
foreach (sort keys %buff) {
- &print_cycbuff_head($buff{$_});
+ print_cycbuff_head($buff{$_});
}
exit(0);
}
@@ -220,7 +222,7 @@
exit(1);
}
-&print_cycbuff_head($buff{$cycbuff});
+print_cycbuff_head($buff{$cycbuff});
sub make_time {
my ($t) = @_;
@@ -242,67 +244,66 @@
}
sub print_cycbuff_head {
- my($buffpath) = $_[0];
- my($CNFSMASIZ)=8;
- my($CNFSNASIZ)=16;
- my($CNFSPASIZ)=64;
- my($CNFSLASIZ)=16;
- my($headerlength) = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
- my($buff, @entries, $e);
- my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff, $blksza);
+ my ($buffpath) = @_;
+ my $CNFSMASIZ = 8;
+ my $CNFSNASIZ = 16;
+ my $CNFSPASIZ = 64;
+ my $CNFSLASIZ = 16;
+ my $headerlength = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
+ my ($BUFF, $buff);
if ($opt_w) {
- if(! open(BUFF, "+< $buffpath") ) {
+ if ( !open $BUFF, '+<', $buffpath ) {
print STDERR "Cannot open Cycbuff $buffpath ...\n";
exit(1);
}
} else {
- if(! open(BUFF, "< $buffpath") ) {
+ if ( !open $BUFF, '<', $buffpath ) {
print STDERR "Cannot open Cycbuff $buffpath ...\n";
exit(1);
}
}
$buff = "";
- if(! read(BUFF, $buff, $headerlength) ) {
+ if ( !read $BUFF, $buff, $headerlength ) {
print STDERR "Cannot read $headerlength bytes from file $buffpath...\n";
exit(1);
}
- ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff, $blksza) = unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8 a16", $buff);
+ my ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff, $blksza) = unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8 a16", $buff);
- if(!$magic) {
+ if (!$magic) {
print STDERR "Error while unpacking header ...\n";
exit(1);
}
- my($len) = bhex($lena);
- my($free) = bhex($freea);
- my($update) = hex($updatea);
- my($cyclenum) = hex($cyclenuma) - 1;
- my($orderinmeta) = hex($orderinmetaa);
- my($blksz) = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
+ my $len = bhex($lena);
+ my $free = bhex($freea);
+ my $update = hex($updatea);
+ my $cyclenum = hex($cyclenuma) - 1;
+ my $orderinmeta = hex($orderinmetaa);
+ my $blksz = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
- my ($nupdate_str, $nago_str) = &make_time ($update);
+ my ($nupdate_str, $nago_str) = make_time($update);
$name =~ s/\0//g;
print " Buffer $name, len: ";
- printf("%.2f", Math::BigFloat->new($len) / (1024 * 1024));
+ printf "%.2f", Math::BigFloat->new($len) / (1024 * 1024);
print " Mbytes, used: ";
- printf("%.2f Mbytes", Math::BigFloat->new($free) / (1024 * 1024));
- printf(" (%4.1f%%) %3d cycles\n",
+ printf "%.2f Mbytes", Math::BigFloat->new($free) / (1024 * 1024);
+ printf " (%4.1f%%) %3d cycles\n",
100 * Math::BigFloat->new($free) / Math::BigFloat->new($len),
- $cyclenum);
- print(" Meta $metaname, order: ");
- printf("%d", $orderinmeta);
- print(", current: $currentbuff");
- print(", blocksize: $blksz");
+ $cyclenum;
+ print " Meta $metaname, order: ";
+ printf "%d", $orderinmeta;
+ print ", current: $currentbuff";
+ print ", blocksize: $blksz";
print "\n Newest: $nupdate_str, $nago_str ago\n";
if ($opt_w) {
print "\nBuffer [$name] => ";
- $in = <>;
+ my $in = <>;
chop $in;
if ($in ne "") {
$name = sprintf("%0.9s\0", $in);
@@ -348,11 +349,12 @@
}
$buff = pack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8", $magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff);
$buff .= pack("a16", $blksza) if ($magic =~ m/^CBuf4/);
- seek(BUFF, 0, 0);
- if(! syswrite(BUFF, $buff, $headerlength) ) {
+ seek $BUFF, 0, 0;
+ if(! syswrite $BUFF, $buff, $headerlength ) {
print STDERR "Cannot write $headerlength bytes to file $buffpath...\n";
exit(1);
}
}
- close(BUFF);
+ close $BUFF;
+ return;
}
Modified: frontends/cnfsstat.in
===================================================================
--- frontends/cnfsstat.in 2011-07-05 18:27:40 UTC (rev 9215)
+++ frontends/cnfsstat.in 2011-07-05 18:30:57 UTC (rev 9216)
@@ -14,17 +14,17 @@
#
# bigint support added by Duane Currie (sandman at hub.org) 1998
-use vars qw($opt_a $opt_h $opt_l $opt_p $opt_P $opt_s $opt_v);
+use strict;
use Getopt::Long;
use Math::BigInt;
use Math::BigFloat;
use English;
-my($conffile) = "$INN::Config::pathetc/cycbuff.conf";
-my($storageconf) = "$INN::Config::pathetc/storage.conf";
+my $conffile = "$INN::Config::pathetc/cycbuff.conf";
+my $storageconf = "$INN::Config::pathetc/storage.conf";
sub usage {
- print <<_end_;
+ print <<"_end_";
Summary tool for CNFS
Usage:
@@ -44,18 +44,19 @@
exit(1);
}
-my(@line, %class, %buff, %stor, $c, @buffers);
+my (%class, %buff, %stor, @storsort, @buffers);
-my($gr, $cl, $min, $max, @storsort, $oclass, $header_printed);
-my $use_syslog = 0;
-
+my ($oclass, $obuffer);
+my %opt = (c=>\$oclass, m=>\$obuffer);
Getopt::Long::config('no_ignore_case');
-GetOptions("-a", "-c=s", \$oclass, "-h", "-l:i", "-m=s", \$obuffer,
+GetOptions(\%opt,
+ "-a", "-c=s", "-h", "-l:i", "-m=s",
"-p", "-P", "-s", "-v");
-&usage if $opt_h;
+usage() if $opt{'h'};
-if ($opt_s) {
+my $use_syslog = 0;
+if ($opt{'s'}) {
eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1 };
if ($use_syslog) {
if ($Sys::Syslog::VERSION < 0.15) {
@@ -68,40 +69,35 @@
}
}
-if ($opt_P) {
- open(FILE, ">$INN::Config::pathrun/cnfsstat.pid") && do {
- print FILE "$$\n";
- close FILE;
+if ($opt{'P'}) {
+ if (open my $FILE, '>', "$INN::Config::pathrun/cnfsstat.pid") {
+ print $FILE "$$\n";
+ close $FILE;
};
}
-my($sleeptime) = (defined($opt_l) && $opt_l > 0) ? $opt_l : 600;
+my $sleeptime = (defined($opt{'l'}) && $opt{'l'} > 0) ? $opt{'l'} : 600;
-unless (&read_cycbuffconf) {
+unless (read_cycbuffconf()) {
print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
exit (1);
}
-unless (&read_storageconf) {
+unless (read_storageconf()) {
print STDERR "No valid $storageconf.\n";
exit (1);
}
-&mrtg($obuffer) if $obuffer;
-&mrtg_config if $opt_p;
+mrtg($obuffer) if $obuffer;
+mrtg_config() if $opt{'p'};
-#foreach $c (keys(%class)) {
-# print "Class: $c, definition: $class{$c}\n";
-#}
-#foreach $c (keys(%buff)) {
-# print "Buff: $c, definition: $buff{$c}\n";
-#}
-# exit(0);
START:
-undef($logline);
+my $logline;
+my $header_printed = 0;
+my ($gr, $cl, $min, $max);
if ($oclass) {
if ($class{$oclass}) {
if (!$header_printed) {
@@ -133,19 +129,19 @@
next;
}
- foreach $b (@buffers) {
+ foreach my $b (@buffers) {
if (! $buff{$b} ) {
print STDERR "No buffer definition for buffer $b ...\n";
next;
}
- &print_cycbuff_head($buff{$b});
+ print_cycbuff_head($buff{$b});
}
} else {
print STDERR "Class $oclass not found ...\n";
}
} else { # Print all Classes
- foreach $c (@storsort) {
+ foreach my $c (@storsort) {
($gr, $cl, $min, $max) = split(/:/, $stor{$c});
if ($use_syslog) {
if ($min || $max) {
@@ -167,12 +163,12 @@
next;
}
- foreach $b (@buffers) {
+ foreach my $b (@buffers) {
if(! $buff{$b} ) {
print STDERR "No buffer definition for buffer $b ...\n";
next;
}
- &print_cycbuff_head($buff{$b});
+ print_cycbuff_head($buff{$b});
}
if (!$use_syslog) {
print STDOUT "\n";
@@ -180,7 +176,7 @@
}
}
-if(defined($opt_l)) {
+if(defined($opt{'l'})) {
sleep($sleeptime);
if (!$use_syslog) {
print STDOUT "$sleeptime seconds later:\n";
@@ -189,24 +185,25 @@
}
sub read_cycbuffconf {
- return 0 unless open (CONFFILE, $conffile);
+ my @line;
+ return 0 unless open my $CONFFILE, '<', $conffile;
- while(<CONFFILE>) {
+ while(<$CONFFILE>) {
$_ =~ s/^\s*(.*?)\s*$/$1/;
# Here we handle continuation lines
while (m/\\$/) {
- $contline = <CONFFILE>;
+ my $contline = <$CONFFILE>;
$contline =~ s/^\s*(.*?)\s*$/$1/;
chop;
$_ .= $contline;
}
# \x23 below is #. Emacs perl-mode gets confused by the "comment"
- next if($_ =~ /^\s*$/ || $_ =~ /^\x23/);
- next if($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
+ next if ($_ =~ /^\s*$/ || $_ =~ /^\x23/);
+ next if ($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
if($_ =~ /^metacycbuff:/) {
@line = split(/:/, $_);
- if($class{$line[1]}) {
+ if ($class{$line[1]}) {
print STDERR "Class $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 0;
}
@@ -217,7 +214,7 @@
if ($_ =~ /^cycbuff/) {
@line = split(/:/, $_);
- if($buff{$line[1]}) {
+ if ($buff{$line[1]}) {
print STDERR "Buff $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 1;
}
@@ -227,24 +224,24 @@
print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
}
- close(CONFFILE);
+ close $CONFFILE;
return 1;
}
sub read_storageconf {
my $line = 0;
- return 0 unless open (STOR, $storageconf);
+ return 0 unless open my $STOR, '<', $storageconf;
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
# defaults
- %key = ("NEWSGROUPS" => "*",
- "SIZE" => "0,0");
+ my %key = ("NEWSGROUPS" => "*",
+ "SIZE" => "0,0");
if (/method\s+cnfs\s+\{/) {
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
last if /\}/;
@@ -272,9 +269,9 @@
}
sub print_cycbuff_head {
- my ($buffpath) = $_[0];
+ my ($buffpath) = @_;
my ($name, $len, $free, $update, $cyclenum, $oldart) =
- &get_cycbuff_info($buffpath);
+ get_cycbuff_info($buffpath);
if ($use_syslog) {
($name) = split(/\s/, $name);
@@ -287,27 +284,28 @@
}
$name =~ s/\0//g;
- print " Buffer $name, size: ", &human_readable($len, 4);
- print ", position: ", &human_readable($free, 4);
- printf(" %.2f cycles\n", $cyclenum + Math::BigFloat->new($free) / Math::BigFloat->new($len));
+ print " Buffer $name, size: ", human_readable($len, 4);
+ print ", position: ", human_readable($free, 4);
+ printf " %.2f cycles\n", $cyclenum + Math::BigFloat->new($free) / Math::BigFloat->new($len);
# The CNFS buffer may not have been initialized yet or received an article.
# Take it into account because $oldart may be undefined.
- my ($when, $ago) = &make_time($update);
- if (defined $oldart || not $opt_a) {
+ my ($when, $ago) = make_time($update);
+ if (defined $oldart or not $opt{'a'}) {
print " Newest: $when, $ago ago\n";
} else {
print " Created: $when, $ago ago\n";
}
- if ($opt_a) {
+ if ($opt{'a'}) {
if (defined $oldart) {
- my ($when, $ago) = &make_time($oldart);
+ my ($when, $ago) = make_time($oldart);
print " Oldest: $when, $ago ago\n";
} else {
print " No oldest article\n";
}
}
+ return;
}
sub make_time {
@@ -357,7 +355,7 @@
sub mrtg {
my $buffer = shift;
# print "Buffer = $buff{$buffer}\n";
- @info = &get_cycbuff_info($buff{$buffer});
+ my @info = get_cycbuff_info($buff{$buffer});
print "$info[1]\n";
print "$info[2]\n";
print "$info[4]\n";
@@ -367,10 +365,10 @@
sub mrtg_config {
print "Sub MRTG-CONFIG\n";
- foreach $class (sort(keys(%class))) {
+ foreach my $class (sort(keys(%class))) {
print "##\n## Class : $class\n## Wildmat: $stor{$class}\n##\n\n";
- foreach $buffer (split /\,/,$class{$class}) {
- &mrtg_buffer($class,$buffer);
+ foreach my $buffer (split /\,/, $class{$class}) {
+ mrtg_buffer($class, $buffer);
}
}
exit(0);
@@ -379,10 +377,10 @@
sub mrtg_buffer {
my ($class,$buffer) = @_;
#my ($name, $num, $buff, $size) = @_;
- $tag = 'cnfs-' . $buffer;
+ my $tag = 'cnfs-' . $buffer;
print 'Target[', $tag, ']: `', "$INN::Config::pathbin/cnfsstat -m ", $buffer, '`', "\n";
- print 'MaxBytes[', $tag, ']: ', (&get_cycbuff_info($buff{$buffer}))[1], "\n";
+ print 'MaxBytes[', $tag, ']: ', (get_cycbuff_info($buff{$buffer}))[1], "\n";
print 'Title[', $tag, ']: ', "${buffer} Usage\n";
print 'Options[', $tag, ']: growright gauge', "\n";
print 'YLegend[', $tag, ']: ', "${buffer}\n";
@@ -390,23 +388,23 @@
print 'PageTop[', $tag, ']: ', "<H1>Usage of ${buffer}</H1>\n";
print "<BR><TT>$stor{$class}</TT>\n";
print "\n";
- 1;
+ return 1;
}
sub bigsysseek {
- my($handle, $offset) = @_;
+ my ($handle, $offset) = @_;
# $offset may be a bigint; and have a value that doesn't fit in a signed long.
# Even with largefiles enabled, perl will still truncate the argument to lseek64
# to 32 bits. So we seek multiple times, <2G at a time.
- if($offset > 2147483647) {
+ if ($offset > 2147483647) {
# Since perl truncates the return value of lseek64 to 32 bits, it might
# see a successful return value as negative, and return FALSE (undef).
# So we must ignore the return value of sysseek and assume that it worked.
seek($handle, 0, 0);
- while($offset > 2000000000) {
+ while ($offset > 2000000000) {
sysseek($handle, 2000000000, 1) || return 0;
$offset -= 2000000000;
}
@@ -425,46 +423,44 @@
}
sub get_cycbuff_info {
- my($buffpath) = $_[0];
+ my ($buffpath) = @_;
my $oldart;
- my($CNFSMASIZ)=8;
- my($CNFSNASIZ)=16;
- my($CNFSPASIZ)=64;
- my($CNFSLASIZ)=16;
- my($headerlength) = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
+ my $CNFSMASIZ = 8;
+ my $CNFSNASIZ = 16;
+ my $CNFSPASIZ = 64;
+ my $CNFSLASIZ = 16;
+ my $headerlength = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
- my($buff, @entries, $e);
- my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma);
+ my ($BUFF, $buff);
- if(! open(BUFF, "< $buffpath") ) {
+ if ( !open $BUFF, '<', $buffpath ) {
print STDERR "Cannot open Cycbuff $buffpath ...\n";
exit(1);
}
$buff = "";
- if(! read(BUFF, $buff, $headerlength) ) {
+ if ( !read $BUFF, $buff, $headerlength ) {
print STDERR "Cannot read $headerlength bytes from file $buffpath...\n";
exit(1);
}
- use vars qw($metaname $orderinmeta $currentbuff);
- ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname,
+ my ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname,
$orderinmeta, $currentbuff, $blksza) =
unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8 a16", $buff);
- if(!$magic) {
+ if (!$magic) {
print STDERR "Error while unpacking header ...\n";
exit(1);
}
- my($len) = bhex($lena);
- my($free) = bhex($freea);
- my($update) = hex($updatea);
- my($cyclenum) = hex($cyclenuma) - 1;
- my($blksz) = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
+ my $len = bhex($lena);
+ my $free = bhex($freea);
+ my $update = hex($updatea);
+ my $cyclenum = hex($cyclenuma) - 1;
+ my $blksz = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
- if ($opt_a) {
+ if ($opt{'a'}) {
my $pagesize = 16384;
my $minartoffset = int($len / ($blksz * 8)) + 512;
@@ -480,15 +476,16 @@
my $sentinel = $cyclenum == 0 ? $free : $len;
my $offset = $cyclenum == 0 ? $minartoffset : $free + $pagesize;
- bigsysseek (BUFF, $offset) || die "sysseek: $!\n";
- check_read_return (sysread (BUFF, $buff, $pagesize));
+ bigsysseek($BUFF, $offset) || die "sysseek: $!\n";
+ check_read_return (sysread ($BUFF, $buff, $pagesize));
do {
- check_read_return (sysread (BUFF, $chunk, $pagesize));
+ my $chunk;
+ check_read_return (sysread ($BUFF, $chunk, $pagesize));
$buff .= $chunk;
while ($buff =~ /^message-id:\s+(<.*?>)/mi) {
$buff = $POSTMATCH;
- $oldart = &lookup_age ($1);
+ $oldart = lookup_age($1);
next unless $oldart;
# Is the article newer than the last update of the cycbuff?
@@ -506,19 +503,19 @@
}
done:
- close(BUFF);
+ close $BUFF;
return($name,$len,$free,$update,$cyclenum,$oldart);
}
sub lookup_age {
my ($msgid) = @_;
- my $history = &safe_run("$INN::Config::newsbin/grephistory", "-l", $msgid);
+ my $history = safe_run("$INN::Config::newsbin/grephistory", "-l", $msgid);
if ($history =~ /\t(\d+)~/) {
return $1;
}
- if ($opt_v) {
+ if ($opt{'v'}) {
print " (Missing $msgid)\n";
}
@@ -528,13 +525,13 @@
sub safe_run {
my $output = "";
- my $pid = open(KID_TO_READ, "-|");
+ my $pid = open my $KID_TO_READ, "-|";
die "fork: $!\n" unless defined $pid;
if ($pid) {
- while (<KID_TO_READ>) {
+ while (<$KID_TO_READ>) {
$output .= $_;
}
- close(KID_TO_READ);
+ close $KID_TO_READ;
} else {
exec(@_) || die "can't exec $_[0]: $!";
# NOTREACHED
Modified: innfeed/procbatch.in
===================================================================
--- innfeed/procbatch.in 2011-07-05 18:27:40 UTC (rev 9215)
+++ innfeed/procbatch.in 2011-07-05 18:30:57 UTC (rev 9216)
@@ -18,20 +18,21 @@
# Hmm, perhaps we should try to read "backlog-directory"
# from innfeed.conf. Oh well.
#
-$tapeDir = $INN::Config::pathspool . "/innfeed";
-$destDir = $INN::Config::spooltemp ;
-$spoolArts = $INN::Config::patharticles ;
-$outGoing = $INN::Config::pathoutgoing;
+use strict;
+my $tapeDir = $INN::Config::pathspool . "/innfeed";
+my $destDir = $INN::Config::spooltemp;
+my $spoolArts = $INN::Config::patharticles;
+my $outGoing = $INN::Config::pathoutgoing;
##
## Everything below here should probably be left alone.
##
-$0 =~ s!.*/!! ;
+$0 =~ s!.*/!!;
use Getopt::Std;
-$usage = "$0 [ -q ][ -v ][ -u ][ -e host ][ -d dir ][ -c [ -s dir ]][ -m [-t dir ]] inn-batchfile\n
+my $usage = "$0 [ -q ][ -v ][ -u ][ -e host ][ -d dir ][ -c [ -s dir ]][ -m [-t dir ]] inn-batchfile\n
-e host to process on entries for only that host
-d dir to put the output file(s) in that directory ($destDir)
-c to check pathnames of articles before storing them
@@ -58,50 +59,50 @@
to peer1 peer2 peer3 in a running innfeed's backlog directory and they will be
picked up automatically and processed by innfeed. Use the '-m' flag and
they'll be moved automatically.
-" ;
+";
-$opt_u = $opt_h = ""; # shut up, perl -w
-$missing = 0;
-getopts ("he:t:s:d:cvumq") || die $usage ;
+my (%opt, %hosts);
+my $missing = 0;
+getopts ("he:t:s:d:cvumq", \%opt) || die $usage;
-die $usage if ( $opt_h ) ;
-die "Cannot specify both -q and -v\n\n" . $usage if ($opt_q && $opt_v);
+die $usage if $opt{'h'};
+die "Cannot specify both -q and -v\n\n" . $usage if ($opt{'q'} && $opt{'v'});
-$spoolArts = $opt_s if $opt_s ;
-$destDir = $opt_d if $opt_d ;
-$tapeDir = $opt_t if $opt_t ;
-$inputFile = shift ;
+$spoolArts = $opt{'s'} if $opt{'s'};
+$destDir = $opt{'d'} if $opt{'d'};
+$tapeDir = $opt{'t'} if $opt{'t'};
+my $inputFile = shift;
-die $usage if !$inputFile ;
+die $usage if !$inputFile;
unless (-f $inputFile) {
- exit if $opt_q;
+ exit if $opt{'q'};
die "No such file: $inputFile\n\n" . $usage;
}
-die "No such directory: $spoolArts\n\n" . $usage if ( ! -d $spoolArts && $opt_c ) ;
-die "No such directory: $destDir\n\n" . $usage if ( ! -d $destDir ) ;
-die "No such directory: $tapeDir\n\n" . $usage if ( ! -d $tapeDir && $opt_m ) ;
+die "No such directory: $spoolArts\n\n" . $usage if ( ! -d $spoolArts && $opt{'c'} );
+die "No such directory: $destDir\n\n" . $usage if ( ! -d $destDir );
+die "No such directory: $tapeDir\n\n" . $usage if ( ! -d $tapeDir && $opt{'m'} );
-print "Using $inputFile\n" if $opt_v ;
-open (INPUT,"<$inputFile") || die "$0: open ($inputFile): $!\n" ;
+print "Using $inputFile\n" if $opt{'v'};
+open (my $INPUT, '<', $inputFile) || die "$0: open ($inputFile): $!\n";
-while (<INPUT>) {
- chop ;
- @F = split ;
+while (<$INPUT>) {
+ chop;
+ my @F = split;
# Check the format of the line vigorously
- next unless (m!^\S+/\d+ <.+ at .+> \S+! || m!^@[0-9A-F]+@ <.+ at .+> \S+!) ;
+ next unless (m!^\S+/\d+ <.+ at .+> \S+! || m!^@[0-9A-F]+@ <.+ at .+> \S+!);
- if ( $opt_c ) {
+ if ( $opt{'c'} ) {
if ( ! -f "$spoolArts/$F[0]" ) {
- $missing++ ;
- print "Dropping file: $spoolArts/$F[0]\n" if $opt_v ;
- next ;
+ $missing++;
+ print "Dropping file: $spoolArts/$F[0]\n" if $opt{'v'};
+ next;
}
}
- for ($i = 2 ; $i <= $#F ; $i++) {
- $host = $F[$i] ;
- next if ($opt_e && $opt_e ne $host) ;
+ for (my $i = 2 ; $i <= $#F ; $i++) {
+ my $host = $F[$i];
+ next if ($opt{'e'} && $opt{'e'} ne $host);
# Keep out host names with any funny characters (from
# corrupted files)
@@ -113,35 +114,34 @@
if ($hosts{$host}) {
print {$hosts{$host}} "$F[0] $F[1]\n";
} else {
- $outputFile = "$destDir/$host.tmp" ;
- print "Starting $host\n" if ($opt_v);
- $hosts{$host}=$host;
- open ($hosts{$host},">>$outputFile") ||
- die "open >>$outputFile: $!\n" ;
+ my $outputFile = "$destDir/$host.tmp";
+ print "Starting $host\n" if ($opt{'v'});
+ open $hosts{$host}, '>>', $outputFile
+ or die "open >>$outputFile: $!\n";
print {$hosts{$host}} "$F[0] $F[1]\n";
}
}
}
-close (INPUT) ;
+close $INPUT;
-foreach $host (keys %hosts) {
- close($hosts{$host});
- $outputFile = "$destDir/$host.tmp" ;
- $tmpTape = "$tapeDir/$host.tmp" ;
- $tapeFile = "$tapeDir/$host" ;
- if ( $opt_m ) {
+foreach my $host (keys %hosts) {
+ close $hosts{$host};
+ my $outputFile = "$destDir/$host.tmp";
+ my $tmpTape = "$tapeDir/$host.tmp";
+ my $tapeFile = "$tapeDir/$host";
+ if ( $opt{'m'} ) {
if ($outputFile ne $tmpTape) {
- $cmd = "mv $outputFile $tmpTape" ;
- system ($cmd) ;
- die "$0: $cmd: failed\n" unless ($? == 0) ;
+ my $cmd = "mv $outputFile $tmpTape";
+ system $cmd;
+ die "$0: $cmd: failed\n" unless ($? == 0);
}
- $cmd = "cat $tmpTape | $INN::Config::sort -u >> $tapeFile && rm -f $tmpTape" ;
- system ($cmd) ;
- die "$0: $cmd: failed\n" unless ($? == 0) ;
+ my $cmd = "cat $tmpTape | $INN::Config::sort -u >> $tapeFile && rm -f $tmpTape";
+ system $cmd;
+ die "$0: $cmd: failed\n" unless ($? == 0);
}
}
-unlink($inputFile) if ($opt_u);
+unlink $inputFile if $opt{'u'};
-print "$missing articles dropped\n" if ( $opt_v && $missing > 0 ) ;
+print "$missing articles dropped\n" if ( $opt{'v'} && $missing > 0 );
Modified: scripts/innmail.in
===================================================================
--- scripts/innmail.in 2011-07-05 18:27:40 UTC (rev 9215)
+++ scripts/innmail.in 2011-07-05 18:30:57 UTC (rev 9216)
@@ -10,41 +10,41 @@
# problems.
#
-$0 =~ s!.*/!! ;
-
-require 5.001 ;
+use strict;
use Getopt::Std;
-use vars qw($opt_h);
+$0 =~ s!.*/!!;
+
die "$0: No \$INN::Config::mta variable defined.\n"
if ! defined ($INN::Config::mta);
-$sm = $INN::Config::mta ;
+my $sm = $INN::Config::mta;
-die "$0: MTA path is not absolute\n" unless ($sm =~ m!^/!) ;
+die "$0: MTA path is not absolute\n" unless ($sm =~ m!^/!);
-$usage = "usage: $0 -s subject addresses\n\n" .
- "Reads stdin for message body\n" ;
+my $usage = "usage: $0 -s subject addresses\n\n" .
+ "Reads stdin for message body\n";
-getopts ("s:h") || die $usage ;
+my (%opt, @addrs);
+getopts ("s:h", \%opt) || die $usage;
-die $usage if $opt_h ;
+die $usage if $opt{'h'};
-if ( !defined($opt_s) ) {
- warn "No subject given. Hope that's OK.\n" ;
- $opt_s = "NO SUBJECT" ;
+if ( !defined($opt{'s'}) ) {
+ warn "No subject given. Hope that's OK.\n";
+ $opt{'s'} = "NO SUBJECT";
} else {
- $opt_s =~ s/\n+\Z//;
+ $opt{'s'} =~ s/\n+\Z//;
}
# Fix up any addresses.
foreach ( @ARGV ) {
- s![^-a-zA-Z0-9+_.@%]!!g ;
+ s![^-a-zA-Z0-9+_.@%]!!g;
- push (@addrs,$_) if ($_ ne "") ;
+ push (@addrs, $_) if ($_ ne "");
}
-die "$0: No addresses specified\n\n$usage" unless @addrs ;
+die "$0: No addresses specified\n\n$usage" unless @addrs;
if ($sm =~ m!%s!) {
$sm = sprintf $sm, join (' ', @addrs);
@@ -52,9 +52,9 @@
$sm .= " " . join(' ', @addrs);
}
- at smarr = split(/\s+/,$sm);
+my @smarr = split(/\s+/, $sm);
-($t = $INN::Config::mta) =~ s!\s.*!!;
+(my $t = $INN::Config::mta) =~ s!\s.*!!;
die "$0: MTA variable definition is changed after substitution\n"
if ($t ne $smarr[0]);
@@ -62,18 +62,18 @@
if ! -x $smarr[0];
# Startup MTA without using the shell.
-$pid = open (MTA,"|-") ;
+my $pid = open my $MTA, '|-';
if ($pid == 0) {
- exec (@smarr) || die "$0: exec of $sm failed: $!\n" ;
+ exec (@smarr) || die "$0: exec of $sm failed: $!\n";
} elsif ($pid < 0) {
- die "$0: Fork failed: $!\n" ;
+ die "$0: Fork failed: $!\n";
}
-print MTA "To: ", join (",\n\t", @addrs), "\n" ;
-print MTA "Subject: $opt_s\n" ;
-print MTA "\n" ;
+print $MTA "To: ", join (",\n\t", @addrs), "\n";
+print $MTA "Subject: $opt{'s'}\n";
+print $MTA "\n";
while (<STDIN>) {
- print MTA $_ ;
+ print $MTA $_;
}
-close (MTA) ;
-exit ;
+close $MTA;
+exit;
More information about the inn-committers
mailing list