package session;
	
	use Exporter;
	
	use strict;
	
	@session::ISA = qw(Exporter);
	
	@session::EXPORT = qw(new_session); 
	
	sub new_session
	{
	my $cgi = shift;
	my $lifet = shift;
	if (int($lifet) != $lifet)
	{
	die "Lifetime muss eine ganze Zahl sein!";
	}
	my $n_sess = session_object->new($cgi, $lifet);
	return $n_sess;
	}
	
	package session_object;
	
	use Fcntl qw ( :DEFAULT :flock);
	use DB_File;
	use CGI qw(:standard);
	
	sub new
	{
	my $class=shift;
	my $cgi = shift;
	my $lifetime = shift;
	my $self={};
	
	$self->{_variablen} = {};
	$self->{_cgi} = $cgi;
	$self->{_thash} = $cgi;
	$self->{_lifetime} = $lifetime;
	$self->{_newsession} = 1;
	$self->{_id} = 0;
	$self->{_newsession_reason}= '';
	
	bless($self, $class);
	$self->_readvars;
	return $self; 
	}
	
	sub end_session
	{
	my $self = shift;
	$self->setvar("lebt_bis", 1);
	}
	
	sub get_newsession
	{
	my $self = shift;
	return $self->{_newsession};
	}
	
	sub get_newsession_reason
	{
	my $self = shift;
	my %textual = (
	0 => "Kein Cookie vorhanden gewesen", 
	1 => "Kein Datenbank-Eintrag für Session vorhanden",
	2 => "Kein Lebenszeit-Eintrag in Datenbank für die Session",
	3 => "Lebenszeit der Session überschritten",
	);
	return $self->{_newsession_reason}, $textual{$self->{_newsession_reason}};
	}
	
	sub getvar
	{
	my $self = shift;
	my $varname = shift;
	my $standardwert = shift;
	
	return $self->{_variablen}{$varname} ? $self->{_variablen}{$varname} : $standardwert;
	}
	
	sub setvar
	{
	my $self = shift;
	my $varname = shift;
	my $newwert = shift;
	$self->{_variablen}{$varname} = $newwert;
	} 
	
	sub _readvars
	{
	my $self = shift;
	
	}
	
	sub header
	{
	my $self = shift;
	my $cgi = $self->{_cgi};
	
	$self->_open_db();
	$self->_makeid();
	
	#my $ltstring = '+'.$self->{_lifetime}.'m';
	my $ltstring = '+2y';
	my $cookie = cookie (
	-name => 'sessionid',
	-value => $self->{_id},
	-expires => $ltstring,
	); 
	return $cgi->header(
	-cookie => $cookie,
	); 
	}
	
	sub _open_db
	{
	my $self = shift;
	my $cgi = $self->{_cgi};
	my %hash;
	my $db = tie %hash, "DB_File", "daten.dat", O_CREAT | O_RDWR, 0777 or die "Kann Hash nicht binden: $!";
	my $fd = $db->fd;
	open DBM, "+<&=$fd" or die "Kann Handle nicht duplizieren: $!";
	flock DBM, LOCK_EX or die "Kann dingens nicht flocken: $!";
	undef $db;
	$self->{_thash} = \%hash;
	#$self->{_thash}{haus} = "schäfer"; 
	
	}
	
	sub _close_db
	{
	my $self = shift;
	my $cgi = $self->{_cgi};
	my $hash_r = $self->{_thash};
	undef $hash_r;
	}
	
	sub _makeid
	{
	my $self = shift;
	my $makenew = shift;
	my $cgi = $self->{_cgi};
	my $keks = $cgi->cookie("sessionid");
	#die $keks;
	my $real_id;
	unless ($keks)
	{
	$self->{_newsession_reason} = 0;
	}
	if ((! $keks) || $makenew)
	{
	
	$self->{_newsession} = 1;
	# Wenn noch kein Cookie da...
	
	# Neue ID erzeugen
	$real_id = $self->generate_id();
	
	# Lebenszeit speichern
	$self->setvar("lebt_bis", time()+$self->{_lifetime}*60); 
	}
	else
	{
	$self->{_newsession} = 0;
	# Ahhh... ein Cookie ist da...
	$real_id = $keks;
	
	my $fail = 0;
	# Wäre noch zu checken: ist das Vieh überhaupt in der Datenbank?
	if (! $self->_get_id_entrys($real_id))
	{
	$self->{_newsession_reason} = 1;
	$fail = 1;
	} 
	elsif (! $self->getvar("lebt_bis"))
	{
	$self->{_newsession_reason} = 2;
	$fail = 1;
	} 
	elsif ($self->getvar("lebt_bis") < time())
	{
	$self->{_newsession_reason} = 3;
	$fail = 1;
	}
	
	# Wenn doch: neue Session
	if ($fail)
	{
	$self->_destroy_entry($real_id);
	$self->{_variablen} = {};
	return $self->_makeid(1);
	}
	
	# Wenn nicht: wir sind glücklich
	}
	
	# Counter für Lösch-Vorgänge
	
	my $howoften = 0; 
	my $already = $self->{_thash}{without_clean};
	
	if ($already > $howoften)
	{
	$self->_search_old_entries();
	$self->{_thash}{without_clean} = 0;
	}
	else
	{
	$self->{_thash}{without_clean}++;
	}
	
	$self->{_id} = $real_id;
	return $self->{_id};
	}
	
	sub _get_id_entrys
	{
	my $self = shift;
	my $id = shift;
	
	my $dbhash = $self->{_thash};
	my $heredata = $dbhash->{$id};
	return 0 unless defined $heredata;
	my $codenow_href;
	eval '$codenow_href = '. $heredata;
	foreach my $key (keys %$codenow_href)
	{
	my $val = $codenow_href->{$key};
	$self->setvar($key, $val);
	} 
	return 1;
	}
	
	sub _refresh_db_data
	{
	my $self = shift;
	my $codenow_href = $self->{_variablen};
	use Data::Dumper;
	my $d = Data::Dumper->new([$codenow_href], [qw(codenow_href)]);
	$d->Purity(1)->Terse(1)->Deepcopy(1); 
	$self->{_thash}{$self->{_id}} = $d->Dump;
	}
	
	sub DESTROY
	{
	my $self = shift;
	$self->_refresh_db_data(); 
	$self->_close_db();
	}
	
	sub _destroy_entry
	{
	my $self = shift;
	my $id = shift;
	delete $self->{_thash}{$id}; 
	}
	
	sub _search_old_entries
	{
	my $self = shift;
	my $dbhash = $self->{_thash};
	use Data::Dumper; 
	foreach my $key (keys %$dbhash)
	{ 
	my $heredata = $dbhash->{$key};
	my $codenow_href;
	eval '$codenow_href = '. $heredata; 
	if (ref($codenow_href) and $codenow_href->{lebt_bis} < time())
	{
	$self->_destroy_entry($key);
	}
	}
	}
	
	sub generate_id
	{
	my $id = rand 1000000;
	my $id2 = rand 1000000;
	my $id3 = rand 1000;
	my $id4 = rand 342221312;
	
	my $real_id = int($id+$id2+$id3+$id4+$ENV{REMOTE_USER});
	return $real_id;
	}