{
# repl_char_in_filenames_via_rename   WJS Jul 15
#   Run through the default directory or the directory tree descending from the default
# directory looking for files with a particular character in the file name.  If such a file 
# is found, a new file name is constructed with a user-supplied character replacing the first 
# occurrence of the particular character.  The old file is renamed to the new name.
#   The program does NOT follow symbolic links

# NB: if used to traverse a directory tree, the program must be invoked with a full
# (absolute) file spec; eg, perl -w /home/somebody/my_copy_of_program.pl.  Typing
# perl -w mycopy_of_program.pl will fail with "file not found" when working on directories
# other than /home/somebody
#
#   In this version of the program the character to be replaced is hard-coded to #
#   Input is 1 arg; either a single character or the string "hex=NN", where each N
# is a hex digit, with NN representing the desired character.
# There is also an optional switch, -d, to ask that the whole directory tree be scanned
#   Summary output is sent to stderr
#   Program will rename plain files and directory files; exit (with "die" status else)
#   Program will exit (with "die" status) if renaming would destroy an existing file.  It exits with a 
# status of 1 if no renames were performed .  Otherwise, it has "standard" exit statuses
#     "die" status if the program argument does not parse
#     "die" status for "system" problems like failure to open or failure to rename
#     0 if, against all odds, things worked

#   Use cwd perl package rather than `pwd` because pwd doesn't necessarily exist (definitely
#   doesn't exist on Windows 7)
  use Cwd;

  $FALSE = 0;
  $TRUE = ! $FALSE;
  
  $char_to_repl = '#';
  $qm_char_to_repl = quotemeta($char_to_repl);
  
#   Need an absolute file spec for the program.  Hopefully specs like ~ will
#   work in the context in which this program runs ... if a user types such things.
  $program_file = $0;
#   If you know how to make an abs spec from a relative spec, put code in here.
#   My unix attempt to distinguish abs from relative failed on a Windows box
  $program_invokation = join ' ',"perl","-w",$program_file,@ARGV;
  
  foreach (@ARGV) {
    if ($_ eq "-d") {
      (defined $directory_tree_scan) && die "-d spec'd more than once";
      $directory_tree_scan = $TRUE;
    } else {
      (defined $arg) && die "Too many arguments on command line";
      $arg = $_;
      ($hexarg) = ($arg =~ /^hex=(.+)/);
      if ($hexarg) {  
        (length($hexarg) == 1)  &&  ($hexarg = '0' . $hexarg);
        (length($hexarg) > 2) && die "Hex input arg longer than 2 chars";
        ($char1,$char2) = ($hexarg =~/(.)(.)/);
        ($char1 =~ /[0123456789abcdefABCDEF]/) || die "Illegal hex input digit";
        ((defined $char2) && ($char2 ne "") && ($char2 =~ /[0123456789abcdefABCDEF]/)) || 
                die "Illegal hex input digit";
        $repl_char = chr(16*$char1 + $char2);
      } else {
        (length($arg) == 1) || die ("Input string empty or > 1 char");
        $repl_char = $arg;
      }
    }
  }
  defined($arg) || die "Need an input character";
  $directory_tree_scan = defined ($directory_tree_scan);

#   Use default directory for ease in recursively traversing directory tree
  $dir = cwd();
  (opendir DIR,$dir) || die "Could not open directory $dir.  \$!=$!";
  $nfiles = $nrenames = 0;
  while ($file = readdir DIR) {
    $nfiles++;
#     Very nice infinite loop if you descend recursively from ..
    ($file eq '..') && next;
#     Duplicate processing if you process .
    ($file eq '.') && next;
#     Turns out that perl "file type" list is NOT mutually exclusive.  In particular, a symbolic
#     link to a directory shows up as both a symbolic link and a directory.
    if ((-d $file) && ( ! -l $file)) {
#       Use && rather than ; in constructing command to get it to work on Windows.  There is
#       a logic issue if the cd fails, since it's not detected.  Further, I assume that if it
#       fails, the program does not run.  If I'm wrong, we have an infinite loop
      $command = "cd $file && $program_invokation";
#       After all these years, I finally see that perl claims that the return from the system
#       command is actually the same as $?.  This leaves open the question of what happens if
#       the fork itself fails.  Presumably $! would have relevant info, but what would 
#       $status be?!  The "256" is an program exit status of 1 since the exit status is
#       "one byte over" in the process completion status
      $status = system($command);
      $OK_status = (($status == 0) || ($status == 256));
      $OK_status || 
          die ("Problem working in directory $dir/$file. Earlier messages should give reason");
    }
    ($file =~ /$qm_char_to_repl/) || next;
#     See comments above about perl file types
    (-l $file) && 
        &die_after_analysis_of_partial_completion($file,"Cannot rename non-plain/non-directory file $file");
    (-f _) || (-d _)
          || &die_after_analysis_of_partial_completion($file,"Cannot rename non-plain/non-directory file $file");
    ($part1,$part2) = split /$qm_char_to_repl/,$file,2;
    $newname = $part1 . $repl_char . $part2;
    (-e $newname) && &die_after_analysis_of_partial_completion($file,"Cannot overwrite $dir/$newname");
    if (rename $file,$newname) {
      $nrenames++;
    } else {
      &die_after_analysis_of_partial_completion($file,"Could not rename $file to $newname\n. \$!=$!");
    }
  }
  $nfiles_addend = ($nfiles == 1) ? "" : "s";
  $nrenames_addend = ($nrenames == 1) ? "" : "s";
  print STDERR " ... $dir:  $nfiles filename" . $nfiles_addend . " processed; " .
                      "$nrenames file" . $nrenames_addend . " renamed\n";
  ($nrenames == 0) ? exit(1) : exit(0);
}
sub die_after_analysis_of_partial_completion
{
  ($problem_file,$msg) = @_;
  $problem_file || ($problem_file = "[Name of problem file unknown - yet another problem]");
  $msg || ($msg = "[No error information provided]");
  ($nrenames == 0) && die $msg;
  $nrename_candidates = 0;
  while ($file = readdir DIR) {
    ($file =~ /$qm_char_to_repl/)  && $nrename_candidates++;
  }
  ($nrename_candidates == 0) && die $msg;
  $nrenames_addend = ($nrenames == 1) ? "" : "s";
  $nrename_candidates_addend = ($nrename_candidates == 1) ? " is" : "s are";
  die ("$msg\n" .
             " *** Directory $dir left in inconsistent state\n" .
             " *** $nrenames rename" . $nrenames_addend . " already performed\n" .
             " *** In addition to $problem_file, $nrename_candidates rename" . 
                              $nrename_candidates_addend. " yet to be done"
      ); 
}