#!/usr/bin/perl
#
#   mv_perl   [-nqf] perl_re files...  # rename based on a free form perl re
#   cp_perl   [-nqf] perl_re files...  # copy the filename using perl_re
#
# Given a perl substitution Regular expression rename files.
#
# For example:
#   remove the string "-junk" from the given filenames
#
#       mv_perl  's/-junk//'   file1-junk   file-junk2
#
# However if script is named (or symbolically linked from such a name) in one
# of the specified ways (see below), then it will use one of built-in regualar
# expression patterns for that specific renaming task.
#
#   mv_lcase  [-nqf] files...      # lowercase filenames
#   mv_ucase  [-nqf] files...      # uppercase filenames
#   mv_caps   [-nqf] files...      # capitialise first letter of each word
#   mv_word   [-nqf] files...      # space out capatialized words
#   mv_uscore [-nqf] files...      # convert spaces to underscores
#   mv_space  [-nqf] files...      # convert underscores to spaces
#   mv_nspace [-nqf] files...      # remove spaces and underscores
#   mv_nquote [-nqf] files...      # remove quotes from filenames
#   mv_npunct [-nqf] files...      # remove punctuation
#
# 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 overlapping from/to number ranges.
#
# But if you name this script "mv_renum" then the syntax is
#    mv_renum [-nqf] -##  files...
# when ## is the number of digits you want all numbers to contain.
#
###
#
# The script real origin is a simple perl "rename" script created by Larry
# Wall.  The "rename" script is still available in Debian Linux (but not
# redhat/fedora).
#
# Original script written by Ronald S. Woan, 02/10/1991
# Modified Anthony Thyssen, 11/10/2000
#   Add the "mv_uscore" method and tighter coding
# Modified Anthony Thyssen, 27/03/2001
#   Add the "mv_renum" method to expand (or unexpand) numbers inside
#   filenames, which in turn allows the filenames to sort correctly.
#   WARNING: this was a year later turned into a seperate #   program that can
#   also re-sequence the numbers if needed
# Modified Anthony Thyssen, 16/06/2002
#   Rewritten main loop to use technique simular to Larry Wall's "rename"
#   script. That is use an evaluated perl expresion for the "$_" variable.
# Modified Anthony Thyssen, 01/10/2009
#   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 (and verbose)
    s/^q// && do { $verbose = 0; redo };    # be quiet
    s/^v// && do { $verbose = 1; redo };    # be verbose (default)
    s/^f// && do { $force = 1; redo };      # force the move
    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;
if ( $force ) {
  @rename = qw( mv -- );                    # forcefull rename file
  @rename = qw( cp -- ) if $prog =~ /cp_/;  # forcefully copy file
} else {   # non-destrictive move or copy
# @rename = qw( mv -n );             # rename file - silent fail on overwrite
# @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)
}

# Free form perl RE filename
# EG:    mv_perl 's/tgz$/tar.gz/' *.tgz
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};     # Spaces 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
$prog =~ /_npunct/o  and  $re = q{s/[^\/\w\d\s_.-]//g}; # Remove Punctuation

# More complex regular expresions
#
# Renumber all numbers in filename
$prog =~ /_renum/o   and  $re = q{s/\d+/sprintf "%0*d", $w, $&/eg};
# 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/;
              };

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

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

#
# For a complex program, the main loop is very short and sweet.
#
for (@ARGV) {
  if ( ! -e ) {
    print STDERR "$prog: can not 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 $_;   # renumber precaution
  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")
}