# -*- perl -*-

#
#   Copyright (C) Dr. Heinz-Josef Claes (2001-2005)
#                 hjclaes@web.de
#   
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

push @VERSION, '$Id: storeBackupLib.pl 336 2005-08-12 21:03:30Z hjc $ ';

use strict;

# Erkennen des Trees mit dem Backup (Wurzel des Backups)
# Listen aller Backup-Verzeichnisse

# Listen aller geänderten Dateien (nach Link + md5-Summe)
# Suchen von Dateien nach md5-Summe
# Suchen von Dateien nach Namen (Pattern), Größe, Datum, etc.
# Löschen von Teilbäumen in einem Backup

##################################################
sub buildDBMs
{
    my (%params) = ('-dbmKeyIsFilename'    => undef,     # Hash
		    '-dbmKeyIsMD5Sum'      => undef,     # Hash
		    '-indexDir'            => undef,     # object pointer
		    '-previousDir'         => undef,     # dbm{filename} wird nur
		                                         # gefüllt, wenn -backupRoot
		                                         # eq -previousDir
		    '-backupRoot'          => undef,     # String
		    '-backupDirIndex'      => undef,     # Index des Pfades
		    '-noBackupDir'         => undef,
		    '-checkSumFile'        => undef,
		    '-checkSumFileVersion' => undef,
		    '-progressReport'      => undef,
		    '-prLog'               => undef
		    );

    &::checkObjectParams(\%params, \@_, '::buildDBMs',
			 ['-dbmKeyIsFilename', '-dbmKeyIsMD5Sum', '-indexDir',
			  '-previousDir', '-backupRoot', '-backupDirIndex',
			  '-noBackupDir', '-checkSumFile',
			  '-checkSumFileVersion', '-prLog']);
    my $dbmKeyIsFilename = $params{'-dbmKeyIsFilename'};
    my $dbmKeyIsMD5Sum = $params{'-dbmKeyIsMD5Sum'};
    my $indexDir = $params{'-indexDir'};
    my $previousDir = $params{'-previousDir'};
    my $backupRoot = $params{'-backupRoot'};
    my $backupDirIndex = $params{'-backupDirIndex'};
    my $noBackupDir = $params{'-noBackupDir'};
    my $checkSumFile = $params{'-checkSumFile'};
    my $checkSumFileVersion = $params{'-checkSumFileVersion'};
    my $progressReport = 5 * $params{'-progressReport'};
    my $prLog = $params{'-prLog'};

    my $isPreviousBackup = ($previousDir eq $backupRoot) ? 1 : 0;

    my $rcsf = readCheckSumFile->new('-checkSumFile' =>
				     "$backupRoot/$checkSumFile",
				     '-prLog' => $prLog);
    my $v = $rcsf->getVersion();
    $prLog->print('-kind' => 'E',
		  '-str' =>
		  ["Version of file " . $checkSumFile .
		   "is $v, must be " . $checkSumFileVersion,
		   "Please upgrade to version $checkSumFileVersion " .
		   "with storeBackupConvertBackup.pl"],
		  '-exit' => 1)
	unless $v eq $checkSumFileVersion;

    $prLog->print('-kind' => 'I',
		  '-str' => ["start reading " . $rcsf->getFilename()]);

    my $noLines = 0;
    my $noEntriesInDBM = 0;
    my ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
	$size, $uid, $gid, $mode, $f);
    while ((($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime,
	     $atime, $size, $uid, $gid, $mode, $f) = $rcsf->nextLine()) > 0)
    {
	++$noLines;
	$prLog->print('-kind' => 'P',
		      '-str' => ["  read $noLines lines ..."])
	    if $progressReport and $noLines % $progressReport == 0;

	next if (length($md5sum) != 32);  # ist dir, pipe, symlink

	my ($fbase, $fname, $index) = $indexDir->newFile($f);

	$$dbmKeyIsFilename{"$index/$fname"} =
	    pack('aIIIH32', $compr, $ctime, $mtime, $size, $md5sum)
	    if ($isPreviousBackup or not
		exists $$dbmKeyIsFilename{"$index/$fname"});

	my $md5pack = pack('H32', $md5sum);
	if ($noBackupDir > 1 and exists $$dbmKeyIsMD5Sum{$md5pack})
	{
	    my ($_inodeBackup) = unpack('I', $$dbmKeyIsMD5Sum{$md5pack});
	    next if ($_inodeBackup <= $inodeBackup);
	}
	else
	{
	    ++$noEntriesInDBM;
	}
	# gibt's noch nicht bzw. $inodeBackup ist kleiner als in dbm file
	$$dbmKeyIsMD5Sum{$md5pack} = pack('IaSa*', $inodeBackup, $compr,
					 $backupDirIndex, "$index/$fname");
    }

    $prLog->print('-kind' => 'I',
		  '-str' =>
		  ["finished reading " . $rcsf->getFilename() .
		   " ($noLines entries)"]);

    return $noEntriesInDBM;
}


##################################################
sub readAllBackupDirs      ####!!! obsolet: ersetzen durch allStoreBackupDirs
{
    my $allBackupsRoot = shift;
    my $prLog = shift;
    my $fullpath = shift;      # 1: ja, 0: nein

# alle Verzeichnisse lesen und merken
    local *BACKUPROOT;
    opendir(BACKUPROOT, $allBackupsRoot) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot opendir <$allBackupsRoot>, exiting"],
		      '-exit' => 1);
    my (@dirs, $entry);
    while ($entry = readdir BACKUPROOT)
    {
	next if (-l $entry and not -d $entry);   # nur Directories interessant
	next unless $entry =~                    # Dateiname muß passen
	    /\A(\d{4})\.(\d{2})\.(\d{2})_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
	push @dirs, $fullpath ? "$allBackupsRoot/$entry" : $entry;
    }
    closedir(BACKUPROOT);

    return (sort @dirs);        # ältestes zuerst
}


##################################################
sub analysePathToBackup
{
    my $prLog = shift;
                              # Einer der beiden folgender Parameter darf
                              # nicht undef sein. Dieser wird dann zur
                              # Bestimmung der return-Werte verwendet
    my $backupRoot = shift;   # gesetzt auf den Pfad zum Archiv oder undef
    my $file = shift;         # Datei innerhalb eines Archivs (oder undef)

    my $checkSumFile = shift; # z.B. '.md5CheckSums'
    my $verbose = shift;      # undef oder definiert


    if ($backupRoot)
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["directory <$backupRoot> does not exit"],
		      '-exit' => 1)
	    unless (-d $backupRoot);
	$backupRoot = &absolutePath($backupRoot);
    }
    else
    {
	my ($dir, $x) = &splitFileDir($file);
	$backupRoot = undef;
	do
	{
	    # feststellen, ob eine .md5sum Datei vorhanden ist
	    if (-f "$dir/$checkSumFile" or -f "$dir/$checkSumFile.bz2")
	    {
		$prLog->print('-kind' => 'I',
			      '-str' => ["found info file <$checkSumFile> in "
					 . "directory <$dir>"])
		    if ($verbose);
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["found info file <$checkSumFile> a second time "
			       . "in <$dir>, first time found in " .
			       "<$backupRoot>"],
			      '-exit' => 1)
		    if ($backupRoot);

		$backupRoot = $dir;
	    }

	    ($dir, $x) = &splitFileDir($dir);
	} while ($dir ne '/');

	$prLog->print('-kind' => 'E',
		      '-str' => ["did not find info file <$checkSumFile>\n"],
		      '-exit' => 1)
	    unless ($backupRoot);
    }

    my $checkSumFileRoot = $checkSumFile;
    $checkSumFileRoot .= ".bz2" if (-f "$backupRoot/$checkSumFile.bz2");
    $prLog->print('-kind' => 'E',
		  '-str' => ["no info file <$checkSumFileRoot> in <$backupRoot>"],
		  '-exit' => 1)
	unless(-f "$backupRoot/$checkSumFileRoot");

# jetzt $restoreTree relativ zu $backupRoot machen
    my $fileWithRelPath = $file ?
	substr($file, length($backupRoot) + 1) : undef;
    my ($storeBackupAllTrees, $fileDateDir) = &splitFileDir($backupRoot);

# ^^^
# Beispiel:            (/tmp/stbu/2001.12.20_16.21.59/perl/Julian.c.bz2)
# $backupRoot beinhaltet jetzt den Pfad zum Archiv
#                      (/tmp/stbu/2001.12.20_16.21.59)
# $file beinhaltet die Datei mit kompletten, absoluten Pfad
#                      (/tmp/stbu/2001.12.20_16.21.59/perl/Julian.c.bz2)
#                  -> nur, wenn $file nicht undef war
# $fileWithRelPath beinhaltet jetzt den relativen Pfad innerhalb des Archivs
#                      (perl/Julian.c.bz2)
#                  -> nur, wenn $file nicht undef war
# $storeBackupAllTrees beinhaltet den Root-Pfad des storeBackup (oberhalb
#      der Datum Directories)
#                      (/tmp/stbu)
# $fileDateDir beinhaltet den Namen des Datum-Dirs des gesuchten files
#                      (2001.12.20_16.21.59)

#print "backupRoot = $backupRoot\n";
#print "file = $file\n";
#print "fileWithRelPath = $fileWithRelPath\n";
#print "storeBackupAllTrees = $storeBackupAllTrees\n";
#print "fileDateDir = $fileDateDir\n\n";

    return ($backupRoot, $file, $fileWithRelPath, $storeBackupAllTrees,
	    $fileDateDir);
}


##################################################
# Bezeichnung für timescale:
#  50d3m -> 50 Tage, 3 Minuten
#  a50d3m -> 50 Tage, 3 Minuten -> Archive Flag gesetzt, wird bei
#                                  keepMaxNumber nicht gelöscht
#                                  bei keepDouplicate werden auch Backups
#                                  mit Archive Flag gelöscht
#
# in (L1) sind alle Directorynamen von Backups
# (keepMaxNumber >= keepMinNumber)
# (Syntax: (L1) -> (L2) bedeutet: alle betroffenen aus Liste 1 nach Liste 2
# verschieben)
#
#1. Duplikate eines Tages separieren:
#   betroffene (aller außer den Letzten des Tages) von (L1) -> (L2)
#
#2. keepDuplicate - zu alte Duplikate löschen:
#   betroffene von (L2) -> (Llösch)
#
#=> in (L2) sind jetzt alle Duplikate, die (erst mal) nicht
#   gelöscht werden sollen
#
#3. keepFirstOfYear - ersten eines Jahres behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#4. keepLastOfYear - letzten eines Jahres behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#5. keepFirstOfMonth - ersten eines Monats behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#6. keepLastOfMonth - letzten eines Monats behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#7. keepFirstOfWeek - ersten einer Woche behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#8. keepLastOfWeek - letzten einer Woche behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#9. keepWeekday (berücksichtigt Defaultwerte von keepAll) -
#	       alle noch nicht zu alten behalten:
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#10. Backups mit Flag 'notDelete' verschieben:
#    betroffene (L1) -> (L3), wenn kein Archiv Flag
#    betroffene (L1) -> (L4), wenn Archiv Flag
#
#11. alle (L1) -> (Llösch) verschieben
#
#=> in Llösch sind die bisher zu löschenden Backupverzeichnisse
#=> L1 ist leer
#=> in L2 sind jetzt die Duplikate
#=> in L3 sind die mit noDelete, aber ohne Archiv Flag
#=> in L4 sind jetzt die, die das Archiv Flag gesetzt haben
#
#12. keepMinNumber - minimal zu behaltende in Sicherheit bringen
#    n = keepMinNumber - scalar(L4)  # die zu archivierenden abziehen
#    die n jüngsten in Sicherheit bringen:
#    betroffene (L3) -> (L4)     in (L3) sind die noDelete ohne Archiv-Flag
#    wenn das nicht reicht, betroffene (Llösch) -> (L4)
#
#13. keepMaxNumber - alles was über die Zahl geht löschen (außer in L4)
#    Der folgenden Reihe nach, beginnend mit den ältesten, verschieben:
#    a) (L2) -> (Llösch)
#    b) wenn noch zu viele: (L3) -> (Llösch)
#
#14. Warnung ausgeben, wenn mehr als keepMaxNumber übrigbleiben
#
#15. Alle in (Llösch) löschen
##################################################
package deleteOldBackupDirs;

sub new
{
    my $class = shift;
    my $self = {};

    my (%params) = ('-targetDir'            => undef,
		    '-doNotDelete'          => undef,
		    '-checkSumFile'         => undef,
		    '-prLog'                => undef,
		    '-today'                => undef,
		    '-keepFirstOfYear'      => undef,
		    '-keepLastOfYear'       => undef,
		    '-keepFirstOfMonth'     => undef,
		    '-keepLastOfMonth'      => undef,
		    '-firstDayOfWeek'       => undef,
		    '-keepFirstOfWeek'      => undef,
		    '-keepLastOfWeek'       => undef,
		    '-keepAll'              => undef,
		    '-keepWeekday'          => undef,
		    '-keepDuplicate'        => undef,
		    '-keepMinNumber'        => undef,
		    '-keepMaxNumber'        => undef,
		    '-statDelOldBackupDirs' => undef,
		    '-alsoCheckLastBackup'  => 'no',
		    '-flatOutput'           => 'no'
		    );


     &::checkObjectParams(\%params, \@_, 'deleteOldBackupDirs::new',
			 ['-targetDir', '-doNotDelete', '-checkSumFile',
			  '-prLog', '-today',
			  '-keepFirstOfYear', '-keepLastOfYear',
			  '-keepFirstOfMonth', '-keepLastOfMonth',
			  '-keepFirstOfWeek', '-keepLastOfWeek',
			  '-keepAll', '-keepWeekday', '-keepDuplicate',
			  '-keepMinNumber', '-keepMaxNumber',
			  '-statDelOldBackupDirs']);
    &::setParamsDirect($self, \%params);


    my $targetDir = $self->{'targetDir'};
    my $checkSumFile = $self->{'checkSumFile'};
    my $prLog = $self->{'prLog'};
    my $today = $self->{'today'};
    my $keepFirstOfYear = $self->{'keepFirstOfYear'};
    my $keepLastOfYear = $self->{'keepLastOfYear'};
    my $firstDayOfWeek = $self->{'firstDayOfWeek'};
    my $keepFirstOfMonth = $self->{'keepFirstOfMonth'};
    my $keepLastOfMonth = $self->{'keepLastOfMonth'};
    my $keepFirstOfWeek = $self->{'keepFirstOfWeek'};
    my $keepLastOfWeek = $self->{'keepLastOfWeek'};
    my $keepAll = $self->{'keepAll'};
    my $keepWeekday = $self->{'keepWeekday'};
    my $keepDuplicate = $self->{'keepDuplicate'};
    my $keepMinNumber = $self->{'keepMinNumber'};
    my $keepMaxNumber = $self->{'keepMaxNumber'};

    bless $self, $class;

    #
    # Formate überprüfen
    #
    $self->{'invalidFormat'} = undef;

    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepFirstOfYear',
			      $keepFirstOfYear, $prLog, 1);
    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepLastOfYear',
			      $keepLastOfYear, $prLog, 1);
    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepFirstOfMonth',
			      $keepFirstOfMonth, $prLog, 1);
    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepLastOfMonth',
			      $keepLastOfMonth, $prLog, 1);
    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepFirstOfWeek',
			      $keepFirstOfWeek, $prLog, 1);
    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepLastOfWeek',
			      $keepLastOfWeek, $prLog, 1);
    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepAll',
			      $keepAll, $prLog, undef);
    $self->{'invalidFormat'} = 1 unless
	&checkTimeScaleFormat('keepDuplicate',
			      $keepDuplicate, $prLog, undef);
    unless ($firstDayOfWeek =~
	    /\ASun\Z|\AMon\Z|\ATue\Z|\AWed\Z|\AThu\Z|\AFri\Z|\ASat\Z/o)
    {
	$self->{'invalidFormat'} = 1;
	$prLog->print('-kind' => 'E',
		      '-str' => ["unknown week day <$firstDayOfWeek> at " .
				 "parameter --firstDayOfWeek, must be one " .
				 "Sun, Mon, Tue, Wed, Thu, Fri, Sat"]);
    }
    my $nodelete = "do not delete anything because of previous error";
    if ($keepMinNumber > $keepMaxNumber and $keepMaxNumber > 0)
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["keepMinNumber ($keepMinNumber) > " .
			       " keepMaxNumber: ($keepMaxNumber)", $nodelete]
		      );
	$self->{'invalidFormat'} = 1;
    }
    $prLog->print('-kind' => 'E',
		  '-str' => ["exiting because of previous errors"],
		  '-exit' => 1)
	if $self->{'invalidFormat'};

    # Directorieeinträge der alten Backups einlesen
    my $dirs = allStoreBackupDirs->new('-rootDir' => $targetDir,
				       '-checkSumFile' => $checkSumFile,
				       '-prLog' => $prLog,
				       '-absPath' => 0);
    my (@l1) = $dirs->getAllDirs();
    pop @l1 if ($self->{'alsoCheckLastBackup'} eq 'no');

    $self->{'l1'} = \@l1;
    ($self->{'weekDayHash'}, $self->{'dayObject'}) = &calcWeekDayHash(\@l1);

    return $self if @l1 == 0;             # noch nichts da

#    print "dirs =\n\t", join("\n\t", @l1), "\n------------\n";

    # Format von keepWeekDay überprüfen und besser eintragen
    $self->calcWeekdayDuration(\@l1); 
    # Ergebnis steht in Hash $self->{'weekDayDuration'}

    return $self;
}


############################################################
sub checkBackups
{
    my $self = shift;

    my $targetDir = $self->{'targetDir'};
    my $checkSumFile = $self->{'checkSumFile'};
    my $prLog = $self->{'prLog'};
    my $today = $self->{'today'};
    my $keepFirstOfYear = $self->{'keepFirstOfYear'};
    my $keepLastOfYear = $self->{'keepLastOfYear'};
    my $firstDayOfWeek = $self->{'firstDayOfWeek'};
    my $keepFirstOfMonth = $self->{'keepFirstOfMonth'};
    my $keepLastOfMonth = $self->{'keepLastOfMonth'};
    my $keepFirstOfWeek = $self->{'keepFirstOfWeek'};
    my $keepLastOfWeek = $self->{'keepLastOfWeek'};
    my $keepAll = $self->{'keepAll'};
    my $keepWeekday = $self->{'keepWeekday'};
    my $keepDuplicate = $self->{'keepDuplicate'};
    my $keepMinNumber = $self->{'keepMinNumber'};
    my $keepMaxNumber = $self->{'keepMaxNumber'};
    my $flatOutput = $self->{'flatOutput'};

    my (@l1) = @{$self->{'l1'}};
    my (@lLoesch) = ();
    $self->{'lLoesch'} = \@lLoesch;
    if (@l1 == 0)
    {
	$prLog->print('-kind' => 'I',
		      '-str' =>
		      ["no old backups yet, nothing to delete"]);
	return;
    }
 
    my $weekDayHash = $self->{'weekDayHash'};
    my $dayObject = $self->{'dayObject'};

    my (%notDelPrintHash); # Für die Ausgabe ins log file werden
                           # hier die Informationen gespeichert,
                           # welche Directories nicht gelöscht werden
    # Format: Hash mit Hash: Dir -> firstDayOfWeek(a), lastDayOfMonth, ...
    my $l;
    foreach $l (@l1)
    {
	$notDelPrintHash{$l} = undef;    # Annahme: wird gelöscht
    }

#1. Duplikate eines Tages separieren:
#   betroffene (aller außer den Letzten des Tages) von (L1) -> (L2)
    my (@l2) = &separateDuplicateOfTheDays(\@l1);
#    print "l1 =\n\t", join("\n\t", @l1), "\n";
#    print "l2 =\n\t", join("\n\t", @l2), "\n";

#2. keepDuplicate - zu alte Duplikate löschen:
#   betroffene von (L2) -> (Llösch)
    (@lLoesch) =
	&delOldDuplicates(\@l2, $today, $keepDuplicate, $prLog,
			  $weekDayHash, $dayObject, \%notDelPrintHash);
#    print "2. lLoesch =\n\t", join("\n\t", @lLoesch), "\n";

#3. keepFirstOfYear - ersten eines Jahres behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
    my (%archiveFlags) = ();    # Hash mit allen Directories, die das Archive
                                # Flag gesetzt bekommen 
    my (%notDeleteFlags) = ();  # Hash mit allen Directories, die nicht
                                # gelöscht werden sollen
    &keepFirstMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
			'keepFirstOfYear', $keepFirstOfYear, $dayObject,
			\%notDelPrintHash);
#    print "3. keepFirstOfYear\n";
#    print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
#    "\n------------\n";
#    print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
#    "\n------------\n";

#4. keepLastOfYear - letzten eines Jahres behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
    &keepLastMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
			'keepLastOfYear', $keepLastOfYear, $dayObject,
		       \%notDelPrintHash);
#    print "4. keepLastOfYear\n";
#    print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
#    "\n------------\n";
#    print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
#    "\n------------\n";

#5. keepFirstOfMonth - ersten eines Monats behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
    &keepFirstMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
			'keepFirstOfMonth', $keepFirstOfMonth, $dayObject,
			\%notDelPrintHash);
#    print "5. keepFirstOfMonth\n";
#    print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
#    "\n------------\n";
#    print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
#    "\n------------\n";

#6. keepLastOfMonth - letzten eines Monats behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
    &keepLastMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
			'keepLastOfMonth', $keepLastOfMonth, $dayObject,
		       \%notDelPrintHash);
#    print "6. keepLastOfMonth\n";
#    print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
#    "\n------------\n";
#    print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
#    "\n------------\n";

    if ($keepFirstOfWeek or $keepLastOfWeek)
    {
#7. keepFirstOfWeek - ersten einer Woche behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
	my $deltaWeekDayDays =
	    &calcDeltaWeekDayDays(\@l1, $firstDayOfWeek, $prLog, $dayObject);
	&keepFirstWeek(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
		       $keepFirstOfWeek, $deltaWeekDayDays, $dayObject,
		       \%notDelPrintHash);
#	print "7. keepFirstOfWeek\n";
#	print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
#	"\n------------\n";
#	print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
#	"\n------------\n";

#8. keepLastOfWeek - letzten einer Woche behalten:
#   (immer den letzten des Tages!)
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
	&keepLastWeek(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
		       $keepLastOfWeek, $deltaWeekDayDays, $dayObject,
		      \%notDelPrintHash);
#	print "8. keepLastOfWeek\n";
#	print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
#	"\n------------\n";
#	print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
#	"\n------------\n";
    }

#9. keepWeekday (berücksichtigt Defaultwerte von keepAll) -
#	       alle noch nicht zu alten behalten:
#   betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
    $self->keepWeekdays(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
			$keepWeekday, \%notDelPrintHash);
#    print "9. keepWeekday\n";
#    print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
#    "\n------------\n";
#    print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
#    "\n------------\n";

#10. Backups mit Flag 'notDelete' verschieben:
#    betroffene (L1) -> (L3), wenn kein Archiv Flag
#    betroffene (L1) -> (L4), wenn Archiv Flag
    my (@l3, @l4);
    &moveBackupsWithFlags(\@l1, \@l3, \@l4, \%archiveFlags, \%notDeleteFlags);

#11. alle (L1) -> (Llösch) verschieben
#
#=> in Llösch sind die bisher zu löschenden Backupverzeichnisse
#=> L1 ist leer
#=> in L2 sind jetzt die Duplikate
#=> in L3 sind die mit noDelete, aber ohne Archiv Flag
#=> in L4 sind jetzt die, die das Archiv Flag gesetzt haben
    (@lLoesch) = sort (@lLoesch, @l1);
    (@l1) = ();
#    print "11. Backups mit Flag 'notDelete' verschieben + lLösch füllen\n";
#    print "lLoesch (", scalar(@lLoesch), ") =\n\t",
#    join("\n\t", @lLoesch), "\n";
#    print "notDelete (", scalar(@l3), "), l3 =\n\t", join("\n\t", @l3), "\n";
#    print "archiveFlag (", scalar(@l4), "), l4 =\n\t", join("\n\t", @l4), "\n";

#12. keepMinNumber - minimal zu behaltende in Sicherheit bringen
#    n = keepMinNumber - scalar(L4)  # die zu archivierenden abziehen
#    die n jüngsten in Sicherheit bringen:
#    betroffene (L3) -> (L4)     in (L3) sind die noDelete ohne Archiv-Flag
#    wenn das nicht reicht, betroffene (Llösch) -> (L4)
    &keepMinNumber(\@l3, \@l4, \@lLoesch, $keepMinNumber - @l4,
		   \%notDelPrintHash);
#    print "12. keepMinNumber\n";
#    print "lLoesch (", scalar(@lLoesch), ") =\n\t",
#    join("\n\t", @lLoesch), "\n";
#    print "notDelete (", scalar(@l3), "), l3 =\n\t", join("\n\t", @l3), "\n";
#    print "archiveFlag (", scalar(@l4), "), l4 =\n\t", join("\n\t", @l4), "\n";
#    print "Duplikate (", scalar(@l2), "), l2 =\n\t", join("\n\t", @l2), "\n";

#13. keepMaxNumber - alles was über die Zahl geht löschen (außer in L4)
#    Der folgenden Reihe nach, beginnend mit den ältesten, verschieben:
#    a) (L2) -> (Llösch)
#    b) wenn noch zu viele: (L3) -> (Llösch)
    &keepMaxNumber(\@l2, \@l3, \@lLoesch, @l4 + @l3 + @l2 - $keepMaxNumber,
		   \%notDelPrintHash)
	if ($keepMaxNumber);
#    print "13. keepMaxNumber\n";
#    print "lLoesch = (", scalar(@lLoesch),
#    ")\n\t", join("\n\t", @lLoesch), "\n";
#    print "notDelete (", scalar(@l3), "), l3 =\n\t", join("\n\t", @l3), "\n";
#    print "archiveFlag (", scalar(@l4), "), l4 =\n\t", join("\n\t", @l4), "\n";
#    print "Duplikate (", scalar(@l2), "), l2 =\n\t", join("\n\t", @l2), "\n";

#14. Warnung ausgeben, wenn mehr als keepMaxNumber übrigbleiben
    $prLog->print('-kind' => 'W',
		  '-str' =>
		  ["keeping " . (@l4 + @l3 + @l2) . " backups," .
		   " this is more than keepMaxNumber ($keepMaxNumber)"])
	if ($keepMaxNumber > 0 and @l4 + @l3 + @l2 > $keepMaxNumber);

    $self->{'lLoesch'} = \@lLoesch;

# Ausgabe ins Log File, was gelöscht wird und was nicht
    my (@p) = ("analysis of old Backups in <$targetDir>:");
    foreach $l (sort keys %notDelPrintHash)
    {
	my $reason = $notDelPrintHash{$l};
	my $deltaDays = $$dayObject{$l}->deltaInDays('-secondDate' => $today);
	my $p = $$weekDayHash{$l} . " $l ($deltaDays): ";
	my ($r, @r);
#print $$weekDayHash{$l} . " $l: ";
	foreach $r (sort keys %$reason)
	{
	    if ($r eq 'keepMaxNumber')
	    {
		unshift @r, "will be deleted ($r)";
	    }
	    else
	    {
		my $a = $$reason{$r};
		$a = "($a)" if $a;
		push @r, "$r$a";
	    }
	}
	if (@r)
	{
	    $p .= join(', ', @r);
#print join(', ', @r), "\n";
	}
	else
	{
	    $p .= "will be deleted";
#print "will be deleted\n";
	}
	push @p, "   $p";
    }
    if ($flatOutput eq 'no')
    {
	$prLog->print('-kind' => 'I',    # Auf einmal ausgeben, wird dann
		      '-str' => [@p]);    # nicht getrennt
    }
    else
    {
	$prLog->pr(@p);
    }
}


############################################################
sub deleteBackups
{
    my $self = shift;

    my $targetDir = $self->{'targetDir'};
    my $doNotDelete = $self->{'doNotDelete'};
    my $prLog = $self->{'prLog'};
    my $statDelOldBackupDirs = $self->{'statDelOldBackupDirs'};

    my $lLoesch = $self->{'lLoesch'};
    my $wdh = $self->{'weekDayHash'};

    return if (@$lLoesch == 0);

#15. Alle in (Llösch) löschen

    if ($doNotDelete)
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["testmode: do not delete any files"]);
    }
    else
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["deleting in backup <$targetDir>:"]);
	my $l;
	foreach $l (@$lLoesch)
	{
	    $prLog->print('-kind' => 'I',
			  '-str' => ["  deleting " . $$wdh{$l} . " $l"]);
	    $statDelOldBackupDirs->incr_noDeletedOldDirs();
	    my $rdd = recursiveDelDir->new('-dir' => "$targetDir/$l",
					   '-prLog' => $prLog);
	    my ($dirs, $files, $bytes, $links) = $rdd->getStatistics();
	    $statDelOldBackupDirs->addFreedSpace($dirs, $files,
						$bytes, $links);
	    my ($b) = &::humanReadable($bytes);
	    $prLog->print('-kind' => 'I',
			  '-str' => ["    freed $b ($bytes), $files files"]);
	}
#	$statDelOldBackupDirs->print();
    }
}


##################################################
sub calcWeekDayHash
{
    my $l1 = shift;

    my ($l, %weekDayHash, %dayObject);
    foreach $l (@$l1)
    {
	my ($year, $month, $day, $hour, $min, $sec) = $l =~
	    /\A(\d{4})\.(\d{2})\.(\d{2})_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
	my $p = dateTools->new('-year' => $year,
			       '-month' => $month,
			       '-day' => $day,
			       '-hour' => $hour,
			       '-min' => $min,
			       '-sec' => $sec);
	$dayObject{$l} = $p;
	$weekDayHash{$l} = $p->getWeekDayName();
    }

    return (\%weekDayHash, \%dayObject);
}


##################################################
sub calcWeekdayDuration
{
    my $self = shift;
    my $l1 = shift;             # Zeiger auf Liste mit allen Backup Dirs

    my $prLog = $self->{'prLog'};
    my $keepAll = $self->{'keepAll'};
    my $keepWeekday = $self->{'keepWeekday'};

    my $keepAllSecs = &dateTools::strToSec('-str' => $keepAll);

    my (%weekDayDuration) = ('Sun' => $keepAll,
			     'Mon' => $keepAll,
			     'Tue' => $keepAll,
			     'Wed' => $keepAll,
			     'Thu' => $keepAll,
			     'Fri' => $keepAll,
			     'Sat' => $keepAll);
    my $entry;
    foreach $entry (split(/\s+/, $keepWeekday))
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["invalid format <$entry> for option " .
				 "--keepWeekday, exiting"],
		      '-exit' => 1)
	    unless ($entry =~ /\A([\w,]+):(\w+)\Z/o);
	my ($days, $duration) = ($1, $2);
	my $archiveFlag = undef;
	if ($duration =~ /\Aa(.*)/o)    # archive Flag gesetzt
	{
	    $duration = $1;
	    $archiveFlag = 1;
	}
	$prLog->print('-kind' => 'E',
		      '-str' =>
		      ["invalid format <$duration> for week day(s) " .
		       "<$days> for option --keepWeekday, exiting"],
		      '-exit' => 1)
	    unless (&dateTools::checkStr('-str' => $duration));

	my $secs = &dateTools::strToSec('-str' => $duration);
	if ($secs > $keepAllSecs)
	{
	    my $d;
	    foreach $d (split(/,/, $days))
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["unknown week day <$d> for option " .
					 "--keepWeekday, exiting"],
			      '-exit' => 1)
		    unless exists $weekDayDuration{$d};
		$duration = 'a' . $duration
		    if $archiveFlag and not $duration =~ /\Aa/;
		$weekDayDuration{$d} = $duration;
	    }
	}
    }

#    my $d;
#    foreach $d (keys %weekDayDuration)
#    {
#	print "$d -> ", $weekDayDuration{$d}, "\n";
#    }

    $self->{'weekDayDuration'} = \%weekDayDuration;
}


##################################################
sub separateDuplicateOfTheDays
{
    my $l1 = shift;         # Zeiger auf @l1

    my (@l1, @l2, $d, $d_old, $i);
    $i = 0;
    foreach $d (@$l1)
    {
	if ($d_old)
	{
	    if (substr($d, 0, 10) eq substr($d_old, 0, 10))
	    {
		push @l2, $d_old;
	    }
	    else
	    {
		push @l1, $d_old;
	    }
	}
	$d_old = $d;
    }
    push @l1, $d_old;      # das letzte Directory

    @$l1 = @l1;

    return (@l2);
}


##################################################
sub delOldDuplicates
{
    my $l2 = shift;
    my $today = shift;
    my $keepDuplicate = shift;
    my $prLog = shift;
    my $weekDayHash = shift;
    my $dayObject = shift;
    my $notDelPrintHash = shift;

    # Zeitpunkt ermitteln, ab dem gelöscht werden soll
    my $delPoint = $today->copy();
    $delPoint->sub('-str' => $keepDuplicate);

    my (@l2, @Lloesch, $l);
    foreach $l (@$l2)
    {
	my $p = $$dayObject{$l};
#print "delOldDuplicates: ", $delPoint->getDateTime(), " - ",
# $p->getDateTime(), "\n";
	if ($delPoint->compare('-object' => $p) == -1  # zu alt
	    and $keepDuplicate)                        # überhaupt was zu tun
	{
#print "\tdrin\n";
	    push @Lloesch, $l;
	}
	else
	{
	    push @l2, $l;
	    my $duration = $keepDuplicate ? $keepDuplicate : 'all';
	    $$notDelPrintHash{$l}{"keepDuplicate($duration)"} = '';
	}
    }

    @$l2 = @l2;

    return (@Lloesch);
}


##################################################
sub keepFirstMonthYear
{
    my $l1 = shift;
    my $today = shift;
    my $archiveFlags = shift;
    my $notDeleteFlags = shift;
    my $what = shift;        # 'keepFirstOfYear' or 'keepFirstOfMonth'
    my $timescale = shift;   # wie lange zurück?
    my $dayObject = shift;
    my $notDelPrintHash = shift;

    return unless $timescale;

    my $length = ($what eq 'keepFirstOfYear') ? 4 : 7;

    # erst mal alle merken, die die Ersten sind
    my ($i, %first);
    my $d_old = $$l1[0];
    $first{$d_old} = 1;
    for ($i = 1 ; $i < @$l1 ; $i++)
    {
	my $d = $$l1[$i];
	if (substr($d, 0, $length) ne substr($d_old, 0, $length))
	{
	    $first{$d} = 1;
	}
	$d_old = $d;
    }

    &setFlags($timescale, $today, \%first, $notDeleteFlags,
	      $archiveFlags, $dayObject, "$what($timescale)",
	      $notDelPrintHash);
}


##################################################
sub keepLastMonthYear
{
    my $l1 = shift;
    my $today = shift;
    my $archiveFlags = shift;
    my $notDeleteFlags = shift;
    my $what = shift;        # 'keepLastOfYear' or 'keepLastOfMonth'
    my $timescale = shift;   # wie lange zurück?
    my $dayObject = shift;
    my $notDelPrintHash = shift;

    return unless $timescale;

    my $length = ($what eq 'keepLastOfYear') ? 4 : 7;

    # erst mal alle merken, die Ersten sind
    my ($i, %last);
    my $d_old = $$l1[0];
    for ($i = 1 ; $i < @$l1 ; $i++)
    {
	my $d = $$l1[$i];
	if (substr($d, 0, $length) ne substr($d_old, 0, $length))
	{
	    $last{$d_old} = 1;
	}
	$d_old = $d;
    }
    $last{$d_old} = 1;

    &setFlags($timescale, $today, \%last, $notDeleteFlags,
	      $archiveFlags, $dayObject, "$what($timescale)",
	      $notDelPrintHash);
}


##################################################
sub calcDeltaWeekDayDays
{
    my $l1 = shift;
    my $firstDayOfWeek = shift;
    my $prLog = shift;
    my $dayObject = shift;

    my $l = $$l1[0];
    my ($year, $month, $day) = $l =~ /\A(\d{4})\.(\d{2})\.(\d{2})/o;
    my $refDate = dateTools->new('-year' => $year,
				 '-month' => $month,
				 '-day' => $day);
    my $index = $refDate->dayOfWeek();           # Son == 0
    my (%wd) = ('Sun' => 0,
		'Mon' => 1,
		'Tue' => 2,
		'Wed' => 3,
		'Thu' => 4,
		'Fri' => 5,
		'Sat' => 6);
    my $indexRefDate = $wd{$firstDayOfWeek};
    $prLog->print('-kind' => 'E',
		  '-str' =>
		  ["unknown weekday <$firstDayOfWeek> for --firstDayOfWeek"],
		  '-exit' => 1)
	unless exists $wd{$firstDayOfWeek};

    $refDate->sub('-day' => 7 + $index - $indexRefDate);
#print "refDate = ", $refDate->getDateTime(), ", index = $index,
# indexRefDate = $indexRefDate\n";

    my (@deltaWeekDayDays);
    foreach $l (@$l1)
    {
	my $p = $$dayObject{$l};
	my $delta = $refDate->deltaInDays('-secondDate' => $p);
	push @deltaWeekDayDays, int($delta / 7);
#print "\t$l -> ", int($delta / 7), "\n";
    }

    return \@deltaWeekDayDays;
}


##################################################
sub keepFirstWeek
{
    my $l1 = shift;
    my $today = shift;
    my $archiveFlags = shift;
    my $notDeleteFlags = shift;
    my $keepFirstOfWeek = shift;
    my $deltaWeekDayDays = shift;
    my $dayObject = shift;
    my $notDelPrintHash = shift;

    return unless $keepFirstOfWeek;

    my ($i, %first);
    $first{$$l1[0]} = 1;
    for ($i = 1 ; $i < @$l1 ; $i++)
    {
	if ($$deltaWeekDayDays[$i] != $$deltaWeekDayDays[$i-1])
	{
	    $first{$$l1[$i]} = 1;
#print "keepFirstWeek = ", $$l1[$i], "\n";
	}
    }

#print "firstOfWeek =\n\t", join("\n\t", sort keys %first), "\n";
    &setFlags($keepFirstOfWeek, $today, \%first,
	      $notDeleteFlags, $archiveFlags, $dayObject,
	      "keepFirstOfWeek($keepFirstOfWeek)", $notDelPrintHash);
}


##################################################
sub keepLastWeek
{
    my $l1 = shift;
    my $today = shift;
    my $archiveFlags = shift;
    my $notDeleteFlags = shift;
    my $keepLastOfWeek = shift;
    my $deltaWeekDayDays = shift;
    my $dayObject = shift;
    my $notDelPrintHash = shift;

    return unless $keepLastOfWeek;

    my ($i, %last);
    for ($i = 0 ; $i < @$l1 ; $i++)
    {
	if ($$deltaWeekDayDays[$i] != $$deltaWeekDayDays[$i-1])
	{
	    $last{$$l1[$i-1]} = 1;
#print "keepLastWeek = ", $$l1[$i-1], "\n";
	}
    }
    $last{$$l1[$i-1]} = 1;
#print "keepLastWeek = ", $$l1[$i-1], "\n";

#print "lastOfWeek =\n\t", join("\n\t", sort keys %last), "\n";
    &setFlags($keepLastOfWeek, $today, \%last,
	      $notDeleteFlags, $archiveFlags, $dayObject,
	      "keepLastOfWeek($keepLastOfWeek)", $notDelPrintHash);
}


##################################################
sub keepWeekdays
{
    my $self = shift;

    my $l1 = shift;
    my $today = shift;
    my $archiveFlags = shift;
    my $notDeleteFlags = shift;
    my $keepWeekday = shift;
    my $notDelPrintHash = shift;

    my $weekDayDuration = $self->{'weekDayDuration'};
    my $weekDayHash = $self->{'weekDayHash'};
    my $dayObject = $self->{'dayObject'};

    my ($l, @l1WeekDayName);
    foreach $l (@$l1)
    {
	push @l1WeekDayName, $$weekDayHash{$l};
    }

    my $wName;
    foreach $wName (keys %$weekDayDuration)   # Sun, Mon, Thu, etc.
    {
	my (%list, $i);
	for ($i = 0 ; $i < @$l1 ; $i++)
	{
	    my $w = $l1WeekDayName[$i];
	    next unless $w eq $wName;   # Listen für einen Wochentag aufbauen

	    $list{$$l1[$i]} = 1;
	}
#print "--$wName--(", $$weekDayDuration{$wName}, ")\n";
	&setFlags($$weekDayDuration{$wName}, $today, \%list,
		  $notDeleteFlags, $archiveFlags, $dayObject,
		  'keepWeekDays(' . $$weekDayDuration{$wName} . ')',
		  $notDelPrintHash);
    }
}

##################################################
sub setFlags
{
    my ($timescale, $today, $hash, $notDeleteFlags,
	$archiveFlags, $dayObject, $what, $notDelPrintHash) = @_;

    # festellen, wie lange behalten werden soll
    my $archiveFlag = undef;
    if ($timescale =~ /\Aa(.*)/o)    # archive Flag gesetzt
    {
	$timescale = $1;
	$archiveFlag = 1;
    }

    my $delPoint = $today->copy();
    $delPoint->sub('-str' => $timescale);

    my $l;
    foreach $l (keys %$hash)
    {
	my $p = $$dayObject{$l};
#print "delPoint: ", $delPoint->getDateTime(), " - ", $p->getDateTime(), "\n";
	if ($delPoint->compare('-object' => $p) == 1)  # im Zeitfenster
	{
#print "\tdrin\n";
	    $$notDeleteFlags{$l} = 1;
	    if ($archiveFlag)
	    {
		$$archiveFlags{$l} = 1;
		$$notDelPrintHash{$l}{$what} = '';
	    }
	    else
	    {
		$$notDelPrintHash{$l}{$what} = '';
	    }
	}
    }
}


##################################################
sub moveBackupsWithFlags
{
    my ($l1, $l3, $l4, $archiveFlags, $notDeleteFlags) = @_;

    my ($l, @l1New);
    foreach $l (@$l1)
    {
	if ($$notDeleteFlags{$l})     # Löschen
	{
	    if ($$archiveFlags{$l})   # zusätzlich Archiv-Flag gesetzt
	    {
		push @$l4, $l;
	    }
	    else                      # Löschen, aber kein Archiv-Flag
	    {
		push @$l3, $l;
	    }
	}
	else                          # nicht löschen
	{
	    push @l1New, $l;
	}
    }

    (@$l1) = (@l1New);
}


##################################################
sub keepMinNumber
{
    my ($l3, $l4, $lLoesch, $n, $notDelPrintHash) = @_;

    return if $n <= 0;

    my (@temp);
    if ($n <= @$l3)
    {
	(@temp) = splice(@$l3, -$n, $n);
	(@$l4) = sort(@$l4, @temp);
    }
    else
    {
	$n -= @$l3;
	$n = @$lLoesch if $n > @$lLoesch;        # begrenzen
	(@temp) = (@$l3, splice(@$lLoesch, -$n, $n));
	(@$l4) = sort(@$l4, @temp);
	(@$l3) = ();
    }
    my $t;
    my $i = 0;
    foreach $t (reverse @$l4)
    {
	++$i;
	$$notDelPrintHash{$t}{"keepMinNumber$i"} = '';
    }
}


##################################################
sub keepMaxNumber
{
    my ($l2, $l3, $lLoesch, $n, $notDelPrintHash) = @_;

    return if $n < 0;

    my (@temp);
    if ($n <= @$l2)
    {
	(@temp) = splice(@$l2, 0, $n);
	(@$lLoesch) = sort(@$lLoesch, @temp);
    }
    else
    {
	$n -= @$l2;
	$n = @$l3 if $n > @$l3;        # begrenzen
	(@temp) = (@$l2, splice(@$l3, 0, $n));
	(@$lLoesch) = sort(@$lLoesch, @temp);
	(@$l2) = ();
    }
    my $t;
    foreach $t (@temp)
    {
	$$notDelPrintHash{$t}{'keepMaxNumber'} = '';
    }
}


##################################################
# überprüft Formate wie '50d3m' oder 'a50d3m' (mit Archiv-Flag)
sub checkTimeScaleFormat
{
    my ($name, $string, $prLog, $archive) = @_;
    my $nodelete = "do not delete anything because of previous error";

    if ($string =~ /\Aa/)        # Archiv-Flag gesetzt
    {
	if ($archive)            # Archiv-Flag ist erlaubt
	{
	    $string =~ s/\A.//;  # erstes Zeichen löschen
	}
	else
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["archive flag is not allowed for $name: " .
			   "<$string>", $nodelete]);
	    return undef;
	}
    }

    if ($string and not &dateTools::checkStr('-str' => $string))   # nicht ok
    {
	$prLog->print('-kind' => 'E',
		      '-str' =>
		      ["invalid format for $name: " .
		       "<$string>", $nodelete]);
	return undef;
    }

    return 1;    # alles ok
}


##################################################
# verwaltet Statistik-Daten für's Löschen mit package deleteOldBackupDirs
package statisticDeleteOldBackupDirs;

sub new
{
    my $class = shift;
    my $self = {};

    my (%params) = ('-prLog' => undef,
		    '-kind' => 'S'      # 'S' für 'Statistic'
		    );

    &::checkObjectParams(\%params, \@_, 'statisticDeleteOldBackupDirs::new',
			 ['-prLog']);
    &::setParamsDirect($self, \%params);

    $self->{'noDeletedOldDirs'} = 0;
    $self->{'freedSpace'} = undef;
    $self->{'dirs'} = 0;
    $self->{'files'} = 0;
    $self->{'bytes'} = 0;
    $self->{'links'} = 0;

    bless $self, $class;
}


########################################
sub incr_noDeletedOldDirs
{
    my $self = shift;
    ++$self->{'noDeletedOldDirs'};
}


########################################
sub addFreedSpace
{
    my $self = shift;
    my ($dirs, $files, $bytes, $links) = @_;

    $self->{'dirs'} += $dirs;
    $self->{'files'} += $files;
    $self->{'bytes'} += $bytes;
    $self->{'links'} += $links;
}


########################################
sub print
{
    my $self = shift;

    my $prLog = $self->{'prLog'};
    my $kind => $self->{'kind'};

    $prLog->print
	('-kind' => $kind,
	 '-str' =>
	 [
	  '           deleted old backups = ' . $self->{'noDeletedOldDirs'},
	  '           deleted directories = ' . $self->{'dirs'},
	  '                 deleted files = ' . $self->{'files'},
	  '          (only)  remove links = ' . $self->{'links'},
	  'freed space in old directories = ' .
	  (&::humanReadable($self->{'bytes'}))[0] . ' (' .
	  $self->{'bytes'} . ')'
	  ]);
}


##################################################
# liest alle Directory-Einträge bestehender Backups ein,
# kann nach verschiedenen Kriterien sortieren bzw. filtern
package allStoreBackupDirs;

sub new
{
    my $class = shift;
    my $self = {};

    my (%params) = ('-rootDir'      => undef,
		    '-checkSumFile' => undef,
		    '-prLog'        => undef,
		    '-absPath'     => 1       # default: ja (0 = nein)
		    );                        # (Dirs mit Pfad oder ohne)

    &::checkObjectParams(\%params, \@_, 'allStoreBackupDirs::new',
			 ['-rootDir', '-checkSumFile', '-prLog']);
    &::setParamsDirect($self, \%params);

    my $rootDir = $self->{'rootDir'};
    my $prLog = $self->{'prLog'};
    my $absPath = $self->{'absPath'};

    local *DIR;
    opendir(DIR, $rootDir) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot opendir <$rootDir>, exiting"],
		      '-exit' => 1);
    my (@dirs, $entry);
    while ($entry = readdir DIR)
    {
	next if (-l $entry and not -d $entry);   # nur Directories interessant
	next unless $entry =~                    # Dateiname muß passen
	    /\A(\d{4})\.(\d{2})\.(\d{2})_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
	my $dir = $absPath ? "$rootDir/$entry" : $entry;
	$dir =~ s/\/\//\//go;                  # doppelte / entfernen
	push @dirs, $dir;
    }
    closedir(DIR);

    @dirs = sort @dirs;              # ältestes zuerst
    $self->{'dirs'} = \@dirs;        # merken

    $self->{'prevCount'} = @dirs;

    bless $self, $class;
}


########################################
sub getAllDirs
{
    my $self = shift;

    return @{$self->{'dirs'}};      # aufsteigend sortierte Liste
}


########################################
sub getAllFinishedDirs             # berücksichtigt checkSumFile.notFinished
{
    my $self = shift;

    my $checkSumFile = $self->{'checkSumFile'};
    my $rootDir = $self->{'rootDir'};
    my @fDirs;
    my $d;
    foreach $d (@{$self->{'dirs'}})
    {
	local *DIR;
	opendir(DIR, "$rootDir/$d") or next;     # falls über NFS -> update
	closedir(DIR);
	push @fDirs, $d unless (-f "$rootDir/$d/$checkSumFile.notFinished");
    }

    return @fDirs;
}


########################################
sub setPrevDirStart
{
    my $self = shift;
    my $startValue = shift;         # 0 = letzter Wert,
                                    # 1 = zweitletzter Wert, etc.

    $self->{'prevCount'} = @{$self->{'dirs'}} - $startValue;
}


########################################
sub getPrev                         # ein primitiver Iterator
{
    my $self = shift;

    my $dirs = $self->{'dirs'};
    if (--$self->{'prevCount'} >= 0)
    {
	return $$dirs[$self->{'prevCount'}];
    }
    else
    {
	$self->{'prevCount'} = @$dirs;
	return undef;
    }
}


########################################
sub getFinishedPrev              # berücksichtigt checkSumFile.notFinished
{
    my $self = shift;

    my $prev;
    my $prLog = $self->{'prLog'};
    my $checkSumFile = $self->{'checkSumFile'};

    while ($prev = $self->getPrev())
    {
	local *DIR;
	opendir(DIR, "$prev") or next;     # falls über NFS -> update
	closedir(DIR);

	return $prev unless (-f "$prev/$checkSumFile.notFinished");

	$prLog->print('-kind' => 'W',
		      '-str' =>
		      ["$prev/$checkSumFile not finished, skipping"]);
    }
    return undef;
}


##################################################
package readCheckSumFile;

sub new
{
    my $class = shift;
    my $self = {};

    my (%params) = ('-checkSumFile' => undef,
		    '-prLog'        => undef);

    &::checkObjectParams(\%params, \@_, 'readCheckSumFile::new',
			 ['-prLog', '-checkSumFile']);
    &::setParamsDirect($self, \%params);

    my $prLog = $self->{'prLog'};
    my $checkSumFile = $self->{'checkSumFile'};

    unless (-f "$checkSumFile.info")
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot find <$checkSumFile.info>"],
		      '-exit' => 1);
    }

    local *FILE;
    open(FILE, "$checkSumFile.info") or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot open <$checkSumFile.info>"],
		      '-exit' => 1);
    my ($l, %meta, @meta);
    while ($l = <FILE>)
    {
	chop $l;
	my ($key, $val) = $l =~ /\A\s*([^=]+)=(.*?)\s*\Z/;
	next unless defined $val;
	$meta{$key} = $val;
	push @meta, $key;           # für die Reihenfolge
    }
    close(FILE);
    unless ($meta{'version'})
    {
	$meta{'version'} eq '1.0';
	(@meta) = ('version', @meta);
    }
    $self->{'metaVal'} = \%meta;
    $self->{'metaKey'} = \@meta;

    if (-f "$checkSumFile.bz2")
    {
	$self->{'filename'} = "$checkSumFile.bz2";
	$self->{'compressed'} = 'yes';
    }
    elsif (-f "$checkSumFile")
    {
	$self->{'filename'} = "$checkSumFile";
	$self->{'compressed'} = 'no';
    }
    else
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot find <$checkSumFile>"],
		      '-exit' => 1);
    }

    $self->{'CHECKSUMFILE'} = undef;

    bless $self, $class;
}


########################################
sub checkSumFileCompressed      # returns 'yes' or 'no'
{
    my $self = shift;

    return $self->{'compressed'};
}


########################################
sub getMetaVal
{
    my $self = shift;

    return $self->{'metaVal'};
}


########################################
sub getMetaKey
{
    my $self = shift;

    return $self->{'metaKey'};
}


########################################
sub getVersion
{
    my $self = shift;

    my $metaVal = $self->{'metaVal'};
    return $$metaVal{'version'};
}


########################################
sub getFilename
{
    my $self = shift;

    return $self->{'filename'};
}


########################################
sub nextLine
{
    my $self = shift;

    my $checkSumFile = $self->{'checkSumFile'};
    my $prLog = $self->{'prLog'};
    my $l;
    local *FILE;
    if ($self->{'CHECKSUMFILE'} eq undef)
    {
	if (-f "$checkSumFile.bz2")
	{
	    open(FILE, "bzip2 -d < $checkSumFile.bz2 |") or
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["cannot open <$checkSumFile.bz2>"],
			      '-exit' => 1);
	}
	elsif (-f "$checkSumFile")
	{
	    open(FILE, "< $checkSumFile") or
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["cannot open <$checkSumFile>"],
			      '-exit' => 1);
	}
	else
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot find <$checkSumFile>"],
			  '-exit' => 1);
	}

	$l = <FILE>;        # erste Kommentarzeile lesen und vergessen
	$self->{'CHECKSUMFILE'} = *FILE;
    }
    else
    {
	*FILE =  $self->{'CHECKSUMFILE'};
    }

again:
    $l = <FILE>;
    return () unless $l;

    chop $l;
    my ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
	$size, $uid, $gid, $mode, $filename);
    my $n = ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
	     $size, $uid, $gid, $mode, $filename) = split(/\s+/, $l, 12);

    if ($n != 12)
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot read line $. in file <" .
				 "$checkSumFile>, line is ..." .
				 "\t$l"]);
	goto again;
    }

    # $filename mit Sonderzeichen wiederherstellen
    $filename =~ s/\\0A/\n/og;    # '\n' wiederherstellen
    $filename =~ s/\\5C/\\/og;    # '\\' wiederherstellen

    return ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime,
	    $atime, $size, $uid, $gid, $mode, $filename);
}


########################################
sub DESTROY
{
    my $self = shift;

    if ($self->{'CHECKSUMFILE'})
    {
	local *FILE = $self->{'CHECKSUMFILE'};

	close(FILE);
	$self->{'CHECKSUMFILE'} = undef;
    }
}


##################################################
package writeCheckSumFile;

sub new
{
    my $class = shift;
    my $self = {};

    my (%params) = ('-checkSumFile'    => undef,   # voller Pfad
		    '-infoLines'       => [],      # Zeilen ohne \n für .info
		    '-prLog'           => undef,
		    '-chmodMD5File'    => undef,
		    '-compressMD5File' => 'yes');

    &::checkObjectParams(\%params, \@_, 'writeCheckSumFile::new',
			 ['-infoLines', '-prLog', '-chmodMD5File',
			  '-checkSumFile']);
    &::setParamsDirect($self, \%params);

    my $prLog = $self->{'prLog'};
    my $chmodMD5File = $self->{'chmodMD5File'};
    my $checkSumFile = $self->{'checkSumFile'};
    my $infoLines = $self->{'infoLines'};
    my $compressMD5File = $self->{'compressMD5File'};

    local *FILE;
    &::checkDelSymLink("$checkSumFile.notFinished", $prLog, 0x01);
    open(FILE, "> $checkSumFile.notFinished") or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot open <$checkSumFile.notFinished>"],
		      '-exit' => 1);
    $self->{"checkSumFile.notFinished"} = "$checkSumFile.notFinished";
    print FILE "$$\n";
    close(FILE);

    &::checkDelSymLink("$checkSumFile.info", $prLog, 0x01);
    open(FILE, "> $checkSumFile.info") or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot open <$checkSumFile.info>"],
		      '-exit' => 1);
    chmod $chmodMD5File, "$checkSumFile.info";
    my $l;
    foreach $l (@$infoLines)
    {
	print FILE "$l\n";
    }
    close(FILE);

    local *FILE;
    my $checkSumFile = $self->{'checkSumFile'};
    if ($self->{'compressMD5File'} eq 'yes')
    {
	$self->{'checkSumFile'} = "$checkSumFile.bz2";
	&::checkDelSymLink("$checkSumFile.bz2", $prLog, 0x01);
	open(FILE, "| bzip2 > $checkSumFile.bz2") or
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot open <$checkSumFile.bz2>"],
			  '-exit' => 1);
	chmod $chmodMD5File, $self->{'checkSumFile'};
    }
    else
    {
	&::checkDelSymLink($checkSumFile, $prLog, 0x01);
	open(FILE, "> $checkSumFile") or
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot open <$checkSumFile>"],
			  '-exit' => 1);
	chmod $chmodMD5File, $self->{'checkSumFile'};
    }
    print FILE "# contents/md5 compr dev-inode inodeBackup " .
	"ctime mtime atime size uid gid mode filename\n";

    $self->{'CHECKSUMFILE'} = *FILE;

    bless $self, $class;
}


########################################
sub getFilename
{
    my $self = shift;

    return $self->{'checkSumFile'};
}


########################################
sub write
{
    my $self = shift;

    my (%params) = ('-filename'    => undef,
		    '-md5sum'      => undef,
		    '-compr'       => undef,
		    '-dev'         => undef,
		    '-inode'       => undef,
		    '-inodeBackup' => undef,
		    '-ctime'       => undef,
		    '-mtime'       => undef,
		    '-atime'       => undef,
		    '-size'        => undef,
		    '-uid'         => undef,
		    '-gid'         => undef,
		    '-mode'        => undef
		    );

    &::checkObjectParams(\%params, \@_, 'aktFilename::store',
			 ['-filename', '-md5sum', '-compr', '-dev', '-inode',
			  '-inodeBackup', '-ctime', '-mtime', '-atime',
			  '-size', '-uid', '-gid', '-mode']);

    my $filename = $params{'-filename'};
    my $md5sum = $params{'-md5sum'};
    my $compr = $params{'-compr'};
    my $dev = $params{'-dev'};
    my $inode = $params{'-inode'};
    my $inodeBackup = $params{'-inodeBackup'};
    my $ctime = $params{'-ctime'};
    my $mtime = $params{'-mtime'};
    my $atime = $params{'-atime'};
    my $size = $params{'-size'};
    my $uid = $params{'-uid'};
    my $gid = $params{'-gid'};
    my $mode = $params{'-mode'};

    local *FILE;
    *FILE = $self->{'CHECKSUMFILE'};

    $filename =~ s/\\/\\5C/og;    # '\\' stored as \5C
    $filename =~ s/\n/\\0A/sog;   # '\n' stored as \0A
    $filename =~ s/^\///o;        # remove leading slash if it exists

    print FILE "$md5sum $compr $dev-$inode $inodeBackup $ctime $mtime $atime",
    " $size $uid $gid $mode $filename\n";
}


########################################
sub DESTROY
{
    my $self = shift;

    if ($self->{'CHECKSUMFILE'})
    {
	local *FILE = $self->{'CHECKSUMFILE'};
	my $filename = $self->{'checkSumFile'};

	close(FILE) or
	    $self->{'prLog'}->print('-kind' => 'E',
				    '-str' =>
				    ["cannot close <$filename>"]);

	chmod $self->{'chmodMD5File'}, $self->{'checkSumFile'}; # wg. pipe und
	                                                # compr. hier nochmals
	$self->{'CHECKSUMFILE'} = undef;
	unlink $self->{"checkSumFile.notFinished"};
    }
}



##################################################
package readConfigFile;

sub new
{
    my $class = shift;

    my $self = {};

    my (%params) = ('-configFile' => undef,
		    '-print'      => undef,
		    '-prLog'      => undef,
		    '-tmpdir'     => undef,
		    '-compress'   => undef,
		    '-uncompress' => undef,
		    '-postfix'    => undef,
		    '-noCompress' => undef,
		    '-queueCompress' => undef,
		    '-noCopy'     => undef,
		    '-queueCopy'  => undef,
		    '-exceptSuffix' => [],
		    '-chmodMD5File' => undef,
		    '-keepAll'    => undef,
		    '-keepDuplicate' => undef,
		    '-verbose'    => undef,
		    '-logInBackupDirFileName' => undef);

    &::checkObjectParams(\%params, \@_, 'readConfigFile::new',
			 ['-configFile', '-prLog', '-tmpdir',
			  '-compress', '-uncompress', '-postfix',
			  '-noCompress', '-queueCompress',
			  '-noCopy', '-queueCopy', '-exceptSuffix',
			  '-chmodMD5File', '-keepAll',
			  '-keepDuplicate',
			  '-logInBackupDirFileName']);
    &::setParamsDirect($self, \%params);

    my $ret = bless $self, $class;
    my $prLog = $self->{'prLog'};
    my $verbose = $self->{'verbose'};
    my $configFile = $self->{'configFile'};

    my (%args) = ('tmpDir' => $params{'-tmpdir'},
		  'otherBackupDirs' => undef,
		  'lockFile' => undef,
		  'unlockBeforeDel' => 'no',
		  'exceptDirs' => undef,
		  'includeDirs' => undef,
		  'contExceptDirsErr' => 'no',
		  'exceptPattern' => undef,
		  'includePattern' => undef,
		  'exceptTypes' => undef,
		  'precommand' => undef,
		  'postcommand' => undef,
		  'followLinks' => 0,
		  'compress' => $params{'-compress'},
		  'uncompress' => $params{'-uncompress'},
		  'postfix' => $params{'-postfix'},
		  'noCompress' => $params{'-noCompress'},
		  'queueCompress' => $params{'-queueCompress'},
		  'noCopy' => $params{'-noCopy'},
		  'queueCopy' => $params{'-queueCopy'},
		  'copyBWLimit' => 0,
		  'withUserGroupStat' => 'no',
		  'userGroupStatFile' => undef,
		  'exceptSuffix' => $params{'-exceptSuffix'},
		  'addExceptSuffix' => undef,
		  'compressMD5File' => 'yes',
		  'chmodMD5File' => $params{'-chmodMD5File'},
		  'verbose' => 'no',
		  'debug' => 0,
		  'resetAtime' => 'no',
		  'doNotDelete' => 'off',
		  'keepAll' => $params{'-keepAll'},
		  'keepWeekday' => undef,
		  'keepFirstOfYear' => undef,
		  'keepLastOfYear' => undef,
		  'keepFirstOfMonth' => undef,
		  'keepLastOfMonth' => undef,
		  'firstDayOfWeek' => 'Sun',
		  'keepDuplicate' => $params{'-keepDuplicate'},
		  'keepFirstOfWeek' => undef,
		  'keepLastOfWeek' => undef,
		  'keepMinNumber' => 0,
		  'keepMaxNumber' => 0,
		  'progressReport' => 0,
		  'printDepth' => 'no',
		  'ignoreReadError' => 'off',
		  'logFile' => undef,
		  'plusLogStdout' => 'off',
		  'withTime' => 'yes',
		  'maxFilelen' => 1e6,
		  'noOfOldFiles' => 5,
		  'saveLogs' => 'no',
		  'compressWith' => 'bzip2',
		  'logInBackupDir' => 'no',
		  'compressLogInBackupDir' => 'yes',
		  'logInBackupDirFileName' =>
		  $params{'-logInBackupDirFileName'});
    $self->{'args'} = \%args;

    my $rk = readKeyFromFile->new('-filename' => $configFile,
				  '-delimiter' => '\s*=',
				  '-prLog' => $prLog,
				  '-verbose' => $verbose);
    my ($noErrors, $Key, $Lineno) =
	$rk->readAndCheckKeys('-defaultValues' => \%args,
			      '-selectKeys' => [sort ((keys %args),
						      'sourceDir',
						      'targetDir')]);
    $prLog->print('-kind' => 'E',
		  '-str' => ["exiting because of previous errors"],
		  '-exit' => 1)
	if $noErrors > 0;

    $args{'sourceDir'} = undef;      # only keys existing in
    $args{'targetDir'} = undef;      # this array are allowed

    my $key;
    foreach $key (sort keys %$Key)
    {
	my $lineno = $$Lineno{$key};
	my (@l) = @{$$Key{$key}};
	my $l = $l[0];

	$prLog->print('-kind' => 'E',
		      '-str' =>
		      ["unknown key <$key> in ($configFile, $lineno)"],
		      '-exit' => 1)
	    unless (exists($args{$key}));

	if ($key eq 'sourceDir' or      # Dateinamen
	    $key eq 'targetDir' or
	    $key eq 'logFile' or
	    $key eq 'lockFile' or
	    $key eq 'userGroupStatFile' or
	    $key eq 'logInBackupDirFileName')
	{
	    $l =~ s/\\n/\n/og;
	    $l =~ s/\\t/\t/og;
	    $l =~ s/\\\\/\\/og;
	    $args{$key} = $l if ($l ne '');
	}
	elsif ($key eq 'exceptDirs' or
	       $key eq 'includeDirs' or
	       $key eq 'otherBackupDirs')
	{
	    my $i;
	    for ($i = 0 ; $i < @l ; $i++)
	    {
		$l[$i] =~ s/\\n/\n/og;
		$l[$i] =~ s/\\t/\t/og;
		$l[$i] =~ s/\\\\/\\/og;
	    }
	    $args{$key} = \@l;
	}
	elsif ($key eq 'exceptPattern' or
	       $key eq 'includePattern' or
	       $key eq 'exceptSuffix' or
	       $key eq 'addExceptSuffix' or
	       $key eq 'precommand' or
	       $key eq 'postcommand' or
	       $key eq 'keepWeekday' or
	       $key eq 'compress' or
	       $key eq 'uncompress' or
	       $key eq 'compressWith')
	{
	    $args{$key} = \@l;
	}
	elsif ($key eq 'exceptTypes')
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["illegal value for key <$key> in <$configFile, " .
			   "$lineno>, allowed are one or more of 'Sbcfpl'"],
			  '-exit' => 1)
		unless ($l =~ /\A[Sbcfpl]*\Z/);
	    $args{$key} = $l if ($l ne '');
	}
	elsif ($key eq 'unlockBeforeDel' or      # 'yes' oder 'no'
	       $key eq 'contExceptDirsErr' or
	       $key eq 'compressMD5File' or
	       $key eq 'verbose' or
	       $key eq 'resetAtime' or
	       $key eq 'withTime' or
	       $key eq 'printDepth' or
	       $key eq 'withUserGroupStat' or
	       $key eq 'saveLogs' or
	       $key eq 'logInBackupDir' or
	       $key eq 'compressLogInBackupDir')
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["illegal value for key <$key> in <$configFile, " .
			   "$lineno>, allowed is 'yes' and 'no'"],
			  '-exit' => 1)
		unless ($l eq 'yes' or $l eq 'no' or $l eq '');
	    $args{$key} = $l if ($l ne '');
	}
	elsif ($key eq 'ignoreReadError' or
	       $key eq 'doNotDelete' or
	       $key eq 'plusLogStdout')
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["illegal value for key <$key> in <$configFile, " .
			   "$lineno>, allowed is 'on' and 'off'"],
			  '-exit' => 1)
		unless ($l eq 'on' or $l eq 'off' or $l eq '');
	    $args{$key} = $l if ($l ne '');
	}
	elsif ($key eq 'followLinks' or   # kleine Zahl inkl. 0
	       $key eq 'keepMinNumber' or
	       $key eq 'keepMaxNumber' or
	       $key eq 'keepMinNumberAfterLastOfDay' or
	       $key eq 'keepMinNumberAfterLastOfDay' or
	       $key eq 'progressReport' or
	       $key eq 'noOfOldFiles' or
	       $key eq 'noCompress' or
	       $key eq 'queueCompress' or
	       $key eq 'noCopy' or
	       $key eq 'queueCopy' or
	       $key eq 'copyBWLimit')
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["illegal value for key <$key> in <$configFile, " .
			   "$lineno>, allowed are only numbers"],
			  '-exit' => 1)
		unless ($l =~ /\A\d*\Z/);
	    $args{$key} = $l if ($l ne '');
	}
	elsif ($key eq 'debug')     # Zahl: 0-2
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["illegal value for key <$key> in <$configFile, " .
			   "$lineno>, allowed are 0, 1 and 2"],
			  '-exit' => 1)
		unless ($l =~ /\A[012]?\Z/);
	    $args{$key} = $l if ($l ne '');
	}
	elsif ($key eq 'maxFilelen')     # Zahl mit Exponent
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["illegal value for key <$key> in <$configFile, " .
			   "$lineno>, allowed are numbers"],
			  '-exit' => 1)
		unless ($l =~ /\A[e\d]*\Z/);
	    $args{$key} = $l if ($l ne '');
	}
	elsif ($key eq 'chmodMD5File')    # Permissions
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["illegal value for key <$key> in <$configFile, " .
			   "$lineno>, must be a valid chmod octal number"],
			  '-exit' => 1)
		unless ($l =~ /\A0[0-7]{3,4}\Z/);
	    $args{$key} = oct $l;
	}
	else                          # keine speziellen Kontrollen
	{
	    $args{$key} = $l if ($l ne '');
	}
    }
#    $self->{'plain'} = \%config_plain;

    return $ret;
}


########################################
sub get
{
    my $self = shift;

    my $what = shift;
    my $args = $self->{'args'};
    if (exists($$args{$what}))
    {
	return $$args{$what};
    }
    else
    {
	return undef;
    }
}


########################################
sub print
{
    my $self = shift;

    my $args = $self->{'args'};
    my $prLog = $self->{'prLog'};

    my (%listVals) = ('exceptDirs' => 1,
		      'includeDirs' => 1,
		      'exceptSuffix' => 1,
		      'addExceptSuffix' => 1,
		      'exceptPattern' => 1,
		      'includePattern' => 1,
		      'precommand' => 1,
		      'postcommand' => 1,
		      'otherBackupDirs' => 1,
		      'compress' => 1,
		      'uncompress' => 1,
		      'compressWith' => 1,
		      'keepWeekday' => 1
		      );

    my $p;
    foreach $p (sort keys %$args)
    {
	if (exists $listVals{$p})
	{
	    my (@a) = @{$$args{$p}};
	    if ($p eq 'exceptDirs' or $p eq 'includeDirs')
	    {
		my (@s) = $p eq 'exceptDirs' ? ('exceptDir', 'excluding') :
		    ('includeDir', 'including');
		@a = &::evalExceptionList(\@a, $self->get('sourceDir'),
					  @s, $prLog);
	    }
	    $prLog->print('-kind' => 'I',
			  '-str' =>
			  ["<$p> => ", "\t<" . join('> <', @a) . '>']);
	}
	else
	{
	    my $a = $$args{$p};
	    if ($p eq 'chmodMD5File')
	    {
		$a = sprintf("0%3o", $a);
	    }

	    $prLog->print('-kind' => 'I',
			  '-str' => ["<$p> =>", "\t<$a>"]);
	}
    }
    exit 0;
}


##################################################
# generates an index out of a directory name
# requests: 'index -> dir' or 'dir -> index'
# this is for shorten the berkely db files and
# therefor for better caching of it
package indexDir;

sub new
{
    my $class = shift;
    my $self = {};

    my (%indexToDir) = ();
    my (%dirToIndex) = ();
    $self->{'indexToDir'} = \%indexToDir;
    $self->{'dirToIndex'} = \%dirToIndex;

    $self->{'count'} = 0;

    bless $self, $class;
}


########################################
sub newFile
{
    my $self = shift;

    my $file = shift;

    my ($d, $f) = &::splitFileDir($file);

    my $dirToIndex = $self->{'dirToIndex'};
    if (exists($$dirToIndex{$d}))
    {
	return ($d, $f, $$dirToIndex{$d});
    }
    else
    {
	my $indexToDir = $self->{'indexToDir'};
	$$dirToIndex{$d} = $self->{'count'};
	$$indexToDir{$self->{'count'}} = $d;

	return ($d, $f, $self->{'count'}++);
    }
}


########################################
sub newDir
{
    my $self = shift;

    my $d = shift;

    my $dirToIndex = $self->{'dirToIndex'};
    if (exists($$dirToIndex{$d}))
    {
	return $$dirToIndex{$d};
    }
    else
    {
	my $indexToDir = $self->{'indexToDir'};
	$$dirToIndex{$d} = $self->{'count'};
	$$indexToDir{$self->{'count'}} = $d;

	return $self->{'count'}++;
    }
}


########################################
sub replaceIndex
{
    my $self = shift;

    my $fileWithIndex = shift;

    my ($index, $f) = split('/', $fileWithIndex, 2);
    my $indexToDir = $self->{'indexToDir'};
    return $$indexToDir{$index} . "/$f";
}


########################################
sub index2dir
{
    my $self = shift;

    my $index = shift;

    my $indexToDir = $self->{'indexToDir'};
    return $$indexToDir{$index};
}


########################################
sub setIndex
{
    my $self = shift;

    my $fileWithoutIndex = shift;

    my ($d, $f, $index) = $self->newFile($fileWithoutIndex);
    return "$index/$f";
}


1