|
|
![eBook-Project by AboutWebDesign.de [LOGO]](logo.jpg)
|
7.6 Session-Management mit Perl
|
|
|
|
|
7.6.1
Einleitung
Einer der großen Vorzüge von PHP gegenüber Perl ist die Vielzahl bereits eingebauter, praktischer Funktionen. Eine davon kümmert sich um Session-Management. Die Perl-Lösungen, die Session-Management implementieren, benötigen jedoch meist einen Apache-Webserver. Wir stellen daher eine Lösung vor, die keinen Apache voraussetzt. Dass unsere Lösung natürlich nicht an den Apache-Ansatz herankommt, ist klar.
|
|
|
7.6.2
Beispiel
Die Verwendung unseres Moduls zeigt folgender Code:
#!/usr/bin/perl
use session;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
my $cgi = new CGI;
my $session = new_session($cgi, 9);
# Session-Header ausgeben
print $session->header();
my $zahl = $session->getvar("zahl", 1);
print "Alter Wert: $zahl<br>";
$zahl = $zahl*2;
print "Neuer Wert: $zahl<br><br>";
$session->setvar("zahl", $zahl);
if ($session->get_newsession)
{
my @grund = $session->get_newsession_reason;
print "Neue Session, weil: $grund[1]";
}
|
|
|
7.6.3
Detaillierte Erläuterungen
7.6.3.1 Übersicht
Zur groben Funktionsweise: der Code überprüft, ob bereits eine Session vorliegt. Wenn nicht, wird eine erzeugt. Wenn doch, werden die Variablen aus der Session geladen.
Die Daten der Session werden auf dem Server in einer Datenbank gespeichert, die von Zeit zu Zeit automatisch gereinigt wird. Auf dem Client landet nur das Cookie, das eine eindeutige Identifikationsnummer der Session enthält. Die Lebenszeit des Cookies liegt bei zwei Jahren. Sollte der Client keine Cookies unterstützen, funktioniert das Modul nicht.
7.6.3.2 Voraussetzungen
Damit das Session-Modul funktioniert, müssen folgende Perl-Module einsatzbereit sein: Fcntl, DB_File, CGI und Data::Dumper. Gerade auf Unix-Systemen sollten diese Module aber standardmäßig installiert sein.
Um den obigen Code funktionsbereit zu machen, speichern Sie ihn unter einem beliebigen Dateinamen ab und legen Sie den weiter unten stehenden Code unter dem Namen session.pm ins gleiche Verzeichnis.
Weiterhin darf in dem Programm, das das session-Modul verwendet, kein normaler Header ausgegeben werden. Statt dessen muss print $session->header(); verwendet werden.
7.6.3.3 Funktionen
Eine neue Session wird erzeugt mit new_session($cgi, 9);. Diese Funktion erwartet eine Referenz auf ein CGI-Objekt und eine Angabe der Lebenszeit in Minuten. Letztere muss eine ganze Zahl sein. Es werden also auch Sessions über einen Browser-Aufruf hinaus unterstützt. Wer das nicht will, entfernt die Zeile -expires => $ltstring, aus der header-Funktion der session.pm.
Wer eine Session-Variable lesen will, verwendet $session->getvar("zahl", 1);. Erstes Argument ist der Name der Variable, zweites ist ein Standard-Wert, falls die Variable nicht gesetzt sein sollte.
Wer dagegen etwas speichern will, nimmt $session->setvar("zahl", $zahl);. Erstes Argument ist der Name der Variable, zweites der zu speichernde Wert. Es sollte hier theoretisch möglich sein, alles zu speichern, was von Data::Dumper verarbeitet werden kann, also auch z.B. Hashes von Hashes. Getestet wurde das jedoch nicht.
Wer wissen will, ob eine neue Session begonnen werden musste, verwendet $session->get_newsession, die dann einen wahren Wert zurückliefert. Wen dann auch noch der Grund interessiert, kann auf ein Konstrukt wie my @grund = $session->get_newsession_reason; zurückgreifen. $grund[0] enthält einen numerischen Fehlercode, $grund[1] eine Begründung.
Da es nötig sein könnte, eine Session direkt zu beenden, gibt es die Funktion $session->end_session();.
|
|
|
7.6.4
Code der session.pm
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;
}
|
|
|
|
