#!/usr/bin/perl 
#
# NAME
#   Rp - replace strings in file.
#
# SYNOPSIS
#   Rp pat rpl 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.
#
# NAMES
#   Note some special cases, based on the name that we're called by:
#
#     Crp matches only function calls, i.e., /\b$pat\s*\(/.
#
#     Frp matches C fields, i.e., variables preceded by '.' or \->'.
#
#     Vrp matches "variables", i.e., /\b$pat\b/
#
#   If called by any other name will merely replace $pat with $rpl globally.
#
# 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 (!$pat) {
			$pat = $f;
			print "$me: pat='$pat'\n" if $V>2;
			next;
		}
		if (!$rpl) {
			$rpl = $f;
			print "$me: rpl='$rpl'\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 ($l = <F>) {
					if ($l =~ s"$p1$pat$p2"$1$rpl$2"g) {
						print $l if $V>1;
						++$M;
					}
					if ($W) {	# Strip white stuff?
						$l =~ s"\s*$"\n";
						if ($l 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 $l;
							$B = 0;	# Forget the blank lines.
						}
					} else {	# Don't strip.
						print T $l;
					}
				}
				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_$$";