#!/usr/bin/perl -w
use strict;
use warnings;
use File::Basename;

my $lowercase;

# Nach Wunsch setzen:
# $lowercase = 1; # Dateiname in Kleinbuchstaben umwandeln
$lowercase = 0; # Gross- und Kleinbuchstaben erlauben

# check for unicodedecoder
my $uniavailable = 0;
eval { require Text::Unidecode; };
unless ($@)
  {
  $uniavailable = 1;
  Text::Unidecode ->import();
  }

# Dateien bearbeiten
foreach my $arg (@ARGV)
  {
  if(-d $arg)  # Verzeichnis komplett bearbeiten
    { ProcessDir($arg); }
  else         # Einzeldatei
    { RenameFile($arg); }
  }



# Umbenennen einer Datei
sub RenameFile # ($pfad)
  {
  my $fullname = shift;
	my $path = dirname($fullname);
	my $file = basename($fullname);
	my $newfile = $file;

	# Zeichen < 32 entfernen und durch _ ersetzen
	$newfile =~ s/[\x00-\x1f]/_/g;

	# Urldecode, falls noetig
	$newfile =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/ge;

  # Unicode --> Umlaute
  $newfile =~ s/\303\204/Ae/g;
  $newfile =~ s/\303\226/Oe/g;
  $newfile =~ s/\303\234/Ue/g;
  $newfile =~ s/\303\244/ae/g;
  $newfile =~ s/\303\266/oe/g;
  $newfile =~ s/\303\274/ue/g;
  $newfile =~ s/\303\237/ss/g;

  # Nach Latin1 umcodieren
  $newfile = uniavailableode($newfile) if($uniavailable);

	$newfile =~ s/\\//g;	   # Backslashes entfernen
	$newfile =~ s/\*/x/g;    # fuer Windows: * --> x
	$newfile =~ s/&/_and_/g; # &-Zeichen austauschen
  $newfile =~ s/@/_at_/g;  # @-Zeichen austauschen
  $newfile =~ s/['"`]//g;  # Apostrophe entfernen
	$newfile =~ s/\357//g;   # dito

	# Umlaute umwandeln (Linux charset)
	$newfile =~ s/ü/ue/g;
	$newfile =~ s/Ü/Ue/g;
	$newfile =~ s/ö/oe/g;
	$newfile =~ s/Ö/Oe/g;
	$newfile =~ s/ä/ae/g;
	$newfile =~ s/Ä/Ae/g;
	$newfile =~ s/ß/ss/g;

	# Umlaute umwandeln (Windows charset)
	$newfile =~ s/\x8e/Ae/g;
	$newfile =~ s/\x99/Oe/g;
	$newfile =~ s/\x9A/Ue/g;
	$newfile =~ s/\x84/ae/g;
	$newfile =~ s/\x94/oe/g;
	$newfile =~ s/\x81/ue/g;
	$newfile =~ s/\xe1/ss/g;
	$newfile =~ s/\253/.5/g;

  # Alle unerwuenschten Zeichen eliminieren
  $newfile =~ s/[^A-Za-z_0-9\(\)\.\-]/_/g;

  # cleanup
	$newfile =~ s/_\././g;   # "_." --> "."
	$newfile =~ s/_-_/-/g;	 # "-" und "_" bearbeiten
	$newfile =~ s/_-/-/g;
	$newfile =~ s/-_/-/g;
	$newfile =~ s/\.\././g;  # Aufeinanderfolgende Punkte eliminieren
	$newfile =~ s/__+/_/g;   # Aufeinanderfolgende Underlines eliminieren

  # lowercase, falls gewuenscht
  $newfile = lc($newfile) if($lowercase);

  # Nur etwas tun, wenn es sich lohnt :-)
	if ($file ne $newfile)
	  {
	  print "   $file --> $newfile";
	  if (-e "$path/$newfile")
	    { print "\tSKIPPED\n"; }
	  else
	    {
 	    if (rename("$path/$file","$path/$newfile"))
 	      { print "\tSUCCESS\n"; }
	    else
	      { print "\tFAILED\n";  }
      }
	  }
  }

# komplettes Verzeichnis bearbeiten
sub ProcessDir # ($path)
  {
  my $path = shift;
  print "Processing $path ...\n";
  # Verzeichnis (Dateinamen) lesen
  opendir(ROOT, $path);
  my @files = readdir(ROOT);
  closedir(ROOT);
  
  # Inhalt des Verzeichnisses bearbeiten
  for my $file (@files)
    {
    next if($file eq '.');    # . und .. uebergehen
    next if($file eq '..');
    my $fullname = $path . "/" . $file;
    ProcessDir($fullname) if (-d $fullname);
    RenameFile($fullname);
    }
  }