news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!swrinde!sdd.hp.com!think.com!paperboy.osf.org!rsalz Mon Jan 25 23:21:54 CST 1993
Article: 528 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:528
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!swrinde!sdd.hp.com!think.com!paperboy.osf.org!rsalz
From: rsalz@osf.org (Rich Salz)
#Subject: C News subst (also used by INN) in perl
Message-ID: <1993Jan20.163336.24509@osf.org>
Sender: news@osf.org (USENET News System)
Organization: Open Software Foundation
Date: Wed, 20 Jan 1993 16:33:36 GMT
Lines: 138

If you've built C News or INN you've run subst.  subst takes a file
of key/value pairs:
	FOO	3
	BAR	5
and uses it to modify a list of files:
	# =()<@<FOO>@ + @<BAR>@>()=
	4 + 6
if you then run "subst -f keyfile samplefile" you'll get
	# =()<@<FOO>@ + @<BAR>@>()=
	3 + 5
kinda neat.  See C News or INN for the manpage.

here it is in perl.

# /usr/bin/perl --
##  A Perl version of subst.

%substitutions = ();

##  Read substutitions file, filling in the %substitutions array.
sub
read_substitutions
{
    local ($file) = @_;
    local ($bad, $value, $text);

    open(FH, $file)
	|| die "cannot open $file $!, stopped";
    $bad = 0;
    %substitutions = ();
    config: while ( <FH> ) {
	chop;
	next config if /^#/ || /^$/;

	unless ( ($value, $text) = /([^\t]+)\t+(.*)/ ) {
	    $bad++;
	    print "Bad line in $file:\n\t$_\n";
	    next config;
	}

	$text =~ s/\\(.)/\1/g;
	$substitutions{$value} = $text;
    }

    close(FH)
	|| die "cannot close $file $!, stopped";
    exit(1)
	if $bad;
}


##  Process one already-opened file.
sub
process
{
    local (*IN, *NEW, $f, $new, $old) = @_;
    local ($bad, $count, $changed, $line, $copy);

    $bad = 0;
    $count = 0;
    line: while ( <IN> ) {
	$count++;
	print NEW;
	chop;
	next line if ! /=\(\)<(.*)>\(\)=/;

	$text = $1;
	$copy = $text;
	chop($line = <IN>);
	if ( eof ) {
	    warn "$f ends permaturely, adding line\n"
	    $line = $text;
	}
	$count++;
	while ( $text =~ /(.*)@<([\w]*)>@(.*)/ ) {
	    if ( ! defined($substitutions{$2}) ) {
		$bad = 1;
		print $f, ":", $count, ": bad line --", $copy;
		print NEW $copy, "\n";
		next line;
	    }
	    $text = $1 . $substitutions{$2} . $3;
	}
	print NEW $text, "\n";
	$changed = 1 if $text ne $line;
    }
    if ( !close(NEW) ) {
	warn "cannot close $new $!\n";
	$bad = 1;
    }
    if ( $bad || !$changed ) {
	unlink $old, $new;
	print $f, ": unchanged\n";
    }
    else {
	rename($f, $old)
	    || die "cannot rename $f to $old $!, stopped";
	rename($new, $f)
	    || die "cannot rename $new to $f $!, stopped";
	unlink $old;
	print $f, ": updated\n";
    }
    $bad;
}

##  Parse "-f substitutions" arguments.
die "No -f flag, stopped"
    if $ARGV[0] ne "-f";
shift;
$file = shift
    || die 'No filename specified after "-f", stopped';
&read_substitutions($file);

##  Process each file.
$| = 1;
$status = 0;
file: foreach $f ( @ARGV ) {
    if ( !open(IN, $f) ) {
	print "cannot open ", $f, " ", $!, "\n";
	next file;
    }
    $dir = ( $f =~ m@(.+)/.+@ ) ? "$1/" : "";
    $old = $dir . "substtmp.old";
    die "$old exists, cannot proceed\n"
	if -f $old;
    die "cannot create temporary $old $!\n"
	unless open(OLD, ">$old") && close(OLD) && unlink $old;
    $new = $dir . "substtmp.new";
    die "$new exists, cannot proceed\n"
	if -f $new;
    open(NEW, ">$new")
	||  die "cannot create temporary $new $!\n";
    $status = 1
	if &process(*IN, *NEW, $f, $new, $old);
    close(IN);
}
exit($status);