# -*- perl -*-

#
#   Copyright (C) Dr. Heinz-Josef Claes (2001-2012)
#                 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 3 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, see <http://www.gnu.org/licenses/>.
#

push @VERSION, '$Id: storeBackupLib.pl 364 2012-02-12 14:14:44Z hjc $ ';

use strict;

use Fcntl;
use IO::Compress::Gzip qw(gzip $GzipError);


# 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

$main::STOREBACKUPVERSION = "3.2.1";

##################################################
sub buildDBMs
{
    my (%params) = ('-dbmKeyIsFilename'    => undef,     # pointer to hash
		    '-dbmKeyIsMD5Sum'      => undef,     # pointer to hash
		    '-dbmBlockCheck'       => undef,     # pointer to hash
		    '-flagBlockDevice'     => 0,         # flag: 0 or 1
		    '-indexDir'            => undef,     # object pointer
		    '-backupRoot'          => undef,     # String
		    '-backupDirIndex'      => undef,     # Index des Pfades
		    '-noBackupDir'         => undef,
		    '-checkSumFile'        => undef,
		    '-checkSumFileVersion' => undef,
		    '-blockCheckSumFile'   => undef,
		    '-progressReport'      => undef,
		    '-prLog'               => undef,
		    '-saveRAM'             => 0,
		    '-dbmBaseName'         => undef
		    );

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

    my $rcsf = readCheckSumFile->new('-checkSumFile' =>
				     "$backupRoot/$checkSumFile",
				     '-prLog' => $prLog);
#    my $v = $rcsf->getVersion();
    my $v = $rcsf->getInfoWithPar('version');
    $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 (%md5InThisBackup, $filenameMd5InThisBackup);
    if ($params{'-saveRAM'})
    {
	$filenameMd5InThisBackup =
	    &::uniqFileName($params{'-dbmBaseName'} . ".localmd5.$$.");
	if (-e $filenameMd5InThisBackup)
	{
	    $prLog->print('-kind' => 'W',
			  '-str' => ["deleting <$filenameMd5InThisBackup>"]);
	    unlink $filenameMd5InThisBackup or
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["cannot delete <$filenameMd5InThisBackup>, exiting"],
			      '-exit' => 1);
	}
	dbmopen(%md5InThisBackup, $filenameMd5InThisBackup, 0600);
    }
    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);

	my $md5pack = pack('H32', $md5sum);

	if ((not exists $md5InThisBackup{$md5pack}
	     and (exists $$dbmKeyIsMD5Sum{$md5pack}))
	    or exists $$dbmKeyIsFilename{"$index/$fname"})
	{
	    next;
	}

	++$noEntriesInDBM;
	$md5InThisBackup{$md5pack} = 1;
	$$dbmKeyIsMD5Sum{$md5pack} = pack('FaSa*', $inodeBackup, $compr,
					      $backupDirIndex, "$index/$fname");
	$$dbmKeyIsFilename{"$index/$fname"} =
	    pack('aIIFH32', $compr, $ctime, $mtime, $size, $md5sum);

#print "### <$index/$fname> <$f> - $size\n";
    }


    if ($params{'-saveRAM'})
    {
	dbmclose(%md5InThisBackup);
	unlink $filenameMd5InThisBackup;
    }

    # read dbmBlockCheck
    my $noEntriesBlockCheck = 0;
    my $f = "$backupRoot/$blockCheckSumFile";
    if ($params{'-flagBlockDevice'} and (-e $f or -e "$f.bz2"))
    {
	my $filenameCheckBlockInThisBackup =
	    &::uniqFileName($params{'-dbmBaseName'} . ".checkBlock.$$.");
	if ($params{'-saveRAM'})
	{
	    if (-e $filenameCheckBlockInThisBackup)
	    {
		$prLog->print('-kind' => 'W',
			      '-str' =>
			      ["deleting <$filenameCheckBlockInThisBackup>"]);
		unlink $filenameCheckBlockInThisBackup or
		    $prLog->print('-kind' => 'E',
				  '-str' =>
				  ["cannot delete " .
				   "<$filenameCheckBlockInThisBackup>, exiting"],
				  '-exit' => 1);
	    }
	    dbmopen(%$dbmBlockCheck, $filenameCheckBlockInThisBackup, 0600);
	}

	local *IN;
	my $in = undef;
	if (-e $f)
	{
	    open(IN, "<",  $f) or
		$prLog->print('-kind' => 'E',
			      '-str' => ["cannot open <$f>, exiting"],
			      '-add' => [__FILE__, __LINE__],
			      '-exit' => 1);
	}
	else    # "$f.bz2"
	{
	    $in = pipeFromFork->new('-exec' => 'bzip2',
				    '-param' => ['-d'],
				    '-stdin' => "$f.bz2",
				    '-outRandom' => '/tmp/stbuPipeFrom0-',
				    '-prLog' => $prLog);
	}
	my $l;
	while ($l = $in ? $in->read() : <IN>)
	{
	    next if $l =~ /\A#/;
	    chop $l;
	    my ($md5, $compr, $filename) = split(/\s/, $l, 3);
	    $filename =~ s/\\0A/\n/og;    # '\n' wiederherstellen
	    $filename =~ s/\\5C/\\/og;    # '\\' wiederherstellen

	    my ($fbase, $fname, $index) =
		$indexDir->newFile("$backupRoot/$filename");

	    $$dbmBlockCheck{$md5} = "$compr $index/$fname";
	    ++$noEntriesBlockCheck;

	    ++$noLines;
	    $prLog->print('-kind' => 'P',
			  '-str' => ["  read $noLines lines ..."])
		if $progressReport and $noLines % $progressReport == 0;
	}

	if ($params{'-saveRAM'})
	{
	    dbmclose(%$dbmBlockCheck);
	}

	if ($in)
	{
	    	my $out = $in->getSTDERR();
		if (@$out)
		{
		    $prLog->print('-kind' => 'E',
				  '-str' =>
				  ["reading from $f.bz2 generated",
				   @$out]);
		    exit 1;
		}
		$in->close();
	}
	else
	{
	    close(IN);
	}
    }

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

    return ($noEntriesInDBM, $noEntriesBlockCheck);
}


##################################################
sub readAllBackupSeries
{
    my $dir = shift;
    my $prLog = shift;

    my (%dirs) = ();
    &::_readAllBackupSeries($dir, \%dirs, $prLog);

    return keys %dirs;
}


##################################################
sub _readAllBackupSeries
{
    my $dir = shift;
    my $dirs = shift;
    my $prLog = shift;

    return if -l $dir;

    my ($x, $entry) = ::splitFileDir($dir);
    if ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}.\d{2}.\d{2}\Z/)
    {
	next if -e "$dir/$::checkSumFile.notFinished";
	$$dirs{$x} = 1;
    }
    elsif ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}.\d{2}.\d{2}-.*\Z/)
    {
	return;
    }
    else
    {
	local *DIR;
	unless (opendir(DIR, $dir))
	{
	    return;
	}
	while ($entry = readdir DIR)
	{
	    next if ($entry eq '.' or $entry eq '..');
	    my $fullEntry = "$dir/$entry";
	    next unless -d $fullEntry;

	    &::_readAllBackupSeries($fullEntry, $dirs, $prLog);
	}
	close(DIR);
    }
}


##################################################
sub readAllBackupDirs   # only used by storeBackupVersion.pl
{
    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"],
		      '-add' => [__FILE__, __LINE__],
		      '-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>"],
		      '-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);
}

########################################
sub calcFileMD5Sum
{
    my $file = shift;

    local *FILE;
    sysopen(FILE, "$file", O_RDONLY) or return undef;
    my $md5All = Digest::MD5->new();
    my $buffer;
    while (sysread(FILE, $buffer, 1024**2))
    {
	$md5All->add($buffer);
    }
    close(FILE) or return undef;

    return $md5All->hexdigest();
}


########################################
sub compressOneBlock
{
    my $block = shift;
    my $file = shift;
    my $compressProc = shift;
    my $compressOptions = shift;
    my $prLog = shift;

    my $comp = pipeToFork->new('-exec' => $compressProc,
			       '-param' => $compressOptions,
			       '-stdout' => $file,
			       '-outRandom' => '/tmp/stbuPipeTo1-',
			       '-delStdout' => 'no',
			       '-prLog' => $prLog);
    $comp->print($block);
    $comp->wait();
    my $out = $comp->getSTDERR();
    if (@$out)
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["$compressProc reports errors:",
				 @$out],
		      '-exit' => 1);
    }
    $comp->close();
    return 0;
}


########################################
sub copyOneBlock
{
    my $block = shift;
    my $file = shift;
    my $prLog = shift;

    local *COMP;
    sysopen(COMP, $file, O_CREAT | O_WRONLY) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot write to <$file>"],
		      '-exit' => 1);
    syswrite(COMP, $block);
    close(COMP);

    return 0;
}


##################################################
sub hardLinkDir
{
    my $from = shift;
    my $to = shift;
    my $mask = shift;    # pattern must match each file
    my $prLog = shift;

    local *DIR;
    opendir(DIR, $from) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot opendir <$from>, exiting"],
		      '-add' => [__FILE__, __LINE__],
		      '-exit' => 1);
    my $entry;
    my $anz = 0;
    while ($entry = readdir DIR)
    {
	next unless -f "$from/$entry";
	next unless $entry =~ /$mask/;
	unless (link "$from/$entry", "$to/$entry")
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["cannot hard link $from/$entry -> $to/$entry"],
			  '-exit' => 1)
		unless ::copyFile("$from/$entry", "$to/$entry");
	}
	++$anz;
    }
    closedir(DIR);
    return $anz;
}


##################################################
# 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. Option lateLinks berücksichtigen
#
#16. Alle in (Llösch) löschen
##################################################
package deleteOldBackupDirs;

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

    my (%params) = ('-targetDir'            => undef,
		    '-doNotDelete'          => undef,
		    '-deleteNotFinishedDirs'=> undef,
		    '-checkSumFile'         => undef,
		    '-actBackupDir'         => undef,
		    '-prLog'                => undef,
		    '-today'                => undef,
		    '-keepFirstOfYear'      => undef,
		    '-keepLastOfYear'       => undef,
		    '-keepFirstOfMonth'     => undef,
		    '-keepLastOfMonth'      => undef,
		    '-firstDayOfWeek'       => undef,
		    '-keepRelative'         => undef,
		    '-keepFirstOfWeek'      => undef,
		    '-keepLastOfWeek'       => undef,
		    '-keepAll'              => undef,
		    '-keepWeekday'          => undef,
		    '-keepDuplicate'        => undef,
		    '-keepMinNumber'        => undef,
		    '-keepMaxNumber'        => undef,
		    '-statDelOldBackupDirs' => undef,
		    '-flatOutput'           => 'no',
		    '-lateLinksParam'       => undef,
		    '-allLinks'             => undef   # object of type lateLink
		    );


     &::checkObjectParams(\%params, \@_, 'deleteOldBackupDirs::new',
			 ['-targetDir', '-doNotDelete', '-checkSumFile',
			  '-prLog', '-today', "-keepRelative",
			  '-keepFirstOfYear', '-keepLastOfYear',
			  '-keepFirstOfMonth', '-keepLastOfMonth',
			  '-keepFirstOfWeek', '-keepLastOfWeek',
			  '-keepAll', '-keepWeekday', '-keepDuplicate',
			  '-keepMinNumber', '-keepMaxNumber',
			  '-statDelOldBackupDirs', '-lateLinksParam', '-allLinks']);
    &::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'};
    my $keepRelative = $self->{'keepRelative'};

    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;
    }

    if (defined $self->{'keepRelative'})
    {
	# keepRelative überprüfen
	my $last;
	my @intervals = @{$self->{'keepRelative'}};
	$self->{'keepRelative'} = [];
	foreach my $el (@intervals)
	{
            my $secs = dateTools::strToSec('-str' => $el);
	    if (not defined $secs)
	    {
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["illegal parameter for option keepRelative, " .
			       "must be a list of intervals"], '-exit' => 1);
	    }

	    if (not defined $last)
	    {
		$last = $secs;
	    }
	    if ($secs < $last)
	    {
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["illegal parameter for option keepRelative, " .
			       "intervals must be in increasing order"],
			      '-exit' => 1);
	    }
	    push @{$self->{'keepRelative'}}, {str => $el, secs => $secs};
	    $last = $secs;
	}
    }

    $prLog->print('-kind' => 'E',
		  '-str' => ["exiting because of previous errors"],
		  '-exit' => 1)
	if $self->{'invalidFormat'};

    # Directoryeinträge der alten Backups einlesen
    my $dirs =
	allStoreBackupSeries->new('-rootDir' => $targetDir,
				  '-actBackupDir' => $self->{'actBackupDir'},
				  '-checkSumFile' => $checkSumFile,
				  '-prLog' => $prLog,
				  '-absPath' => 0);
    my (@l1) = $dirs->getAllFinishedDirs();

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

    my (@nfd) = $dirs->getAllNotFinishedDirs();
    $self->{'notFinishedBackupDirs'} = \@nfd;

    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 $keepRelative = $self->{'keepRelative'};
    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, no regular backups 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
    }

    # Alternative Methode
    if ($keepRelative and @$keepRelative)
    {
        # Sort (new backups first)
        @l1 = reverse(sort @l1);


        # Always keep most recent backup (we don't know when the next
        # backup will be made, so we cannot judge if we may need it or
        # not)
        $notDelPrintHash{$l1[0]}{"most recent"} = "";

        my $bi = 0;
        my $off = 0;
        my $debug = 0;
        my ($backup, $age, $period);

        # Loop over periods, starting from the most recent one
period:;
	for (my $pi=0; $pi <= @$keepRelative-2; $pi++)
	{
            $period = $keepRelative->[$pi]->{str} . " to ".
                $keepRelative->[$pi+1]->{str};
            $prLog->print('-kind' => 'D',
                          '-str' => ["[keepRelative] Examining period $period"]) if $debug;
backup:
	    while ($bi < @l1)
	    {
                $backup = $l1[$bi];

                # Keep first backup that is older than the beginning
                # of the current period
                $age = ($$dayObject{$backup})->deltaInSecs('-secondDate' => $today);
                if ($age >= $keepRelative->[$pi]->{'secs'}+$off) {

                    # If the backup is actually too old for this
                    # period, make sure that the following intervals
                    # are shifted by the same amount
                    if ($age >= $keepRelative->[$pi+1]->{'secs'} + $off)
		    {
                        $notDelPrintHash{$backup}{"$period (nearest older)"} = "";
                        $off += $age - ($keepRelative->[$pi+1]->{'secs'}+$off);
                        $prLog->print('-kind' => 'W',
                                      '-str' =>
                                      ["no backup for period $period, choosing next older backup instead"]);
                    }
                    else
		    {
                        $notDelPrintHash{$backup}{$period} = "";
                    }
                    $keepRelative->[$pi]->{bi} = $bi;
                    last backup;
                }
                $bi++;
            }

            # If we didn't find any backup old enough, we take the
            # oldest one instead
            if ($bi == @l1)
	    {
                $bi = $#l1;
                $backup = $l1[$bi];
                $prLog->print('-kind' => 'W',
                              '-str' =>
                              ["no backup for period $period, choosing oldest backup instead.",
                               "This is usually caused by backups not being done regularly enough." ]);
                $notDelPrintHash{$backup}{"$period (oldest possible)"} = "";
                $keepRelative->[$pi]->{bi} = $bi;
            }
            $prLog->print('-kind' => 'D',
                          '-str' =>
                          ["[keepRelative] <$period> is satisfied by backup $backup"]) if $debug;


            # The following loop goes forward in time, starting from
            # the backup that at the time of this run satisfies the
            # current period to the most recent backup.

            # For each backup $backup, it is checked if the backup
            # will at some point in the future be needed to satisfy
            # the period. If so, it is marked as 'candidate' for
            # keeping.

            # A backup $prevBackup is required for a period, if the
            # backup that satisfied the period in the last iteration
            # ($keptBackup) is going to run out of the period before
            # the next backup ($backup) is entering the period.

            my $i = $bi;
            my $keptBackup = $backup;
            my $prevBackup;

            # Determine number of seconds until the currently
            # held backup will be too old for the period
            my $expires = $keepRelative->[$pi+1]->{secs}
                - ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
            $prLog->print('-kind' => 'D',
                          '-str' =>
                          ["[keepRelative] $keptBackup will leave period in " . sprintf("%.1f", $expires/3600) . " hours."]) if $debug;
            while ($i > 0)
	    {
                $prevBackup = $backup;
                $backup = $l1[--$i];


                # Determine number of seconds until the next more
                # recent backup will be old enough for the period
                my $remaining = $keepRelative->[$pi]->{secs}
                    - ($$dayObject{$backup})->deltaInSecs(-secondDate => $today);

                # If the backup has already expired, then we obviously
                # need the next one
                if ($expires < 0) {
                    $notDelPrintHash{$backup}{"$period (candidate)"} = "";
                    $keptBackup = $backup;
                    $expires = $keepRelative->[$pi+1]->{secs}
                        - ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
                    $prLog->print('-kind' => 'D',
                                       '-str' =>
                                       ["[keepRelative] Has already left period. Keeping $backup. Will leave period in " . sprintf("%.1f", $expires/3600) . " hours."]) if $debug;

                }

                # If the backup last marked to keep for
                # this period will be too old before the current
                # backup is old enough, also mark the previous backup
                # for keeping.
                elsif ($expires <= $remaining) {
                    $prLog->print('-kind' => 'D',
                                  '-str' =>
                                  ["[keepRelative] $backup will enter period in ".sprintf("%.1f", $remaining/3600) ." hours".
                                   "- this is too late, trying to keep intermediate backup.."]) if $debug;
                    if ($keptBackup eq $prevBackup) {
                        $prLog->print
                            ( '-kind' => 'W',
                              '-str' =>
                              ["There will be no backup for period $period in ".
                               sprintf("%.1f", $expires/(3600*24))." days.",
                               "This is usually caused by backups not being done regularly enough." ]);

                        # At least we try to minimize the gap
                    $notDelPrintHash{$backup}{"$period (candidate)"} = "";
                        $keptBackup = $backup;
                        $expires = $keepRelative->[$pi+1]->{secs}
                            - ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
                        $prLog->print('-kind' => 'D',
                                      '-str' =>
                                      ["[keepRelative] Marking $backup to minimze gap. Will leave period in " . sprintf("%.1f", $expires/3600) . " hours."]) if $debug;
                    }
                    else {
                        $notDelPrintHash{$prevBackup}{"$period (candidate)"} = "";
                        $keptBackup = $prevBackup;

                        $expires = $keepRelative->[$pi+1]->{secs}
                            - ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
                        $prLog->print('-kind' => 'D',
                                      '-str' =>
                                      ["[keepRelative] Marking $keptBackup. Will leave period in " . sprintf("%.1f", $expires/3600) . " hours."]) if $debug;
                    }
                }
                else {
                    $prLog->print('-kind' => 'D',
                                  '-str' =>
                                  ["[keepRelative] $backup will enter period in ".sprintf("%.1f", $remaining/3600) ." hours - no need to keep intermediate backup."]) if $debug;
                }
            }

            $bi++;

        }
        foreach $l (@l1)
        {
            if (not defined $notDelPrintHash{$l})
	    {
                push @{$self->{'lLoesch'}}, $l;
            }
        }
    }
    else
    {

#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;
    }

#15. check for collision with backups who have unresolved links or
# unresolved links to them
    my (@lateLinkDirs) = ($self->{'allLinks'}->getAllDirsWithLateLinks());
    if (@lateLinkDirs)
    {
	my (%lateLinkDirs) = ();
	my ($dir, $x);
	foreach $dir (@lateLinkDirs)
	{
	    ($x, $dir) = ::splitFileDir($dir);
	    $lateLinkDirs{$dir} = 1;
	}
	my (%loesch) = ();
	foreach $dir (@{$self->{'lLoesch'}})
	{
	    $loesch{$dir} = 1;
	}

	my $actBackupDir;
	($x, $actBackupDir) = ::splitFileDir($self->{'actBackupDir'});
	my (@loesch) = ();
	foreach $dir (keys %notDelPrintHash)
	{
	    if (exists $lateLinkDirs{$dir})
	    {
		$notDelPrintHash{$dir}{'affected by unresolved links'} = '';
		if (exists $loesch{$dir})
		{
		    $notDelPrintHash{$dir}{'would be deleted'} = '';
		    delete $notDelPrintHash{$dir}{'keepMaxNumber'};
		}
	    }
	    elsif ($dir eq $actBackupDir)
	    {
		$notDelPrintHash{$dir}{'affected by unresolved links'} = ''
		    if $self->{'lateLinksParam'}
	    }
	    elsif (exists $loesch{$dir})
	    {
		push @loesch, $dir;
	    }
	}
	$self->{'lLoesch'} = \@loesch;
    }


# 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 $deltaSecs = $$dayObject{$l}->deltaInSecs('-secondDate' => $today);
        my $deltaDays = int($deltaSecs/(3600*24));
        my $deltaHours = int( ($deltaSecs - $deltaDays * 3600 * 24) / 3600);
	my $p = $$weekDayHash{$l} . " $l (${deltaDays}d${deltaHours}h): ";
	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(', ', sort @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'};

    if ($self->{'deleteNotFinishedDirs'} and not $self->{'doNotDelete'})
    {
	my $abd = $self->{'actBackupDir'};
	my (@nfd) = @{$self->{'notFinishedBackupDirs'}};
	my $d;
	foreach $d (@nfd)
	{
	    $prLog->print('-kind' => 'W',
			  '-str' =>
			  ["deleting not finished backup <$targetDir/$d>"]);
	    $self->{'statDelOldBackupDirs'}->incr_noDeletedOldDirs();
	    my $rdd = recursiveDelDir->new('-dir' => "$targetDir/$d",
					   '-prLog' => $prLog);
	    my ($dirs, $files, $bytes, $links, $stayBytes) =
		$rdd->getStatistics();
	    $self->{'statDelOldBackupDirs'}->addFreedSpace($dirs, $files,
							   $bytes, $links);
	    my ($b) = &::humanReadable($bytes);
	    my ($sb) = &::humanReadable($stayBytes);
	    $prLog->print('-kind' => 'I',
			  '-str' => ["    freed $b ($bytes), $files files" .
			  " [$sb hard linked somewhere else]"]);
	}
    }

    return if (@$lLoesch == 0);

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

    if ($doNotDelete)
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["Skipping removal of old backups."]);
    }
    else
    {

	$prLog->print('-kind' => 'I',
		      '-str' => ["deleting in backup series <$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, $stayBytes) =
		$rdd->getStatistics();
	    $statDelOldBackupDirs->addFreedSpace($dirs, $files,
						$bytes, $links);
	    my ($b) = &::humanReadable($bytes);
	    my ($sb) = &::humanReadable($stayBytes);
	    $prLog->print('-kind' => 'I',
			  '-str' => ["    freed $b ($bytes), $files files" .
			  " [$sb hard linked somewhere else]"]);
	}
#	$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'};

    $prLog->print
	('-kind' => $self->{'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 allStoreBackupSeries;

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

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

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

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

    local *DIR;
    opendir(DIR, $rootDir) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot opendir <$rootDir>, exiting"],
		      '-add' => [__FILE__, __LINE__],
		      '-exit' => 1);
    my (@dirs) = ();
    my (@finished) = ();
    my (@notFinished) = ();
    my (@finishedWithoutActBackupDir) = ();
    my $entry;
    while ($entry = readdir DIR)
    {
	next if (-l $entry and not -d $entry);   # nur Directories interessant
	next unless $entry =~                    # Dateiname muss 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
	if (-f "$rootDir/$dir/$checkSumFile.notFinished")
	{
	    if ($actBackupDir eq "$rootDir/$dir")
	    {
		push @finished, $dir;
		next;
	    }
	    $prLog->print('-kind' => 'W',
			  '-str' => ["backup <$rootDir/$dir> not finished"]);
	    push @notFinished, $dir;
	}
	else
	{
	    push @finished, $dir;
	    push @finishedWithoutActBackupDir, $dir;
	}
    }
    closedir(DIR);

    @notFinished = sort @notFinished; # oldest first
    $self->{'notFinished'} = \@notFinished;

    @finished = sort @finished;
    $self->{'finished'} = \@finished;

    @finishedWithoutActBackupDir = sort @finishedWithoutActBackupDir;
    $self->{'finishedWithoutActBackupDir'} = \@finishedWithoutActBackupDir;

    @dirs = sort (@notFinished, @finished);
    $self->{'dirs'} = \@dirs;

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

    bless $self, $class;
}


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

    return @{$self->{'dirs'}};
}


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

    return @{$self->{'finished'}};
}


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

    return @{$self->{'finishedWithoutActBackupDir'}};
}


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

    return @{$self->{'notFinished'}};
}


########################################
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 not finished, skipping"]);
    }
    return undef;
}


##################################################
# reads info (.md5CheckSums.info)
##################################################
package readInfoFile;

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

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

    &::checkObjectParams(\%params, \@_, 'readInfoFile::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);
    }

    my (@checkBlocks);
    {
	my $i;
	foreach $i (0..$main::noBlockDevices-1)
	{
	    push @checkBlocks,
	    Option->new('-name' => "checkBlocksRule$i",
			'-cf_key' => "checkBlocksRule$i",
			'-multiple' => 'yes'),
	    Option->new('-name' => "checkBlocksBS$i",
			'-cf_key' => "checkBlocksBS$i",
			'-param' => 'yes'),
	    Option->new('-name' => "checkBlocksCompr$i",
			'-cf_key' => "checkBlocksCompr$i",
			'-param' => 'yes'),
	    Option->new('-name' => "checkBlocksRead$i",
			'-cf_key' => "checkBlocksRead$i",
			'-multiple' => 'yes');
	}
    }

    # all options with parameters!
    my $CSFile =
	CheckParam->new('-configFile' => '-f',
			'-replaceEnvVar' => 'no',
			'-ignoreLeadingWhiteSpace' => 1,
			'-list' => [
			    Option->new('-name' => 'infoFile',
					'-cl_option' => '-f',
					'-param' => 'yes'),
			    Option->new('-name' => 'version',
					'-cf_key' => 'version',
					'-must_be' => 'yes',
					'-default' => '1.0'),
			    Option->new('-name' => 'date',
					'-cf_key' => 'date',
					'-must_be' => 'yes',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'sourceDir',
					'-cf_key' => 'sourceDir',
					'-param' => 'yes'),
			    Option->new('-name' => 'followLinks',
					'-cf_key' => 'followLinks',
					'-param' => 'yes'),
			    Option->new('-name' => 'compress',
					'-cf_key' => 'compress',
					'-must_be' => 'yes',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'uncompress',
					'-cf_key' => 'uncompress',
					'-must_be' => 'yes',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'postfix',
					'-cf_key' => 'postfix',
					'-must_be' => 'yes',
					'-param' => 'yes'),
			    Option->new('-name' => 'comprRule',
					'-cf_key' => 'comprRule',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'exceptDirs',
					'-cf_key' => 'exceptDirs',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'includeDirs',
					'-cf_key' => 'includeDirs',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'exceptRule',
					'-cf_key' => 'exceptRule',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'includeRule',
					'-cf_key' => 'includeRule',
					'-multiple' => 'yes'),
			    Option->new('-name' => 'writeExcludeLog',
					'-cf_key' => 'writeExcludeLog',
					'-param' => 'yes'),
			    Option->new('-name' => 'exceptTypes',
					'-cf_key' => 'exceptTypes',
					'-param' => 'yes'),
			    @checkBlocks,
			    Option->new('-name' => 'preservePerms',
					'-cf_key' => 'preservePerms',
					'-param' => 'yes'),
			    Option->new('-name' => 'lateLinks',
					'-cf_key' => 'lateLinks',
					'-param' => 'yes'),
			    Option->new('-name' => 'lateCompress',
					'-cf_key' => 'lateCompress',
					'-param' => 'yes'),
			    Option->new('-name' => 'cpIsGnu',
					'-cf_key' => 'cpIsGnu',
					'-param' => 'yes'),
			    Option->new('-name' => 'logInBackupDir',
					'-cf_key' => 'logInBackupDir',
					'-param' => 'yes'),
			    Option->new('-name' => 'compressLogInBackupDir',
					'-cf_key' => 'compressLogInBackupDir',
					'-param' => 'yes'),
			    Option->new('-name' => 'logInBackupDirFileName',
					'-cf_key' => 'logInBackupDirFileName',
					'-param' => 'yes')
			]);
    $CSFile->check('-argv' => ['-f' => "$checkSumFile.info"],
		   '-help' =>
		   "cannot read file <$checkSumFile.info>\n",
		   '-ignoreAdditionalKeys' => 1);

    my $opt;
    my (%withPar, @allOpts);
    foreach $opt ($CSFile->getOptNamesSet('-type' => 'withPar'))
    {
	$withPar{$opt} = $CSFile->getOptWithPar($opt);
	push @allOpts, $opt;
    }
    $self->{'withPar'} = \%withPar;
    $self->{'allOpts'} = \@allOpts;

    bless $self, $class;
}


########################################
sub getInfoWithPar
{
    my $self = shift;
    my $opt = shift;

    my $withPar = $self->{'withPar'};
    return exists $$withPar{$opt} ? $$withPar{$opt} : undef;
}


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

    return @{$self->{'allOpts'}};
}


########################################
#sub getInfoWithoutPar
#{
#    my $self = shift;
#    my $opt = shift;
#
#    my $withoutPar = $self->{'withoutPar'};
#    return exists $$withoutPar{$opt} ? $$withoutPar{$opt} : 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);
    }

    $self->{'InfoFile'} =
	readInfoFile->new('-checkSumFile' => "$checkSumFile",
			  '-prLog' => $prLog);

    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 getInfoWithPar
{
    my $self = shift;
    my $opt = shift;

    unless (defined $self->{'InfoFile'}->getInfoWithPar($opt))
    {
	# compatibility to old versions where these options did not exist
	if ($opt eq 'writeExcludeLog' or
	    $opt eq 'lateLinks' or
	    $opt eq 'lateCompress' or
	    $opt eq 'cpIsGnu' or
	    $opt eq 'logInBackupDir' or
	    $opt eq 'compressLogInBackupDir')
	{
	    return 'no';
	}
#print "----not defined: $opt\n";
    }
    return $self->{'InfoFile'}->getInfoWithPar($opt);
}


########################################
sub getInfoWithoutPar
{
    my $self = shift;
    my $opt = shift;

    return $self->{'InfoFile'}->getInfoWithoutPar($opt);
}


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

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


########################################
#sub getMetaValField
#{
#    my $self = shift;
#
#    return $self->{'metaValField'};
#}

########################################
#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, @l);
    do
    {
	$l = $self->nextBinLine();
	return () unless $l;

    } while ((@l =
	      evalBinLine($l, $prLog, $checkSumFile)) != 12);

    return (@l);
}


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

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

    my $l;
    my $csf = undef;
    local *FILE = undef;
    if ($self->{'checksumfile'} eq undef
	and $self->{'CHECKSUMFILE'} eq undef)
    {
	if (-f "$checkSumFile.bz2")
	{
	    $csf = pipeFromFork->new('-exec' => 'bzip2',
				     '-param' => ['-d'],
				     '-stdin' => "$checkSumFile.bz2",
				     '-outRandom' => '/tmp/stbuPipeFrom1-',
				     '-prLog' => $prLog);
	}
	elsif (-f "$checkSumFile")
	{
	    open(FILE, "< $checkSumFile") or
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["cannot open <$checkSumFile>"],
			      '-add' => [__FILE__, __LINE__],
			      '-exit' => 1);
	}
	else
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot find <$checkSumFile>"],
			  '-exit' => 1);
	}

                            # erste Kommentarzeile lesen und vergessen
	$l = $csf ? $csf->read() : <FILE>;

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

    $l = $csf ? $csf->read() : <FILE>;
    return undef unless $l;

    chomp $l;
    return $l;
}

########################################
sub evalBinLine               # function!
{
    my $l = shift;
    my $prLog = shift;
    my $checkSumFile = shift;
    
    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' => 'W',
		      '-str' => ["cannot read line $. in file <" .
				 "$checkSumFile>, line is ..." .
				 "\t$l"]);
	return ();
    }

    # $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'})
    {
	$self->{'checksumfile'}->close();
	$self->{'checksumfile'} = undef;
    }
    elsif ($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
		    '-blockCheckSumFile' => undef, # voller Pfad
		    '-infoLines'       => [],      # Zeilen ohne \n für .info
		    '-prLog'           => undef,
		    '-chmodMD5File'    => undef,
		    '-compressMD5File' => 'yes',
		    '-lateLinks'       => undef);

    &::checkObjectParams(\%params, \@_, 'writeCheckSumFile::new',
			 ['-checkSumFile', '-blockCheckSumFile',
			  '-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>"],
		      '-add' => [__FILE__, __LINE__],
		      '-exit' => 1);
    $self->{"checkSumFile.notFinished"} = "$checkSumFile.notFinished";
    print FILE "$$\n" or
        $prLog->print('-kind' => "E",
		      '-str' => ["cannot write <$checkSumFile.notFinished>: $!"]);
    FILE->autoflush(1);
    close(FILE) or
        $prLog->print('-kind' => "E",
		      '-str' => ["couldn't close <$checkSumFile.notFinished>: $!"]);

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

    #
    my $checkSumFile = $self->{'checkSumFile'};
    my $csf = undef;
    if ($self->{'compressMD5File'} eq 'yes')
    {
	$self->{'checkSumFile'} = "$checkSumFile.bz2";
	&::checkDelSymLink("$checkSumFile.bz2", $prLog, 0x01);
	$csf = pipeToFork->new('-exec' => 'bzip2',
			       '-stdout' => "$checkSumFile.bz2",
			       '-outRandom' => '/tmp/stbuPipeTo2-',
			       '-delStdout' => 'no',
			       '-prLog' => $prLog);
	chmod $chmodMD5File, $self->{'checkSumFile'};

	$csf->print("# contents/md5 compr dev-inode inodeBackup " .
		    "ctime mtime atime size uid gid mode filename\n");
    }
    else
    {
	&::checkDelSymLink($checkSumFile, $prLog, 0x01);
	open(FILE, "> $checkSumFile") or
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot open <$checkSumFile>"],
			  '-add' => [__FILE__, __LINE__],
			  '-exit' => 1);
	chmod $chmodMD5File, $self->{'checkSumFile'};

	print FILE "# contents/md5 compr dev-inode inodeBackup " .
	    "ctime mtime atime size uid gid mode filename\n" or
            $self->{prLog}->print(-kind => "E",
                                  -str => ["couldn't write checksum file: $!"]);
    }
    $self->{'CHECKSUMFILE'} = *FILE;
    $self->{'checksumfile'} = $csf;

    local *BLOCKFILE;
    my $bcsf = undef;
    my $blockCheckSumFile = $self->{'blockCheckSumFile'};
    if ($self->{'compressMD5File'} eq 'yes' and not $self->{'lateLinks'})
    {
	$self->{'blockCheckSumFile'} = "$blockCheckSumFile.bz2";
	&::checkDelSymLink("$blockCheckSumFile.bz2", $prLog, 0x01);
	$bcsf = pipeToFork->new('-exec' => 'bzip2',
				'-stdout' => "$blockCheckSumFile.bz2",
				'-outRandom' => '/tmp/stbuPipeTo3-',
				'-delStdout' => 'no',
				'-prLog' => $prLog);
	chmod $chmodMD5File, $self->{'blockCheckSumFile'};
	$bcsf->print("# md5 compr filename\n");
    }
    else
    {
	&::checkDelSymLink($blockCheckSumFile, $prLog, 0x01);
	open(BLOCKFILE, "> $blockCheckSumFile") or
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot open <$blockCheckSumFile>"],
			  '-add' => [__FILE__, __LINE__],
			  '-exit' => 1);
	chmod $chmodMD5File, $self->{'blockCheckSumFile'};
	print BLOCKFILE "# md5 compr filename\n" or
            $self->{prLog}->print(-kind => "E",
                       -str => ["couldn't write blockchecksum file: $!"]);
    }
    $self->{'blockchecksumfile'} = $bcsf;
    $self->{'BLOCKCHECKSUMFILE'} = *BLOCKFILE;

    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, \@_, 'writeCheckSumFile:write',
			 ['-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'};
    my $csf = $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

    if ($csf)
    {
	$csf->print("$md5sum $compr $dev-$inode $inodeBackup $ctime " .
		    "$mtime $atime $size $uid $gid $mode $filename\n");
    }
    else
    {
	print FILE "$md5sum $compr $dev-$inode $inodeBackup $ctime " .
	    "$mtime $atime $size $uid $gid $mode $filename\n" or
            $self->{prLog}->print(-kind => "E",
                          -str => ["couldn't write checksum entry: $!"]);
    }
}

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

    my (%params) = ('-filename' => undef,
		    '-md5sum'   => undef,
		    '-compr'    => undef
	);

    &::checkObjectParams(\%params, \@_, 'writeCheckSumFile:writeBlock',
			 ['-filename', '-md5sum', '-compr']);

    my $filename = $params{'-filename'};
    my $md5sum = $params{'-md5sum'};
    my $compr = $params{'-compr'};

    local *BLOCKFILE;
    *BLOCKFILE = $self->{'BLOCKCHECKSUMFILE'};
    my $csf = $self->{'blockchecksumfile'};

    $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

    if ($csf)
    {
	$csf->print("$md5sum $compr $filename\n");
    }
    else
    {
	print BLOCKFILE "$md5sum $compr $filename\n" or
	    $self->{prLog}->print(-kind => "E",
		     -str => ["couldn't write blockchecksum entry: $!"]);
    }
}


########################################
# !!! default destructor not possible !!!
# would be called in fork / exit at
# ::calcBlockMD5Sums
# now this method is called from
# aktFilename::closeInfoFile
# via call
sub destroy
{
    my $self = shift;

    if ($self->{'checksumfile'})
    {
	$self->{'checksumfile'}->close();

	$self->{'checksumfile'} = undef;
	unlink $self->{"checkSumFile.notFinished"}
	or $self->{prLog}->print(-kind => "E",
				 -str => ["couldn't delete .notFinished: $!"]);
    }
    elsif ($self->{'CHECKSUMFILE'})
    {
	local *FILE = $self->{'CHECKSUMFILE'};
	my $filename = $self->{'checkSumFile'};

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

	chmod $self->{'chmodMD5File'}, $filename; # wg. pipe und
	                                          # compr. hier nochmals
	$self->{'CHECKSUMFILE'} = undef;
#        if (not $self->{prLog}->encountered(-kind => "E"))
#	{
	unlink $self->{"checkSumFile.notFinished"}
	or $self->{prLog}->print(-kind => "E",
				 -str => ["couldn't delete .notFinished: $!"]);
#        }
    }

    my $filename = $self->{'blockCheckSumFile'};
    if ($self->{'blockchecksumfile'})
    {
	$self->{'blockchecksumfile'}->close();
	$self->{'blockchecksumfile'} = undef;
	chmod $self->{'chmodMD5File'}, $filename; # wg. pipe und
	                                          # compr. hier nochmals
    }
    elsif ($self->{'BLOCKCHECKSUMFILE'})
    {
	local *FILE = $self->{'BLOCKCHECKSUMFILE'};

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

	chmod $self->{'chmodMD5File'}, $filename; # wg. pipe und
	                                          # compr. hier nochmals
	$self->{'BLOCKCHECKSUMFILE'} = undef;
    }
}


##################################################
# 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";
}


######################################################################
package lateLinks;

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

    my (%params) = ('-dirs'     => [],
		    '-kind'     => undef, # 'directList' or 'recursiveSearch'
		    '-checkLinkFromConsistency' => undef,
		    '-verbose'  => undef,
		    '-prLog'    => undef,
		    '-verbose'  => undef,
		    '-debug'    => undef,
		    '-interactive' => undef,
		    '-autorepair' => undef,
		    '-includeRenamedBackupDirs' => undef);

    &::checkObjectParams(\%params, \@_, 'lateLinks::new',
			 ['-dirs', '-kind', '-prLog', '-verbose']);

    &::setParamsDirect($self, \%params);

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

onceAgainBecauseOfErrorCorrection:;        # only in interactive mode
    my (@dirs) = @{$self->{'dirs'}};
#print "---------dirs = @dirs--------\n";
    my $dirs = \@dirs;                     # Kopie anlegen
    my $verbose = $self->{'verbose'};
    my $debug = $self->{'debug'};
    my $autorepair = $self->{'autorepair'};
    my $ar = $autorepair ? "autorepair: " : "";

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

    my $d;
    $self->{'allStbuDirs'} = [];
    foreach $d (@$dirs)
    {
	$d = ::absolutePath("$d/..")
	    if $self->{'kind'} eq 'directList';

	if (-d $d)
	{
	    my ($s, $b, $r) = $self->listAllStoreBackupDirs($d);
	    $prLog->print('-kind' => 'S',
			  '-str' =>
			  ["found $s backup series, $b backups, " .
			   "$r renamed backups"]);
	}
    }

    my $allStbuDirs = $self->{'allStbuDirs'};

    if ($verbose)
    {
	my (@mes) = ("reading late link entries in");
	foreach $d (sort @$allStbuDirs)
	{
	    push @mes, "  $d";
	}
	$prLog->print('-kind' => 'I',
		      '-str' => \@mes);
    }

    #### read linkTo and linkFrom
    my $error = 0;
    my (%linkTo, %linkFrom);
    $self->{'linkTo'} = \%linkTo;
    $self->{'linkFrom'} = \%linkFrom;
#print "allStbuDirs = @$allStbuDirs\n";

    foreach $d (@$allStbuDirs)
    {
	$d = ::absolutePath($d);
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot access <$d/.storeBackupLinks>, " .
				 "check permissions"],
		      '-exit' => 1)
	    unless -r "$d/.storeBackupLinks";
	my $hasLinkFile = -e "$d/.storeBackupLinks/linkFile.bz2";
	my $hasLinkToFile = -e "$d/.storeBackupLinks/linkTo";
#print "$d: hasLinkFile = $hasLinkFile, hasLinkToFile = $hasLinkToFile\n";

	if ($hasLinkToFile and not $hasLinkFile)
	{
	    if ($self->{'interactive'})
	    {
		my $f = "$d/.storeBackupLinks/linkTo";
		my $answer;
		do
		{
		    print "backup <$d> has linkTo file\n",
		    "<$f>, but no\n",
		    "linkFile.bz2 in <$d/.storeBackupLinks>!!\n",
		    "This means, this backup has a reference to another backup\n",
		    "but no information what to reference (link):\n",
		    "THIS BACKUP IS CORRUPTED AND NOT RECOVERABLE\n",
		    "(you can save the existing files in it,\n",
		    "but not recover the hard links)\n",
		    "delete the (useless) linkTo referene?\n",
		    "yes / no  -> ";
		    $answer = <STDIN>;
		    chomp $answer;
		} while ($answer ne 'yes' and $answer ne 'no');
		if ($answer eq 'yes')
		{
		    if (unlink("$f"))
		    {
			$prLog->print('-kind' => 'I',
				      '-str' => ["deleted <$f>"]);
		    }
		    else
		    {
			$prLog->print('-kind' => 'E',
				      '-str' => ["cannot delete <$f>"],
				      '-exit' => 1);
		    }
		    if (rename($d, "$d-broken"))
		    {
			$prLog->print('-kind' => 'I',
				      '-str' => ["renamed <$d> to <$d-broken>"]);
		    }
		    else
		    {
			$prLog->print('-kind' => 'E',
				      '-str' => ["cannot rename <$d> to <$d-broken>"],
				      '-exit' => 1);
		    }
		}
		$prLog->print('-kind' => 'E',
			      '-str' => ["",
					 "----- repeating consistency check -----"]);
		goto onceAgainBecauseOfErrorCorrection;
	    }
	    else
	    {
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["backup <$d> has linkTo file, but no",
			       "linkFile.bz2 in .storeBackupLinks",
			       "this means it has a reference to another backup",
			       "but no information what to reference: this backup is lost!",
			       "please repair with storeBackupUpdateBackup.pl"],
			      '-exit' => 1)
	    }
	}

	$allBackupDirsWithLateLinks{$d} = 1
	    if $hasLinkFile;

	local *DIR;
#print "--- reading <$d/.storeBackupLinks>\n";
	unless (opendir(DIR, "$d/.storeBackupLinks"))
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot open <.storebackupLinks> in <$d>".
			  " please check your backup or permissions of this program!"],
			  '-add' => [__FILE__, __LINE__]
		);
	    $error++;
	    next;
	}

	my $entry;
	while ($entry = readdir DIR)
	{
#print "-0- entry <$entry>\n";
	    next if ($entry eq '.' or $entry eq '..');
	    if ($entry eq 'linkTo')
	    {
		my $f = "$d/.storeBackupLinks/$entry";
		$f =~ s/\/{2,}/\//og;
		unless (-w $f)
		{
		    $error++;
		    $prLog->print('-kind' => 'E',
				  '-str' => ["no write permissions on <$f>"]);
		}
		local *FILE;
#print "-1- open <$f>\n";
		unless (open(FILE, $f))
		{
		    $prLog->print('-kind' => 'E',
				  '-str' => ["cannot open <$f>"],
				  '-add' => [__FILE__, __LINE__]);
		    $error++;
		    next;
		}
		my $line;
		while ($line = <FILE>)
		{
		    chomp $line;
#print "-2- line = <$d/$line>\n";
		    my $l = &::absolutePath("$d/$line");
#print "-3- l = <$l>\n";
		    unless ($l)
		    {
			$prLog->print('-kind' => 'E',
				      '-str' => ["FATAL ERROR: link <$line> to non existing" .
						 " dir in <$f>"]);
			$error++;
			if ($self->{'interactive'})
			{
			    my $answer;
			    do
			    {
				print "Backup <$d> refers to NON EXISTING\n",
				"backup <$line>!!\n",
				"This means:\n",
				"- you didn't call $0 with all backup directories\n",
				"- the backup <$line> was deleted by somebody\n",
				"MAKE SHURE YOU ARE CALLING $0 WITH ALL\n",
				"BACKUPS AS A PARAMETER AND RESTART (say 'no' below)!\n",
				"rename backup to <${d}-broken>?\n",
				"yes / no  -> ";
				$answer = <STDIN>;
				chomp $answer;
			    } while ($answer ne 'yes' and $answer ne 'no');
			    close(FILE);
			    closedir(DIR);
			    if ($answer eq 'yes')
			    {
				if (rename($d => "${d}-broken"))
				{
				    $prLog->print('-kind' => 'I',
						  '-str' =>
						  ["renamed <$d> to <${d}-broken"]);
				    ::clearAbsolutePathCache();
				}
				else
				{
				    $prLog->print('-kind' => 'E',
						  '-str' => ["cannot rename <$d>"],
						  '-exit' => 1);
				}
			    }
			    $prLog->print('-kind' => 'E',
					  '-str' => ["",
						     "----- repeating consistency check -----"]);
			    goto onceAgainBecauseOfErrorCorrection;
			}
		    }
		    $linkTo{$d}{$l} = $f;
		    $allBackupDirsWithLateLinks{$d} = 1;
		    $allBackupDirsWithLateLinks{$l} = 1;
		}
		close(FILE);
	    }
	    elsif ($entry =~ /\AlinkFrom\d+\Z/)
	    {
		my $f = "$d/.storeBackupLinks/$entry";
		$f =~ s/\/{2,}/\//og;
		unless (-w $f)
		{
		    $error++;
		    $prLog->print('-kind' => 'E',
				  '-str' => ["no write permissions on <$f>"]);
		}
		local *FILE;
#print "-10- open <$f>\n";
		unless (open(FILE, $f))
		{
		    $prLog->print('-kind' => 'E',
				  '-str' => ["cannot open <$f>"],
				  '-add' => [__FILE__, __LINE__]);
		    $error++;
		    next;
		}
		my $line;
		$line = <FILE>;
		chomp $line;
#print "-11- line = <$d/$line>\n";
		my $l = &::absolutePath("$d/$line");
#print "-12- l = <$l>\n";
		unless ($l)
		{
		    $prLog->print('-kind' => 'E',
				  '-str' => ["2 link <$line> to non existing " .
					     "dir in <$f>"]);
		    $error++;
		    if ($self->{'interactive'} or $autorepair)
		    {
			my $answer;
			if ($autorepair)
			{
			    $answer = 'yes';
			}
			else
			{
			    do
			    {
				print "There was a backup <$line> refering to <$d>.\n",
				"The backup <$line> cannot be found. This means:\n",
				"- you didn't call $0 with all backup directories or\n",
				"- the backup <$line> was deleted by somebody.\n",
				"ONLY DELETE THIS REFERENCE IF THE BACKUP <$line> DOES\n",
				"NOT EXIST ANY MORE!\n",
				"delete this reference?\n",
				"yes / no  -> ";
				$answer = <STDIN>;
				chomp $answer;
			    } while ($answer ne 'yes' and $answer ne 'no');
			}
			close(FILE);
			closedir(DIR);
			if ($answer eq 'yes')
			{
			    if (unlink($f))
			    {
				$prLog->print('-kind' => 'I',
					      '-str' => ["${ar}deleted <$f>"]);
			    }
			    else
			    {
				$prLog->print('-kind' => 'E',
					      '-str' => ["${ar}cannot delete <$f>"],
					      '-exit' => 1);
			    }
			}
			$prLog->print('-kind' => 'E',
				      '-str' => ["",
				      "----- repeating consistency check -----"]);
			goto onceAgainBecauseOfErrorCorrection;
		    }

		}
		$linkFrom{$d}{$l} = $f;
#print "-13- linkFrom{$d}{$l} = $f\n";
		$allBackupDirsWithLateLinks{$d} = 1;
		$allBackupDirsWithLateLinks{$l} = 1;
		close(FILE);
	    }
	    elsif ($entry eq 'linkFile.bz2')
	    {
		my $f = "$d/.storeBackupLinks/$entry";
		$f =~ s/\/{2,}/\//og;
		unless (-w $f)
		{
		    $error++;
		    $prLog->print('-kind' => 'E',
				  '-str' => ["no write permissions on <$f>"]);
		}
	    }
	    
	}
	closedir(DIR);
    }

    if ($error and not $self->{'interactive'})
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["found $error inconsistencies, please " .
				 "repair and check again"],
		      '-exit' => 1);
    }

#    $self->printLinkRef('linkTo');
#    $self->printLinkRef('linkFrom');

    if ($self->checkLinkConsistency())
    {
	$prLog->print('-kind' => 'E', # return == 1 only in
		      '-str' =>       # interactive mode
		      ["", "----- repeating consistency check -----"]);
	goto onceAgainBecauseOfErrorCorrection;
    }

    $prLog->print('-kind' => 'I',
		  '-str' => ["consistency check finished successfully"]);

#    if ($verbose)
    if (1)
    {
	my $link = undef;
	$link = $self->{'linkTo'} if defined $self->{'linkTo'};
	my (@mes) = ();

	if ($link)
	{
	    my $path;
	    foreach $path (sort keys %$link)
	    {
		push @mes, "  $path";
		my $hash = $$link{$path};
		my $p;
		foreach $p (sort keys %$hash)
		{
		    push @mes, "    -> $p";
		}
	    }
	}

	if (@mes)
	{
	    unshift @mes, "listing references:";
	    $prLog->print('-kind' => 'I',
			  '-str' => \@mes);
	}
	else
	{
	    $prLog-> print('-kind' => 'I',
			   '-str' =>
			   ["found no references to other backups"]);
	}
    }

    return $self;
}


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

    my $interactive = $self->{'interactive'};
    my $autorepair = $self->{'autorepair'};
    my $ar = $autorepair ? "autorepair: " : "";
    my $prLog = $self->{'prLog'};
    my $verbose = $self->{'verbose'};
    my $debug = $self->{'debug'};
    my $checkLinkFromConsistency = $self->{'checkLinkFromConsistency'};

    $prLog->print('-kind' => 'I',
		  '-str' => ["listing unresolved links"])
	if $debug;

    my $fromDir = $self->{'linkTo'};
    my $toDir = $self->{'linkFrom'};
    my $error = 0;
    my $dir;
#print "interactive = <$interactive>\n";
#print "........... checkLinkConsistency ............\n";
    foreach $dir (sort keys %$fromDir)
    {
	my $link;
	my $hash = $$fromDir{$dir};

	foreach $link (sort keys %$hash)
	{
	    $prLog->print('-kind' => 'I',
			  '-str' => ["linkTo: $dir -> $link"])
		if $debug;
#print "..1.. $dir $link\n";
	    if ($dir eq $link)
	    {
#print "..2.. equal\n";
		$prLog->print('-kind' => 'E',
			      '-str' => ["\tdir <$dir> has link to itself!",
				"\tin file " . $$fromDir{$dir}{$link},
				"\tto correct, delete this link / line"]);
		$error++;
		if ($interactive or $autorepair)
		{
		    my $answer;
		    if ($autorepair)
		    {
			$answer = 'yes';
		    }
		    else
		    {
			do
			{
			    print "delete this link (it makes no sense at all)?\n",
			    "yes / no  -> ";
			    $answer = <STDIN>;
			    chomp $answer;
			} while ($answer ne 'yes' and $answer ne 'no');
		    }
		    if ($answer eq 'yes')
		    {
			$self->deleteLinkFromFileLinkTo($$fromDir{$dir}{$link},
							$link, $dir, $ar);
			$prLog->print('-kind' => 'W',
				      '-str' => ["${ar}link deleted"]);
		    }
		    return 1;
		} 
	    }
	    elsif (defined $$toDir{$link})
	    {
#print "..3.. toDir defined $link\n";
		$prLog->print('-kind' => 'I',
			      '-str' => ["\tdirectory <$dir> has linkTo"])
		    if $debug;
		if (defined $$toDir{$link}{$dir})
		{
		    $prLog->print('-kind' => 'I',
				  '-str' =>
				  ["\t\tand links back to <$dir>",
				   "\t\t\t(file " . $$fromDir{$dir}{$link} . ")",
				   "\t\t\t(file " . $$toDir{$link}{$dir} . ")"])
			if $debug;
		}
		else
		{
		    if ($checkLinkFromConsistency)
		    {
			$prLog->print('-kind' => 'E',
				      '-str' =>
				      ["\t\t1 no link back to <$dir>",
				       "\t\t\t(file " . $$fromDir{$dir}{$link} . ")",
				       "\t\t\t(missing in directory " .
				       "$link/.storeBackupLinks/linkFrom...)"]);
			$error++;
			if ($interactive or $autorepair)
			{
			    my $answer;
			    if ($autorepair)
			    {
				$answer = 'yes';
			    }
			    else
			    {
				do
				{
				    print "write the link back (save)?\n",
				    "yes / no  -> ";
				    $answer = <STDIN>;
				    chomp $answer;
				} while ($answer ne 'yes' and $answer ne 'no');
			    }
			    $self->writeFileLinkFrom($link, $dir, $ar);
			    return 1;
			}
		    }
		}
	    }
	    else
	    {
		if ($checkLinkFromConsistency)
		{
		    $prLog->print('-kind' => 'E',
				  '-str' => ["\t1 directory <$link> has no " .
					     "linkFrom entry"]);
		    $error++;

		    if ($interactive or $autorepair)
		    {
			my $answer;
			if ($autorepair)
			{
			    $answer = 'yes';
			}
			else
			{
			    do
			    {
				print "set entry in <$link>?\n",
				"yes / no  -> ";
				$answer = <STDIN>;
				chomp $answer;
			    } while ($answer ne 'yes' and $answer ne 'no');
			}

			$self->writeFileLinkFrom($link, $dir, $ar)
			    if $answer eq 'yes';
			return 1;
		    }
		}
	    }
	}
    }

    foreach $dir (sort keys %$toDir)
    {
	my $link;
	my $hash = $$toDir{$dir};
	foreach $link (sort keys %$hash)
	{
	    $prLog->print('-kind' => 'I',
			  '-str' => ["linkTo: $dir -> $link"])
		if $debug;
	    if ($dir eq $link)
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["\tdir <$dir> has link to itself!",
				"\tin file " . $$toDir{$dir}{$link},
				"\tto correct, delete this file"]);
		$error++;
		if ($interactive)
		{                  # covered through error handling above
		    $prLog->print('-kind' => 'E',
				  '-str' => ["error 1 in checkLinkConsistency",
					     "This should never happen",
					     "please write a bug report"],
				  '-exit' => 1);
		}

	    }
	    elsif (defined $$fromDir{$link})
	    {
		$prLog->print('-kind' => 'I',
			      '-str' => ["\tdirectory <$dir> has linkFrom"])
		    if $debug;
		if (defined $$fromDir{$link}{$dir})
		{
		    $prLog->print('-kind' => 'I',
				  '-str' =>
				  ["\t\tand links back to <$dir>",
				   "\t\t\t(file " . $$toDir{$dir}{$link} . ")",
				   "\t\t\t(file " . $$fromDir{$link}{$dir} . ")"])
			if $debug;
		}
		else
		{
		    $prLog->print('-kind' => 'E',
				  '-str' =>
				  ["\t\t2 no link back to <$dir>",
				   "\t\t\t(file " . $$toDir{$dir}{$link} . ")",
				   "\t\t\t(missing in directory " .
				   "$link/.storeBackupLinks/linkTo)"]);
		    $error++;
		    if ($interactive)
		    {                  # covered through error handling above
			$prLog->print('-kind' => 'E',
				      '-str' => ["error 1 in checkLinkConsistency",
						 "This should never happen",
						 "please write a bug report"],
				      '-exit' => 1);
		    }

		}
	    }
	    else
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["\t2 directory <$link> has no entry",
					 "in linkTo to <$dir> but",
					 "<$dir> has linkFrom to <$link>"]);
		$error++;
		if ($interactive or $autorepair)
		{
		    my $answer;
		    if ($autorepair)
		    {
			$answer = 'yes';
		    }
		    else
		    {
			do
			{
			    print "set entry in <$link>?\n",
			    "yes / no  -> ";
			    $answer = <STDIN>;
			    chomp $answer;
			} while ($answer ne 'yes' and $answer ne 'no');
		    }

		    $self->addLink2LinkTo($link, $dir, $ar)
			if $answer eq 'yes';
		    return 1;
		}
	    }
	}
    }

    unless ($interactive)
    {
	if ($error)
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["found $error inconsistencies, please " .
				     "repair and check again"],
			  '-exit' => 1);
	}
	else
	{
	    $prLog->print('-kind' => 'I',
			  '-str' => ["no unresolved links"])
		if $debug;
	}
    }

    return 0;   # leave in non-interactive mode
}


########################################
sub listAllStoreBackupDirs
{
    my $self = shift;
    my $dir = shift;

    return (0, 0, 0) if -l $dir;

    $dir =~ s#/+$##;     # remove trailing slash

    my $prLog = $self->{'prLog'};
    my $verbose = $self->{'verbose'};
    my $includeRenamedBackupDirs = $self->{'includeRenamedBackupDirs'};
    my ($series, $backup, $renamed) = (0, 0, 0);

    my ($x, $entry) = ::splitFileDir($dir);
    if ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}.\d{2}.\d{2}\Z/)
    {
#print "----------if $entry\n";
	next if -e "$dir/$::checkSumFile.notFinished";
	$self->{'prLog'}->print('-kind' => 'I',
				'-str' => ["\tfound <$dir>"])
	    if $self->{'verbose'};
	++$backup;
	push @{$self->{'allStbuDirs'}}, $dir;
    }
    elsif ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}.\d{2}.\d{2}-.*\Z/)
    {
#print "----------elsif $entry\n";
	push @{$self->{'allStbuDirs'}}, $dir
	    if $includeRenamedBackupDirs;
	++$renamed;
    }
    else
    {
	$prLog->print('-kind' => 'I',
		      '-str' =>
		      ["scanning directory <$dir> for existing backups"]);
	++$series;

	local *DIR;
	unless (opendir(DIR, $dir))
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["cannot opendir <$dir>"],
			  '-add' => [__FILE__, __LINE__])
		if $verbose;
	    return ($series, $backup, $renamed);
	}
	while ($entry = readdir DIR)
	{
	    next if ($entry eq '.' or $entry eq '..');
	    my $fullEntry = "$dir/$entry";
	    next unless -d $fullEntry;

	    my ($s, $b, $r) = $self->listAllStoreBackupDirs($fullEntry);
	    $series += $s;
	    $backup += $b;
	    $renamed += $r;
	}
	close(DIR);
    }

    return ($series, $backup, $renamed);
}


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

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


########################################
sub checkDir
{
    my $self = shift;
    my $dir = shift;       # must be an absolute path name

#print "\tchecking <$dir> against:\n";
#print "\t\t<", join('><', sort keys %{$self->{'allBackupDirsWithLateLinks'}}), ">\n";
    return exists $self->{'allBackupDirsWithLateLinks'}{$dir};
}

########################################
sub checkDirHasLinkTo
{
    my $self = shift;
    my $dir = shift;       # must be an absolute path name

    return -e "$dir/.storeBackupLinks/linkTo";
}


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

    return keys %{$self->{'allBackupDirsWithLateLinks'}};
}


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

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


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

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


########################################
sub printLinkRef
{
    my $self = shift;
    my $name = shift;

    my $link = undef;
    $link = $self->{$name} if defined $self->{$name};
    return unless $link;

    print "---- begin $name ----\n";
    my $path;
    foreach $path (sort keys %$link)
    {
	print "$path:\n";
	my $hash = $$link{$path};
	my $p;
	foreach $p (sort keys %$hash)
	{
	    print "\t$p\n";
	}
    }
    print "---- end $name ----\n";
}


########################################
sub deleteLinkFromFileLinkTo
{
    my $self = shift;
    my $file = shift;
    my $link = shift;
    my $actDir = shift;
    my $ar = shift;
#print ".........in deleteLinkFromFileLinkTo\n";

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

    # read whole file and filter
    local *FILE;
    open(FILE, $file) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot open <$file>"],
		      '-add' => [__FILE__, __LINE__],
		      '-exit' => 1);
    my ($l, @l);
    while ($l = <FILE>)
    {
	chomp $l;
	push @l, $l unless $link eq ::absolutePath("$actDir/$l");
    }
    close(FILE) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot close <$file>"],
		      '-exit' => 1);

    # write data back
    open(FILE, "> $file") or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot open <$file> for writing"],
		      '-add' => [__FILE__, __LINE__],
		      '-exit' => 1);
    print FILE join("\n", @l), "\n";

    close(FILE) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot close <$file>"],
		      '-exit' => 1);
}


########################################
#sub setX1
sub addLink2LinkTo     # adds a link in linkTo
{
    my $self = shift;
    my $dirOfLinkTo = shift;
    my $refTo = shift;
    my $ar = shift;
#print ".........in addLink2LinkTo\n";

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

#print "\tdirOfLinkTo = <$dirOfLinkTo>\n";
#print "\trefTo = <$refTo>\n";

    my $f = "$dirOfLinkTo/.storeBackupLinks/linkTo";
    local *TO;
    open(TO, ">> $f") or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot open for appending <$f>"],
		      '-exit' => 1);
    my $relpath = ::relPath($dirOfLinkTo, $refTo);
    print TO "$relpath\n" or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot write to <$f>"],
		      '-exit' => 1);
    close(TO) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot close <$f>"],
		      '-exit' => 1);
    $prLog->print('-kind' => 'W',
		  '-str' => ["${ar}wrote linkTo <$refTo> in " .
			     "<$dirOfLinkTo>"]);

}


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

    my $dirWhereToSetLinkFrom = shift;
    my $targetForLinkFrom = shift;
    my $ar = shift;
#print ".........in writeFileLinkFrom\n"; 

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

#print "\tdirWhereToSetLinkFrom = <$dirWhereToSetLinkFrom>\n";
#print "\ttargetForLinkFrom = <$targetForLinkFrom>\n";

    my $i = 0;
    local *FROM;
    my $from = "$dirWhereToSetLinkFrom/.storeBackupLinks/linkFrom";
    $i++ while -e "$from$i";
    open(FROM, "> $from$i") or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot open for writing <$from$i>"],
		      '-exit' => 1);
    my $relpath = ::relPath($dirWhereToSetLinkFrom, $targetForLinkFrom);
    print FROM "$relpath\n" or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot write to <$from$i>"],
		      '-exit' => 1);
    close(FROM) or
	$prLog->print('-kind' => 'E',
		      '-str' => ["${ar}cannot close <$from$i>"],
		      '-exit' => 1);
    $prLog->print('-kind' => 'W',
		  '-str' => ["${ar}wrote linkFrom from <$dirWhereToSetLinkFrom>" .
			     " to <$targetForLinkFrom>"]);
}


############################################################
package evalInodeRule;

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

    # set default values for parameters
    my (%params) = ('-line'    => [],
		    '-keyName' => undef,   # eg. includeRule
		    '-debug'   => 0,       # debug == 0: no output
		                           # debug == 1: result per file
		                           # debug == 2: debugging output
		    '-tmpdir'      => '/tmp',
		    '-prLog'       => undef
	);

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

    if ($self->{'line'})
    {
	my $prLog = $self->{'prLog'};

	my (@allowedVars) = ('file', 'size', 'mode', 'ctime', 'mtime',
			     'uid', 'uidn', 'gid', 'gidn', 'type');
	my $evalTools = evalTools->new('-linevector' => $self->{'line'},
				       '-allowedVars' => \@allowedVars,
				       '-tmpdir' => $self->{'tmpdir'},
				       '-prefix' => $self->{'keyName'},
				       '-prLog' => $prLog);
	$evalTools->checkLineBug('-exitOnError' => 1,
				 '-printError' => 1);
	$self->{'evalTools'} = $evalTools;
    }

    bless $self, $class;
}


########################################
sub checkRule
{
    my $self = shift;
    my ($file, $size, $mode, $ctime, $mtime, $uidn, $gidn, $type) = @_;

    my $debug = $self->{'debug'};
    my $evalTools = $self->{'evalTools'};

    my $uid = getpwuid($uidn);
    my $gid = getgrgid($gidn);
    $uid = '' unless $uid;
    $gid = '' unless $gid;
    my (%values) = ('file' => $file,
		    'size' => $size,
		    'mode' => $mode,
		    'ctime' => $ctime,
		    'mtime' => $mtime,
		    'uid' => $uid,
		    'uidn' => $uidn,
		    'gid' => $gid,
		    'gidn' => $gidn,
		    'type' => $type);

    my $ret;
    if ($debug == 0 or $debug == 1)
    {
	$ret = $evalTools->fastEval(\%values);
	$self->{'prLog'}->print('-kind' => 'D',
				'-str' => [$self->{'keyName'} .
					   ": <$ret> <== <$file>"])
	    if $debug == 1;
    }
    else    # debug >= 2
    {
	$ret = $evalTools->checkLineDebug(\%values, ", <$file>: ");
    }
    return $ret;
}


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

    $self->{'debug'} = shift;   # 0, 1, 2
}


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

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


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

    return $self->{'line'} ? join(' ', @{$self->{'line'}}) : undef;
}


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

    return $self->{'line'} ? 1 : 0;
}


########################################
%main::DATE_Cache = ();
sub main::DATE
{
    my $par = shift;

    return $main::DATE_Cache{$par} if exists $main::DATE_Cache{$par};

    my $ret = undef;
    if ($par =~ /\A(\d{4})\.(\d{2})\.(\d{2})(_\d{2}\.\d{2}\.\d{2})?\Z/o)
    {
	my (@p) = ('-year' => $1,
		   '-month' => $2,
		   '-day' => $3);
	my $t = $4;
	if (defined $t)
	{
	    $t =~ /\A_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
	    push @p, ('-hour' => $1,
		      '-min' => $2,
		      '-sec' => $3);
	}
	my $d = dateTools->new(@p);
	$ret = $d->getSecsSinceEpoch() if $d->isValid();
    }
    elsif (dateTools::checkStr('-str' => $par))   # ..d..h..m..s
    {
	my $now = dateTools->new();
	$now->sub('-str' => $par);
	$ret = $now->getSecsSinceEpoch();
    }
    else
    {
	$main::__prLog->print('-kind' => 'E',
			      '-str' => ["illegal format <$par> in ::DATE"],
			      '-exit' => 1);
    }

    $main::__prLog->print('-kind' => 'E',
			  '-str' => ["time <$par> before 1970 not possible"],
			  '-exit' => 1)
	if $ret < 0;

    $main::DATE_Cache{$par} = $ret;

    return $ret;
}


########################################
%main::SIZE_Cache = ();
sub main::SIZE
{
    my $par = shift;

    return $main::SIZE_Cache{$par} if exists $main::SIZE_Cache{$par};

    my ($ret) = &::revertHumanReadable($par);

    $main::__prLog->print('-kind' => 'E',
			  '-str' => ["cannot convert <$par> in ::SIZE"],
			  '-exit' => 1)
	unless defined $ret;

    $main::SIZE_Cache{$par} = $ret;
    return $ret;
}


########################################
sub main::COMPRESSION_CHECK
{
    my $file = shift;

    $file = $main::sourceDir . "/$file";
#print "###########$file##########\n";
    local *IN;
    unless (sysopen(IN, $file, "O_RDONLY"))
    {
	return 0;      # no compression
    }
    my $inBuffer;
    sysread(IN, $inBuffer, 10*1024**2);
    close(IN);

    return 0
	if length($inBuffer) == 0;

    my $outBuffer;
    ::gzip \$inBuffer => \$outBuffer, Level => 1;

    if (length($outBuffer)/length($inBuffer) < 0.95)
    {
#print "--$file--1\n";
	$main::stat->incr_noComprCheckCompr();
	return 1;      # compression possible
    }
    else
    {
#print "--$file--0\n";
	$main::stat->incr_noComprCheckCp();
	return 0;      # no compression
    }
}


############################################################
# returns block size of first matching rule or 0
package evalInodeRuleMultiple;

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

    # set default values for parameters
    my (%params) = ('-lines'         => [],   # set these three
		    '-blockSize'     => [],   # in parallel!
		    '-blockCompress' => [],
		    '-blockRead'     => [],
		    '-blockParallel' => [],
		    '-keyName'       => undef,# eg. includeRule
		    '-debug'         => 0,    # debug == 0: no output
		                              # debug == 1: result per file
		                              # debug == 2: debugging output
		    '-tmpdir'        => '/tmp',
		    '-prLog'         => undef
	);

    &::checkObjectParams(\%params, \@_, 'evalInodeRuleMultiple::new',
			 ['-lines', '-blockSize', '-blockCompress',
			  '-blockRead', '-blockParallel', '-keyName',
			  '-prLog']);
    &::setParamsDirect($self, \%params);

    my $lines = $self->{'lines'};
    my $blockSize = $self->{'blockSize'};
    my $blockCompress = $self->{'blockCompress'};
    my $blockRead = $self->{'blockRead'};
    my $blockParallel = $self->{'blockParallel'};
    my ($i, @evalInodeRule, %blockSize, %blockCompress, %blockRead,
	%blockParallel);
    @evalInodeRule = ();
    foreach ($i = 0 ; $i < @$lines ; $i++)
    {
	my $line = $$lines[$i];
	if (defined $line)
	{
	    my $r =
		evalInodeRule->new('-line' => $line,
				   '-keyName' => $self->{'keyName'} . $i,
				   '-debug' => $self->{'debug'},
				   '-tmpdir' => $self->{'tmpdir'},
				   '-prLog' => $self->{'prLog'});
	    push @evalInodeRule, $r;
	    $blockSize{$r} = $$blockSize[$i];
	    $blockCompress{$r} = $$blockCompress[$i];
	    $blockRead{$r} = $$blockRead[$i] ? $$blockRead[$i] : [];
	    $blockParallel{$r} = $$blockParallel[$i];
	}
    }

    $self->{'evalInodeRule'} = \@evalInodeRule;
    $self->{'blockSize'} = \%blockSize;
    $self->{'blockCompress'} = \%blockCompress;
    $self->{'blockRead'} = \%blockRead;
    $self->{'blockParallel'} = \%blockParallel;

    bless $self, $class;
}


########################################
sub checkRule
{
    my $self = shift;
    my ($file, $size, $mode, $ctime, $mtime, $uidn, $gidn, $type) = @_;

    my $evalInodeRule = $self->{'evalInodeRule'};
    my $blockSize = $self->{'blockSize'};
    my $blockCompress = $self->{'blockCompress'};
    my $blockRead = $self->{'blockRead'};
    my $blockParallel = $self->{'blockParallel'};

    my $e;
    foreach $e (@$evalInodeRule)
    {
	if ($e->checkRule($file, $size, $mode, $ctime, $mtime, $uidn,
			  $gidn, $type))
	{
	    return ($$blockSize{$e}, $$blockCompress{$e},
		    $$blockParallel{$e}, $$blockRead{$e});
	}
    }
    return (0, undef, []);
}


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

    my $evalInodeRule = $self->{'evalInodeRule'};

    my $e;
    foreach $e (@$evalInodeRule)
    {
	$e->setDebugFlag();
    }
}


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

    my $evalInodeRule = $self->{'evalInodeRule'};

    my ($e, @line);
    (@line) = ();
    foreach $e (@$evalInodeRule)
    {
	push @line, (@{$e->getLine()}, '; ');
    }
    return \@line;
}


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

    return $self->getLine() ? join(' ', @{$self->getLine()}) : undef;
}


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

    my $evalInodeRule = $self->{'evalInodeRule'};
    my $e = scalar @$evalInodeRule;
    return $e;
}


1
