Xref: utzoo news.software.b:3537 comp.sources.d:4385
Path: utzoo!utstat!jarvis.csri.toronto.edu!mailrus!ames!vsi1!daver!tscs!ateng!chip
From: chip@ateng.com (Chip Salzenberg)
Newsgroups: news.software.b,comp.sources.d
Subject: C News "upact" in Perl 3.0
Message-ID: <2565B57C.10978@ateng.com>
Date: 18 Nov 89 20:03:08 GMT
Organization: A T Engineering, Tampa, FL
Lines: 151

The C News "expire" program doesn't update the third (min) field of the
active file.  The authors of C News consider this field a hack.  However,
they do provide a separate shell script, "upact", that updates the min
field according to the actual contents of the spool directory.  While the
distributed upact works, it's _very_ slow.

Enter Perl 3.0.  This wondrous language now includes opendir, readdir and
closedir.  Since I just got Perl 3.0 running on my system, I figured I
should check out its new features.

The result:  A upact script written in Perl 3.0.  It's not exactly a work
of art, but it's a lot faster than the shell script.  On my system, a 20MHz
'386 running SCO Xenix/386, it processes my 495-line active file in one
minute and twenty seconds of real time.

Shar and enjoy.

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  upact
# Wrapped by chip@ateng on Sat Nov 18 14:59:21 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'upact' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'upact'\"
else
echo shar: Extracting \"'upact'\" \(2393 characters\)
sed "s/^X//" >'upact' <<'END_OF_FILE'
Xeval 'exec /bin/perl -S $0 ${1+"$@"}'
X	if $running_under_some_shell;
X$prog = $0;
X
X# Update 3rd field (minimum art. #) of a 4-field active file.
X
X$config = "/usr/lib/news/bin/config" unless $config = $ENV{'NEWSCONFIG'};
Xopen(config) || die "can't open $config: $!";
Xwhile (<config>) {
X	if (/^(NEWS[A-Z]+)=\${\1-(.*)}/) {
X		$var = $1;
X		$value = $2 unless $value = $ENV{$var};
X		$NEWSCTL    = $value if $var eq "NEWSCTL";
X		$NEWSBIN    = $value if $var eq "NEWSBIN";
X		$NEWSARTS   = $value if $var eq "NEWSARTS";
X		$NEWSPATH   = $value if $var eq "NEWSPATH";
X		$NEWSUMASK  = $value if $var eq "NEWSUMASK";
X		$NEWSMASTER = $value if $var eq "NEWSMASTER";
X		$NEWSCONFIG = $value if $var eq "NEWSCONFIG";
X	}
X}
Xclose(config);
X
X$ENV{'PATH'} = "$NEWSCTL/bin:$NEWSBIN/expire:$NEWSBIN:$NEWSPATH";
Xumask($NEWSUMASK);
X
Xchdir($NEWSCTL) || die "$prog: can't chdir to $NEWSCTL: $!";
X
Xopen(active, "active") || die "can't open active: $!";
X$_ = <active>;
Xchop;
Xclose(active);
X@F = split(/[ \t]+/);
Xdie "$prog: active file has other than 4 fields" unless $#F == 3;
X
X# lock news system
X$lock = "$NEWSCTL/LOCK";
X$ltemp = "$NEWSCTL/L.$$";
Xopen(ltemp,">$ltemp");
Xprint ltemp "$$\n";
Xclose(ltemp);
X
X@KILL = ($ltemp);
X
X$SIG{'HUP'} = 'gotsig';
X$SIG{'INT'} = 'gotsig';
X$SIG{'TERM'} = 'gotsig';
X
Xsub gotsig {
X	local ($sig) = @_;
X	do leave("got SIG$sig\n");
X}
X
Xsub leave {
X	local (@MSG) = @_;
X	print stderr @MSG if ($#MSG >= 0);
X	unlink(@KILL);
X	exit(0);
X}
X
Xwhile (1) {
X	if (link($ltemp, $lock)) {
X		push(@KILL, $lock);
X		last;
X	}
X	sleep 30;
X}
X
Xopen(active, "active") || do leave("can't open active: $!");
Xopen(newactive, ">active.new") || do leave("can't create active.new: $!");
X
Xwhile (<active>) {
X	chop;
X	($group, $max, $min, $fourth) = split(/[ \t]+/);
X	($dir = $group) =~ y#.#/#;
X	$newsdir = "$NEWSARTS/$dir";
X	$min = (-d $newsdir) ? (do dirlow($newsdir)) : "";
X	$min = $max + 1 unless $min;
X	printf newactive "%s %010d %010d %s\n", $group, $max, $min, $fourth;
X}
X
Xclose(active);
Xclose(newactive);
X
X# replace active, carefully
X
Xunlink "active.old";
Xrename("active", "active.old");
Xrename("active.new", "active");
X
Xdo leave();
X
X# find the lowest file number in the directory.
X
Xsub dirlow {
X	local ($dir) = @_;
X	local ($low, $f);
X
X	opendir(dir,$dir) || return "";
X	$low = "";
X	while ($f = readdir(dir)) {
X		next unless $f =~ /^[0-9]+$/;
X		$low = $f if ($low eq "") || ($f < $low);
X	}
X	closedir(dir);
X	return $low;
X}
END_OF_FILE
if test 2393 -ne `wc -c <'upact'`; then
    echo shar: \"'upact'\" unpacked with wrong size!
fi
# end of 'upact'
fi
echo shar: End of shell archive.
exit 0
-- 
You may redistribute this article only to those who may freely do likewise.
Chip Salzenberg at A T Engineering;  <chip@ateng.com> or <uunet!ateng!chip>
    "Did I ever tell you the Jim Gladding story about the binoculars?"