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: [email protected] (Rich Salz)
#Subject: C News subst (also used by INN) in perl
Message-ID: <[email protected]>
Sender: [email protected] (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);