#!/usr/bin/perl

$timestamp = "Time-stamp: <Mon, 13 Sep 1999, 14:25:33 PDT  tilo>";
$timestamp =~ s/.+: <(\d+) (\w+) (\d+) ([0-9:]+) (\w+)>/$1 $2 $3  $4  by $5/;

####################################################################################################
#
#  PERL program for query search replace of strings in multiple files
#
#  Copyright by Tilo Sloboda,  created 08 June 94 
#
#  License:
#         Freely available under the terms of the OpenSource "Artistic License"
#         in combination with the Addendum A (below)
# 
#         In case you did not get a copy of the license along with the software, 
#         it is also available at:   http://www.unixgods.org/~tilo/replace_string/ 
#
#  Addendum A: 
#         THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU!
#         SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
#         REPAIR OR CORRECTION. 
#
#         IN NO EVENT WILL THE COPYRIGHT HOLDERS  BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, 
#         SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY 
#         TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED 
#         INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM 
#         TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF THE COPYRIGHT HOLDERS OR OTHER PARTY HAS BEEN
#         ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
#
#
#  USAGE: run without parameters, or see message in subroutine "show_parameters" below.
#
#  NOTE:  this script was written as a quick-fix back in 1994, using perl4, and has "grown" 
#         since then.. 
#         I would not consider it to be an example for good perl5 programming style!
#         In other words: I really need to re-write it sometime
#
#== RCS INFO: =============================================================================
#
# $Id: replace_string,v 1.10 2001/05/27 19:35:10 tilo Exp $
#
# $Log: replace_string,v $
# Revision 1.10  2001/05/27 19:35:10  tilo
# some minor changes. Changed Copyright notice to OpenSource Artistic License
#
# Revision 1.9  2000/01/04 02:22:40  tilo
# added option -del to remove lines, which would be empty after a substitution.
# default is to NOT delete such lines!
#
# Revision 1.8  1996/01/18  19:06:54  sloboda
# introduced paragraph input mode (option -p)
#
# Revision 1.7  1995/05/18  10:02:12  sloboda
# removed minor bug
#
# Revision 1.6  1995/05/16  12:47:20  sloboda
# new option -d which duplicates and renames a line matching the given reg-exp.
# all substitutions are then applied to the new renamed line only.
#
# Revision 1.5  1995/03/04  18:17:14  sloboda
# replacements may only affect lines matching a regular expression (see option '-m')
# removed minor bug: permissions of output files are as of the orignial files
# added acouple of error messages
#
# Revision 1.4  1995/01/11  17:14:15  sloboda
# comments (lines starting with ; or with #) and empty lines are now
# ignored when reading in the substitution list.
#
# Revision 1.3  1994/12/02  02:31:12  sloboda
# fixed serious bug -- the last char in the last line of a file was chopped off
# if the file wasn't terminated by a newline character...
#
# Revision 1.2  1994/11/27  17:16:21  sloboda
# Added some sanity checks: non-plain files (such as named pipes, sockets, directories)
# and non-writable files and files with size zero will be ommitted from the file list!
#
# Revision 1.1  1994/11/20  05:10:02  sloboda
# removed minor bug
#
# Revision 1.0  1994/11/20  01:13:31  sloboda
# this revision can handle multiples search/replace rules
# for each line in each file.
#
# Revision 0.3  1994/11/20  01:07:15  sloboda
# this was the first version which was released.
# it could handle only one substitution for each line.
#
####################################################################################################
require "flush.pl";

$revision        = '$Revision: 1.10 $';
$revision        =~ tr/$//d;
$revision        =~ s/Revision: (\d+.\d+)/$1/;


$iamroot    = ($> == 0);        # is the script run by root?
$do_query   = 1;
$do_backups = 1;
$bak        = 'bak';            # suffix for backups (without dot)
$verbose    = 0;
$show_rules = 1;
$paragraph_mode = 0;
$old_format = 0;
$delete_empty_lines = 0;        # delete lines which get replaced to nothing? 

#---------------------------------------------------------------------------------------------------
# Usage message:
#
if ($#ARGV == -1) {
  &show_parameters("default");

  die "
 ... bye bye ...\n"   if !&y_or_n("\n  do you want to proceed with these default values? ");
 }
else {
 &process_options();
}
#---------------------------------------------------------------------------------------------------
#
$verbose = 1    if $do_query;
$show_rules = 1 if $verbose;

if ($old_format) {
  $search_replace = "s/$oldstr/$newstr/g";
  
  print "
============================================================

  IMPORTANT:
  
    You used   -o $oldstr -n $newstr   on the commandline
    The -o and -n options will become obsolete soon. 

    Please use   -s $search_replace   in the future!

============================================================

"
}

#---------------------------------------------------------------------------------------------------
#
warn "\n >>> WARNING: you are running '$0' as ROOT!\n     UIDs, GIDs and modes will be preserved!\n\n" if $iamroot;

$SIG{"INT"} = 'interrupt_handler';   # install an interrupt handler in case the user hits CTRL-C

#---------------------------------------------------------------------------------------------------
#
if (defined $subslist) {
   print "\nreading file with substitution rules \"$subslist\"\n\n" if $show_rules;

   open(F, "< $subslist") || die " >>> ERROR: can not open substitution list!\n";
   while(<F>) {
     next if /^;/;                              ### ignore this line if it is a comment
     next if /^#/;                              ### ignore this line if it is a comment
     next if /^\s*$/;                           ### ignore this line if it is empty
     s/\n$//;                                   ### chop off CR if there's any
     $substitutions[++$#substitutions] = $_;
     print "   $_\n" if $show_rules;
   }
   close(F);
}
else {
  $substitutions[++$#substitutions] = $search_replace;
  print "   $search_replace\n" if $show_rules;
}
print "\n" if $show_rules;

#---------------------------------------------------------------------------------------------------
#
if (defined $filelist) {
   open(F, "< $filelist") || die " >>> ERROR: can not open file list!\n";
   while(<F>) {
     s/\n$//;                                   ### instead of chop
     $files[++$#files] = $_;
   }
   close(F);
}
#---------------------------------------------------------------------------------------------------
# Don't process any named pipes, sockets or directories
#
### print "\n\n @files\n";
{
   local($i)=0;
   local(@new) = @files;
   local($old,$reason);
   foreach $file (@files) {

#     print "\n\n@new\n";

     if    (! -e $file) {
        $reason =  "file does not exist!";
     }
     elsif (-d $file) {
        $reason =  "this is a directory!";
     }
     elsif (-l $file) {
        $reason =  "this is a symbolic link!";
     }
     elsif (-p $file) {
        $reason =  "this is a named pipe!";
     }
     elsif (-S $file) {
        $reason =  "this is a socket!";
     }
     elsif (-z $file) {
        $reason =  "file has zero size!";
     }
     elsif (! -w $file) {
        $reason =  "file is write protected!";
     }
     elsif (! -f $file) {
        $reason =  "this is not a plain file!";
     }
#     elsif (-f $file) {
#        $reason =  "this is a plain file!\n";
#     }

     if ((! -f $file) || (! -w $file) || (-z $file)) {
        $old = splice(@new,$i,1);
        printf(" >>> WARNING: %-26s - omitting \"$old\"\n", $reason);
        next;
     } 
     else {
        $i++;
     }
   }
  @files = @new;
}
### print "\n\n ==> @files\n";
print "\n"  if ($verbose);
#---------------------------------------------------------------------------------------------------

$tempfile = "/tmp/__tmp_$$_file";   ## unique name for the temp file
$newstr = '"'.$newstr.'"';
$file_nr = 0;

foreach $file (@files) {
  local($temp_touched) = 0;
  local(@stats,$org_mode,$org_uid,$org_gid); ## we need this to keep track of the original file permissions
  
  $file_nr++;
  
  open(FILE,  "< $file")        || die " >>> ERROR: can not open file $file for reading!\n";
  open(NEW,   "> $tempfile")    || die " >>> ERROR: can not open temporary file $tempfile for writing!\n";

  $quit        = 0;             ## stop processing this file?        (after user typed 'q')
  $replace_all = 0;             ## start to replace all occurences?  (after user typed '!')
  @stats = stat(FILE);          ## we need this to keep track of the original file permissions
  $org_mode = $stats[2];
  $org_uid  = $stats[4];
  $org_gid  = $stats[5];
  @commands = ();               ## commands for copying files (for the -mcf option)
  
  print "\n########################################\n" if $verbose;
  print "file $file_nr: \"$file\"\n";
  print "########################################\n\n" if $verbose;

  if ($paragraph_mode) { # multi-line matching and paragraph input mode if requested
   $/ = "\n\n"; 
   $* = 1;
}
  
  $line_nr = 1;
  while(<FILE>) {
    local($subs) = 0;

    s/\n$//;            ### instead of chop
    $line = $_;

    if(defined $copy_line) {          ## if we defined a regexp with '-d' to copy a line
       print NEW "$line\n";             ## first print the "original" or non-matching line
       $line_nr++;
       
       if (! eval $copy_line) {       ## if we can rename this line (eg. in UTT-files)
          next;                         ## process the next line...
       }
    } elsif(defined $do_match) {      ## if we defined a regexp with '-m'
       if ($line !~ $do_match) {        ## ignore all lines which do not match the given reg-exp!!
          print NEW "$line\n";          ## and directly write them to the output file
          $line_nr++;
          next;                         ## process the next line...
       }
    } elsif(defined $do_not_match) {  ## if we defined a regexp with '-nm'
       if ($line =~ $do_not_match) {    ## ignore all lines which do match the given reg-exp!
          print NEW "$line\n";          ## and directly write them to the output file
          $line_nr++;
          next;                         ## process the next line...
       }
    }

    foreach $search_replace (@substitutions) {
      $subs += eval $search_replace;    # apply this substitution rule
      warn " >>> ERROR:  $@     DURING EVALUATION OF \'$search_replace\'\n\n" if $@;
    }
    
    if ($subs) {
       if ($do_query) {
          printf("line %4d : \"%s\"\n", $line_nr, $line);
          print  "        ==> \"$_\"\n";
          print"\n  ($subs substitutions) ";

          if ($replace_all || &ask_user('  substitute? ',*replace_all,*quit)) {
             $line = $_;
             $temp_touched = 1;
             print "  substituted!\n\n";
          }
          else {
             print "  not modified!\n\n";
          }
       }
       else {
          printf("substituted line %4d : \"%s\"\n", $line_nr, $line) if ($verbose);
          printf("(%3d substitutions) to: \"$_\"\n\n", $subs)       if ($verbose);
          $line = $_;
          $temp_touched = 1;
       }
    }
    last if $quit;              ## stop processing this file if user typed 'Q'uit
    
    ## omit to print an empty line, if it was replaced to an empty line
    ## but we want to keep empty lines in the original file, if they are un-touched.

    if ($delete_empty_lines) {
        print NEW "$line\n" if ((!$subs) || ($line ne ""));
    } else {
        print NEW "$line\n";
    }    
    $line_nr++;
  }
  close(FILE);
  close(NEW);

  if ($temp_touched && !$quit) {                        ### if we changed anything and user didn't interrupt
    print "file \"$file\" was modified!\n\n";
    system("cp -p $file $file.$bak") if ($do_backups);  ###   make a backup of the original file if requested
    system("mv $tempfile $file");                       ###   and replace the original file by the modified one
    chmod($org_mode, $file);                            ###   keep permissions as of the original file
    chown($org_uid,$org_gid, $file) if $iamroot;        ###        and keep owner and group id if running as root
    if ($do_backups) {                                  ###   if we do backups:
       chmod($org_mode, "$file.$bak");                     ###   keep permissions as of the original file
       chown($org_uid,$org_gid, "$file.$bak") if $iamroot; ###        and keep owner and group id if running as root
    }
  }
  else {
    print "file \"$file\" not modified!\n\n";
  }
  system("rm -f $tempfile");
}
print "  processed $file_nr files\n";


####################################################################################################
#
#   S U B R O U T I N E S : 
#
####################################################################################################

#===================================================================================================
# SUBROUTINE  find unique filename for backup
#
sub find_filename {
    local ($name) = @_;
    while (-e $name) {
      ($a,$b) = split(/;/,$name);
      $b = 'auto' if ($b eq '');
    }
}

#===================================================================================================
# SUBROUTINE  yes_or_no prompting routine :  (CR is NO)
#
sub y_or_n {
    local ($prompt) = @_;
    $/ = "\n" if $paragraph_mode;
    print STDOUT "$prompt (y/n) ";
    local ($answer) = scalar(<STDIN>);
    chomp $answer;
    
    $/ = "\n\n" if $paragraph_mode;
    return ($answer =~ /^y/i) ;                                  ## returns BOOLEAN
}

#===================================================================================================
# SUBROUTINE  enhanced yes or no prompting routine :   yY is YES , nN or CR is NO , ! is ALL further occurances
#
sub ask_user{
    local ($prompt,*all,*quit) = @_;
    $/ = "\n" if $paragraph_mode;
    print STDOUT "$prompt (y/n/!/q) ";
    local ($answer) = scalar(<STDIN>);
    chomp $answer;
    $answer =~ tr/A-Z/a-z/;             ## lowercase the answer

    if ($answer =~ '!') {              ## e.g. replace all further occurances in this file
       $all = 1;
       $quit= 0;
       $answer = 'y';
    } elsif ($answer =~ 'q') {         ## e.g. stop processing this file and keep it untouched
       $all = 0;
       $quit= 1;
       $answer = 'n';
    }

    $/ = "\n\n" if $paragraph_mode;

#   print "answer = '$answer'\n";

    return ( $answer =~ /y/i ) ;                                  ## returns BOOLEAN
}

#===================================================================================================
# SUBROUTINE  INTERRUPT HANDLER (in case the user hits CTRL-C)
#
sub interrupt_handler {
    if (&y_or_n("\n >>> USER INTERRUPT: do you really want to quit?")) {
       system("rm -f $tempfile");
       die "\n\n ... I just cleaned up ... poof! now I'm dead!\n\n";
    }
    $SIG{"INT"} = 'interrupt_handler';   # RE-INSTALL the interrupt handler, the user might want to hit CTRL-C again!!
}

#===================================================================================================
# SUBROUTINE  show parameters : (the output should be 80 characters wide)
#
sub show_parameters
{
   local($note) = @_;

  print "                                         
     Copyright by  Tilo Sloboda <sloboda\@cs.cmu.edu>
                   Tilo Sloboda <tilo\@unixgods.org>

     Freely distributable under the terms of the Open Source Artistic License.
     Homepage:   http://www.unixgods.org/~tilo/replace_string/
     
                     created    :   8 Jun 94  by  Tilo Sloboda
                     last edited:  $timestamp
                     revision   :  $revision

     with this PERL program you can query-search-replace multiple strings in multiple files.

     USAGE:  replace_string {options} -f filenames
             replace_string {options} -F filename

     OPTIONS:

       -s    str   substitution in PERL format (eg.: s/aha/haha/g)
       -S    str   alternatively you can provide a file
                   containing PERL search/replace expressions.
                   This way you can do multiple search/replaces
                   (see the note below).
       
       -f    str   one or more space separarted filenames            ($note: files)
                   this has to be the last option!
       -F    str   alternatively you can provide a file 
                   containing the list of files to be processed

       -v          verbose                                           ($note: quiet)
       -b    str   suffix for backup files                           ($note: '$bak')
       -nb         don't create backup files                         ($note: create backups)
       -nr         don't print out the substitution rules            ($note: print)
       -nq         don't query, replace without asking               ($note: query)

       -p          paragraph mode (multi-line matching)
       
       -m    str   only replace lines matching the given reg-exp     ($note: all lines)
                   keeps all other lines untouched.
       -nm   str   only replace lines NOT matching the given reg-exp ($note: all lines)
                   keeps all other lines untouched.
         
       -del        delete lines which are empty after replace operations ($note: no)
          
       -d    str   first duplicates lines matching the given         ($note: no)
                   PERL search/replace command (eg.: s/^machine:/LM_line:/ )
                   then applies all given substitutions (by -s -S options)
                   to the new line. (-d has preceedence over -m option)

       -mcf        modify filenames and copy files.                  ($note: no)
                   Each match of reg-exp is considered as a filename 
                   which is in another directory. Additional to the 
                   search/replace operation, the referenced file will 
                   be copied into the same directory as the file which 
                   is referencing it.

     NOTES: - The matching is done case-sensitive!
            - you can use regular expressions (PERL style, see \"man perl\")
            - If you want to do multiple search/replace operations on each line
              of each file, keep in mind that the substitutions are carried out
              in the same order as in the file you provide with the -S option.
            - a file will not be processed, if
              it is not a plain file or a write protected file or has size zero.
            - UIDs and GIDs are preserved if replace_string is run by ROOT

     QUERY-MODE:
              The user will be asked for every match if it should be replaced 
              (unless you use the '-nq' option). When asked, the user can answer 
              'n' for no, 'y' for yes, '!' for all further occurences in this 
              file, and 'q' for quit processing this file (proceed with the next 
              file).
              
"
}
#===================================================================================================
# SUBROUTINE  Process the Options:
#
sub process_options {

    $args = @ARGV;
    $arg_error = 0;     # FALSE

    while (@ARGV) {
      
      if ($ARGV[0] eq '-o') {
        shift(@ARGV);
        $oldstr = $ARGV[0];
        $old_format = 1;
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-n') {
        shift(@ARGV);
        $newstr = $ARGV[0];
        $old_format = 1;
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-s') {
        shift(@ARGV);
        $search_replace = $ARGV[0];
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-nb') {
        shift(@ARGV);
        $do_backups = 0;
      }
      elsif ($ARGV[0] eq '-del') {
        shift(@ARGV);
        $delete_empty_lines = 1;         # do delete lines which are empty after all substitutions
      }
      elsif ($ARGV[0] eq '-mcf') {
        shift(@ARGV);
        $modify_filenames = 1;           # consider the given regexp's as filenames...
      }
      elsif ($ARGV[0] eq '-m') {
        shift(@ARGV);
        $do_match = $ARGV[0];            # read the regular expression
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-nm') {
        shift(@ARGV);
        $do_not_match = $ARGV[0];        # read the regular expression
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-d') {
        shift(@ARGV);
        $copy_line = $ARGV[0];           # read the search/replace regular expression
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-b') {
        shift(@ARGV);
        $bak = $ARGV[0];
        $bak =~ s/^\.//;                 # remove initial point, if any
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-p') {
        shift(@ARGV);
        $paragraph_mode = 1;
      }
      elsif ($ARGV[0] eq '-v') {
        shift(@ARGV);
        $verbose = 1;
      }
      elsif ($ARGV[0] eq '-nr') {
        shift(@ARGV);
        $show_rules = 0;
      }
      elsif ($ARGV[0] eq '-nq') {
        shift(@ARGV);
        $do_query = 0;
      }
      elsif ($ARGV[0] eq '-F') {
        shift(@ARGV);
        $filelist = $ARGV[0];           # read the name of the file with the filelist
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-S') {
        shift(@ARGV);
        $subslist = $ARGV[0];           # read the name of the file with the substitutions
        shift(@ARGV);
      }
      elsif ($ARGV[0] eq '-f') {
        shift(@ARGV);
        @files = @ARGV;
        $#ARGV = -1;
      }
      else {
        $arg_error = 1;    # TRUE
        warn "
     ... unknown option $ARGV[0] ...
    \n";
        shift(@ARGV);      # remove the bogus option
      }
     };

    if ($arg_error) {
      &show_parameters("set to");
        die "
     ... dying due to unknown options (as listed above) ...
    \n"
    }
}

####################################################################################################