INN commit: branches/2.5 (4 files)

INN Commit rra at isc.org
Sun Jul 17 18:20:50 UTC 2011


    Date: Sunday, July 17, 2011 @ 11:20:50
  Author: iulius
Revision: 9258

add 'use strict' mode to cnfsheadconf, cnfsstat, innmail and procbatch

Clean up these Perl scripts.

Thanks to Florian Schlichting for this patch.

Modified:
  branches/2.5/frontends/cnfsheadconf.in
  branches/2.5/frontends/cnfsstat.in
  branches/2.5/innfeed/procbatch.in
  branches/2.5/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-17 18:20:17 UTC (rev 9257)
+++ frontends/cnfsheadconf.in	2011-07-17 18:20:50 UTC (rev 9258)
@@ -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-17 18:20:17 UTC (rev 9257)
+++ frontends/cnfsstat.in	2011-07-17 18:20:50 UTC (rev 9258)
@@ -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-17 18:20:17 UTC (rev 9257)
+++ innfeed/procbatch.in	2011-07-17 18:20:50 UTC (rev 9258)
@@ -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-17 18:20:17 UTC (rev 9257)
+++ scripts/innmail.in	2011-07-17 18:20:50 UTC (rev 9258)
@@ -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