#!/usr/bin/perl
#
#   mv_perl [-nqfd] perl_re files...  # rename based on a free form perl_re
#   cp_perl [-nqfd] perl_re files...  # copy the filename using perl_re
#
# Given a perl substitution Regular expression rename files.
#
# For example:
#   remove the string "-junk" from anywhere in the given filenames
#
#       mv_perl  's/-junk//'   file1-junk   file-junk2
#
# If this script is named (or symbolically linked to this script) with one of
# the names below, then it will use a matching built-in regualar expression
# patterns for that specific file renaming task, and the first argument is not
# needed, just the list of filenames.
#
#   mv_lcase  files...      # lowercase filenames
#   mv_ucase  files...      # uppercase filenames
#
#   mv_uscore files...      # convert spaces to underscores
#   mv_space  files...      # convert underscores to spaces
#   mv_nspace files...      # remove spaces and underscores
#
#   mv_nquote files...      # remove quotes from filenames
#   mv_npunct files...      # remove punctuation and uscore spaces
#   mv_upunct files...      # convert punctuation/spaces to uscores
#
#   mv_caps   files...      # capitialise first letter of each word
#   mv_word   files...      # space out capatialized words
#   mv_urls   files...      # remove url % escapes
#
#   mv_renum  -## files...  # Re-format all numbers of given width
#                           # (depreciated for scrit of same name)
#
# Note: File renumbering was moved to a seperate script, "mv_renum" and
# "mv_reseq"  to perform both renumbering and resequencing with more control
# options, and better handling of overlapped from/to number ranges.  However
# the regular expression to do this has been kept in this script as
# a referance, of the technique.
#
###
#
# This script was developed from the simple perl "rename" script created by
# Larry Wall, and available under debian linux.
#
# There are a number of different programs called "rename", each  a different
# program with different argument syntax.  Which is another reason why I use
# my own version to rename files.  That way I know what I am using!
#
# It is also simular to "mmv" available on many linux machines.
#
# Another similar script is "multi" by Simon Tatham
#   https://www.chiark.greenend.org.uk/~sgtatham/utils/
#   https://git.tartarus.org/?p=simon/multi.git
# In some ways it is more versitile in that ANY command can be run, including
# shell scripts with the two arguments (in any order), but it does not have
# 'existing file' protections or 'directory' protections, making it much more
# dangerious.
#
###
# Version History...
#
# 02/10/1991  Ronald S. Woan
#   Original modifications of "rename" script
#
# 11/10/2000  Anthony Thyssen <A.Thyssen@griffith.edu.au>
#   Add the "mv_uscore" method and tighter coding,
#   Replaced rename() with a selected program with "merge" prefered
#   as it will not overwrite existing files.
#
# 27/03/2001  Anthony Thyssen <A.Thyssen@griffith.edu.au>
#   Add the "mv_renum" method to expand (or unexpand) numbers inside
#   filenames, which in turn allows the filenames to sort correctly.
#   WARNING: this was later turned into a seperate program that can
#   also re-sequence the numbers (starting point, increment etc)
#
# 16/06/2002  Anthony Thyssen <A.Thyssen@griffith.edu.au>
#   Rewritten main loop to use technique simular to Larry Wall's "rename"
#   script. That is use an evaluated perl expresion for the "$_" variable.
#
# 01/10/2009  Anthony Thyssen <A.Thyssen@griffith.edu.au>
#   Added -d flag to allow renaming of directories (non-files)
#
###
( my $prog = $0 ) =~ s/^.*\///;
sub Usage {
  warn "$prog: ", @_,
       "Usage: $prog ", $prog =~ /renum/o ? '[-#] '
                      : $prog =~ /perl/o  ? 'perl_re' : '', " files...\n",
       "options: -n    dryrun - report actions, don't actually do them\n",
       "         -q    be quiet\n",
       "         -f    force the rename even if it overwrites\n",
       "         -d    rename directories (non-files) too\n";
  exit(10);
}

my $dryrun  = 0;  # don't actually do the update
my $verbose = 1;  # verbose on/off
my $force   = 0;  # move even if destination exists
my $dirs    = 0;  # move directories (non-files) too
my $w       = 2;  # default to 2 digits per number (mv_renum)

ARGUMENT:  # Multi-switch option handling
while( @ARGV && $ARGV[0] =~ s/^-(?=.)// ) {
  $_ = shift; {
    m/^$/  && do { next };     # next argument
    m/^-$/ && do { last };     # End of options
    m/^\?/ && do { Usage };    # Usage Help

    s/^n// && do { $dryrun  = 1;  redo };   # dry run
    s/^q// && do { $verbose = 0; redo };    # be quiet
    s/^v// && do { $verbose++; redo };      # be more verbose
    s/^f// && do { $force = 1; redo };      # force the move (overwrite)
    s/^d// && do { $dirs = 1; redo };       # move directories (non-files) too
    s/^(\d+)// && do {
        Usage("digit option only for mv_renum\n") unless $prog =~ /renum/o;
        $w = $1;  # width of all numbers in filename
    };
    Usage( "Unknown Option \"-$_\"\n" );
  } continue { next ARGUMENT }; last ARGUMENT;
}
my @rename;   # the program to use to rename/copy/link the files
if ( $force ) {
  @rename = qw( mv -- );                    # forcefully rename file
  @rename = qw( cp -- ) if $prog =~ /cp_/;  # forcefully copy file
} else {   # non-destrictive move or copy  (using my "merge" program)
# @rename = qw( mv -n );                   # rename file - silent fail
# @rename = qw( cp -n ) if $prog =~ /cp_/; # copy (uncommon)
  @rename = qw( merge -- );                # add suffix and warning overwrite
  @rename = qw( merge -c -- ) if $prog =~ /cp_/; # copy (uncommon)
}
print "$prog: rename program = @rename\n"  if $verbose >= 2;

my $re;
$prog =~ /_perl/o and  $re = shift;                 # user provided RE

# Predefined Regular expressions for symbolic linked scripts

$prog =~ /_lcase/o   and  $re = q{tr/A-Z/a-z/};    # Lowercase filenames
$prog =~ /_ucase/o   and  $re = q{tr/a-z/A-Z/};    # Uppercase filenames
$prog =~ /_uscore/o  and  $re = q{s/[\s_,]+/_/g};  # Whitespace to Underscore
$prog =~ /_space/o   and  $re = q{s/_+/ /g};       # UScore back to spaces
$prog =~ /_nspace/o  and  $re = q{s/\s_//g};       # Remove spaces
$prog =~ /_nquote/o  and  $re = q{s/["'`]//g};     # Remove Quotes

# More complex regular expresions


# Remove Punctuation, and underscore spaces
$prog =~ /_npunct/o  and  $re = q{s/[^\/\w\d\s_.,-]//g;s/[\s_,-]+/_/g};

# Replace both punctuation and spaces with underscores
$prog =~ /_upunct/o  and  $re = q{s/[^\/\w\d\s_.,-]/_/g;s/_+/_/g};

# Unescape URL % escapes
$prog =~ /_urls/o    and
       $re = q{s/\%([A-Fa-f0-9._-]{2})/pack("C", hex($1))/seg};

# Capitalise Words
$prog =~ /_caps/o    and  $re = q{s/(?<!['a-z0-9\.])[a-z]+/"\u$&"/ige};

# Space out capatialised words with underscores and lowercase them
$prog =~ /_word/o    and
       $re = q{ next if /^README$/;
                s/(?<=[a-z\d])[A-Z]/_$&/g;
                s/(?<=[a-z])\d/_$&/ig;
                tr/A-Z/a-z/;
              };

# Reformat all numbers in filename
# (depreciated as I use a dedicated script to do this)
$prog =~ /_renum/o   and  $re = q{s/\d+/sprintf "%0*d", $w, $&/eg};

print "$prog: RE expression = $re\n"  if $verbose >= 2;

Usage("Missing filename to rename...\n") unless @ARGV;

Usage("Unable to determine type of file renaming operation wanted!\n")
    unless $re;


# Main Loop...
#
# For such a complex program, the main loop is very short!
#
for (@ARGV) {
  print "$prog: file \"$_\"\n"  if $verbose >= 2;
  if ( ! -e $_ ) {
    print STDERR "$prog: cannot stat \"$_\" : $! \n"  if $verbose;
    next;
  }
  unless ( -f _ || $dirs ) {
    print STDERR "$prog: skipping non-file \"$_\"\n"  if $verbose;
    next;
  }
  (my $p = $_) =~ s/[^\/]+$//;  # get directory path (including / )
  s/^.*\///;                    # just path from input file
  my $f = $_;                   # save a copy of filename

  eval $re;                     # perform the operation on $_
  die $@ if $@;                 # abort on any errors

  next if $f eq $_;   # precaution no filename change
  if ( -e "$p$_" && ! $force ) {
    print STDERR "SKIP $rename \"$f\" \"$_\" -- destination exists\n";
    next;
  }
  print "@rename \"$p$f\" \"$p$_\"\n"  if $dryrun || $verbose;
  system @rename, $p.$f, $p.$_         unless $dryrun;
  #rename(  $p.$f, $p.$_ ) or die("rename \"$f\" \"$_\" failed: $!\n")
}