# POD-Dokumentation - siehe Dateiende!
package User::InetMw::Session;

use strict;
our $VERSION = 1.00;

use Carp qw(croak);
use Fcntl qw(:flock);

sub new
{ my ($class, %arg) = @_;
  my $self =
  { sidfile => $arg{sidfile} || croak('missing sidfile'),
    timeout => $arg{timeout} || 60 * 60,
    destroy => $arg{destroy},
    session => {},
  };
  bless $self, ref($class) || $class;
  return $self;
}

sub _open_read_sid
{ my $self = shift;
  for (0 x 4, 1)
  { open FILE, "+>> $self->{sidfile}" and last;
    croak qq(open "$self->{sidfile}"\n$!) if $_;
    sleep 1;
  }
  for (0 x 4, 1)
  { flock FILE, LOCK_EX and last;
    croak qq(flock LOCK_EX "$self->{sidfile}"\n$!) if $_;
    sleep 1;
  }
  seek FILE, 0, 0 or croak qq(seek "$self->{sidfile}"\n$!);
  while (<FILE>)
  { if
    ( my ($sid) = /sid=(\d+)/
      and
      my ($time) = /time=(\d+)/
      and
      my ($timeout) = /timeout=(\d+)/
    )
    { if ($time + $timeout >= time())   # Zeit noch im Limit, also wiederherstellen
      { $self->{session}->{$sid}->{time} = $time;
        $self->{session}->{$sid}->{user} = $1 if /user=(\w+)/;
        $self->{session}->{$sid}->{ip} = $1 if /ip=([0-9\.]+)/;
      }
      else   # evtl. Aufräumen erforderlich
      { $self->{destroy}->($sid) if $self->{destroy};
      }
    }
  }
}

sub _write_close_sid
{ my $self = shift;
  seek FILE, 0, 0 or croak qq(seek "$self->{sidfile}"\n$!);
  truncate FILE, tell FILE or croak qq(truncate "$self->{sidfile}"\n$!);
  foreach my $sid (keys %{$self->{session}})
  { print FILE
      "sid=$sid",
      " time=$self->{session}->{$sid}->{time}",
      " timeout=$self->{timeout}",
      ( exists $self->{session}->{$sid}->{user}
        ? " user=$self->{session}->{$sid}->{user}"
        : ""
      ),
      ( exists $self->{session}->{$sid}->{ip}
        ? " ip=$self->{session}->{$sid}->{ip}"
        : ""
      ),
      "\n"
    or croak qq(write "$self->{sidfile}"\n$!);
  }
  close FILE or croak qq(close "$self->{sidfile}"\n$!);
}

sub NewSid
{ my ($self, %arg) = @_;
  $self->_open_read_sid();
  my $sid;
  do
  { $sid = int rand(2**32);
  } while (!$sid or exists $self->{session}->{$sid});
  $self->{session}->{$sid}->{time} = time();
  $self->{session}->{$sid}->{user} = $arg{user} if exists $arg{user};
  $self->{session}->{$sid}->{ip} = $arg{ip} if exists $arg{ip};
  $self->_write_close_sid();
  return $sid;
}

sub RefreshSid
{ my ($self, %arg) = @_;
  $arg{sid} or croak 'missing sid';
  $self->_open_read_sid();
  return unless exists $self->{session}->{$arg{sid}};
  if (exists $self->{session}->{$arg{sid}}->{ip})
  { $arg{ip} eq $self->{session}->{$arg{sid}}->{ip} or return;
  }
  $self->{session}->{$arg{sid}}->{time} = time();
  $self->_write_close_sid();
  return $arg{sid};
}

sub GetUser
{ my ($self, $sid) = @_;
  $sid or croak 'missing sid';
  return
  ( exists $self->{session}->{$sid} and exists $self->{session}->{$sid}->{user}
    ? $self->{session}->{$sid}->{user}
    : ()
  );
}

sub DestroySid
{ my $self = shift;
  # 2. Parameter ist sid;
  $self->_open_read_sid();
  delete $self->{session}->{$_[0]};
  $self->_write_close_sid();
  undef $_[0];
}

### nicht definierte Funktionsaufrufe abfangen #################

sub AUTOLOAD
{ our $AUTOLOAD;
  croak "undefined sub: $AUTOLOAD";
}

1;

=head1 NAME

User::InetMw:Session - Session-Management

=head1 SYNOPSIS

 use User::InetMw::Session;

 # Session-Objekt erstellen
 my $session = new User::InetMw::Session
 ( # Sid's werden in diesem File verwaltet
   sidfile => 'filename',
   # ohne Angabe: Defaultwert ist 1 Stunde
   timeout => 60*60,
   # callback zum Aufräumen
   destroy => sub
   { $sid = shift;
     unlink "zB_ein_File_mit_$sid_im_Name.dat"
   },
 );

 # neue sid anlegen (Login), evtl. User und/oder IP-Adresse zuweisen
 my $sid = $session->NewSid(user => 'username', ip => '127.0.0.1');

 # wieder volle Timeout-Zeit zulassen
 # Wenn IP-Adresse bei NewSid angegeben ist, dann wird sie hier auch geprüft.
 # Gibt es die sid nicht oder gehört die IP-Adresse nicht zu der angegebenen sid,
 # dann wird anstatt der sid undef zurückgegeben.
 $sid = $session->RefreshSid(sid => $sid, ip => '127.0.0.1');

 # username oder undef auslesen
 $user = $session->GetUser($sid);

 # sid abmelden (Logout)
 $session->DestroySid($sid);

=head1 DESCRIPTION

Mehrere Anwendungen können nicht das gleiche File benutzen.
Jedoch kann die gleiche Anwendung mit je einem Sessionobjekt
mehrfach und gleichzeitig laufen.

=head1 AUTHOR

Steffen Winkler, 11.04.2003