#!/lang/perl -w
# replace.pl root [extension]

# BE VERY CAREFUL USING THIS PROGRAM!

# currently it DOES NOT BACKUP the files you are changing,
# so you might want to copy the whole `root' directory yourself
# before running this.  Don't put $root = C: or something by mistake!!
# It does ask you to confirm the operation after finding the files.

use strict;
use IO::File;

# parameters: from, to

my $from = <<End;
This is a
multi line
chunk of text
to replace.
End

my $to = <<End;
Here is the
replacement text.
End

# If you want to replace something shorter than a line, don't use the <<End
# syntax as that puts a newline on the end of the quoted text, just use
#   my $from = "some text";  my $to = "some other text";
# in that case.

# Should we get $from and $to from a different config file or files?
# If so, should that be a single perl file, or two separate text files?

my ($root, $extension) = @ARGV;
# $root is the directory which contains the files to be processed.  files
# in subdirectories will also be processed.  Or $root can be the pathname
# of a file, in which case just that file will be processed.

# if you don't want to type things on the command line, you can hard-code
# $root and $extension here.

# If you want to process just .html files, for example, you can have:
#     $extension = '.html'

if (!defined $root or ! -e $root) {
	die "you didn't not specify a root to find files\n";
}

$extension ||= "";
if ($extension ne "") {
	# put a dot at the start of it if not already
	$extension =~ /^\./ or
		$extension = ".$extension";
}

# get a list of files to work on
my @files = find_files($root, $extension);

# We ask the user to confirm that we are working on the right directory.
print @files." files found under $root\nProcess (y/n)? ";
my $confirm = <STDIN>;
if ($confirm !~ /^[yY]/) {
	print "not processing.\n";
	exit 0;
} else {
	print "processing...\n";
}

for my $file (@files) {
	print "  $file : ";		
	my $n = replace_in_file($file, $from, $to);
	print "$n\n";
}

exit 0;

sub find_files {
	my @roots = $_[0];
	my $extension = $_[1];
	my @files = ();
	while (@roots) {
		my $root = shift @roots;
		if (-f $root) {
			if ($root =~ /\Q$extension\E$/) {
				push @files, $root;
			}
		} elsif (-d $root and ! -l $root) {  # directory, but not symlink
			opendir DIRH, $root;
			my $file;
			while (defined ($file = readdir DIRH)) {
				next unless File::Spec->no_upwards($file);
				push @roots, File::Spec->catfile($root, $file);
			}
			closedir DIRH;
		}
	}
	return @files;
}

sub replace_in_file {
	my ($file, $from, $to) = @_;
	my $text = slurp($file);
	my $n = $text =~ s/\Q$from\E/$to/g;
	  # the \Q and \U mean to treat $from as plain text to match
	  # not a regexp pattern.  If you want $from to be a regexp pattern,
	  # remove the \Q and the \U
	belch($file, $text);
	return $n || 0;
}

sub slurp {
	my $f = IO::File->new($_[0]) or
		die "can't open file `$_[0]' to read: $!";
	return join '', <$f>;
}

sub belch {
	my $f = IO::File->new($_[0], "w") or
		die "can't open file `$_[0]' to write: $!";
	print $f $_[1] or
		die "can't write to `$_[0]': $!";
}