#!/usr/local/bin/perl

# this program can be used as a "convenient" template for any single
# line transformation. Go to text marked by #BB

chop($prog = `basename $0`);    # get program name, usually "xform"

$Usage = <<EOQ;

$prog: Perl script to transform records from: 

100169 BACHMAN,JOY-I                  1 5 10/28/88 6 12/30/85 10/28/88 1
to:
100169 Bachman,Joy-I                  1 5 10/28/88 6 12/30/85 10/28/88 1

Usage:

$prog [-help] [-ext<.ext>] [-back<.ext>] [-f] [-d] file1 file2 ...

	-help:		Print out this info.
	-ext<.ext>: 	Place output in file1.ext (default: file1.out).
	-back<.ext>: 	Overwrite file and backup to file1.ext, etc.
	-grep: 		Print only (transformed) lines that match pattern
	-d: 		Debug mode (prints both old and new records).
	-bb: 		Make BareBones script ${prog}_bb
	-f: 		Write all output to standard output.

	Use "-" as filename to indicate file is from standard input.

Default behavior:

	file1 -> file1.out
	file2 -> file2.out
	etc...

Examples:

	$prog file1			(output placed in "file1.out")

	$prog -ext.new file1		(output placed in "file1.new")

	$prog -back.oldie file1 file2	(output placed in "file1" with
					 backup to "file1.oldie")

	$prog -f file1 | more		(output piped to "more")

	cat file1 file2  | $prog -	(input from stdin, output to, e.g., 
					 \"$prog-$$.out\")

EOQ

$overwrite = '';	# Initialize these switches to "False"
$stdout = '';
$debug = '';
$grep = '';

			# Process command line arguments...

LOOP:
while (@ARGV) {
	$_ = shift;
	CASE: {
		/^-h/ && ( (&help), exit 0, last CASE);
		/^-bb$/ && ( (&barebones), exit 0, last CASE);
		/^-f$/ && ( $stdout = 'True', last CASE);
		/^-d/ && ( $debug = 'True', last CASE);
		/^-grep/ && ( $grep = 'True', last CASE);
		/^-back(\S*)$/ && ( $overwrite = "T$1", last CASE);
		/^-ext(\S*)$/ && ( $ext = "$1", last CASE);
		/^-.+/ && ( (print STDERR 
			    "\n$prog: $_ not an option! try: $prog -help\n\n"),
			    exit 1, last CASE);
		unshift(ARGV,$_);		# must be filename, put back..
		last LOOP;
	}
}

			# Fix backup/overwrite situation

if ( $overwrite =~ /^T(\S+)/ ) {
	$backup = "$1";
} elsif ( $overwrite =~ /^T$/ ) {
	$backup = ".bak";		# used only if $overwrite set.
}

if ( ! $ext ) {				# default extension
	$ext = '.out';
}

			# Loop over input files:

foreach $file (@ARGV) {
				# Read in whole file into array @FILE:

	open(FILE, "$file") || die "Couldn't open $file";
	@FILE = <FILE>;
	close(FILE);

				# Get output file ready:
	if ( $stdout ) {
		$out = "-";
	} elsif ( $overwrite && $file ne "-" ) {	# Backup unless stdin
		if ( $backup eq "" ) { $backup = ".bak"; } 
		system "cp $file $file$backup";
		if ( ! -f "$file$backup" ) {
			print STDERR "Error in making $file$backup, skipping "; 
			print STDERR "$file\n"; 
			$out = "";
			next;
		} else {
			$out = "$file";			# Gulp!
		}
	} else {
		if ( $file eq "-" ) {
			$out = "$prog-$$$ext";		# input is in stdin
		} else {				# so use made up name
			$out = "$file$ext";
		}
	}
	open(OUT, ">$out") || die "Couldn't open $out for writing";

				# OK, FINALLY process the text!!!

	foreach (@FILE) {	# loop over lines of input file saved in @FILE

#		if ( /^\d+\s+\w(.*)[,\/]\s*\w(.*)-\w\S*\s/ ) {
#		if ( /^\d+\s+\w(.*),\w(.*)-\w\s/ ) {
# Place your transformation below:
#BB
		if ( /^\d+\s+\w(.*)[,\/]\s*\w(.*)-\w\S*\s/ ) {
			$x1 = "$1";
			$x2 = "$2";
			$x1 =~ tr/A-Z/a-z/;	
			$x2 =~ tr/A-Z/a-z/;	
			print "$_" if $debug;
			$_ =~ s/$1/$x1/;
			$_ =~ s/$2/$x2/;
		}
#BB
				# print to OUT, whatever that may be...
		print OUT "$_" unless $grep;
	}

	close(OUT);
}

exit 0;

sub help {		# Subroutine to write out Usage message.

        if ( open(MORE, "|more") ) {    # open pipeline to "more"
                print MORE "$Usage";	# just in case more than one page.
                close(MORE);
        } else {
                print STDERR "$Usage";	# hmmm, no "more" I guess.
        }
}

sub barebones {		# Subroutine to make barebones version of
			# this program

        open(PROG, "$0") || die "can't open $0";	# open this file
	$print = '';
	open(PROG_BB, ">${prog}_bb") || die "can't open ${prog}_bb";

	print PROG_BB <<'EOQ';
#!/usr/local/bin/perl
# Barebones script for pattern substitution
# Program takes list of filenames to be processed, and writes
# everything to standard output

while (<>) {
EOQ
	while (<PROG>) { 
		if ( ! $print && /^#BB/ ) {
			$print = 'True';
		} elsif ( $print && /^#BB/ ) {
			$print = '';
		}
		if ( ! /^#BB/ ) {
			print PROG_BB "$_" if $print;
		}
	}

	print PROG_BB <<'EOQ';
		print "$_";
}

exit 0;

EOQ

	close(PROG_BB);
	chmod(0755, "${prog}_bb");
	close(PROG_BB);
	print STDERR "\nMade script: ${prog}_bb\n\n";

}

__END__

# Data and Misc junk below here...


# Old pattern match Code:


		#      1       2   3    4    5    6
		if ( /(\d+\s+)(\w)(\w*)(,\w)(\w*)(.*)/ ) {
			$x3 = "$3";
			$x5 = "$5";
			$x3 =~ tr/A-Z/a-z/;	
			$x5 =~ tr/A-Z/a-z/;	
			print "$_";	# more debug
			print STDOUT "3: $x3\n" if $debug;
			print STDOUT "5: $x5\n" if $debug;
			$_ = "$1"."$2"."$x3"."$4"."$x5"."$6"."\n";
		}