#!/usr/local/bin/perl

# $Id: tafel,v 1.15 2001-05-31 21:51:43+02 czyborra Exp czyborra $

$action=$ENV{'SCRIPT_NAME'}.$ENV{'PATH_INFO'}; 

$query = $ENV{'QUERY_STRING'}; $ENV{'REQUEST_METHOD'} ne 'POST' 
    || read (STDIN, $query, $ENV{'CONTENT_LENGTH'});

exit print "location: $action/$1.html\n\n" if $query =~ /create=(.*)/i;

$url = "http://$ENV{'SERVER_NAME'}/tafel"; $now = localtime;

$tafel = $1 if $ENV{'PATH_INFO'} =~ /^\/([a-z][-a-z_]+)[.]html$/i
    || exit print "content-type: text/plain\n\n", `cat $0`;

chdir ($tafeln = "$ENV{'DOCUMENT_ROOT'}/tafel")
    || exit print "content-type: text/plain\n\n$tafeln: $!\n";

# parse existing table

open (T,"$tafel.html"); for ($#cols = $#rows = 0, $row = - 1; <T>; )
{
    ++$row, $col=-1 if /<tr/; ++$col if /<th|<td/;
    
    if (($id)= / id=(\w+)/)
    {
	$cols[$col]=$id, $val{$id} =  $col if ! $row;
	$rows[$row]=$id, $val{$id} = -$row if ! $col;
	$val{$rows[$row],$cols[$col]} = $id if $row && $col;
    }
    if (($_)=/<td .* value=([^>]*)/)
    {
	s/&#(\d+);/chr($1)/gie; $val{$id}=$_;
    }
}

# process change requests

foreach (split('&',$query))
{
    s/[+]/%20/g; s/%([0-9A-F]{2})/chr(hex($1))/gie;

    if (($new) = /v$id=(.*)/)
    {
	$val{$id} = $new eq $old ? $val{$id} || $new :
	    $val{$id} && $val{$id} ne $old && $val{$id} ne $new ?
		"$val{$id} | $new" : $new;
    }
    if (($id,$row,$col,$old) = /o(\d+)=(\d+)_(\d+)_(.*)/)
    {
	$val{$row,$col} = $id;
	$val{$row} ||= push(@rows,$row);
	$val{$col} ||= push(@cols,$col);
    }
}

if ($query =~ /delete=(\d+)/)
{
    @rows = grep ($_ ne $1, @rows);
    @cols = grep ($_ ne $1, @cols);
}

sub id { $id = int rand 1e9; $id && ! defined $val{$id} ? $id : &id; }

if ($query =~ /append=(\d+)/)
{
    $val{$1} > 0 ? splice(@cols,1+$val{$1},0,&id) :
    $val{$1} < 0 ? splice(@rows,1-$val{$1},0,&id) : 
	$1 == 1 ? push(@cols,&id) : push(@rows,&id);
    $update=$id;
}

if ($query =~ /moveup=(\d+)/)
{
    splice(@cols,$i-1,2,@cols[$i,$i-1]) if ($i = $val{$1}) > 1;
    splice(@rows,$i-1,2,@rows[$i,$i-1]) if ($i = -$i) > 1;
}

if ($query =~ /mirror=$cols[0]/)
{
    @diag = @cols;
    @cols = @rows;
    @rows = @diag;
}

if ($query =~ /update=(\d+)/)
{
    $update = $1;
}

# synthesize new table

$html = "<title>$tafel</title>
<form action=$action method=POST><input type=submit value=\@>
$now
<a href=$url/
>$url/</a><a 
href=$url/$tafel.html
>$tafel.html</a> 
<table border>\n";

sub button { $html.= "<a href=$action?$_[0]>$_[1]</a>"; }

for ($row = 0; $row <= $#rows; ++ $row)
{
    for ($html.="<tr align=left>\n", $col=0; $col <= $#cols; ++ $col)
    {
	$id = $row && $col ? $val{$rows[$row],$cols[$col]} || 
	    $val{$cols[$col],$rows[$row]} || 
		&id : $row ? $rows[$row] : $cols[$col] || &id;

	$updatecell = $update &&
	    ($update eq $rows[$row] || $update eq $rows[0]||
	     $update eq $cols[$col] || $update eq $id);

	if ($row && $col)
	{
	    $_=$val{$id}; s/[^-+A-Z0-9]/sprintf("&#%d;",ord($&))/gie;
	    $html.= "\t<td id=$id value=$_>";

	    if ($updatecell)
	    {
		$html.= "<input type=hidden name=o$id " .
		    "value=$rows[$row]_$cols[$col]_$_>";
		$html.= "<input size=10 type=text name=v$id value=$_>";
	    }
	    else {
		$_="<a href=$_>$_</a>" if /^http/;
		$_="<b>$_</b>" if $row == 1 || $col == 1;
		$html.= $_;
	    }
	}
	else
	{
	    $html.= "<th id=$id><font size=-1>";
	    &button ("append=$id", '=') if $row >= $col;
	    &button ("moveup=$id", '«') if $col;
	    &button ("update=$id", '@') unless $updatecell;
	    &button ("delete=$id", '#') if $updatecell && $row + $col;
	    &button ("mirror=$id", 'X') if $updatecell && $row == $col; 
	    &button ("moveup=$id", '^') if $row;
	    &button ("append=$id",'||') if $col;
	    &button ("append=1",  '||') if $row == $col;
	    $html.= "</font>";
	}
	$html.="\n";
    }
}

$html.= "</table><font size=-1><br>
|| fügt neue Spalte ein, « verschiebt Spalte nach links<br>
= fügt neue Zeile ein, ^ verschiebt Zeile nach oben<br>
@ ändert, # löscht Zeile/Spalte, X transponiert\n</font></form>";

open (T, ">$tafel.$$.htm") 
    && (print T $html) && close T
    && rename ("$tafel.$$.htm", "$tafel.html") 
    || ($html .= $!);

system "/mmach/bin/ci -l -m$ENV{REMOTE_ADDR} -q -zLT $tafel.html"
    unless $update;

# print "content-type: text/html\n\n$html\n";
print "location: $url/$tafel.html?t=$^T\n\n";