#!/usr/bin/perl -s

use strict;
use Encode;
use File::Basename;
use File::Path;
my ($dir,@list);
use Encode::Guess;
#Encode::Guess->add_suspects("latin1");


if(scalar(@ARGV)==1 && -d $ARGV[0] ) {
  $dir = shift;
  chdir($dir);
}
else { @list = @ARGV  }

our ($k, $v, $r, $lc, $uc, $ac, $utf8, $seq, $q, $svn);

my $tmp="/tmp/__$$";
my $tmpd="/tmp/__$$.dirs";

$r = "*/*" if $r >= 1;
$r = "*/*/* $r" if $r >= 2;
$r = "*/*/*/* $r" if $r >= 3;
$r = "*/*/*/*/* $r" if $r >= 4;

open(F,">$tmp") or die;
open(F1,">$tmpd") or die;
##open(F3,">DEBUB") or die;
##binmode(F,":utf8") ;
##binmode(F1,":utf8");
binmode(F3,":utf8");
@list = (<$r *>) unless @list; 

my $seqn = $seq || 1;
$svn = $svn ? "svn" : "";

for(@list){
    next if ($_ eq "__");
    next if ($_ eq "CVS");
##    $_= decode("utf-8", $_, 0) if $utf8;
##    $_= decode("guess", $_);
    my $v=$_;
    s/%([A-F0-9]{2})/pack("c",hex($1))/ge;
    my $x; 
    my $decoder = Encode::Guess->guess($_);
    if(ref($decoder)){ $x = $decoder->decode($_);}
    else             { $x = $_}
    ## $_ = p1($_); ## pode ser boa ideia!!!
    $_ = $x;
    ## print F3 "V=$v\nX=$x\n_=$_\n\n" if ($x ne $_);
    
    $_ = lc($_) if $lc;
    $_ = uc($_) if $uc;
    y/������������������񺪰������&/aeioucaeiouaoaeiounoaoaeiouBE/ unless $ac;
    y/������������������������/AEIOUCAEIOUAOAEIOUNAEIOU/ unless $ac;
    s/[\x{FF}-\x{FFFF}]/_/g;
    s/['"�]//g;
    s/(\.\w{1,4})$/lc($1)/e;
    s/^-+//g;
    s/[��?+:;,! ]/_/g;
    s/[()\[\]{}]/_/g unless $k;
    s/_*([.\-])_*/$1/g;

    if ($seq) {
        my $ext = $_;
        $ext =~ s/.*\.//;
        $_ = sprintf("%05d.%s",$seqn++, $ext);
    }

    if (-d $v){
        if (!$seq) {
            $v =~ s/'/\\'/g; print F1 qq{mv   '$v'	"$_"\n};
        }
    }
    else  { $v =~ s/'/\\'/g; print F  qq{mv   '$v'	"$_"\n};}
}

close F1;
print F "\n#### Directories\n",`cat $tmpd` ;
close F;

if   ($v){ system ("gvim --nofork $tmp") ;}
elsif($q){                       }
else     { system ("vim $tmp") ; }

open(F,"$tmp") or die;
binmode(F,":utf8") if $utf8;
warn("warning: permission denied\n") unless -w ".";
while(<F>){ chomp;
  next if(/^mv\s+'((?:[^']|\\\\')+)'\s+"\1"$/);                 ## mv a   a  = skip
  if   (/^mv\s+'((?:[^']|\\\\')+)'\s+""$/)      { unlink($1)  } ## mv 'a' "" = rm a
  elsif(/^mv\s+'(.+?)'\s+"((?:[^"]|\\\\")+)"$/) { 
      my ($a1,$b1)=($1,$2);
      if(-d $a1){ 
         $a1 =~ s!^-!./-!g;
         $a1 =~ s!'!'"'"'!g;
         ### Parece-me que isto est� a mais???  $a1 =~ s!'!'"'"'!g;
         system("$svn mv '$a1' '$b1'");
      }
      else {
         $a1 =~ s!\\"!"!g;
         $a1 =~ s!\\'!'!g;
         if(-f $a1 ){
            my $d=dirname($b1);
            mkpath($d) unless (-d $d);
            $a1 =~ s!^-!./-!g;
            if ($svn){ system("svn mv '$a1' '$b1'");}
            else     { rename($a1,$b1);}
         }
         else { warn("warning: cant find '$a1'\n") }
      }
  }
  elsif(/^(#.*|[#\s]*)$/s){}
  else{ print  "???? $_\n" }
}

unlink $tmp;
unlink $tmpd;

sub p1{
 my $final = shift;
   $final =~ s/à/�/g;
   $final =~ s/è/�/g;
   $final =~ s/ì/�/g;
   $final =~ s/ò/�/g;
   $final =~ s/ù/�/g;

   $final =~ s/á/�/g;
   $final =~ s/é/�/g;
   $final =~ s/í/�/g;
   $final =~ s/ó/�/g;
   $final =~ s/ú/�/g;
   $final =~ s/ã/�/g;
   $final =~ s/õ/�/g;
   $final =~ s/â/�/g;
   $final =~ s/ê/�/g;
   $final =~ s/î/�/g;
   $final =~ s/ô/�/g;
   $final =~ s/û/�/g;
   $final =~ s/ç/�/g;
   $final =~ s/ñ/�/g;
   $final =~ s/ü/�/g;
   $final =~ s/ö/�/g;
   $final =~ s/ë/�/g;
   $final =~ s/ï/�/g;
   $final =~ s/ä/�/g;

   $final =~ s/À/�/g;
   $final =~ s/È/�/g;
   $final =~ s/Ì/�/g;
   $final =~ s/Ò/�/g;
   $final =~ s/Ù/�/g;

   $final =~ s/Á/�/g;
   $final =~ s/É/�/g;
   $final =~ s/Í/�/g;
   $final =~ s/Ó/�/g;
   $final =~ s/Ú/�/g;
   $final =~ s/Ã/�/g;
   $final =~ s/Õ/�/g;
   $final =~ s/Â/�/g;
   $final =~ s/Ê/�/g;
   $final =~ s/Î/�/g;
   $final =~ s/Ô/�/g;
   $final =~ s/Û/�/g;
   $final =~ s/Ç/�/g;
   $final =~ s/Ñ/�/g;
   $final =~ s/Ü/�/g;
   $final =~ s/Ö/�/g;
   $final =~ s/Ë/�/g;
   $final =~ s/Ï/�/g;
   $final =~ s/Ä/�/g;

   $final =~ s/°/�/g;
   $final =~ s/§/�/g;
   $final =~ s/»/�/g;
   $final =~ s/«/�/g;
   $final =~ s/º/�/g;
   $final =~ s/ª/�/g;
   $final
}
	

__END__

=head1 NAME

drename - rename the files of one directoru

=head1 SYNOPSIS

 drename [options]      - renames the contents of current directory
 drename [options] dir  - renames the files of dir
 drename [options] file-list  - renames the file-list

=head1 DESCRIPTION

C<drename> builds a file with the contents of a directory and the
default rename and call C<vi> to edit it.

By default it changes spaces to "-", deletes "'" char and chages 
"_-_" into "-", and accents are replaced with non-accent char.
Deletes leading "-".

In the edit process, we can chose a new name (rename it)
or keep tha name (nop) or give an empty name (to remove the file)

=head2 Options

 -lc     - lower case renaming
 -uc     - upper case renaming
 -ac     - keep accents
 -utf8   - filenames using utf8 encoding (normally not necessary)
 -r=2    - recursively rename filesystem tree upto 2 level 
 -q      - no vim manual edition
 -k      - keep '()[]{}'
 -v      - use gvim instead of vim
 -svn    - svn mv file1 file2
 -seq    - use sequential numbering. Use C<-seq=10> to specify first value.

=head1 BUGS

Option C<-r> accepts a maximum of 4 levels

=head1 AUTHOR

J.Joao Almeida, jj@di.uminho.pt

=head1 SEE ALSO

perl(1).

=cut