#!/usr/local/bin/perl -w
# cgi-s-server.pl -- Zustandserhaltung mit serverseitiger Speicherung
#              und Sitzungscookies.

use strict;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use CGI::Cookie;
use Tie::RDBM;
use Math::TrulyRandom;

use constant INITSTATE => 1;
use constant STATETTL  => '+5m';
use constant STATENAME => 'mystate';

use constant STATEDSN  => 'dbi:mysql:database=www';
use constant STATEUSER => 'nobody';
use constant STATEPASS => 'wwwpass';
use constant STATETBL  => 'statesessions';

my  %sql;
tie %sql, 'Tie::RDBM', STATEDSN,
          { user  => STATEUSER, password => STATEPASS,
            table => STATETBL,  create => 1 }
    or die "can't tie: $!\n";

my ($state, $cookie_needed) = retrieve_state();
my $nextstate               = compute_next_state($state);
my $saveaction              = save_state($nextstate, $cookie_needed);

# Tue etwas abhaengig von $state:
print $cookie_needed ? header(-cookie => $saveaction) : header(),
    start_html('State with Cookies'),
    "Current state: ", $state->{'STATE'}, p,
    "If you call me again, I'll increment it for you",
    end_html;

sub retrieve_state {
    my $SID = cookie(-name => STATENAME);
    my ($SVL, $cookie_needed) = (INITSTATE, 1);

    if (defined $SID) {
        # Cookie gibt eine Session-ID vor:
    $SVL = $sql{$SID} || die "Sorry, unknown session: $SID!\n";
    $cookie_needed = 0;
    } else {
    # Das ist eine neue Sitzung!
    tied(%sql)->{'dbh'}->do("LOCK TABLES " . STATETBL . " WRITE");
        die "$DBI::errstr" if $DBI::err;

          # Um Race Conditions zu vermeiden, laeuft das in einer
          # Transaktion bzw. bei gesperrten Tabellen (MySQL) ab.
      do { $SID = truly_random_value() } while exists $sql{$SID};
      $sql{$SID} = $SVL;
      die "Error: $DBI::errstr\n" if $DBI::err;

    tied(%sql)->{'dbh'}->do("UNLOCK TABLES ");
    die "$DBI::errstr" if $DBI::err;
    }

    # Den Zustand mit der zugehoerien Sitzungs-ID zurueckgeben.
    return ({ SESSION => $SID, STATE => $SVL }, $cookie_needed);
}

sub compute_next_state {
    my $current_state = shift;
    $current_state->{'STATE'} = $current_state->{'STATE'} + 1;
    return $current_state;
}

sub save_state {
    my $newstate      = shift;
    my $cookie_needed = shift;

    my $cookie   = new CGI::Cookie(-name     => STATENAME,
                   -value    => $newstate->{'SESSION'},
                       -expires  => STATETTL)
    if $cookie_needed;

    # Den Zustand serverseitig speichern:
    $sql{$newstate->{'SESSION'}} = $newstate->{'STATE'};

    return $cookie_needed ? $cookie : undef;
}