#!c:/perl/bin/perl -w
# das sind module für strictes programmieren und warnungen
use strict;
use warnings;
use File::Copy;
use File::Spec;
use File::Find;
use File::stat;

# ein paar konstanten

use constant LOESCHEN => 0;
use constant BEHALTEN => 1;
use constant DELETED => -1;
use constant MOVED => 2;

# dein ordner wo drinne geloescht werden soll

my $srcDir = 'C:\test';
my $destDir = 'C:\backup';
my $oldInDays=30;

# das log file

my $logFile = File::Spec->join($srcDir,'log.txt');

# zeitpunkt minus $oldInDays tage also alt die dateien und ordner hoechstens sein dürfen
my $backxdays = (time()-(86400*$oldInDays));

# hier springt er in die sub read_dirs
# und liefert einen Hash mit relativen Pfadangaben zurück
my %allFiles=read_dirs(File::Spec->rel2abs($srcDir));

# alle dateien durchgehen und schauen ob sie aelter als 30 tage sind
# ordner werden automatisch auf loeschen gesetzt

for ( sort keys(%allFiles))
{
  # aus dem relaitven Pfad einen absoluten machen
  my $srcName=File::Spec->rel2abs($_, $srcDir);
  # ModifikationsZeit lesen
  my $lastMod = stat($srcName)->mtime();

  # ist es älter als erlaubt?
  $allFiles{$_} = BEHALTEN if(($lastMod - $backxdays) > 0 && -f $srcName);
  $allFiles{$_} = LOESCHEN if(($lastMod - $backxdays) < 0 && -f $srcName);
  $allFiles{$_} = LOESCHEN if -d $srcName;
}

# die dateien loeschen die aelter als 30 tage sind

for (sort keys(%allFiles))
{
  # für die Quelle aus dem relaiven einen absoluten Pfad machen
  my $srcName=File::Spec->rel2abs($_, $srcDir);
  # ist es eine Datei und soll gelöscht werden?
  if ($allFiles{$_} == LOESCHEN && -f $srcName)
  {
    # für das Ziel aus dem relaiven einen absoluten Pfad machen
    my $destName=File::Spec->rel2abs($_, $destDir);

    # nötige Verzeichnisse am Ziel erstellen wenn es nötig ist.
    my ($volume,$directories,$file) = File::Spec->splitpath( $destName );
    make_dirs(File::Spec->catpath($volume, $directories));

    # Datei verschieben
    $allFiles{$_} = MOVED if move($srcName,$destName);
  }
}

# die ordner loeschen die leer sind
# rmdir loescht nur leere ordner

foreach( sort keys(%allFiles))
{
  if ($allFiles{$_} == LOESCHEN && -d $_)
  {
    my $DirName=File::Spec->rel2abs($_, $srcDir);
    $allFiles{$_} = DELETED if rmdir($DirName);
  }
}

# den ganzen spass in ne log datei schreiben
&loggen($logFile,$srcDir,%allFiles);

########################################################################
########################################################################
# logdatei schreiben
sub loggen
{
  my $logfile=shift;
  my $srcdir=shift;
  my %files=@_;
  open(my $logfh, '>', $logfile) or die "ERROR open: $logfile ($!)";

  foreach(sort keys(%files))
  {
    my $filename=File::Spec->rel2abs($_, $srcdir);
    print $logfh $filename," --> ";
    print $logfh "File/Directory wurde geloescht...\n\n" if $files{$_} == DELETED;
    print $logfh "File/Directory ist aktuell...\n\n" if $files{$_} == BEHALTEN;
    print $logfh "File/Directory wurde nicht geloescht...\n\n" if $files{$_} == LOESCHEN;
    print $logfh "File/Directory wurde verschoben...\n\n" if $files{$_} == MOVED;
  }
  close($logfh);
}

# Diese Funktion nutzt File::Find um alle Unterverzeichnisse nach Dateien zu durchsuchen
# und liefert einen Hash zurück der alle Dateien und Ordner als relaitiven pfad zu "$dir" enthält

sub read_dirs
{
  my $dir = shift;
  my %files=();
  # File::Find::find ausführen
  find(sub{
    # nicht eigener Ordner und vorheriger
    return if($_ eq '.' || $_ eq '..');
    # Pfadanagen von Absolut nach relative wandeln
    my $name=File::Spec->abs2rel($File::Find::name,$dir);
    # Haswert setzen
    $files{$name}=undef;
  }, $dir);
  return %files;
}

# Erzeugen von Verzeichnissen wenn sie nicht existieren

sub make_dirs
{
  my $path=shift;

  my $dnow='';
  ($dnow,$path)=File::Spec->splitpath($path, 1);
  for(File::Spec->splitdir($path))
  {
    $dnow=File::Spec->join($dnow, $_);
    unless(-d $dnow)
    { mkdir($dnow) or die("ERROR mkdir: $dnow ($!)"); }
  }
}