#!/usr/bin/perl -w
# Hierarchical string substitution
# $Id: hsed,v 1.6 2000/01/19 22:29:01 earl Exp $

# Copyright (c) 1998 by Earl A. Killian.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published
# by the Free Software Foundation version 2.
#
# This file is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this file; see the file COPYING.  If not, write to the
# Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

package hsed;

use strict;
use Getopt::Long;
use FileHandle;

$::myname = 'hsed';		# for error messages

use vars qw($diff $verbose $update %exclude $excludepat);

# walktree(function, path)
# if path is a file, call function with that filename
# if path is a directory, call function on all files contained in that
# directory hierarchy
sub walktree {
  my ($function, $path) = @_;
  if (   $exclude{$path}
      || (defined($excludepat) && $path =~ /$excludepat/o)) {
    # ignore file or directory
  } elsif (-l $path) {
    # ignore links
  } elsif (-f $path) {
    &$function ($path);
  } elsif (-d $path) {
    opendir (D, $path)
      || die("$::myname: Error: $!, opening directory '$_'.\n");
    my @dir = grep($_ ne '.' && $_ ne '..', readdir(D));
    closedir (D);
    my $e;
    foreach $e (@dir) {
      walktree ($function, $path . '/' . $e);
    }
  } else {
    print STDERR ("$::myname: Warning: '$path' is not a file, link, or directory.\n");
  }
}

# hsed(filename)
# perform substitutions to filename
sub hsed {
  my ($f) = @_;
  open (I, "<$f")
    || die("$::myname: Error: $!, opening '$f'.\n");
  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = stat I;
  my $fnew = $f . '.new';
  open (O, ">$fnew")
    || die("$::myname: Error: $!, creating '$fnew'.\n");
  my $nsubst = &hsed::subst();
  close (I);
  close (O);
  chmod ($mode, $fnew) == 1
      || die("$::myname: Error: $!, chmod ".sprintf("%o",$mode)." $fnew.\n");
    
  if ($nsubst == 0) {
    unlink ($fnew)
      || print STDERR ("$::myname: Warning: $!, deleting '$fnew'.\n");
  } else {
    print STDOUT ($nsubst, " substitutions in ", $f, "\n")
	if $verbose;
    if ($diff) {
      print STDOUT ("diff $f $f.new\n");
      system ('diff', $f, $f.'.new');
    }
    if ($update) {
      my $fold = $f . '.old';
      rename ($f, $fold)
	|| print STDERR ("$::myname: Error: $!, renaming '$f' to '$fold'.\n");
      rename ($fnew, $f)
	|| print STDERR ("$::myname: Error: $!, renaming '$fnew' to '$f'.\n");
    } else {
      unlink ($fnew)
	  || print STDERR ("$::myname: Warning: $!, deleting '$fnew'.\n");
    }
  }
}

# readsubst(filename)
# read substitution commands from filename and return
sub readsubst {
  my ($file) = @_;
  open (F, "<$file")
    || die("$::myname: Error: $!, opening '$file'.\n");
  my @lines = grep(!/^\s*\#/, <F>);
  close (F);
  @lines;
}

# Top-level code
{
  # command line
  my @subst = ();
  my @substfile = ();
  $diff = 1;
  $verbose = 1;
  $update = 1;
  my @exclude = ();
  if (!(&GetOptions("f=s@" => \@substfile,
		    "e=s@" => \@subst,
		    "diff!" => \$diff,
		    "v!" => \$verbose,
		    "update!" => \$update,
		    "exclude=s@" => \@exclude,
		    "expat=s" => \$excludepat)
	&& $#ARGV >= 0)) {
    print STDERR ("Usage is: $::myname options... dirorfile...\n");
    print STDERR ("    when directories are specifed, they are processed recursively\n");
    print STDERR ("    options:\n");
    print STDERR ("\t-e subst\tperl substitution command (s/from/to/flags)\n");
    print STDERR ("\t-f file\t\tdo substitutions in file\n"); 
    print STDERR ("\t-[no]diff\trun diff on all changed files\n"); 
    print STDERR ("\t-[no]v\t\tprint out changed files\n"); 
    print STDERR ("\t-[no]update\tdon't actually update the files\n"); 
    print STDERR ("\t-e and -f may be specified multiple times\n");
    exit (1);
  }

  # convert excludes to hash
  %exclude = ();
  foreach (@exclude) {
    $exclude{$_} = 1;
  }

  # read substitution files
  my $substfile;
  foreach $substfile (@substfile) {
    push (@subst, readsubst($substfile));
  }

  # create substitution function
  my $sedfile = "/tmp/hsed$$.pl";
  open (S, ">$sedfile")
    || die("$::myname: Error: $!, creating '$sedfile'.\n");
  print S ("sub hsed::subst {\n");
  print S ("  my \$nsubst = 0;\n");
  print S ("  while (<I>) {\n");
  my $subst;
  foreach $subst (@subst) {
    chomp ($subst);
    print S ("    \$nsubst += ", $subst, ";\n");
  }
  print S ("    print O \$_;\n");
  print S ("  }\n");
  print S ("  \$nsubst;\n");
  print S ("}\n");
  print S ("1;\n");
  close (S);

  require ($sedfile);
  unlink ($sedfile)
    || print STDERR ("$::myname: Warning: $!, deleting '$sedfile'.\n");

  if ($diff || $verbose) {
    STDOUT->autoflush(1);	# make sure our output intermixes cleanly
  				# diff output
  }

  # process the files and directories
  my $f;
  foreach $f (@ARGV) {
    walktree (\&hsed, $f);
  }
}

# 
# Local Variables:
# mode:perl
# perl-indent-level:2
# cperl-indent-level:2
# End: