package Cache;
use strict;

=head1 AUTHOR

Peter Baumann
Version 1.11
=head1 EXAMPLE

use Cache;
use strict;

# initialising Cache
my $cache=Cache->new;
or
my $cache=Cache->new("Folder","Max-Filesize","Digits of Stack-Files");


# putting some Data
$cache->put("Name","Data");
#or
$cache->put("Name","Data",time_in_seconds);

# getting Data
my $foo=$cache->get("Name");

# Does it exist? If yes, show Data
print $foo if $cache->exists();

# Deleting one entry and getting it's last value
$value=$cache->delete("Name");

# deleting all old entries
$cache->purge();

# deleting the complete Cache
$cache->erase();
or
$cache->clear();

# gives this thread the exclusive rights
# locks other threads
# and is a little bit faster
$cache->exclusive();

# shares the Servertime with other Cache-Threads
$cache->nonexclusive;

# No automatic purge
$cache->nopurge;

# Enables the autimatic purging
$cache->activate_purge;

# get's the expiration time of an element
$time=$cache->expires($name);

# gives an array of all element-names
@array=$cache->all_elements();

=cut

############################################################################
sub new{
my %set=();
my $reffile;
my $type=shift;
my $self={};


use Fcntl qw/:DEFAULT :flock/;

my $field={};
my $directory=shift;
my $filesize=shift;
my $digitnum=shift;

$filesize=48000 if $filesize < 1;
$digitnum=1 if $digitnum < 1;

chomp($directory);
if ($directory eq ''){$directory="cache";}

my $dateinamestack="cachestack.txt";
my $reffile="$directory/lock.txt";

if (!-e $directory){mkdir $directory,0777 || die "can not create Cache-Directory $directory in Module Cache.pm";}
if (!-e "$directory/cache"){mkdir "$directory/cache",0777 || die "can not create Sub-Cache-Directory $directory cache in Module Cache.pm";}

bless ($field,$type);
$field->{digitnum}=$digitnum;
$field->{filesize}=$filesize;
$field->{reffile}=$reffile;
$field->{stack}=$dateinamestack;
$field->{directory}=$directory;
$field->{exclusive}=0;
$field->{dateicou}=0;
$field->{nopurge}=0;
$field->{nextfiles}=();
$field->{nextfile}="";
@{$field->{garbage}}=();

if (!-e "$reffile"){
						open (my $OUT,">",$reffile);
						chmod $reffile,0666;
						print $OUT "0\n";
						close $OUT;
						}
open (my $datlock,"$reffile");
$field->{nextfilesize}=0;

$field->{datlock}=\$datlock;

&init_nextfile($field);
_find_next_cachefile($field);

#print $field->{nextfile};
END {&nonexclusive($field);}

return $field;
}


########################
# Setzt Exclusiv-Modus für diesen Prozess
# Alle parallel laufenden Prozesse haben keinen Zugriff mehr
#####################################################
sub exclusive{
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;

_lockit($objekt);
$objekt->{exclusive}=1;
}


#######################
# setzt exclusivmodus zurück
###############################
sub nonexclusive{
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $reffile=$objekt->{reffile};
my $lock;
my $datlock=$objekt->{datlock};
if ($objekt->{exclusive} == 1){

								_unlockit($objekt);
								$objekt->{exclusive}=0;
								$objekt->{stackpuf}=();
								$objekt->{datpuf}='';
								$objekt->{datstack}=();
								}

}


#################
# findet nächste Datei zum Schreiben
#######################################
sub _find_next_cachefile{
my $objekt=shift;
my $directory=$objekt->{directory};

if ($objekt->{nextfile} ne '' &&
	$objekt->{nextfilesize} < $objekt->{filesize}){return $objekt->{nextfile};}

	{
	foreach my $file (keys %{$objekt->{nextfiles}}){
	#my $file=$_;

	if ($file ne ''){
				if (-s "$directory/cache/$file" >= $objekt->{filesize}){
																		delete $objekt->{nextfiles}{$file};
																		next;
																		}

				$objekt->{nextfile}=$file; # nextfile ist nächstes File aus Liste
				$objekt->{nextfilesize}=$objekt->{nextfiles}{$file};	# Länge auch laden
				return $file;
			}
			}
	# nix gefunden??? Dann neue Liste erstellen und das Ganze nochmal
	init_nextfile($objekt);
	redo;
	}

}

#################
# bereitet nextfile vor -> nextfile ist die Datei, die als nächstes beschrieben werden kann
#############################################################################################
sub init_nextfile{
my $objekt=shift;
my $directory=$objekt->{directory};
my ($filename, %cachefiles, $datei);
my $found=0;

opendir (my $DIR,"$directory/cache");
my @cachefiles=readdir ($DIR);
closedir $DIR;
my $filecou=0;

foreach (@cachefiles){  # processing whole directory
						next if ($_ eq '.' || $_ eq '..');
						$filecou++; # count files
						my $filesize=(-s "$directory/cache/$_");
						if ($filesize < $objekt->{filesize}){ # if actual file is smaller thean the limit
															$objekt->{nextfiles}{$_}=$filesize;
															if ($objekt->{nextfile} eq ''){
																							$objekt->{nextfile}=$_ ;
																							$objekt->{nextfilesize}=$filesize;
																							}
															$found++;
															}
					}

while ($found < 1000){

					{
						$filecou++;
						redo if (-e "$directory/cache/$filecou.txt");
					}
					$objekt->{nextfile}="$filecou.txt" if $objekt->{nextfile} eq '';
					$objekt->{nextfiles}{"$filecou.txt"}=0;
					$found++;
					}
}

#########################
# lockt cache
##################################################
sub _lockit{
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $reffile=$objekt->{reffile};
my $datlock=${$objekt->{datlock}};
my $lock;


{
open ($datlock,"<",$reffile);
while (<$datlock>){$lock=$_;}

redo if (!flock($datlock,LOCK_EX));
}

}


##############################
#	unlockt cache
#
######################################
sub _unlockit{
my $objekt=shift;
my $reffile=$objekt->{reffile};
my $datlock=${$objekt->{datlock}};

close $datlock;
}

#################################
# gibt alle Einträge zurck
################################
sub all_elements{

my $objekt=shift;

my $directory=$objekt->{directory};
my $stack=$objekt->{stack};

purge($objekt) if ($objekt->{nopurge}==0);
if ($objekt->{exclusive} == 0){ _lockit($objekt);}

opendir (my $DIR,$directory);
my @files=readdir ($DIR);
close $DIR;
my @all=();
foreach my $datei (@files){
							next if ($datei eq '.' ||
									 $datei eq '..' ||
									 $datei eq 'lock.txt' ||
									 ( -d "$directory/$datei" )
									 );
							open (my $IN,'<',"$directory/$datei");
							my %stack=<$IN>;
							close $IN;

							push (@all, keys %stack);
							chomp (@all);
							}

if ($objekt->{exclusive} == 0){ _unlockit($objekt);}
return @all;
}
#############
# prüft ob name in Stack
#####################
sub _is_data_in_stack{
my $objekt=shift;
my $name=shift;

purge($objekt) if ($objekt->{nopurge} == 0);
my $namegesucht=$name."\n";
my $directory=$objekt->{directory};
my $stack=$objekt->{stack};

my $firstchar=_FIRSTCHAR($objekt,$name);
my $datei='';


my @arr=();

if ($objekt->{exclusive} == 1){
			# wenn exclusive, dann Stack in Speicher laden und Daten von da holen
			if (exists ($objekt->{stackpuf}{$firstchar}{$namegesucht})){ # Daten schon da?
						$datei= $objekt->{stackpuf}{$firstchar}{$namegesucht};
						chomp ($datei);
						return $datei;
							   							}
							   							else
							   							{ # wenn Daten noch nicht da, dann laden
							   							if (open (my $IN,"<$directory/$firstchar$stack")){

							   							%{$objekt->{stackpuf}{$firstchar}}=<$IN>;
							   							close $IN;

							   							$datei= $objekt->{stackpuf}{$firstchar}{$namegesucht};
							   							chomp ($datei);
							   							return $datei;
							   							 }else {return;}
							   							 }
}
else
{ # nonexclusive
open (my $IN,"<$directory/$firstchar$stack");
while (<$IN>){
			push (@arr,$_);
			next if $. % 2;

			($name,$datei)=@arr;
			@arr=();

			if ($name eq $namegesucht){
										chomp($datei);
										close $IN;
										return $datei;
					     				}
			}
close $IN;
}
return;
}


############################################################
# puts something into cache
############################################################
sub put{
use Fcntl qw/:DEFAULT :flock/;

my $objekt=shift;
my $name=shift;
my $wert=shift;
my $dauer=shift || 60*60*24; # Default-Time 1 Day

my $directory=$objekt->{directory};
my ($tmpname,$datei,$i,$found,$filefound,$file,@file);
my $stack=$objekt->{stack};
my $found=0;
$dauer=$dauer+time();
if ($name eq ''){die "no name given for put in Modul Cache.pm->put";}

my $namegesucht=$name."\n";
my $datlock=$objekt->{datlock};
my $reffile=$objekt->{reffile};

my @erg=();
my $datei='';
if ($objekt->{exclusive} == 0){
								_lockit($objekt);
								}


$datei=_is_data_in_stack($objekt,$name);
#print "Datei -$datei-\n";
if ($datei ne ''){$found = 1;}

##########################
# wenn gefunden
if ($found == 1){
				my $gesucht=$name;
				my $filename="$directory/cache/$datei";
				my $output='';
				my $filesize= (-s $filename);
				open (my $in,"<",$filename) || die "nonono $filename";
				binmode ($in);
				my ($inhalt,$nameold,$zeit);

				if ($objekt->{exclusive} == 1){ # wenn exclusive, dann Daten in Speicher einlesen
								if ($objekt->{datstack} ne $filename){
																		my @file=<$in>;

																		$objekt->{datpuf}=join("",@file); @file=();
																		close $in;
																		$objekt->{datstack} = $filename;
																		}
				my $pos=0;

				{
				my $posold=$pos;

				my $namelae=substr ($objekt->{datpuf},$pos,4); $pos+=4;
				$namelae=unpack("N",$namelae);
				my $akname=substr($objekt->{datpuf},$pos,$namelae); $pos+=$namelae;
				#print "$name\n";

				if ($akname eq $gesucht){
										$pos+=4; # time
										my $inhaltlae=substr ($objekt->{datpuf},$pos,4); $pos+=4;
										$inhaltlae=unpack("N",$inhaltlae);
										$pos+=$inhaltlae;

										$objekt->{datpuf}=substr($objekt->{datpuf},0,$posold).substr($objekt->{datpuf},$pos,length($objekt->{datpuf})-$pos);
										$objekt->{datpuf}.=pack ("N",length($gesucht)).$gesucht.pack("N",$dauer).pack ("N",length($wert)).$wert;

										open (my $out,">",$filename) || die "nonono $filename";
										binmode ($out);
										#print "printfromdatpuf\n";
										print $out $objekt->{datpuf};
										close $out;
										$objekt->{nextfilesize}= (-s $filename);
										return;
										}
										else
										{
										$pos+=4;
										my $inhaltlae=substr ($objekt->{datpuf},$pos,4); $pos+=4;
										$inhaltlae=unpack("N",$inhaltlae);
										$pos+=$inhaltlae;
										}



				last if $pos eq length ($objekt->{datpuf});
				redo;
				}


				} # if exclusive
				else
				{ # Daten von Platte einlesen

{
my $pos=tell($in);
read ($in,$nameold,4);
last if (!$nameold); # File-Ende
my $namepacked=$nameold;
$nameold=unpack("N",$nameold);
read ($in,$nameold,$nameold);

read ($in,$zeit,4);
my $zeitpacked=$zeit;
$zeit=unpack("N",$zeit);

				if ($name eq $nameold){


								read ($in,$inhalt,4);
								$inhalt=unpack("N",$inhalt);
								seek ($in,$inhalt,1);
								#$inhalt="";
								my $akpos=tell($in);

								seek ($in,0,0);
								read($in,$output,$pos);
								$output.=$namepacked.$nameold.pack("N",$dauer).pack("N",length($wert)).$wert;

								seek ($in,$akpos,0);

								read ($in,my $danach,$filesize-$akpos);
								$output.=$danach;

								close $in;

								open (my $out,">",$filename) || die "nonono $filename";
								binmode ($out);
								print $out $output;
								close $out;
								$objekt->{nextfilesize}= (-s $filename);
								last;
								}
								else
								{
								read ($in,$inhalt,4);
								$inhalt=unpack("N",$inhalt);

								read ($in,$inhalt,$inhalt);
								$inhalt='';

								}
redo;
}
}

close $in;

}

###############################
#wenn bisher nicht im Cache
if ($found == 0){
				my $firstchar=_FIRSTCHAR($objekt,$name);


				my $datei=_find_next_cachefile($objekt);
				my $filename="$directory/cache/$datei";

				#_append($objekt,$name,$dauer,$wert,$filename);
				open (my $out,">>",$filename);
				binmode $out;
				print $out pack("N",length($name)).$name.pack("N",$dauer).pack("N",length($wert)).$wert;
				close $out;

				$objekt->{nextfilesize} = (-s $filename);

				open (my $OUT,">>$directory/$firstchar$stack");
				print $OUT "$name\n$datei\n";
				close $OUT;



				if ($objekt->{exclusive} == 1){ if ($objekt->{datstack} eq $filename){ $objekt->{datstack}.=pack("N",length($name)).$name.pack("N",$dauer).pack("N",length($wert)).$wert;}
												$objekt->{stackpuf}{$firstchar}{"$name\n"}="$datei\n";
												}
				}
# Lock freigeben
if ($objekt->{exclusive} == 0){
				_unlockit($objekt);
				}
return;
}


############################################################
# löscht kompletten Cache - siehe clear
###############################################################
sub erase{

my $objekt=shift;
&clear($objekt);

}


####################################
# schaltet das purging ab, also das automatische Löschen verfallener Daten
##############################################################################
sub nopurge{
my $objekt=shift;
$objekt->{nopurge}=1;
return;
}

####################################
# schaltet das purging ab, also das automatische Löschen verfallener Daten
##############################################################################
sub aktivate_purge{
my $objekt=shift;
$objekt->{nopurge}=0;
return;
}

############################################################
# löscht kompletten Cache
###############################################################
sub clear{
my ($lock,$tmpname,$datei,$i,$found,$filefound,$file,@file);
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $datlock=$objekt->{datlock};
my $directory=$objekt->{directory};
my $stack=$objekt->{stack};
my $reffile=$objekt->{reffile};

if ($objekt->{exclusive} == 0){
						_lockit($objekt);
								}
opendir (my $IN,"$directory/cache");
my @files=readdir ($IN);
closedir $IN;

foreach (@files){
 		unlink "$directory/cache/$_";
		}

opendir (my $IN,"$directory");
my @files=readdir ($IN);
closedir $IN;

foreach (@files){
				if (index ($_,"lock") == -1){
							 	unlink "$directory/$_";
							 }
				}
if ($objekt->{exclusive} == 0){
							_unlockit($objekt);
							}
}



############################################################
# löscht verfallene Daten aus Cache
###############################################################
sub purge{
use Fcntl qw/:DEFAULT :flock/;

my $objekt=shift;

my $directory=$objekt->{directory};
my $stack=$objekt->{stack};
my $reffile=$objekt->{reffile};
my ($lock);
my $datlock=$objekt->{datlock};
if ($objekt->{exclusive} == 0){
								_lockit($objekt);
								}

opendir (my $IN,"$directory/cache");
my @files=readdir ($IN);
closedir $IN;

_clear_garbage_list($objekt);

foreach (@files){
				_garbage($objekt,"$directory/cache/$_") if $_=~ /.txt$/;
				}
_garbage_collection($objekt);

if ($objekt->{exclusive} == 0){
							_unlockit($objekt);
							}
}



########################
# gibt 1 zurück, falls Element existiert
#############################
sub exists{

my $objekt=shift;
my $name=shift;

# if nopurge is activated, look only in stackfile
if ($objekt->{nopurge} == 1){my $datei = _is_data_in_stack($objekt,$name);
							return if $datei eq '';
							return 1;
							}

my $wert=get($objekt,$name);

if ($wert){return 1} else {return;}
}

########################################################################
# holt Wert aus Cache
########################################################################
sub get{

use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $name=shift;
my $zeit=time();
my ($datei,$found,$dauer,$wert);
my $stack=$objekt->{stack};
my $directory=$objekt->{directory};
my $namegesucht=$name."\n";
my $lock=0;
my $file='';

my $firstchar='';
my $found=0;
$objekt->{exists}=0;	# Exists auf 0 setzen

#locking
my $datlock=$objekt->{datlock};
my $reffile=$objekt->{reffile};

		if ($objekt->{exclusive} == 0){
						_lockit($objekt);
								}

$firstchar=_FIRSTCHAR($objekt,$name);

$datei=_is_data_in_stack($objekt,$name);

if ($datei ne ''){
					$found=1;

					}




if ($found == 0){

				if ($objekt->{exclusive} == 0){
							_unlockit($objekt);
							}
				$objekt->{exists}=0;
				return;
				}



my $akdatei="$directory/cache/$datei";

my $gesucht=$name;


my $wert=_find_entry($objekt,$akdatei,$name);

if ($objekt->{exclusive} == 0){
							_unlockit($objekt);
							}
if ($wert){ $objekt->{exists}=1;
			return $wert;
			}
			else
			{
			$objekt->{exists}=0;
			return;
			}
}

#############################
# gibt Verfallzeit aus
#######################################
sub expires{
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $namegesucht=shift;
my ($inhalt,$zeit);
my $datlock=$objekt->{datlock};
my $stack=$objekt->{stack};
my $directory=$objekt->{directory};
my $found=0;
my $wert="";
my $reffile=$objekt->{reffile};
my ($name,$zeit);
if ($objekt->{exclusive} == 0){
				_lockit($objekt);
				}

# aktuelle cache-datei einlesen

my $firstchar=_FIRSTCHAR($objekt,$namegesucht);

my $datei=_is_data_in_stack($objekt,$namegesucht);

if ($datei ne ''){$found = 1};

#print "datei : $datei";
#wenn nicht vorhanden, dann zurück
if ($found==0){
				if ($objekt->{exclusive} == 0){
												_unlockit($objekt);
												}
				return;
				}

open (my $in,'<',"$directory/cache/$datei");
binmode ($in);

{
read ($in,$name,4);
last if (!$name);
$name=unpack("N",$name);
read($in,$name,$name);

if ($namegesucht eq $name){
							read ($in,$zeit,4);
							$zeit=unpack("N",$zeit);
							close $in;
							return $zeit;
							}
							else
							{
							seek($in,4,1);
							read($in,$inhalt,4);
							$inhalt=unpack("N",$inhalt);
							seek($in,$inhalt,1);
							}
redo;
}

return;
}

#############################
# löscht einen Eintrag, und NUR den
#######################################
sub delete{
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $name=shift;
my ($inhalt,$zeit);
my $datlock=$objekt->{datlock};
my $stack=$objekt->{stack};
my $directory=$objekt->{directory};
my $found=0;
my $wert="";
my $reffile=$objekt->{reffile};
my $zeit=time();
if ($objekt->{exclusive} == 0){
				_lockit($objekt);
				}

# aktuelle cache-datei einlesen

my $firstchar=_FIRSTCHAR($objekt,$name);

my $akstack="$directory/$firstchar$stack";

my $stackinhalt='';



my $datei=_is_data_in_stack($objekt,$name);

if ($datei ne ''){$found = 1};

#print "datei : $datei";
#wenn nicht vorhanden, dann zurück
if ($found==0){
				if ($objekt->{exclusive} == 0){
												_unlockit($objekt);
												}
				return;
				}
my $namegesucht=$name."\n";
open (my $in,"<",$akstack);
my %stack=<$in>;
close $in;

delete $stack{$namegesucht};

#Stack neu schreiben
open (my $OUT,">",$akstack);
chmod 0666,$akstack;
print $OUT %stack;
close $OUT;

my $filename="$directory/cache/$datei";


my @erg=();
my $now = time();

open (my $in,"<",$filename) || die "nonono";
binmode ($in);


$namegesucht=$name;

my $output="";
{
read ($in,$name,4);
last if (!$name); # File-Ende
my $namepacked=$name;
$name=unpack("N",$name);
read ($in,$name,$name);

read ($in,$zeit,4);
my $zeitpacked=$zeit;
$zeit=unpack("N",$zeit);


if ($namegesucht ne $name){
					read ($in,$inhalt,4);
					my $inhaltpacked=$inhalt;
					$inhalt=unpack("N",$inhalt);
					read ($in,$inhalt,$inhalt);

					$output.=$namepacked.$name.$zeitpacked.$inhaltpacked.$inhalt;
					push (@erg,$name);
					push (@erg,$zeit);
					push (@erg,$inhalt);
					}
					else
					{
					if ($zeit > $now){
									read ($in,$wert,4);
									$wert=unpack("N",$wert);
									read ($in,$wert,$wert);
									}
									else
									{
									read ($in,$wert,4);
									$inhalt=unpack("N",$inhalt);
									seek ($in,$inhalt,1);
									}
					}
redo;
}

close $in;

open (my $out,">",$filename) || die "nonono";
binmode ($out);
print $out $output;
close $out;

			if ($objekt->{exclusive} == 0){
							_unlockit($objekt);
							}
			return $wert;
}

############
# sleep't
############################
sub sleep{

my $sleeptime=rand (100);
for (my $i=0;$i<$sleeptime;$i++){}


}

##########################################################
# generiert quersumme aus name(ord) mit quersumme >0 <$digitnum
############################################################
sub _FIRSTCHAR{
my $objekt=shift;
my $name=shift;
my @chars=split('',$name);
		$name=0;
		foreach (@chars){
						$name+=ord($_);
						}

	{
		 my @chars=split('',$name);

		$name=0;
		foreach (@chars){
						$name+=$_;
						}
	redo if (length($name) > $objekt->{digitnum});
	}
	return $name;
}

################################################################
sub _write_array{
my $objekt=shift;
my $filename=shift;
my @erg=@_;

open (my $out,">",$filename) || die $!;
binmode $out;
for (my $i=0;$i<@erg;$i+=3){
print $out pack("N",length($erg[$i])).$erg[$i].pack("N",$erg[$i+1]).pack("N",length($erg[$i+2])).$erg[$i+2];
}
close $out;
}

############################################################
sub _append{
my $objekt=shift;
my $name=shift;
my $zeit=shift;
my $inhalt=shift;
my $filename=shift;

open (my $out,">>",$filename);
binmode $out;

print $out pack("N",length($name)).$name.pack("N",$zeit).pack("N",length($inhalt)).$inhalt;
close $out;
}

################################
# löscht Liste veralteter Dateien
#####################################
sub _clear_garbage_list{
my $objekt=shift;
@{$objekt->{garbage}}=();
}

###########################
# entfernt Müll aus Stack-Dateien
###################################
sub _garbage_collection{
my $objekt=shift;

my $directory=$objekt->{directory};
opendir (my $in,$directory);
my @dateien=readdir($in);
close $in;

return if @{$objekt->{garbage}} == 0;
my @sets=@{$objekt->{garbage}};
foreach my $datei (@dateien){
							next if ($datei eq '.' ||
									$datei eq '..' ||
									(-d $datei)		||
									$datei eq 'lock.txt');

							open ($in,"<","$directory/$datei");
							my %stack=<$in>;
							close $in;

							foreach my $entry (@sets){
											delete $stack{"$entry\n"};
											}
#print "direc $directory/$datei";
							open (my $out,">","$directory/$datei") || die "$datei $!";
							print $out %stack;
							close $out;


							}
_clear_garbage_list($objekt);
}

###########################################
# findet alle verfallenen Datensätze
###########################################
sub _garbage{
my $objekt=shift;
my $filename=shift;

my $change=0;
my @erg=();
my $now = time();
#print "$filename";
open (my $in,"<",$filename) || die "nonono $!";
binmode ($in);
my ($inhalt,$name,$zeit);
my $directory=$objekt->{directory};
my $stack=$objekt->{stack};

{
read ($in,$name,4);
last if (!$name); # File-Ende
$name=unpack("N",$name);
seek ($in,$name,1);

read ($in,$zeit,4);
$zeit=unpack("N",$zeit);


if ($zeit < $now){		# wenigstens ein Eintrag ist veraltet
				seek ($in,0,0);
				$change=1;
				last;
				}
redo;
}

return if $change == 0;


if ($change == 1){
{
read ($in,$name,4);
last if (!$name); # File-Ende
$name=unpack("N",$name);
read ($in,$name,$name);

read ($in,$zeit,4);
$zeit=unpack("N",$zeit);


if ($zeit < $now){
					read ($in,$inhalt,4);
					$inhalt=unpack("N",$inhalt);
					seek ($in,$inhalt,1);
					$change=1;

					push (@{$objekt->{garbage}},$name);
				}
				else
				{

				read ($in,$inhalt,4);
				$inhalt=unpack("N",$inhalt);
				read ($in,$inhalt,$inhalt);

				push (@erg,$name);
				push (@erg,$zeit);
				push (@erg,$inhalt);
				}
redo;
}
				}
close $in;

if (@erg > 0){
_write_array($objekt,$filename,@erg) if $change == 1;
}
else
{
unlink $filename;
}
}

#########################################################
sub _find_entry{
my $objekt=shift;
my $filename=shift;
my $gesucht =shift;

if ($objekt->{nopurge} == 0){
				_garbage($objekt,$filename) ;
				_garbage_collection($objekt) ;
				}

my $now = time();
open (my $in,"<",$filename) || return; # return, weil Datei möglicherweise durch garbage-collection gelöscht wurde
binmode ($in);
my ($inhalt,$name,$zeit);
{
my $startpos=tell($in);
read ($in,$name,4);
last if (!$name); # File-Ende
$name=unpack("N",$name);
read ($in,$name,$name);

read ($in,$zeit,4);
$zeit=unpack("N",$zeit);

if ($name ne $gesucht){
						read ($in,$inhalt,4);
						$inhalt=unpack("N",$inhalt);
						seek ($in,$inhalt,1);
						}

						else
						{
						if ($zeit < $now){return;}

						read ($in,$inhalt,4);
						$inhalt=unpack("N",$inhalt);
						read ($in,$inhalt,$inhalt);

						return $inhalt;
						}

redo;
}
close $in;

return;
}


1;