#!/usr/bin/perl
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);  # Nur fuer den Test

$| = 1;

my $cgi = CGI->new();

# HTTP-Header
if (defined($cgi->param('neu')) && defined($cgi->param('name')))
  { print $cgi->header(-cookie => create_cookie()); }
else
  { print $cgi->header(); }

# HTML-Header
my $bgcolor = $cgi->cookie('bgcolor');
if (defined($bgcolor))
  { print $cgi->start_html(-bgcolor => $bgcolor); }
else
  { print $cgi->start_html(); }

print $cgi->h2("Cookie-Spielseite");
print $cgi->ul(
        $cgi->li(qq(Sie können ein Cookie löschen, ),
            qq(indem Sie seine Lebensdauer auf 1 Minute setzen.)),
        $cgi->li(qq(Achtung: Neu gesetzte Cookies werden erst beim ),
               qq(nächsten HTTP-Request angezeigt)),
        $cgi->li(qq(Testen Sie ein Cookie mit Namen "bgcolor"),
            qq(und einer HTML-Farbe wie "blue" oder "#6699cc")));

print $cgi->h3("Neues Cookie");
print $cgi->start_form(-method => "post");
print $cgi->start_table();
foreach my $name ("name", "value", "path", "domain", "secure")
  {
  print $cgi->Tr($cgi->td(ucfirst($name)),
                 $cgi->td($cgi->textfield(-name => $name)));
  }
print $cgi->Tr($cgi->td("Expires"),
               $cgi->td($cgi->popup_menu(-name => "expires",
                         -values => ["+1m", "+1h", "+1d"])));
print $cgi->end_table();
print $cgi->p($cgi->submit(-name => "neu", -value => "absenden"));
print $cgi->end_form();

# alle anzeigen
print $cgi->h3("Alle gesetzten Cookies");
print $cgi->start_table(-cellpadding => 2,
                        -cellspacing => 2,
                        -border      => 1);
print $cgi->Tr($cgi->th("Name"), $cgi->th("Wert"));
foreach ($cgi->cookie())
  { print $cgi->Tr($cgi->td($_), $cgi->td($cgi->cookie($_))); }
print $cgi->end_table();

# Hash fuer neues Cookie (Attribute) erzeugen
sub create_cookie
  {
  my $hash = {};
  for ("name", "value", "path", "domain", "secure", "expires")
    { $hash->{$_} = $cgi->param($_) if (defined $cgi->param($_)); }
  return $cgi->cookie($hash);
  }