'use strict', cleanup everywhere

Florian Schlichting fschlich at CIS.FU-Berlin.DE
Fri Jul 1 13:29:40 UTC 2011


Hi Julien,

after my first patches for inncheck were so well received, I leisurely
got to work on the other perl scripts that didn't use 'use strict' yet,
and also cleaned out some perl4-ish features. Given what you told be
about your schedule, I thought I might just dump the results on you
right before I leave for my summer holiday... Even though I noticed just
today that procbatch, scanspool and signcontrol don't have manpages yet,
so if you won't, I might write some pod when I find the time...

Florian


---
 backends/mod-active.in    |   86 +++++++++++----------
 control/signcontrol.in    |  114 +++++++++++++--------------
 frontends/cnfsheadconf.in |  122 +++++++++++++++--------------
 frontends/cnfsstat.in     |  187 ++++++++++++++++++++++-----------------------
 frontends/scanspool.in    |  181 +++++++++++++++++++++----------------------
 innfeed/procbatch.in      |  110 +++++++++++++-------------
 scripts/innmail.in        |   56 +++++++-------
 7 files changed, 424 insertions(+), 432 deletions(-)

diff --git a/backends/mod-active.in b/backends/mod-active.in
index 48440bd..d6b9d89 100644
--- a/backends/mod-active.in
+++ b/backends/mod-active.in
@@ -9,21 +9,22 @@
 # is output by docheckgroups and actsync, and efficiently handles them all at
 # once.  Input can come from command-line files or stdin, a la awk/sed.
 
-$oldact = $INN::Config::active;         # active file location
-$newact = "$oldact.new$$";              # temporary name for new active file
-$actime = $INN::Config::activetimes;    # active.times file
-$pausemsg = 'batch active update, ok';  # message to be used for pausing?
-$diff_flags = '';                       # flags for diff(1); default chosen if null
-$changes = 0;                           # number of changes to do
+use strict;
+my $oldact = $INN::Config::active;         # active file location
+my $newact = "$oldact.new$$";              # temporary name for new active file
+my $actime = $INN::Config::activetimes;    # active.times file
+my $pausemsg = 'batch active update, ok';  # message to be used for pausing?
+my $diff_flags = '';                       # flags for diff(1); default chosen if null
+my $changes = 0;                           # number of changes to do
 
 $0 =~ s#^.*/##;
 
 die "$0: must run as $INN::Config::newsuser user"
   unless $> == (getpwnam($INN::Config::newsuser))[2];
 
-$debug = -t STDOUT ? 1 : 0;
+my $debug = -t STDOUT ? 1 : 0;
 
-$| = 1;                # show output as it happens (for an rsh/ssh pipe)
+local $| = 1;                # show output as it happens (for an rsh/ssh pipe)
 
 # Guess at best flags for a condensed diff listing.  The
 # checks for alternative operating systems is incomplete.
@@ -41,28 +42,20 @@ unless ($diff_flags) {
 
 print "reading list of groups to update\n" if $debug;
 
-$eval  = "while (<OLDACT>) {\n";
-$eval .= "  \$group = (split)[0];\n";
-
+my (%toadd, %todelete, %tochange);
 while (<>) {
   if (/^\s*\S*ctlinnd newgroup (\S+) (\S+)/) {
     $toadd{$1} = $2;
     $changes++;
   } elsif (/^\s*\S*ctlinnd rmgroup (\S+)/) {
-    $eval .= "  next if \$group eq '$1';\n";
+    $todelete{$1} = 1;
     $changes++;
   } elsif (/^\s*\S*ctlinnd changegroup (\S+) (\S+)/) {
-    $eval .= "  s/ \\S+\$/ $2/ if \$group eq '$1';\n";
+    $tochange{$1} = $2;
     $changes++;
   }
 }
 
-$eval .= "  delete \$toadd{\$group};\n";
-$eval .= "  if (!print(NEWACT \$_)) {\n";
-$eval .= "    die \"\$0: writing \$newact failed (\$!), aborting\\n\";\n";
-$eval .= "  }\n";
-$eval .= "}\n";
-
 if ($changes == 0) {
     print "active file not changed\n" if $debug;
     exit 0;
@@ -70,43 +63,54 @@ if ($changes == 0) {
 
 print "$changes change(s) to do\n" if $debug;
 
-&ctlinnd("pause $pausemsg");
+ctlinnd("pause $pausemsg");
 
-open(OLDACT, "< $oldact") || die "$0: open $oldact: $!\n";
-open(NEWACT, "> $newact") || die "$0: open $newact: $!\n";
+open my $OLDACT, '<', $oldact || die "$0: open $oldact: $!\n";
+open my $NEWACT, '>', $newact || die "$0: open $newact: $!\n";
 
 print "rewriting active file\n" if $debug;
-eval $eval;
+
+while (<$OLDACT>) {
+  my $group = (split)[0];
+  next if exists $todelete{$group};
+  s/ \S+$/ $tochange{$group}/ if exists $tochange{$group};
+  delete $toadd{$group};
+  if (!print $NEWACT $_) {
+    ctlinnd("go $pausemsg");
+    die "$0: writing $newact failed ($!), aborting\n";
+  }
+}
+
 for (sort keys %toadd) {
-  $add = "$_ 0000000000 0000000001 $toadd{$_}\n";
-  if (!print(NEWACT $add)) {
-    &ctlinnd("go $pausemsg");
+  my $add = "$_ 0000000000 0000000001 $toadd{$_}\n";
+  if (!print $NEWACT $add) {
+    ctlinnd("go $pausemsg");
     die "$0: writing $newact failed ($!), aborting\n";
   }
 }
 
-close(OLDACT) || warn "$0: close $oldact: $!\n";
-close(NEWACT) || warn "$0: close $newact: $!\n";
+close $OLDACT || warn "$0: close $oldact: $!\n";
+close $NEWACT || warn "$0: close $newact: $!\n";
 
-if (!rename("$oldact", "$oldact.old")) {
+if (!rename "$oldact", "$oldact.old") {
   warn "$0: rename $oldact $oldact.old: $!\n";
 }
 
-if (!rename("$newact", "$oldact")) {
+if (!rename "$newact", "$oldact") {
   die "$0: rename $newact $oldact: $!\n";
 }
 
-&ctlinnd("reload active 'updated from checkgroups'");
-system("diff $diff_flags $oldact.old $oldact");
-&ctlinnd("go $pausemsg");
+ctlinnd("reload active 'updated from checkgroups'");
+system "diff $diff_flags $oldact.old $oldact";
+ctlinnd("go $pausemsg");
 
 print "updating $actime\n" if $debug;
-if (open(TIMES, ">> $actime")) {
-  $time = time;
+if (open my $TIMES, '>>', $actime) {
+  my $time = time;
   for (sort keys %toadd) {
-    print TIMES "$_ $time checkgroups-update\n" || last;
+    print $TIMES "$_ $time checkgroups-update\n" || last;
   }
-  close(TIMES) || warn "$0: close $actime: $!\n";
+  close $TIMES || warn "$0: close $actime: $!\n";
 } else {
   warn "$0: $actime not updated: $!\n";
 }
@@ -118,13 +122,11 @@ if (! chmod 0664, $oldact, "$oldact.old", $actime) {
 
 exit 0;
 
-sub
-ctlinnd
-{
-  local($command) = @_;
+sub ctlinnd {
+  my ($command) = @_;
 
   print "ctlinnd $command\n" if $debug;
-  if (system("$INN::Config::newsbin/ctlinnd -s $command")) {
+  if (system "$INN::Config::newsbin/ctlinnd -s $command") {
     die "$0: \"$command\" failed, aborting\n";
   }
 }
diff --git a/control/signcontrol.in b/control/signcontrol.in
index 88974b5..0b81b99 100644
--- a/control/signcontrol.in
+++ b/control/signcontrol.in
@@ -1,4 +1,5 @@
 #! /usr/bin/perl -w
+use strict;
 # written April 1996, <tale at isc.org> (David C Lawrence)
 # Currently maintained by Russ Allbery <rra at stanford.edu>
 # Version 1.8, 2003-07-06
@@ -59,11 +60,11 @@
 # work to lock against other instances of signcontrol, not all pgp uses.
 # $pgplock is not used if $pgp ends in 'gpg' since GnuPG doesn't need
 # this.
-$pgpsigner = 'INSERT_YOUR_PGP_USERID';
-$pgppassfile = '';      # file with pass phrase for $pgpsigner
-$pgp = "/usr/local/bin/pgp";
-$pgpheader = "X-PGP-Sig";
-$pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
+my $pgpsigner = 'INSERT_YOUR_PGP_USERID';
+my $pgppassfile = '';      # file with pass phrase for $pgpsigner
+my $pgp = "/usr/local/bin/pgp";
+my $pgpheader = "X-PGP-Sig";
+my $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
 
 # this program is strict about always wanting to be consistent about what
 # headers appear in the control messages.  the defaults for the
@@ -74,6 +75,7 @@ $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
 # Subject: is forced to be the Control header prepending by "cmsg".  also,
 # Newsgroups: is forced to be just the group being added/removed.
 #             (but is taken as-is for checkgroups)
+my %force;
 $force{'Path'} = 'bounce-back';
 $force{'From'} = 'YOUR_ADDRESS_AND_NAME';
 $force{'Approved'} = 'ADDRESS_FOR_Approved_HEADER';
@@ -85,7 +87,7 @@ $force{'X-Info'}='ftp://ftp.isc.org/pub/pgpcontrol/README.html'
 # created with the given value.  None are enabled by default, because they
 # should not be necessary.  Setting one to a null string will pass through
 # any instance of it found in the input, but not generate one if it is
-# missing.  If you set any $default{} variables, you must also put it in
+# missing.  If you set any $use_or_add{} variables, you must also put it in
 # @orderheaders below.
 #
 # Note that Distribution nearly never works correctly, so use it only if
@@ -93,13 +95,14 @@ $force{'X-Info'}='ftp://ftp.isc.org/pub/pgpcontrol/README.html'
 # you intend.  This normally means that you control all servers the
 # distribution will go to with an iron fist.
 #
+my %use_or_add;
 # $use_or_add{'Reply-To'} = 'YOUR_REPLY_ADDRESS';
 # $use_or_add{'Oranization'} = 'YOUR_ORGANIZATION';
 # $use_or_add{'Distribution'} = 'MESSAGE_DISTRIBUTION';
 
 # host for message-id; this could be determined automatically based on
 # where it is run, but consistency is the goal here
-$id_host = 'FULL_HOST_NAME';
+my $id_host = 'FULL_HOST_NAME';
 
 # headers to sign.  Sender is included because non-PGP authentication uses
 # it.  The following should always be signed:
@@ -109,12 +112,12 @@ $id_host = 'FULL_HOST_NAME';
 #  Date       -- guards against replay attacks.
 #  From       -- used by news systems as part of authenticating the message.
 #  Sender     -- used by news systems as part of authenticating the message.
- at signheaders = ('Subject', 'Control', 'Message-ID', 'Date', 'From', 'Sender');
+my @signheaders = ('Subject', 'Control', 'Message-ID', 'Date', 'From', 'Sender');
 
 # headers to remove from real headers of final message.
 # If it is a signed header, it is signed with an empty value.
 # set to () if you do not want any headers removed.
- at ignoreheaders = ('Sender');
+my @ignoreheaders = ('Sender');
 
 # headers that will appear in final message, and their order of
 # appearance.  all _must_ be set, either in input or via the $force{} and
@@ -130,7 +133,7 @@ $id_host = 'FULL_HOST_NAME';
 # any non-null header in the input but not in @orderheaders or @ignoreheaders
 #   is an error.
 # null headers are silently dropped.
- at orderheaders =
+my @orderheaders =
   ('Path', 'From', 'Newsgroups', 'Subject', 'Control', 'Approved',
    'Message-ID', 'Date', 'Lines', 'X-Info', $pgpheader);
 
@@ -141,7 +144,7 @@ $id_host = 'FULL_HOST_NAME';
 # set to match only hierarchies you will use it on
 # include no '|' for a single hierarchy (eg, "$hierarchies = 'uk';").
 
-$hierarchies = 'HIERARCHIES';
+my $hierarchies = 'HIERARCHIES';
 
 # the draft news article format standard says:
 #   "subsequent components SHOULD begin with a letter"
@@ -157,11 +160,11 @@ $hierarchies = 'HIERARCHIES';
 # newsgroups that have name components that begin with a letter, like
 # news.announce.newgroups does with comp.sys.3b1 and 17 other groups.
 
-$start_component_with_letter = 'MUST';
+my $start_component_with_letter = 'MUST';
 
 ## END CONFIGURATION
 
-use Fcntl qw(F_SETFD);
+use Fcntl qw(F_SETFD LOCK_EX);
 use FileHandle;
 use IPC::Open3 qw(open3);
 use POSIX qw(setlocale strftime LC_TIME);
@@ -171,18 +174,19 @@ $0 =~ s#^.*/##;
 
 die "Usage: $0 < message\n" if @ARGV > 0;
 
+my $LOCK;
 umask(0022);                    # flock needs a writable file, if we create it
 if ($pgp !~ /gpg$/) {
-  open(LOCK, ">>$pgplock") || die "$0: open $pgplock: $!, exiting\n";
-  flock(LOCK, 2);               # block until locked
+  open $LOCK, '>>', $pgplock || die "$0: open $pgplock: $!, exiting\n";
+  flock $LOCK, LOCK_EX;         # block until locked
 }
 
-&setgrouppat;
+my ($die, $group, $action, $grouppat, %header, $moderated, $body, @ERROR);
 
-$die = '';
+setgrouppat();
 
-&readhead;
-&readbody;
+readhead();
+readbody();
 
 if ($die) {
   if ($group) {
@@ -196,20 +200,18 @@ if ($die) {
   }
 }
 
-&signit;
+signit();
 
 if ($pgp !~ /gpg$/) {
-  close(LOCK) || warn "$0: close $pgplock: $!\n";
+  close $LOCK || warn "$0: close $pgplock: $!\n";
 }
 exit 0;
 
-sub
-setgrouppat
 
-{
-  my ($hierarchy, $plain_component, $no_component);
+
+sub setgrouppat {
+  my ($plain_component, $no_component);
   my ($must_start_letter, $should_start_letter);
-  my ($eval);
 
   # newsgroup name checks based on RFC 1036bis (not including encodings) rules:
   #  "component MUST contain at least one letter"
@@ -238,29 +240,25 @@ setgrouppat
     die "$0: unknown value configured for \$start_component_with_letter\n";
   }
 
-  foreach $hierarchy (split(/\|/, $hierarchies)) {
+  foreach my $hierarchy (split /\|/, $hierarchies) {
     die "$0: hierarchy name $hierarchy not standards-compliant\n"
       if $hierarchy !~ /^$plain_component$/o;
   }
 
-  $eval = "\$_ = 'test'; /$grouppat/;";
-  eval $eval;
+  eval { 'test' =~ /$grouppat/ };
   die "$0: bad regexp for matching group names:\n $@" if $@;
+  return;
 }
 
-sub
-readhead
-
-{
-  my($head, $label, $value);
-  local($_, $/);
+sub readhead {
+  my ($head, $label, $value);
 
-  $/ = "";
+  local $/ = "";
   $head = <STDIN>;              # get the whole news header
   $die .= "$0: continuation lines in headers not allowed\n"
     if $head =~ s/\n[ \t]+/ /g; # rejoin continued lines
 
-  for (split(/\n/, $head)) {
+  foreach (split /\n/, $head) {
     if (/^(\S+): (.*)/) {
       $label = $1;
       $value = $2;
@@ -317,17 +315,14 @@ readhead
   } else {
     $die .= "$0: can't verify message content; missing Control header\n";
   }
+  return;
 }
 
-sub
-readbody
+sub readbody {
+  my ($status, $ngline, $fixline, $used, $desc, $mods);
 
-{
-  local($_, $/);
-  local($status, $ngline, $fixline, $used, $desc, $mods);
-
-  undef $/;
-  $body = $_ = <STDIN>;
+  local $/ = undef;
+  $body = <STDIN>;      # slurp the rest of the article
   $header{'Lines'} = $body =~ tr/\n/\n/ if $body;
 
   # the following tests are based on the structure of a
@@ -373,7 +368,7 @@ readbody
 
   # checkgroups have structured bodies
   if ($action eq 'check') {
-    for (split(/\n/, $body)) {
+    for (split /\n/, $body) {
       my ($group, $description) = /^(\S+)\t+(.+)/;
       $die .= "$0: no group:\n  $_\n"           unless $group;
       $die .= "$0: no description:\n  $_\n"     unless $description;
@@ -383,6 +378,7 @@ readbody
       $die .= "$0: $group line too long\n"      if length(expand($_)) > 80;
     }
   }
+  return;
 }
 
 # Create a detached signature for the given data.  The first argument
@@ -497,22 +493,19 @@ sub pgp_sign {
   }
   shift @signature;
   pop @signature;
-  $signature = join ('', @signature);
+  $signature = join '', @signature;
   chomp $signature;
   undef @ERROR;
   return wantarray ? ($signature, $version) : $signature;
 }
 
-sub
-signit
-
-{
-  my($head, $header, $signheaders, $pgpflags, $pgpbegin, $pgpend);
+sub signit {
+  my ($head, $signheaders);
 
   # Form the message to be signed.
-  $signheaders = join(",", @signheaders);
+  $signheaders = join ",", @signheaders;
   $head = "X-Signed-Headers: $signheaders\n";
-  foreach $header (@signheaders) {
+  foreach my $header (@signheaders) {
     $head .= "$header: $header{$header}\n";
   }
   my $message = "$head\n$body";
@@ -521,15 +514,15 @@ signit
   my $passphrase;
   if ($pgppassfile && -f $pgppassfile) {
     $pgppassfile =~ s%^(\s)%./$1%;
-    if (open (PGPPASS, "< $pgppassfile\0")) {
-      $passphrase = <PGPPASS>;
-      close PGPPASS;
+    if (open my $PGPPASS, '<', $pgppassfile) {
+      $passphrase = <$PGPPASS>;
+      close $PGPPASS;
       chomp $passphrase;
     }
   }
 
   # Sign the message, getting the signature and PGP version number.
-  my ($signature, $version) = pgp_sign ($pgpsigner, $passphrase, $message);
+  my ($signature, $version) = pgp_sign($pgpsigner, $passphrase, $message);
   unless ($signature) {
     die "@ERROR\n$0: could not generate signature\n";
   }
@@ -547,18 +540,19 @@ signit
   }
 
   $head = '';
-  foreach $header (@orderheaders) {
+  foreach my $header (@orderheaders) {
     $head .= "$header: $header{$header}\n" if $header{$header};
     delete $header{$header};
   }
 
-  foreach $header (keys %header) {
+  foreach my $header (keys %header) {
     die "$0: unexpected header $header left in header array\n";
   }
 
   print STDOUT $head;
   print STDOUT "\n";
   print STDOUT $body;
+  return;
 }
 
 # Our lawyer told me to include the following.  The upshot of it is that
diff --git a/frontends/cnfsheadconf.in b/frontends/cnfsheadconf.in
index bcfecc7..266a760 100644
--- a/frontends/cnfsheadconf.in
+++ b/frontends/cnfsheadconf.in
@@ -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 bint2hex {
 }
 
 sub usage {
-    print <<_end_;
+    print <<"_end_";
 Summary tool for cycbuff header manipulation
 
 Usage:
@@ -94,45 +94,46 @@ _end_
     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|help'    => 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 @@ sub read_cycbuffconf {
 
 	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 @@ sub read_cycbuffconf {
 
 	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 @@ sub read_storageconf {
 	    } else {
 		$stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" .
 			"$key{'SIZE'}:$key{'OPTIONS'}";
-		push(@storsort, $key{'OPTIONS'});
 	    }
 	}
     }
+    close $STOR;
     return 1;
 }
 
@@ -210,7 +212,7 @@ START:
 # 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 @@ if (not defined $buff{$cycbuff}) {
     exit(1);
 }
 
-&print_cycbuff_head($buff{$cycbuff});
+print_cycbuff_head($buff{$cycbuff});
 
 sub make_time {
     my ($t) = @_;
@@ -242,67 +244,66 @@ sub make_time {
 }
 
 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 @@ sub print_cycbuff_head {
 	}
         $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;
 }
diff --git a/frontends/cnfsstat.in b/frontends/cnfsstat.in
index 864cf45..ecabf81 100644
--- a/frontends/cnfsstat.in
+++ b/frontends/cnfsstat.in
@@ -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 @@ _end_
     exit(1);
 }
 
-my(@line, %class, %buff, %stor, $c, @buffers);
-
-my($gr, $cl, $min, $max, @storsort, $oclass, $header_printed);
-my $use_syslog = 0;
+my (%class, %buff, %stor, @storsort, @buffers);
 
+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_s) {
     }
 }
 
-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 @@ if ($oclass) {
 	    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 @@ if ($oclass) {
 	    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 ($oclass) {
     }
 }
 
-if(defined($opt_l)) {
+if(defined($opt{'l'})) {
     sleep($sleeptime);
     if (!$use_syslog) {
 	print STDOUT "$sleeptime seconds later:\n";
@@ -189,24 +185,25 @@ if(defined($opt_l)) {
 }
 
 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 @@ sub read_cycbuffconf {
 
 	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 @@ sub read_cycbuffconf {
 
 	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 read_storageconf {
 }
 
 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 @@ sub print_cycbuff_head {
     }
 
     $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 || 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 human_readable {
 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 {
 
 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_config {
 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 @@ sub mrtg_buffer {
         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 check_read_return {
 }
 
 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 @@ sub get_cycbuff_info {
 	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 @@ sub get_cycbuff_info {
     }
 
 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 lookup_age {
 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
diff --git a/frontends/scanspool.in b/frontends/scanspool.in
index 08bd0da..42e6354 100644
--- a/frontends/scanspool.in
+++ b/frontends/scanspool.in
@@ -1,5 +1,6 @@
 #! /usr/bin/perl -w
 # fixscript will replace this line with code to load INN::Config
+use strict;
 
 # @(#)scanspool.pl	1.20 4/6/92 00:47:35
 #
@@ -72,21 +73,25 @@
 
 # Data structures
 #
+my %gname2type;
 # $gname2type{$name}
 #    $name	- newsgroup name in foo.dot.form
 #    produces  => 4th active field  (y, n, x, ...)
 #		  alias type is "=", not "=foo.bar"
 #
+my %realgname;
 # $realgname{$name}
 #    $name      - newsgroup name in foo.dot.form
 #    produces  => newsgroup name in foo.dot.form
 #		  if type is =, this will be a.b, not $name
 #
+my %lowart;
 # $lowart{$name}
 #    $name      - newsgroup name in foo.dot.form
 #    produces  => lowest article allowed in the group
 #		  if type is =, this is not valid
 #
+my %highart;
 # $highart{$name}
 #    $name      - newsgroup name in foo.dot.form
 #    produces  => highest article allowed in the group
@@ -98,46 +103,38 @@
 #
 use Getopt::Std;
 
-use vars qw($opt_c);
-
-# setup non-buffered stdout and stderr
-#
-select(STDERR);
-$|=1;
-select(STDOUT);
-$|=1;
-
 # global constants
 #
-$prog = $0;			 	# our name
-$spool = "$INN::Config::patharticles";
-$active = "$INN::Config::active";
-$ctlinnd = "$INN::Config::pathbin/ctlinnd";
-$reason = "running scanspool";		# throttle reason
+my $prog = $0;                          # our name
+my $spool = "$INN::Config::patharticles";
+my $active = "$INN::Config::active";
+my $ctlinnd = "$INN::Config::pathbin/ctlinnd";
+my $reason = "running scanspool";       # throttle reason
 
 # parse args
 #
-getopts("a:s:vcn");
-$active = $opt_a if (defined($opt_a));
-$spool = $opt_s if (defined($opt_s));
+my %opt;
+getopts("a:s:vcn", \%opt);
+$active = $opt{'a'} if defined $opt{'a'};
+$spool = $opt{'s'} if defined $opt{'s'};
 
 # throttle innd unless -n
 #
-if (! defined($opt_n)) {
+if (! defined $opt{'n'}) {
     system("$ctlinnd throttle '$reason' >/dev/null 2>&1");
 }
 
 # process the active file
 #
-&parse_active($active);
+parse_active($active);
 
 # check the spool directory
 #
-&check_spool($spool);
+check_spool($spool);
 
 # unthrottle innd unless -n
 #
-if (! defined($opt_n)) {
+if (! defined $opt{'n'}) {
     system("$ctlinnd go '$reason' >/dev/null 2>&1");
 }
 
@@ -147,47 +144,47 @@ exit(0);
 
 # parse_active - parse the active file
 #
-# From the active file, fill out the @gname2type (type of newsgroup)
-# and @realgname (real/non-aliased name of group), @lowart & @highart
+# From the active file, fill out the %gname2type (type of newsgroup)
+# and %realgname (real/non-aliased name of group), %lowart & %highart
 # (low and high article numbers).  This routine will also check for
 # aliases to missing groups or groups that are also aliases.
 #
 sub parse_active
 {
-    local ($active) = $_[0];	# the name of the active file to use
-    local (*ACTIVE);		# active file handle
-    local ($line);		# active file line
-    local ($name);		# name of newsgroup
-    local ($low);		# low article number
-    local ($high);		# high article number
-    local ($type);		# type of newsgroup (4th active field)
-    local ($dir);		# directory path of group from $spool
-    local ($alias);		# realname of an aliased group
-    local ($linenum);		# active file line number
+    my ($active) = @_;  # the name of the active file to use
+    my $ACTIVE;         # active file handle
+    my $line;           # active file line
+    my $name;           # name of newsgroup
+    my $low;            # low article number
+    my $high;           # high article number
+    my $type;           # type of newsgroup (4th active field)
+    my $dir;            # directory path of group from $spool
+    my $alias;          # realname of an aliased group
+    my $linenum;        # active file line number
 
     # if verbose (-v), say what we are doing
-    print "\tscanning $active\n" if defined($opt_v);
+    print "\tscanning $active\n" if defined $opt{'v'};
 
     # open the active file
-    open (ACTIVE, $active) || &fatal(1, "cannot open $active");
+    open $ACTIVE, '<', $active || fatal(1, "cannot open $active");
 
     # parse each line
     $linenum = 0;
-    while ($line = <ACTIVE>) {
+    while ($line = <$ACTIVE>) {
 
 	# count the line
 	++$linenum;
 
 	# verify that we have a correct number of tokens
 	if ($line !~ /^\S+ 0*(\d+) 0*(\d+) \S+$/o) {
-	    &problem("WARNING: active line is mal-formed at line $linenum");
+	    problem("WARNING: active line is mal-formed at line $linenum");
 	    next;
 	}
 	($name, $high, $low, $type) = $line =~ /^(\S+) 0*(\d+) 0*(\d+) (\S+)$/o;
 
 	# watch for duplicate entries
-	if (defined($realgname{$name})) {
-	    &problem("WARNING: ignoring dup group: $name, at line $linenum");
+	if (defined $realgname{$name}) {
+	    problem("WARNING: ignoring dup group: $name, at line $linenum");
 	    next;
 	}
 
@@ -215,27 +212,28 @@ sub parse_active
     }
 
     # close the active file
-    close (ACTIVE);
+    close $ACTIVE;
 
     # be sure that any alias type is aliased to a real group
-    foreach $name (keys %realgname) {
+    foreach my $name (keys %realgname) {
 
 	# skip if not an alias type
 	next if $gname2type{$name} ne "=";
 
 	# be sure that the alias exists
 	$alias = $realgname{$name};
-	if (! defined($realgname{$alias})) {
-	    &problem("WARNING: alias for $name: $alias, is not a group");
+	if (! defined $realgname{$alias}) {
+	    problem("WARNING: alias for $name: $alias, is not a group");
 	    next;
 	}
 
 	# be sure that the alias is not an alias of something else
 	if ($gname2type{$alias} eq "=") {
-	    &problem("WARNING: alias for $name: $alias, is also an alias");
+	    problem("WARNING: alias for $name: $alias, is also an alias");
 	    next;
 	}
     }
+    return;
 }
 
 
@@ -245,15 +243,14 @@ sub parse_active
 # A final newline is appended to it.
 #
 # usage:
-#	&problem(arg, arg2, ...)
+#	problem(arg, arg2, ...)
 #
 sub problem
 {
-    local ($line);		# the line to write
-
     # print the line with the header and newline
-    $line = join(" ", @_);
+    my $line = join(" ", @_);
     print STDERR $line, "\n";
+    return;
 }
 
 
@@ -264,11 +261,11 @@ sub problem
 # to it.  This function exists with the code of exitval.
 #
 # usage:
-#	&fatal(exitval, arg, arg2, ...)
+#	fatal(exitval, arg, arg2, ...)
 #
 sub fatal
 {
-    local ($exitval) = $_[0];	# what to exit with
+    my ($exitval, @args) = @_;
 
     # firewall
     if ($#_ < 1) {
@@ -279,18 +276,17 @@ sub fatal
     }
 
     # print the error message
-    shift(@_);
-    $line = join(" ", @_);
+    my $line = join(" ", @args);
     print STDERR "$prog: ", $line, "\n";
 
     # unthrottle innd unless -n
     #
-    if (! defined($opt_n)) {
+    if (! defined $opt{'n'}) {
 	system("$ctlinnd go '$reason' >/dev/null 2>&1");
     }
 
     # exit
-    exit($exitval);
+    exit $exitval;
 }
 
 
@@ -306,38 +302,38 @@ sub fatal
 #
 sub check_spool
 {
-    local ($spooldir) = $_[0];	# top of article tree
-    local ($filename);		# article pathname under $spool
-    local ($artgrp);		# group of an article
-    local ($artnum);		# article number in a group
-    local ($prevgrp);		# previous different value of $artgrp
-    local ($preverrgrp);	# previous non-active $artgrp
-    local (*ARTICLE);		# article handle
-    local ($aline);		# header line from an article
-    local (@group);		# array of groups from the Newsgroup header
-    local ($j);
+    my ($spooldir) = @_;        # top of article tree
+    my $filename;               # article pathname under $spool
+    my $artgrp;                 # group of an article
+    my $artnum;                 # article number in a group
+    my $prevgrp;                # previous different value of $artgrp
+    my $preverrgrp;             # previous non-active $artgrp
+    my $ARTICLE;                # article handle
+    my $aline;                  # header line from an article
+    my @group;                  # array of groups from the Newsgroup header
+    my $FINDFILE;               # find command pipe handle
 
     # if verbose, say what we are doing
-    print "\tfinding articles under $spooldir\n" if defined($opt_v);
+    print "\tfinding articles under $spooldir\n" if defined $opt{'v'};
 
     # move to the $spool directory
-    chdir $spooldir || &fatal(2, "cannot chdir to $spool");
+    chdir $spooldir || fatal(2, "cannot chdir to $spool");
 
     # start finding files
     #
-    if (!open (FINDFILE,
-	  "find . \\( -type f -o -type l \\) -name '[0-9]*' -print 2>&1 |")) {
-	&fatal(3, "cannot start find in $spool");
+    if (!open $FINDFILE, '-|',
+	  "find . \\( -type f -o -type l \\) -name '[0-9]*' -print 2>&1") {
+	fatal(3, "cannot start find in $spool");
     }
 
     # process each history line
     #
-    while ($filename = <FINDFILE>) {
+    while ($filename = <$FINDFILE>) {
 
 	# if the line contains find:, assume it is a find error and print it
 	chop($filename);
 	if ($filename =~ /find:\s/o) {
-	    &problem("WARNING:", $filename);
+	    problem("WARNING:", $filename);
 	    next;
 	}
 
@@ -359,7 +355,7 @@ sub check_spool
 	$artgrp =~ s#/#.#go;
 
 	# if verbose (-v), then note if our group changed
-	if (defined($opt_v) && $artgrp ne $prevgrp) {
+	if (defined $opt{'v'} && $artgrp ne $prevgrp) {
 	    print "\t$artgrp\n";
 	    $prevgrp = $artgrp;
 	}
@@ -370,13 +366,13 @@ sub check_spool
 	# If we complained about this dgroup before, don't complain again.
 	# If verbose, note files that could be removed.
 	#
-	if (!defined($gname2type{$artgrp}) || $gname2type{$artgrp} =~ /[=jx]/o){
+	if (!defined $gname2type{$artgrp} || $gname2type{$artgrp} =~ /[=jx]/o){
 	    if ($preverrgrp ne $artgrp) {
-		&problem("$artgrp: not an active group directory");
+		problem("$artgrp: not an active group directory");
 		$preverrgrp = $artgrp;
 	    }
-	    if (defined($opt_v)) {
-		&problem("$filename: article found in non-active directory");
+	    if (defined $opt{'v'}) {
+		problem("$filename: article found in non-active directory");
 	    }
 	    next;
 	}
@@ -385,35 +381,35 @@ sub check_spool
 	$artnum = $filename;
 	$artnum =~ s#^.+/##o;
 	if ($artnum =~ m/^0/o) {
-	    &problem("$filename: article basename starts with a 0");
+	    problem("$filename: article basename starts with a 0");
 	}
-	if (defined($gname2type{$artgrp})) {
+	if (defined $gname2type{$artgrp}) {
 	    if ($lowart{$artgrp} > $highart{$artgrp}) {
-		&problem("$filename: active indicates group should be empty");
+		problem("$filename: active indicates group should be empty");
 	    } elsif ($artnum < $lowart{$artgrp}) {
-		&problem("$filename: article number is too low");
+		problem("$filename: article number is too low");
 	    } elsif ($artnum > $highart{$artgrp}) {
-		&problem("$filename: article number is too high");
+		problem("$filename: article number is too high");
 	    }
 	}
 
 	# if check filenames only (-c), then do nothing else with the file
-	next if (defined($opt_c));
+	next if (defined $opt{'c'});
 
 	# don't open a control or junk, they can be from anywhere
 	next if ($artgrp eq "control" || $artgrp eq "junk");
 
 	# try open the file
-	if (!open(ARTICLE, $filename)) {
+	if (!open $ARTICLE, '<', $filename) {
 
 	    # the find is now gone (expired?), give up on it
-	    &problem("WARNING: cannot open $filename");
+	    problem("WARNING: cannot open $filename");
 	    next;
 	}
 
 	# read until the Newsgroup header line is found
 	AREADLINE:
-	while ($aline = <ARTICLE>) {
+	while ($aline = <$ARTICLE>) {
 
 	    # catch the newsgroup: header
 	    if ($aline =~ /^Newsgroups:\w*\W/io) {
@@ -426,7 +422,7 @@ sub check_spool
 		@group = split(",", $aline);
 
 		# see if any groups in the Newsgroup list are our group
-		for ($j=0; $j <= $#group; ++$j) {
+		for (my $j=0; $j <= $#group; ++$j) {
 
 		    # look at the group
 		    if ($realgname{$group[$j]} eq $artgrp) {
@@ -436,25 +432,26 @@ sub check_spool
 		}
 
 		# no group or group alias was found
-		&problem("$filename: does not belong in $artgrp");
+		problem("$filename: does not belong in $artgrp");
 		last;
 
 	    # else watch for the end of the header
 	    } elsif ($aline =~ /^\s*$/o) {
 
 		# no Newsgroup: header found
-		&problem("WARNING: $filename: no Newsgroup header");
+		problem("WARNING: $filename: no Newsgroup header");
 		last;
 	    }
-	    if (eof(ARTICLE)) {
-		&problem("WARNING: $filename: EOF found while reading header");
+	    if (eof $ARTICLE) {
+		problem("WARNING: $filename: EOF found while reading header");
 	    }
 	}
 
 	# close the article
-	close(ARTICLE);
+	close $ARTICLE;
     }
 
     # all done with the find
-    close(FINDFILE);
+    close $FINDFILE;
+    return;
 }
diff --git a/innfeed/procbatch.in b/innfeed/procbatch.in
index c86a404..0664e26 100644
--- a/innfeed/procbatch.in
+++ b/innfeed/procbatch.in
@@ -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 @@ that is the same as innfeed's backlog file format.  Simply rename these files
 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 @@ while (<INPUT>) {
 		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) ;
-
-foreach $host (keys %hosts) {
-	close($hosts{$host});
-	$outputFile = "$destDir/$host.tmp" ;
-	$tmpTape = "$tapeDir/$host.tmp" ;
-	$tapeFile = "$tapeDir/$host" ;
-	if ( $opt_m ) {
+close $INPUT;
+
+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 );
diff --git a/scripts/innmail.in b/scripts/innmail.in
index 696da30..8683272 100644
--- a/scripts/innmail.in
+++ b/scripts/innmail.in
@@ -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 @@ if ($sm =~ m!%s!) {
     $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 @@ die "$0:  MTA excutable doesn't appear to exist:  $smarr[0]\n"
     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;
-- 
1.7.3.1

-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/x-pkcs7-signature
Size: 5557 bytes
Desc: not available
URL: <https://lists.isc.org/pipermail/inn-workers/attachments/20110701/45144aa9/attachment.bin>


More information about the inn-workers mailing list