#! /usr/bin/perl
#
# File: remv
# Time-stamp: <13-Dec-2004 22:08:08 ska>
# $Id: $
#
# Copyright (C) 2004 by Stefan Kamphausen
#
# Author: Stefan Kamphausen
#

use warnings;
use strict;

use Getopt::Long;
use Pod::Usage;
use File::Basename;
use Cwd;
use Data::Dumper;

my $Version = "remv - 0.5 (C) Stefan Kamphausen";
my $Webpage ="http://www.skamphausen.de/software/remv/";

############################################################
#                          OPTIONS                         #
############################################################
my $EnvOptions = $ENV{REMV_OPTIONS} || "";
if ($EnvOptions ne "") {
  push @ARGV, split /\s+/,$EnvOptions;
}
GetOptions(
           "expr|e=s" => \my $opt_expr,
           "filter|f=s" => \my $filter,
           "outputdir|o=s" => \my $outputdir,
           "copy|c!" => \my $copy,
           "interactive|i!" => \my $interactive,
           "recursive|r!" => \my $recursive,
           "nosave|n!" => \my $nosave,
           "verbose|v!" => \my $verbose,
           "undo|u!" => \my $undo,
           "yes|y!" => \my $yesdoit,
           "man|m!" => \my $manpage,
           "help|h!" => \my $help,
           "version!" => \my $version
          ) or pod2usage(-verbose => 0);;

if ($help) {
  pod2usage(-verbose => 1,
            -exitval => 0,
            -output => \*STDOUT);
}
if ($manpage) {
  pod2usage(-verbose => 2,
            -exitval => 0,
            -output => \*STDOUT);
}
if ($version) {
  print $Version,"\n";
  print "$Webpage\n";
  exit 0;
}

############################################################
#                           INIT                           #
############################################################
my $LastFile = $ENV{REMV_LAST_FILE} || "$ENV{HOME}/.remv_last";
my $LastAge = $ENV{REMV_LAST_AGE} || "300";
my %translation_table = ();

if($undo) {
  undo_from_file($LastFile);
  exit(0);
}

my $expression = $opt_expr || shift @ARGV;
if ($expression && -f $expression && !$opt_expr) {
    $expression = undef;
}
if (!($expression || $yesdoit)) {
  pod2usage('no expression found and no --yes option given');
}

############################################################
#                           MAIN                           #
############################################################
if ($expression && scalar(@ARGV) > 0) {
  table_from_expression($expression,@ARGV);
} elsif ($yesdoit && !$expression && scalar(@ARGV) <= 0) {
  table_from_file($LastFile)
}

table_to_file($LastFile,%translation_table) unless $nosave;
table_sanity(%translation_table);
table_action(%translation_table);
exit;

############################################################
#                           SUBS                           #
############################################################

####################################################
sub table_action {   # rename/copy according to list
####################################################
  my %tab = @_;
  print "# renaming ",scalar(keys(%tab))," files...\n" if $verbose;
  foreach my $old (keys %tab) {
    my $new = $tab{$old};
    if (!$yesdoit || $verbose) {
      print "\"$old\"  -->  \"$new\"\n";
    }
    if ($yesdoit) {
      # FIXME: do it and interactive
      if ($copy) {
        print "copy\n";
      } else {
        print "move\n";
      }
    }
  }
}
####################################################
sub table_sanity {    # check for possible conflicts
####################################################
  my %table = @_;
  my @all_old_names = ();
  my @all_new_names = ();

  foreach my $old (keys %table) {
    my $insane = 0;
    my $new = $table{$old};
    if (grep /$old/,@all_old_names) {
      print "# Found duplicate: $old; remove it from list\n";
      print "#   old on old list . \n" if $verbose;
      $insane = 1;
    }
    if (grep /$old/,@all_new_names) {
      print "# Found duplicate: $old; remove it from list\n";
      print "#   old already on new list . \n" if $verbose;
      $insane = 1;
    }
    if (grep /$new/,@all_old_names) {
      print "# Found duplicate: $new; remove it from list\n";
      print "#   new on old list . \n" if $verbose;
      $insane = 1;
    }
    if (grep /$new/,@all_new_names) {
      print "# Found duplicate: $new; remove it from list\n";
      print "#   new already on new list . \n" if $verbose;
      $insane = 1;
    }
    if ($insane) {
      $table{$old} = undef;
    }
    push @all_old_names, $old;
    push @all_new_names, $new;
  }
}

####################################################
sub table_to_file { # write to file for undo and yes
####################################################
  my $file = shift;
  my %tab = @_;
  print "# writing table to file \"$file\"\n" if $verbose;
  open OUT,">$file" or die
    "can't write table to file $file\n$!";
  foreach my $old (keys %tab) {
    my $new = $tab{$old};
    unless (substr($new,0,1) eq "/") {
      my $cwd = getcwd();
      $new = "$cwd/$new";
      $old = "$cwd/$old";
    }
    print OUT "\"$old\" \"$new\"\n";
  }
  close OUT;
}

####################################################
sub undo_from_file {  # good, we kept a log, undo it
####################################################
  my $file = shift;
  print "# undo from $file\n" if $verbose;
  table_from_file($file);
  print "# reversing table\n" if $verbose;
  my %revtab = ();
  foreach my $old (keys %translation_table) {
    $revtab{$translation_table{$old}} = $old;
  }
  table_action(%revtab);
}

####################################################
sub table_from_file {        # read the stored table
#       this generates the global %translation_table
####################################################
  my $file = shift;
  print "# creating table from file $file\n"  if $verbose;
  my @filestat = stat($file) or die
    "can't stat() the file $file\n$!";

  if (time() - $filestat[9] > $LastAge) {
    print STDERR "LastFile is too old!\nRemoving it\n";
    ####FIXME unlink $file or die "can't remove it\n$!";
    print STDERR "Exit.\n";
    exit(0);
  }
  open IN,$file or die
    "can't read table to file $file\n$!";
  foreach (<IN>) {
    m/"(.*?)"\s+"(.*?)"/;
    print "$1 ---> $2\n";
    $translation_table{$1} = $2;
  }
  close IN;
}

####################################################
sub table_from_expression {   # files and expression
#       this generates the global %translation_table
####################################################
  my $exp = shift;
  my @files = @_;
  print "# creating table from exp \"$exp\" (@files)\n" if $verbose;
  append_to_global_table($exp,@files);
}

####################################################
sub append_to_global_table {     # for the recursion
####################################################
  my $exp = shift;
  my @files = @_;
  # FIXME: test this!
#   if (defined $filter) {
#     eval "\@files = grep /$filter/ \@files";
#   }
  foreach my $f (@files) {
    if (-d $f && $recursive) {
      append_to_global_table($exp,<$f/*>);
    } elsif (-d $f || -f $f) {
      my ($newname,$dir) = fileparse($f);
      my $oldname = $newname;
      eval "\$newname =~ $exp";
      $translation_table{$f} = "$dir$newname" if $oldname ne $newname;
    } else {
      warn "# $f is neither file nor directory\n",
        "# refuse to work on it, because it only complicates things\n";
    }
  }
}
######################################################################
#                   That's it - now for the docs...                  #
######################################################################
__END__
=head1 NAME

remv - regular expression move

=head1 SYNOPSIS

remv [-y] [-r] [-v] [-c] [-o DIR] [-f FILTER] [-u]
    [-n] [[-e] EXPRESSION] [FILE[S]]

remv [-h] [-m] [--version]

=head1 OPTIONS

=over

=item B<-y,--yes>

Yes, actually do what has been shown.  This can be given as an
additional option to the last command or without expression and files.
In the latter case the last stored translation table is used.

=item B<-r,--recursive>

Recurse directories.  If this switch is not given any directory will
be renamed just as a file would

=item B<-v,--verbose>

Be verbose in output.  Usually remv will be quiet when actually
performing the renaming.

=item B<-c,--copy>

Copy the files instead of moving them.

=item B<-i,--interactive>

Prompt before renaming.

=item B<-o,--outputdir=DIR>

When used together with the copy-options all files will be copied to
the directory DIR.

=item B<-f,--filter=FILTER>

A Perl expression that can be used to filter the files.  This will be
applied to the list using the grep of perl.

=item B<-u,--undo>

Undo the last renaming.  This program stores the last translation
table in a file (see also ENVIRONMENT) and when an error occurred that
table is used to undo the action.

=item B<n-,--nosave>

There should be no need to actually use this, but if you are sure what
you are doing and you desperately need those few bytes of hard-disk
space, you can suppress the writing of the translation table.  Note
however, that in that case neither undo nor the --yes without
expression form of remv will work.

=item B<-e,--expr>

This switch can be used to pass the expression to apply to the
filenames.  If this option is unused the first item of the remaining
list after parsing all options will be taken unless it is a file.

=item B<EXPRESSION>

Usually this will be something like 's/search/replace/', the search
and replace operator of Perl.  But it can be any Perl expression that
can be map'ped to a list, the list of filenames that is.

The EXPRESSION can be spared if remv is called with the --yes-option
turned on, shortly after a preceding call which stored the translation
table to a file.

=item B<FILE[S]>

Well, the FILE or FILES to be renamed.

=item B<-h,--help>

Print short usage information

=item B<-m,--man>

Print long usage information, aka the man-page

=item B<--version>

Print version information

=back

=head1 ENVIRONMENT

=over

=item B<REMV_LAST_FILE>

The filename to use for the storage of the last translation table.
This table is used for the undo action and the yes-do-it command call
without FILES and EXPRESSION.  The default is "$HOME/.remv_last".

=item B<REMV_LAST_AGE>

When the REMV_LAST_FILE is older than this number of seconds it is not
considered valid for the yes-do-it command call without FILES and
EXPRESSION.  It can still be used to undo a renaming action but the
user will be asked.  The default value is 300s.

=item B<REMV_OPTIONS>

A string containing default options to remv, just like the well known
LESS-environment variable.  E.g. for bash you could do something like

 export REMV_OPTIONS="-v -i"

=head1 SEE ALSO

See the Webpage at

http://www.skamphausen.de/software/remv/

Another nice multi file renamer is called I<mmv>,
and the KDE-project has I<krename> which has a GUI, is probably more
sophisticated and maybe more secure.  Furthermore it has a
plugin-architecture.

==cut