Alwanza Home Alwanza Bells and Whistles


#!/usr/bin/perl
#!C:\perl\bin

# this script has been modified for Windows
# textSubstitute.pl, textSub.pl textSu.pl
# by Meryll Larkin      return to Alwanza
# created 5/11/00    last revision: 3/2/02
# suggestions for improvement encouraged (I'm new at this)


# This perl script will:
# Substitute multiple instances of one string for another
# in files within a directory or nested directories
# provided the string is completely contained within
# a single line.
# This script is useful for changing email addresses,
# update or copyright dates in .html docs & similar
# It will ask for the path to the directory
# It will prompt user for error checks in multiple places
# It will allow for original text to contain regular expressions or not
# by user choice
# Make a status report for each directory &
# send the report to screen, file, or both, by user choice.

# to change revision date try regular expression, something like:
# rev\s\d+\s\w+\s\d+ this will match: rev 4 April 2000

# ********************************************************

use strict;
use Cwd;
use File::Copy;

{
# FLAGS
my $DETECT_ONLY;
my $SAVE_OLD_FILE;

# Variables
my $dirpath;
my @stringsToChange;
my @subdirectFound;
my $rh_subdirectDone;
my $logpath;
my @file;
my $file;
my $i;
my $divider = 0;
my (@originalString,@booRegex,@replacementString);
my $input;

$dirpath=cwd();
$divider+=9 if $dirpath =~ m|/|; # ix (Linux, Unix, 9)
$divider+=23 if $dirpath =~ m|\\|; # win
if (($dirpath =~ m|:|) &&
   ($dirpath !~ m|^\w+\:\\[^\:]+$|) && ($dirpath !~ m|^\w+\:/[^\:]+$|)) {
   $divider+=13; # mac
}
if (($divider == 22) || ($divider > 23)) {
   print "Invalid directory or file names\nQuitting";
   exit (0);
} else {
   $divider = "/" if $divider == 9; # ix (Linux, Unix, 9)
   $divider = "\\" if $divider == 23; # win
   $divider = ":" if $divider == 13; # mac
}

my $name = ucfirst($ENV{LOGNAME}); # doesn't work in Windows

print "\nHello $name\n";

print qq|

This script will detect multiple instances of one or many strings
inside files within a directory or nested directories.
You can choose to just detect the string or substitute
   one string for another.

You will be asked to provide:
   the path to the directory you wish to change
   the original text string(s) you wish to change
   and the new text string(s) you wish to substitute in place
   of the original text

You will also be informed of subdirectories found nested within
   your directory, and asked if you want to make the
   same changes to the files within those directories. |;

&query_proceed;
$DETECT_ONLY = &detect_or_alter;
$SAVE_OLD_FILE = &backup_oldfile if (!$DETECT_ONLY);
$dirpath = &get_first_dirpath;
$dirpath = &verify_and_goto_dirpath($dirpath);

unless (opendir( CHANGEME, $dirpath )){
   print "\nCan't open $dirpath. Do you wish to rewrite? (y or n) ";
    $input = <STDIN>;
    $input = &validate_intgr_input($input);
    &continue_or_quit($input);
    $dirpath = &get_first_dirpath;
}

closedir CHANGEME;

@stringsToChange = &get_strings($dirpath, $DETECT_ONLY);

foreach my $ra_set(@stringsToChange) {
   my ($originalString,$booRegex,$replacementString) = @$ra_set;
   print "\nIn directory $dirpath, you are about to change the ";
   print "following original text:\n\n";
   print "   $originalString\n   to this:\n";
   print "   $replacementString\n";
}

&query_proceed;

my $printLog = &where_print_log;

if (( $printLog eq "F" ) || ($printLog eq "B" )) {
   # detect & correct for existing status report
   # there will be one status report for the entire job
   my $logpath2 = cwd() . $divider . "ChangeLog_old.txt";
   $logpath = cwd() . $divider . "ChangeLog.txt";
   if ( -e $logpath ) {
      rename ($logpath, $logpath2) || die "can't rename $logpath $!";
   }
}

# begin @subdirectToDo with first $dirpath

unshift (my @subdirectToDo,$dirpath);
# commented out for Windows
# chmod(0775, $dirpath) or die "Can't modify ".
# "permissions on directory $dirpath: $!\n";

while ( defined $dirpath ) {   # extracted from $subdirectToDo
   &verify_and_goto_dirpath($dirpath);
   unless (opendir( CHANGEME, $dirpath )){
      print "\nCan't open $dirpath. Do you wish to rewrite? (y or n) ";
      $input = <STDIN>;
      $input = &validate_intgr_input($input);
      &continue_or_quit($input);
      $dirpath = &get_first_dirpath;
   }
   # find all directory contents OTHER than those that begin in .
   my @dirContents = grep !/^\./, readdir(CHANGEME);

   # separate the files from the subdirectories
   my ($ra_file, @subdirectFound)=&populate_files_dirs($printLog, $logpath, $divider, $dirpath, @dirContents);

   # determine which files contain strings
   my %filesToCopyChange=&examine_files($printLog, $logpath, $ra_file, $DETECT_ONLY, @stringsToChange);

   if ($SAVE_OLD_FILE) {
      &make_backup_copy($printLog, $logpath, %filesToCopyChange);
   }
   unless ($DETECT_ONLY) {
      &write_new_data_to_file(%filesToCopyChange);
   }

   # all files in dir have been processed
   # empty file array so that it is ready for next dir
   @file = [];
   shift @file;
   pop @subdirectToDo;
   # are there additional subdirectories?
   if (! @subdirectFound ) {
      my $statusString = "No subdirectories were detected in\n   $dirpath.";
      &print_status($printLog, $statusString, $logpath);
   } else {
      my $statusString = "\nSubdirectories were detected inside   \n$dirpath";
      &print_status($printLog, $statusString, $logpath);
      $input = -2; # initialize for data validation
      while($input == -2) {
         print "\nWould you like to make exactly the same changes\n in " .
         "any of the subdirectories? (y or n) ";
         $input = <STDIN>;
         $input = &validate_intgr_input($input);
         if ($input == 1 ) {
            my @subdirectToAdd = &add_moredir($printLog, $logpath, @subdirectFound);
            @subdirectToDo = (@subdirectToDo, @subdirectToAdd);
         }
      } # END while $input == -2
   } # END if/else @subdirectFound
   # compile an array of completed directories for
   # navigation purposes in &select_nextdir
   ${$rh_subdirectDone}->{$dirpath} = 1;
   if (@subdirectToDo) {
         ($dirpath, @subdirectToDo) = &select_nextdir($rh_subdirectDone, @subdirectToDo);
         ${$rh_subdirectDone}->{$dirpath} = 0;
   } else {
      $dirpath = '';
      print "Job completed. Quitting.\n\n";
      print "The log of changes/detection is here: $logpath.\n\n";
      closedir ( CHANGEME );
      exit (0);
   }
} # End while ( defined $dirpath )

print "Job completed. Quitting.\n\n";
print "The log of changes/detection is here: $logpath.\n\n";

closedir ( CHANGEME );

exit (0);

}

#********************************************************

sub query_proceed {
   print "\n\nDo you wish to proceed? (y or n) ";
   my$input = <STDIN>;
   $input = &validate_intgr_input($input);
   &query_proceed if $input == -2;
   &continue_or_quit($input);
}

#*****************************************

sub validate_intgr_input {
   my $input = shift;
   $input =~ s/\s*$//; # remove trailing spaces
   $input =~ s/^\s*//; # remove leading spaces
   $input = uc(substr($input, 0, 1));
   if (( $input ne "Y" ) && ( $input ne "N" )) {
         print "\n$input is not a valid answer.\n";
         print "Do you wish to continue? (y or n) ";
         $input = <STDIN>;
         $input = &validate_intgr_input($input);
         &continue_or_quit($input);
         return (-2);
   } else {
      # $input is now either "Y" or "N"
      $input = ($input eq "Y" ) ? 1 : 0;
      return ($input);
   }
}

#*****************************************

sub continue_or_quit {
   my $continue = shift;
   if ( $continue == 0 ) {
      print "Quitting per user request.\n";
      exit (0);
   }
   return 1;
}

#*****************************************

sub detect_or_alter {
   print "\nWould you prefer that the string be\n   detected ";
   print "and reported only\n   without making any changes? (y or n) ";
   my $DETECT_ONLY = <STDIN>;
   $DETECT_ONLY = &validate_intgr_input($DETECT_ONLY);
   &detect_or_alter if $DETECT_ONLY == -2;
   return $DETECT_ONLY;
}

#*****************************************

sub backup_oldfile {
   print "\nFor all files, do you wish to have old data saved\n";
   print "   in a back-up file? (y or n) ";
   my $SAVE_OLD_FILE = <STDIN>;
   $SAVE_OLD_FILE = &validate_intgr_input($SAVE_OLD_FILE);
   &backup_oldfile if $SAVE_OLD_FILE == -2;
   return $SAVE_OLD_FILE;
}

#*****************************************

sub get_first_dirpath {
   print "\nWrite the full path for the directory to be examined:\n";
   chomp(my $dir = <STDIN>);    # remove "enter"
   if ( $dir !~ /\w/ ) {
         &get_first_dirpath;
    }
   return $dir;
}

#*****************************************

sub verify_and_goto_dirpath {
   my ($dir) = @_;
   my $dircurrent = cwd();
   my $datagood;
   TRYAGAIN:
   unless (( chdir $dir ) || ( $dircurrent eq $dir )) {
      print "\nCan't move into $dir $!\n\n";
      print "Try again, and follow this format:\n    $dircurrent\n\n";
      $dir = &get_first_dirpath;
      goto TRYAGAIN;
   }
   if ( $dircurrent ne $dir ) {
      print "\nIs this the directory you want?\n    $dir (y or n) ";
      $datagood = <STDIN>;
      $datagood = &validate_intgr_input($datagood);
      if ( $datagood != 1 ) {
         $dir = &get_first_dirpath;
      } else {
         $dir = cwd();
      }
   }
   return $dir;
}

#*****************************************

sub get_strings {
   my ($dir, $DETECTONLY) = @_;
   my $datagood = "Y";
   my @stringsToChange;
   my @stringData;
   my $ra_stringData;
   my $fixedText;
   while (1) {
      print "\nProvide one original string that you wish to detect:\n";
      chomp(my $orgText = <STDIN>);    # remove "enter"
      print "\nDoes this string contain specialized characters " .
      "that you wish to\n";
      print "treat as \"regular expressions\"? (y or n, default = n) ";
      my $booRegex = <STDIN>;
      $booRegex = &validate_intgr_input($booRegex);
      # Y = 1, everything else = 0
      unless ($DETECTONLY) {
         print "\nProvide the corrected text that you wish to " .
         "substitute for $orgText:\n";
         chomp($fixedText = <STDIN> );   # remove "enter"
      } else {
         print "\n\nYou have selected the DETECT ONLY option\n";
         print "Your substitute text will be the same as original text.\n";
         $fixedText = $orgText;
      }
      print "\nPlease confirm you want to change the " .
      "following original text:\n\n";
      print "$orgText\n" .
      "    to this:\n    $fixedText\n         in directory:\n";
      print "$dir.\n\n";
      print "Is this substitution correct? (y or n) ";
      $datagood = <STDIN>;
      $datagood = &validate_intgr_input($datagood);
      if ( $datagood != 1 ) {
         print "\nDiscarding bad data\n";
      } else {
         my $ra_changeItem = [$orgText, $booRegex, $fixedText];
         push (@stringData, $ra_changeItem);
      }
      print "\nWould you like to make another " .
         "text substitution? (y or n) ";
      my $moretext = <STDIN>;
      $moretext = &validate_intgr_input($moretext);
      last if $moretext == 0;
   }
   return @stringData;
}

#*****************************************

sub where_print_log {
   print "\nWould you like to print the status report\n";
   print "to the monitor (m), to a file (f), or both (b) ? ";
   my $printLog = uc(substr(<STDIN>, 0, 1));
   unless ( $printLog =~ /^[MFB]$/) {
      print "Please select m, f, or b\n";
      &where_print_log;
   }
   return $printLog;
}

#*****************************************

sub populate_files_dirs {
   my ($printLog, $logpath, $divider, $dirpath, @dirContents) = @_;
   my @file;
   my @subdirectFound;
   my $statusString;
   foreach my $dirContent ( @dirContents ) {
      #do not include ChangeLogs in file array for string detection
      if ( $dirContent =~ /ChangeLog/) {
      }
      elsif ((-s $dirContent) || (-d $dirContent)){
         if (-d $dirContent) {
            $dirContent = cwd() . $divider . $dirContent;
            push(@subdirectFound, $dirContent);
         } else {
            # $file[$#file + 1] = $dirContent;
            push(@file, $dirContent);
         }
      } else {
         $statusString = "-s (nonzero size) test failed $dirContent\n";
         &print_status($printLog, $statusString, $logpath);
      }
   }
   if ( !@file ) {
         $statusString = "No files were detected inside directory\n   $dirpath";
         &print_status($printLog, $statusString, $logpath);
   } else {
         $statusString = "\nThe results for directory $dirpath:\n";
         &print_status($printLog, $statusString, $logpath);
   }
   my $ra_file = \@file;
   return $ra_file, @subdirectFound;
}

#*****************************************

sub examine_files {
   my ($printLog, $logpath, $ra_file, $DETECT_ONLY, @stringsToChange) = @_;
   my @originalString;
   my %filesToCopyChange;
   foreach my $ra_set(@stringsToChange) {
      my ($originalStrg,$boRegex,$replacementStrg) = @$ra_set;
      push (@originalString,$originalStrg);
   }
   foreach my $file ( @{$ra_file} ) {
         my $rh_stringDetected;
         my @dataLine;
      ($rh_stringDetected, @dataLine)=
            &detect_string($printLog, $logpath, $file, @stringsToChange);
      foreach my $originalString(@originalString) {
         if (not defined ${$rh_stringDetected}->{$originalString} ) {
            my $statusString = "Unable to detect string \"";
            $statusString .= $originalString;
            $statusString .= "\" inside file $file.";
            &print_status($printLog, $statusString, $logpath);
         } else {
            unless ($DETECT_ONLY) {
              $filesToCopyChange{$file} = \@dataLine;
            } # END unless ($DETECT_ONLY)
         } # END else/if (not defined ${$rh_stringDetected}->{$originalString}
      } # END foreach my $originalString(@originalString) {
   } # END foreach my $file ( @{$ra_file} ) {
   return %filesToCopyChange;
}

#*****************************************

sub make_backup_copy {
   my ($printLog, $logpath, %filesToCopyChange) = @_;
   my $oldfile;
   for my $ra_copyfile (keys %filesToCopyChange) {
      #deconstruct file name into name and extension
      if ($ra_copyfile =~ /^(\w+)\.(\w+)$/) {
         # name oldfile to hold original data
         $oldfile = $1 . "_old." . $2;
         # test to make sure file doesn't already exist
         $oldfile = $1 . ".bkup" if ( -e $oldfile );
      } else { # filename does not follow standard format
            # name oldfile to hold original data
            $oldfile = "$ra_copyfile" . "_old";
            # test to make sure file doesn't already exist
            $oldfile = "$ra_copyfile" . "_oldbkup" if ( -e $oldfile );
      }
      if ( -e $oldfile ) {
         my $statusString = "Can't copy " . $ra_copyfile .$2. " to $oldfile ";
         $statusString .= "because $oldfile already exists.\n";
         print "Quitting.\n";
         &print_status($printLog, $statusString, $logpath);
         exit (0);
      }
    copy ($ra_copyfile, $oldfile);
   }
   return 1;
}

#*****************************************

sub write_new_data_to_file {
   my %filesToCopyChange = @_;
   for my $ra_copyfile (keys %filesToCopyChange) {
      # make temporary file to hold corrected data
      my $newfile = "temp" . $ra_copyfile;
      $newfile = "tempest" . $ra_copyfile if ( -e $newfile );
      open ( NEWFILE, ">>$newfile" ) or die "Can't open " .
         "NEWFILE/$newfile\n";
         # commented out for Windows
         # chmod(0775, $newfile) or die "Can't " .
         # "modify permissions on new file $newfile: $!\n";
      for my $line (@{$filesToCopyChange{$ra_copyfile}}) {
          print NEWFILE "$line\n";
      }
      close ( NEWFILE );    # close files before copying them!!!!!
      #put corrected text into original filename
      rename ($newfile, $ra_copyfile) || die "can't rename $newfile $!";
      delete $filesToCopyChange{$ra_copyfile};
   } # END for $ra_file (keys %filesToCopyChange)
   return 1;
}

#*****************************************

sub detect_string {
   my ($printLog, $logpath, $file, @stringsToChange) = @_;
   my $rh_stringDetected;
   my @dataLine;
   my $j; # string count for each string needing detection
   # commented out for Windows
   # chmod(0775, $file) or die "Can't " .
   # "modify permissions on file $file: $!\n";
   open(INPUT, $file) or die "Can't open $file\n";
   my $i = 0; # initialize a line count for file contents
   # goes through file line by line
   # at each line, search for each string in @stringsToChange
   while (<INPUT>) {
      $j = 0; # string count for each string needing detection
      $dataLine[$i] = $_; #make a line by line array of the file contents
      chomp($dataLine[$i]);
      $dataLine[$i] =~ s/\^M//;   # delete DOS carriage return characters
      $dataLine[$i] =~ s/\r//;    # delete DOS carriage return characters
      for (0..$#stringsToChange) {
         my $originalString = $stringsToChange[$_]->[0];
         my $booRegex = $stringsToChange[$_]->[1];
         my $replacementString = $stringsToChange[$_]->[2];
         my (@originalString,@booRegex,@replacementString);
         $originalString[$j] = $originalString;
         $booRegex[$j] = $booRegex;
         $replacementString[$j] = $replacementString;
         if ($dataLine[$i] =~ /$originalString[$j]/){ #detect original string
            my $swapData = $dataLine[$i];
            # substitute new string for original string
            # did user indicate that string contains regular expression?
            if (! $booRegex[$j]) {
               # the \Q and \E make this a string match ignoring regex
               $swapData =~ s/\Q$originalString[$j]\E/$replacementString[$j]/g;
            } else {
               $originalString[$j] =~ s|^/||; # remove leading /
               $originalString[$j] =~ s|/$||; # remove trailing /
               $swapData =~ s/$originalString[$j]/$replacementString[$j]/g;
            } # END if ! booRegex[$j]
            $dataLine[$i] = $swapData;
            ${$rh_stringDetected}->{$originalString} = $file;
            my $statusString = "\"$originalString\" has been detected in file ";
            $statusString .= "\"$file\", line number " . ($i + 1);
            &print_status($printLog, $statusString, $logpath);
         } # END if $dataLine
         $j++; # advance to detect next string
      } # END foreach $ra_set
      $i++; # advance line count for next line in file
   } # END while <INPUT>
   close ( INPUT);
   return ($rh_stringDetected, @dataLine);
}

#*****************************************

sub add_moredir {
   my ($printLog, $logpath, @subdirectFound) = @_;
   my @subdirectToAdd;
   print "\nWhich subdirectories would you like to include?\n";
   print "Write y or n after each:\n";
   foreach my $subdirectFound ( @subdirectFound ) {
      my $statusString = "    subdirectory found: $subdirectFound";
      print "\n$statusString\n" if $printLog eq "F";
      &print_status($printLog, $statusString, $logpath);

      my $includeSub = <STDIN>;
      $includeSub = &validate_intgr_input($includeSub);
      if ( $includeSub == 1 ) {
         $statusString= "\nFiles will be examined in " .
          "subdirectory:\n   $subdirectFound\n";
         print "\n$statusString\n" if $printLog eq "F";
         &print_status($printLog, $statusString, $logpath);
         push(@subdirectToAdd, $subdirectFound);
      }
      redo if $includeSub == -2;
   } # END foreach my $subdirectFound ( @subdirectFound )
   return @subdirectToAdd;
}

#*****************************************

sub select_nextdir {
   my ($rh_subdirectDone, @subdirectToDo) = @_;
   my $dir_old = cwd();
   my $dircurrent;
   my $nextSub;
   # navigate to children, grandchildren, before aunts
   for my $subdirect(reverse(@subdirectToDo)) {
      if (( defined $subdirect) &&
         ((not defined ${$rh_subdirectDone}->{$subdirect}) ||
         (${$rh_subdirectDone}->{$subdirect} == 0 ))) {
         print "\nThe next subdirectory selected for examination is\n";
         print $subdirect . "\n";
         print "Shall we proceed? (y or n) ";
         $nextSub = $subdirect;
         my $input = <STDIN>;
         $input = &validate_intgr_input($input);
         last if ($input == 1);
         # this removes the current $subdirect being examined
         pop @subdirectToDo if ($input == 0);
      }
   }
   opendir(CHANGEME, $nextSub) || die "Can\'t change into $nextSub, $!";
   unless ( chdir $nextSub) {
      print "\nCan\'t change into $nextSub, $!";
   }
   $dircurrent = cwd();
   if ($dircurrent eq $dir_old) {
      print "\nData transfer error\nQuitting\n";
      print "$dircurrent = $dircurrent\ndir_old = $dir_old\n";
      exit (0);
   }
   closedir (CHANGEME);
   return ($dircurrent, @subdirectToDo);
}

#*****************************************

sub print_status {
   my ($printLog, $statusString, $logpath) = @_;
   if (( $printLog eq "B" ) || ($printLog eq "F")) {
      open ( STATFILE, ">>$logpath" ) or die "Can't open $logpath $!";
      print STATFILE "$statusString\n";
      close STATFILE;
   }
   if (( $printLog eq "B" ) || ($printLog eq "M")) {
      print "$statusString\n";
   }
   return 1;
}

#************************ END