#!/usr/bin/perl
#
# NAME
#   subst - replace strings in file.
#
# SYNOPSIS
#   subst 's/pat/rpl/opts' file...
#
# DESCRIPTION
#   This program takes a perl pattern and scans thru the files for it.   When
#   it  is  found,  the file is "edited" so that all instances of the pattern
#   pat are replaced by the string rpl.  The editing is done "in place", by
#   copying  the  text  over to a /tmp/ file, and if any matches succeed, the
#   /tmp/ file is copied back to the original file.  This method is like  ed,
#   and  works  for  multiply-linked files.  It also doesn't touch files that
#   don't contain the pattern, so make still  works  properly.   At  present,
#   there  is  no provision for making a backup copy, but it'd be easy enough
#   to do if needed.
#
# OPTIONS
#
#   -v<N> or +v<N>
#     Sets the verbose level to <N>.  The default is 1, which shows the names
#     of the modified files.  At level 2, you see the changed lines, too.
#
#   -w
#     Reduce white space.   Trailing  whitespace  is  replaced  by  a  single
#     newline.   Multiple blank lines are reduced to a single blank line, and
#     all trailing blank lines are dropped.
#
# DEBUGGING
#   In  addition  to  the perl debugger, we have a verbose option, via any of
#   the V_Rp, T_Rp or D_Rp environment variables, or a -V or +V  command-line
#   option.   The  value  is  a  simple  integer  which controls our level of
#   verbosity.
#
# BUGS
#   I haven't yet figured out how to make $1 and the rest work in the rpl.
#
# AUTHOR
#   John Chambers <jc@trillian.mit.edu>

$| = 1;
($me = $0) =~ s'.*/'';
$T = $ENV{'TMPDIR'} || '/tmp';
#U = "Usage: $me pattern replacement [filename]...\n";
$V = $ENV{"V_$me"} || $ENV{"T_$me"} || $ENV{"D_$me"} || 1;
$W = 0;		# Strip white space?

# Check out the name we were called with:
#
$p1 = $p2 = '';
#r1 = $r2 = '';
if ($me eq 'Crp') {			# Crp matches function calls.
	$p1 = '(\b)';
	$p2 = '\s*(\()';
#	$r2 = '(';
} elsif ($me eq 'Vrp') {	# Vrp matches variables.
	$p1 = '\b';
	$p2 = '\b';
} elsif ($me eq 'Frp') {	# Frp matches fields.
	$p1 = '([>.])';
	$p2 = '\b';
#	$r1 = '$1';
}
$, = ' ';

for $f (@ARGV) {
	if ($f =~ /^[-+]v(\d*)/i) {
		if ($1 ne '') {$V = $1} else {$V++}
	} elsif ($f =~ /^-w/i) {
		++$W;
	} elsif ($f ne '') {
		if (!$op) {
			$op = $f;
			print "$me: op='$op'\n" if $V>2;
			next;
		}
		print "File : $f\n" if $V>2;
		if (open(F,"<$f")) {
			$t = "$T/fr_$$";
			if (open(T,">$t")) {
				$B = $M = 0;	# Number of blank lines and modifications.
				while (<F>) {
					$l = $_;
					eval($op);
					if ($l ne $_) {
						print if $V>1;
						++$M;
					}
					if ($W) {	# Strip white stuff?
						s"\s*$"\n";
						if ($_ eq "\n") {
							++$B;	# Count the blank lines.
							print "$B blanks.\n" if $V>2;
						} else {
							print T "\n" if $B > 0;
							++ $M if $B > 1;	# Blank-line deletion is a mod.
							print T;
							$B = 0;	# Forget the blank lines.
						}
					} else {	# Don't strip.
						print T;
					}
				}
				close(F);
				close(T);
				if ($M || $B) {
					print "=====>	$f\n" if $V>0;
					system "cp $t $f"; 
				}
				system "rm $t";
			} else {
				printf STDERR "Can't write \"$t\"\n";
			}
		} else {
			printf STDERR "Can't read \"$f\"\n";
		}
	}
}
system "rm -f $T/fr_$$";