#!/usr/bin/perl -w

######################################################################
##
## random_places
##
## Created 29.10.2001 by Lasse A Vartiainen <lav@iki.fi>
##
## Try to allot given theater seats to given list of ticket holders,
## so that all the tickets of one holder are within same block.
##
## 2002-12-14 : Bug fixes (just before the lottery)
##              - Pre-reservations now set again after failure-reset
##              - Love-seat randomized only within same sized groups,
##                -> will fix later
## 2002-11-14 : Minor changes
##              - Map shift around y axis - corresponds to the real theatre
##              - Internal links with name rather than id number
##                (since some browsers show it)
## 
######################################################################


#Pseudo-algorithm
# - Seed the random generator with the argument, if given
#
# Do
# - Get next from sublist of reservations where value 'info' is 'LOVE'
# - Get random odd numbered seat from line 19, expand, and connect to the reservation
# Until sublist empty or line 19 has no more free seats
#
# - Sort unseated reservations by the value of 'amount', largest first

# - For each reservation, pick a random seat and try expand it to a
#   block of seats of required size.  If some expansion keeps failing
#   for long, reset all reservations and reserved seats, and start
#   again.

#Format for the locations file
#line        = ( (comment) | (row) ) '\n'
#  comment   = '#' (*char)
#  row      =   *((seat)|(non_seat))
#    seat    = '1'
#    non_seat= (char NOT seat)

#Format for the reservations file
#line         = ( (comment) | (reservation) | (pre-reservation) ) '\n'
#  comment    = '#' (*char)
#  reservation= (name) (comma) (association) (comma) (amount)
#    name     = (*char NOT comma)
#  association= (*char NOT comma)
#    amount   = (*digit)
# pre-reservation = reservation '=' (*pair)
#        pair = (row) (comma) (seat)
#        row  = (*digit)
#        seat = (*digit)

#*** Locations Class ***
# Internal global variables:
#  @Main::pl_places[$y][$x]{$class}, $class = ["state"|"row"|"seat"]
#  %Main::pl_info{'free'}[line]
#
#Member functions
# success  = places_Init($filename)
# @seats   = places_GetRandomFree($line)
# success  = places_IsFree(@seats);
# void       places_AssureValid();
# $maxI    = places_MaxIndex($line)
# $maxR    = places_MaxRow($line)
#success   = places_Reserve(@seats);
#          = places_Reset();
#[success  = places_Release(@seats)];
#@seats    = places_Expand($number,%seat)
#          = places_Changed($line);
#@seats    = places_ConvertToMachine(@seats)
# $free    =  places_CountFree([line])
# $seats   =  places_CountSeats(line)
# void        places_Display()

#Modes:
$Main::NORMAL=0;
$Main::FIXED=1;
$Main::STRAIGHT=2;
$Main::loverow=19;

# *** Reservations Class ***
# Internal global variables
# @Main::rr_reserve{$id}{$class}, $class = ["name"|"assoc"|"amount"|"seated"]

# success  = reserve_Init($filename)
# void       reserve_AssureValid();
# _value_  = reserve_GetValue($id,$keyname);
# void       reserve_SetSeated($id,@seats);
# boolean  = reserve_IsSeated($id);
#
# @ids     = reserve_AllIds($id);
# @ids     = reserve_GetSorted($mode[,$key[,[@ids]);
# @ids     = reserve_GetMatching($mode,$key,$matchvalue,[@ids]);
# @ids     = reserve_Shuffler(@ids);
# *** Seats Class ***
#Structure @seats[] = @ ( %seat, %seat, .. )
#Structure %seat{} = { {'line'}, {'index'} }
# @seats   = seats_Create(@list_of_pairs)
# @seats   = seats_Next($modY,$modX,@baseSeat);


#--- Initialize ---
use strict;
use Getopt::Long;

$Main::verbose=2;
$Main::places="kinopalatsi1.txt";
$Main::reserv="varaukset.txt";
$Main::HTML=0;
$Main::INIT=0;
$Main::DEBUG="/dev/null";



$Main::COLOUR[0]="#000000";
$Main::COLOUR[1]="#440000";
$Main::COLOUR[2]="#880000";
$Main::COLOUR[3]="#cc0000";
$Main::COLOUR[4]="#004400";
$Main::COLOUR[5]="#008800";
$Main::COLOUR[6]="#00cc00";
$Main::COLOUR[7]="#000044";
$Main::COLOUR[8]="#000088";
$Main::COLOUR[9]="#0000cc";

      

#--- Begin ---
Getopt::Long::config("auto_abbrev","ignore_case","getopt_compat","permute","norequire_order",
                     "nobundling","nopass_through");
GetOptions
    (
     "verbose:i"  => \$Main::verbose,
     "places:s"   => \$Main::places,
     "map:s"      => \$Main::places,
     "reservations:s" =>\$Main::reserv,
     "noheader!"  => \$Main::HEADER,
     "html!"      => \$Main::HTML,
     "init:i"     => \$Main::INIT,
     "debug:s"    => \$Main::DEBUG,
     "tsh!"        => \$Main::TSH2001,
     );

$Main::OUTPUT=\*STDERR;
if("$Main::DEBUG" ne "/dev/null") {
    open(STDERR,">>$Main::DEBUG") || die "Failed to open $Main::DEBUG for stderr";
}

debug(basename($0)." called with: verbose=$Main::verbose, places=$Main::places, reservations=$Main::reserv init=$Main::INIT\n",1);

if(defined($ARGV[0])) {$Main::INIT=$ARGV[0];}
elsif($Main::INIT==0) {$Main::INIT=int(rand(100000));}
srand(int($Main::INIT));debug("Perl $] initialized srand($Main::INIT) at [".localtime(time())."]\n",1);

places_Init("$Main::places") || die "Failed to initialize places";
reserve_Init("$Main::reserv") || die "Failed to initialize reservations";




#--- Main ---

my(@seats)=();

my($failed);my($id)="";
my($got_total,$wanted);
do {
    @seats=();$failed=0;$got_total=0;$wanted=0;

    #Fill the row 19 (loveseats) (in 'seat' terminology these are counted from 0 to 29)
    my(@loveids)=(reserve_GetSorted(1,"amount",reserve_GetMatching(1,"info","LOVE")),(reserve_GetMatching(1,"amount","2")));

    #A very TSH2001(LoTR) specific rude hack to assure we can fill
    #loveseats properly. Depends on total 44 wanted loveseats, the
    #groups being 10,6,4 and 12x2
    if(defined($Main::TSH2001)) {
	my($removed)="";
	if(rand(1)>0.580) {$removed.=":".splice(@loveids,2,1);}
	if(rand(1)>(0.50)) {$removed.=":".splice(@loveids,1,1);}
	else {$removed.=":".splice(@loveids,0,1);}
	debug("Dropped (by random) from loveseats$removed\n",2);
	debug("Ids for loveseats: @loveids",4);
    }

    foreach $id (@loveids) {
	my($get,$got)=(reserve_GetValue($id,"amount"),0);
	if(places_CountFree($Main::loverow)<2) {last;}
	if(reserve_IsSeated($id)) {debug("Skipping $id (was seated)\n",3);next;}
	if(($get%2 == 1)) {
	    error("Unexpected, invalid (odd) requested amount ($get) for line ${Main::loverow}th, skipping id $id",0);
	    next;
	}			   
	debug("Love: I:<$id> N:".reserve_GetValue($id,"name")."\tO:".reserve_GetValue($id,"assoc")."[".=reserve_GetValue($id,"tag")."]\tA:$get\n",1);
	
	my($tries)=0;$got=0;
	while($tries++<50 && $got<$get) {
	    #Accept only even places (0,2,4..28)
	    do {@seats=places_GetRandomFree($Main::loverow);} until ($seats[0]{'index'} % 2 == 0);
	    
	    @seats=places_Expand($get,$Main::STRAIGHT,@seats);
	    $got=($#seats+1);
	}
	if($got < $get) {error("Got $got/$get places, skipping id $id",0); next;}
	if($got%2 == 1) {error("Unexpected error, expand for ${Main::loverow}th line is odd ($id), skipping id:$id",0);next}
	
	if(!places_Reserve($id,@seats)) {error("Failed to reserve expanded places",0);$failed=3;}
	else {
	    $wanted+=$get;
	    reserve_SetSeated($id,@seats);
	    $got_total+=$got;
	}
    }    
    if(places_CountFree($Main::loverow)>0) {
	error("Odd, ".places_CountFree($Main::loverow)." places left for ${Main::loverow}th row",0);}
    
    #Seat the largest factions first
    foreach $id (reserve_GetSorted(1,"amount")) {
	my($get)=reserve_GetValue($id,"amount");$wanted+=$get;
	debug("I:<$id> N:".reserve_GetValue($id,"name")."\tO:".reserve_GetValue($id,"assoc")."[".=reserve_GetValue($id,"tag").
	      "]\tA:".reserve_GetValue($id,"amount")."/$get\n",2);
	  
	my(@seats)=();
	my($mode)=$Main::FIXED; #more sensible block shapes
	my($tries,$got)=(0,0);
	while($got<$get) {
	    if($tries++<25) {$mode=$Main::FIXED;} else {$mode=$Main::NORMAL;}
	    @seats=places_GetRandomFree();$got=($#seats+1);	    
	    if($got<1) {die "More reservations than places, aborting ($tries)!";}
	    @seats=places_Expand($get,$mode,@seats);$got=($#seats+1);
	    if($tries>5) {
		debug("At try ${tries} got $got seats when requested for $get.\n",2);
	    }
	    if($tries>=200) {$failed=2;last;}
	}
	if(!places_Reserve($id,@seats)) {error("Failed to reserve expanded places",0);$failed=3;}
	reserve_SetSeated($id,@seats);
	$got_total+=$got;
	if($failed) {last;}
    }
    if($failed) {
	if($Main::verbose>0 && !$Main::HTML) {places_Display();}
	debug("Failed ($failed), resetting and trying again..\n",1);
	places_Reset();	
    }
} until($failed==0);
debug("Got total $got_total/$wanted places through expanding.\n",1);

#Checks
foreach $id (reserve_GetSorted(1,"amount")) {
    error("Unexpected error, still got unseated id <$id>\n",0);}


print html_Header() if($Main::HTML);
places_Display() unless($Main::HTML);
places_Display(1,$Main::HTML) if ($Main::HTML);

#Show the tickets
print "<table>\n" if($Main::HTML);
foreach $id (reserve_GetSorted(-1,"name")) {
    print "<tr>" if($Main::HTML); 
    print "<td><small>" if($Main::HTML);
#    print "<a name=\"H".reserve_GetValue($id,"idcount")."\">" if($Main::HTML);
    print "<a name=\"$id\">" if($Main::HTML);
    print "$id ";
    print "<td>" if($Main::HTML);
    print "<a href=\"#P".reserve_GetValue($id,"idcount")."\">" if($Main::HTML);    
    print "[".reserve_GetValue($id,"idcount");
    print "='".reserve_GetValue($id,"tag")."'" unless($Main::HTML);
    print "],";
    print "</a>" if($Main::HTML);
    print "<td><small>" if($Main::HTML);
    print "(".reserve_GetValue($id,"assoc").") ";
    print "</small>"  if($Main::HTML);
    print "<td>" if($Main::HTML);
    print "yht ".reserve_GetValue($id,"amount")," lippu(a): ";
    print "<td>" if($Main::HTML);
    print places_Show(@{reserve_GetValue($id,"seated")})."\n";    
}
print "</table></small>\n" if($Main::HTML);
print html_Footer() if($Main::HTML);


exit;
#--- Functions ---


sub html_Header {
    my($data)="";
    if(!defined($Main::HEADER)) {
	$data.=qx(cat header.txt);
    }
    $data.="<h1>Koearvonta</h1>\n";
    $data.="<small><ul>\n";
    $data.="<form action=\"raffle.php3\" METHOD=\"GET\" ENCTYPE=\"x-www-form-encoded\"\">";
    $data.="<li>init=<input size=6 type=text name=\"init\" value=$Main::INIT>\n";
    $data.="<li><a href=\"$Main::reserv\">reserv=</a><input size=80 maxsize=255 type=text name=\"reserv\" value=$Main::reserv>\n";
    $data.="<li><a href=\"$Main::places\">places=</a><input size=80 maxsize=255 type=text name=\"map\" value=$Main::places>\n";
    $data.="<br><input type=submit name=\"submit\" value=\"raffle\">\n";
    $data.="</form>\n";
    $data.="<li>Aika=".time()." [".localtime(time())."]\n";
    $data.="<li>Debug=<a href=\"$Main::DEBUG\">debug</a>\n" if ("$Main::DEBUG" ne "/dev/null");
    $data.="<li><a href=\"index.html\">Viralliset paikat</a></a>\n";


    $data.="<li>Generoija:<a href=\"random_places.pl\">random_places.pl</a> and\n";
    $data.="<a href=\"raffle.php3.txt\">raffle.php3</a>\n";
    
    $data.="</ul></small>\n";
    return $data;
}

sub html_Footer {
    my($data)="";
    $data.="</body></html>\n";
    return $data;
}

# *** Seat Class ***

#Arg: List consisting of (line,index) pairs
sub seats_Create {
    my(@list)=@_;
    my(@seats);
    my($count)=0;

    
    while(($#list+1) >= 2) {
	$seats[$count]{'line'}=shift(@list);
	$seats[$count]{'index'}=shift(@list);
	$count++;
    }
    return @seats;
}

#Return seat near the current, modified with y,x
#Args: Ydiff,Xdiff,@seat
sub seats_Next {
    my($y,$x,@seats)=@_;
    my($newY,$newX)=($seats[0]{'line'}+$y,$seats[0]{'index'}+$x);
    if($newY<1 || $newX<0 || $newY>places_MaxRow() || $newX>places_MaxIndex($newY)) {return ();}
    return (seats_Create($newY,$newX));
}
    

# *** Places Class ***

#Mode: 2-Only within one line, increasing order
#Mode: 1-Produces more sensible block-shapes, but may keep failing
#Mode: 0-Expands to a bit more odd shapes as well
sub places_Expand {
    my($want,$mode,@start)=@_;
    debug("Expanding $want from ($start[0]{'line'},$start[0]{'index'})[".($#start+1)."]\n",4);

    my(@seats)=@start;


    #Straight mode: within one line, increasing order
    if($mode == $Main::STRAIGHT) {
	my($count)=1;my(@candi);
	while($count<$want) {
	    if(places_IsFree(@candi=seats_Next(0,$count,@start))) {
		debug("Got free at (".($start[0]{'line'}).",".($start[0]{'index'}+$count).")\n",4);
		push(@seats,@candi);
	    } else {
		return @seats;
	    }
	    $count++;
	}
    }

    my(%border); #Borders define the limits of the local group
    $border{0}{-1}=0;$border{0}{1}=0; #The starting point
   
    my(@try)=();
    #Some optimized pairs;
    if($want >= 1 && $want <= 8) {@try=(0,8);}
    if($want >= 9 && $want <= 20) {@try=(0,int($want/2+1),1,int($want/2+1));}
    if($want >= 21 && $want <= 30) {@try=(0,int($want/3+1),1,int($want/3+1),-1,int($want/3+1))}
    if($want >= 31 && $want <= 80) {@try=(0,int($want/4+1),1,int($want/4+1),-1,int($want/4+1),2,int($want/4+1))}
    if($mode==$Main::FIXED || $want>80 ) {    
	#Target row,max_width pairs
	push(@try, 0,8, 1,8, 0,16, 1,16, -1,16, 0,24, 1,24, -1,24, -2,24, 0,30, 1,30, -1,30, -2,30, 0,99);
	#fill also less sensible combinations:
	for(my($i)=1;$i<places_MaxRow();$i++) {push(@try, $i,99, -$i, 99);}
    }

    
    my($width,$mid);
    my(%vertFail);$vertFail{-1}=0;$vertFail{1}=0;
    while($#seats<$want && ($#seats+1)<$want && defined($try[1])) {
	my($row, $towidth)=(shift(@try),shift(@try));	
	debug("Expanding row $row to width $towidth.\n",5);
	if($row!=0 && $vertFail{int($row/abs($row))}) {next;}
	
	my($init)=1;

	#If first time on this row, set init to 0
	if(!defined($border{$row})) {$border{$row}{-1}=0;$border{$row}{1}=0;$init=0};

	my($innerrow)=0;if($row>0) {$innerrow=$row-1;}; if($row<0) {$innerrow=$row+1;}

	#Loop till got right width, or both right and left expand have failed
	my($dir)=1; # 1=right, -1=left
	my(%dirFail);$dirFail{$dir}=0;$dirFail{-$dir}=0;       
	my(@candi);
	while( !$dirFail{$dir} || !$dirFail{-$dir}) {
	    @candi=();
	    #Expand to right one (checking for conditions first)
	    if( (($width=abs($border{$row}{$dir}-$border{$row}{-$dir}) + $init) >= $towidth) || ($#seats+1)>=$want)  {
		$dirFail{$dir}=3;$dirFail{-$dir}=3;}
	    #if($border{$row}{$dir} > $dir*$border{$innerrow}{$dir}) {$dirFail{$dir}=2;}
	    if($row != $innerrow && $border{$row}{-1} <= $border{$innerrow}{-1}) {$dirFail{-1}=2;}
	    if($row != $innerrow && $border{$row}{1} >= $border{$innerrow}{1}) {$dirFail{1}=2;}

	    
	    debug("Row $row, width=$width\n",5);

	    #Expand first right, then left and so on
	    $dir=-$dir;
	    if(!$dirFail{$dir}) {
		if(places_IsFree(@candi=seats_Next($row,$border{$row}{$dir}+$dir*$init,@start))) {
		    debug("Got free at (".($start[0]{'line'}+$row).",".($start[0]{'index'}+$border{$row}{$dir}+$dir*$init).")\n",4);
		    $border{$row}{$dir}+=$dir*$init;
		    if(!$init) {$init=1;$dir=-$dir;}
		    push(@seats,@candi);
		} else {
		    $dirFail{$dir}=1;
		    if($mode==$Main::FIXED) {return @seats;}
		}
	    }
	}
	#If only single on current line, remove the seat and mark this direction (up/down) as failure
	if($row!=0 && (($width=abs($border{$row}{$dir}-$border{$row}{-$dir})+$init)<=1)) {
	    if($#candi>=0 && $width==1) {
		pop(@seats);
		#if($#seats<=0) {
		#    debug("Tried to expand from (".($start[0]{'line'}).",".($start[0]{'index'})."), width=$width seats=".($#seats+1)." init=$init, row=$row \n",2);
		#    places_Display();
		#}
	    }
		
	    $vertFail{int($row/abs($row))}=1;debug("Ignoring this line-direction\n",4);
	    
	}
	debug("Width for row=$row now $width, fails dir".($dir)."=$dirFail{$dir}, dir".(-$dir)."=$dirFail{-$dir}\n",4);	    
    }
	  
    return @seats;
    
}    

sub places_IsFree {
    places_AssureValid();
    my(@seats)=@_;

    if(!defined($seats[0])) {return 0;}
    while(defined($seats[0])) {
	my(%seat)=%{pop(@seats)};
	debug("IsFree($seat{'line'},$seat{'index'})=$Main::pl_places[$seat{'line'}][$seat{'index'}]{'state'}\n",5);
	if("$Main::pl_places[$seat{'line'}][$seat{'index'}]{'state'}" ne "VALID") {
	    return 0;
	}
    }    
    return 1;
}

sub places_IsValid {
    places_AssureValid();
    my(@seats)=@_;
    
    if(!defined($seats[0])) {return 0;}
    while(defined($seats[0])) {
	my(%seat)=%{pop(@seats)};
	debug("IsFree($seat{'line'},$seat{'index'})=$Main::pl_places[$seat{'line'}][$seat{'index'}]{'state'}\n",4);
	if("$Main::pl_places[$seat{'line'}][$seat{'index'}]{'state'}" eq "NONE") {
	    return 0;
	}
    }
    return 1;
}

sub places_Reserve {
    places_AssureValid();
    my($id,@seats)=@_;
    if(length("$id")<3) {error("Reserving for <$id>, possible error",0);}
    if(!places_IsFree(@seats)) {return 0;}

    while(defined($seats[0])) {
	my(%seat)=%{pop(@seats)};
	$Main::pl_places[$seat{'line'}][$seat{'index'}]{'state'}="$id";
	if(defined($Main::pl_info{'free'}[$seat{'line'}])) {$Main::pl_info{'free'}[$seat{'line'}]--;}
	if(defined($Main::pl_info{'free'}[0])) { $Main::pl_info{'free'}[0]--;}
    }
    return 1;    
}    

sub places_Changed {
    my($line)=@_;
    if(defined($line) && $line > 0) {
	undef($Main::pl_info{'free'}[$line]);
	undef($Main::pl_info{'free'}[0]);
    } else {
	undef($Main::pl_info{'free'});
    }    
}

sub places_CountFree {
    places_AssureValid();
    my($targetline)=@_;if(!defined($targetline)) {$targetline=0;}

    #Already counted?
    if(defined($Main::pl_info{'free'}[$targetline])) {
	return $Main::pl_info{'free'}[$targetline];
    }

    my($beg,$end,$line,$ind,$sum);
    if($targetline==0) {
	$beg=1;$end=places_MaxRow();	
    } else { $beg=$targetline;$end=$targetline; }

    $sum=0;
    for($line = $beg; $line <= $end; $line++) {
	for($ind = 0; $ind <= places_MaxIndex($line); $ind++) {
	    if(places_IsFree(seats_Create($line,$ind))) { $sum++; }
	}
    }
    $Main::pl_info{'free'}[$targetline]=$sum;
    return $sum;
}

sub places_CountSeats {
    places_AssureValid();
    my($targetline)=@_;if(!defined($targetline)) {$targetline=0;}

    #Already counted?
    if(defined($Main::pl_info{'seats'}[$targetline])) {
	return $Main::pl_info{'seats'}[$targetline];
    }
    
    my($beg,$end,$line,$ind,$sum);
    if($targetline==0) {
	$beg=1;$end=places_MaxRow();	
    } else { $beg=$targetline;$end=$targetline; }

    $sum=0;
    for($line = $beg; $line <= $end; $line++) {
	for($ind = 0; $ind <= places_MaxIndex($line); $ind++) {
	    if(places_IsValid(seats_Create($line,$ind))) { $sum++; }
	}
    }
    $Main::pl_info{'seats'}[$targetline]=$sum;
    return $sum;
}


sub places_GetRandomFree {
    my($line)=@_;
    if(!defined($line)) {$line=0;}
    my(@seats)=();
       
    if(places_CountFree($line)<=0) {return @seats;}

    #Get random non-empty line
    while($line == 0) {
	$line=int(rand(places_MaxRow())+1); #1 .. max
	if(places_CountFree($line)==0) {$line=0;}
    }
    my($max)=places_MaxIndex($line)+1;
    do {
	@seats=seats_Create($line,int(rand($max)));
    } until places_IsFree(@seats);
    return @seats;
}

#Find internal representation for row/seat ones
#(Currently changes only seat->index)
sub places_ConvertToMachine {
    my(@seats)=@_;
    my($i,$row,$seat);
    for $i (0..$#seats) {
	my($index)=0;
	my($row,$seat)=($seats[$i]{'line'},$seats[$i]{'index'});
	while($index<=places_MaxIndex($row) && $Main::pl_places[$row][$index]{'seat'} != $seat) {$index++;}
	$seats[$i]{'index'}=$index;
    }
    return @seats;
}

#Print list of seats in sensible format
#(ie convert from machine table to real table)
#Numbering: Line  1 = Row 1
#         : Index 0 = Seat 1
sub places_Show {
    my(@seats)=@_;
    my(%pairs)=();
    while(defined($seats[0])) {
	my(%seat)=%{pop(@seats)};
	#print "Row:$Main::pl_places[$seat{'line'}][$seat{'index'}]{'row'} ";
	#print "Seat:$Main::pl_places[$seat{'line'}][$seat{'index'}]{'seat'}\n";
	$pairs{$Main::pl_places[$seat{'line'}][$seat{'index'}]{'row'}}{"$Main::pl_places[$seat{'line'}][$seat{'index'}]{'seat'}"}=1;
    }
    my($result)="";
    my($row,$seat);
    foreach $row (sort keys %pairs) {
	$result.=" rivi_$row=paikat ";
	my($line)="";
	my($beg,$end,$last)=(0,0,0);
	foreach $seat (sort {$a <=> $b} keys %{$pairs{$row}}, 9999) {
	    if($last) {
		if( $seat-1 == $last) {
		    if(!$beg) {$beg=$last;}
		    $end=$seat;
		} else {
		    if($line ne "") {$line.=", ";}
		    if($beg && $end) {
			$line.=($beg)."-".($end);
			$beg=0;$end=0;
		    } else { $line .= "$last";}
		}
	    }
	    $last=$seat;
	}
	$result.="$line";
    }
    return $result;
}

sub places_Display {
    places_AssureValid();
    my($mode,$html)=@_;
    if(!defined($mode)) {$mode=0;}
    if(!defined($html)) {$html=0;}

    my($VALID,$NONE,$ERRS,$IDST,$PAD)=('.','-','ง',"tag","");
    if($mode>0) {($VALID,$NONE,$ERRS,$IDST,$PAD)=('...','---','งงง',"idcount","-");}
    if($html) {($VALID,$NONE,$ERRS,$IDST,$PAD)=('&nbsp;','--','งง',"idcount","");}
    
    my($line,$ind,$free);
    my($totfree)=0;
    my(@free_seats)=();
    print "<table border=1>\n" if($html);
    for($line=1;$line<=places_MaxRow();$line++) {
	print "<tr><td><small>\n" if($html);
	print "Row $line\t:";
	$free=0;
	#for($ind=0;$ind<=places_MaxIndex($line);$ind++) {
	for($ind=places_MaxIndex($line);$ind>=0;$ind--) {
	    my($id)="$Main::pl_places[$line][$ind]{'state'}";
	    print "<td><small>" if($html);
	    if("$id" eq "VALID") {
		$free++;$totfree++;
		push(@free_seats,seats_Create($line,$ind));
		print "$VALID$PAD";
	    } elsif("$id" eq "NONE") {
		print "$NONE$PAD";		    
	    } elsif(defined(reserve_GetValue($id,$IDST))) {
		if($html) {print "<a name=\"P".reserve_GetValue($id,$IDST)."\">";}
		#if($html) {print "<a href=\"\#H".reserve_GetValue($id,$IDST)."\">";}
		if($html) {print "<a href=\"\#$id\">";}
		if($html) {print "<font color=\"".reserve_GetValue($id,"colour")."\">";}
		print reserve_GetValue($id,$IDST).$PAD;
		if($html) {print "</a>";}
	    } else {
		print "ERRS$PAD";
	    }
	}
	print "<td>" if($html);
	print "\t($free of ".places_CountSeats($line).",".places_MaxIndex($line).")\n";
    }
    print "</table></small>\n" if($html);

    print "Total $totfree seats left from ".places_CountSeats()."\n";
    print "<br>\n" if($html);
    my($counted)=0;
    if($totfree != ($counted=places_CountFree())) {
	error("Odd, totfree=$totfree, yet by counting $counted",0);
    }

    if($#free_seats>=0) {
	print "Free seats: ".places_Show(@free_seats)."\n";
	print "<br>\n" if($html)	
    }	
}

sub places_MaxRow {
    places_AssureValid();
    my($i)=0;
    while(defined($Main::pl_places[$i+1])) {$i++;}
    return $i;    
}

sub places_MaxIndex {
    places_AssureValid();
    my($line)=@_;
    if(!defined($line) || $line == 0 || $line>places_MaxRow()) {error("MaxIndex needs argument\n",0);return -1;}
    my($i)=0;
    while(defined($Main::pl_places[$line][$i+1])) {$i++;}
    return $i;    
}

sub places_AssureValid {    
    if(!defined(@Main::pl_places)) {die "Member (".(caller(1))[3].") called without calling _init() first";}
}    

sub places_Reset {
    places_AssureValid();
    my($y,$x,$key);    
    foreach $y (1..places_MaxRow()) {
	foreach $x (0..places_MaxIndex($y)) {
	    if("$Main::pl_places[$y][$x]{'state'}" ne "NONE") {
		$Main::pl_places[$y][$x]{'state'}="VALID";
	    }
	}
    }
    foreach $id (keys %Main::rr_reserve) {
	undef($Main::rr_reserve{$id}{'seated'});
    }
    places_Changed();
    reserve_Init("$Main::reserv")
}

sub places_Init {
    my($filename)=@_;
    @Main::pl_places=();
    open_data(\*LFILE,"$filename")||error("Couldn't open $filename");

    my($line)="";
    my($linenum)=0;
    
    my($totseats)=0;
    while(($line=getLine(\*LFILE)) ne "EOF" && length($line)>5) {
	if(length($line)<3) {next;};
	$linenum++;
	my($index);my($seat)=1;
	
	for($index=0;$index<length($line);$index++) {
	    my($char)=substr($line,$index,1);
	    
	    if("$char" eq "1") {
		$Main::pl_places[$linenum][$index]{'state'}="VALID";
		$Main::pl_places[$linenum][$index]{'row'}=$linenum;
		$Main::pl_places[$linenum][$index]{'seat'}=$seat++;
	    } else {
		$Main::pl_places[$linenum][$index]{'state'}="NONE";
		$Main::pl_places[$linenum][$index]{'row'}=0;	    
		$Main::pl_places[$linenum][$index]{'seat'}=0;
	    }	   
	}	
        $totseats+=$seat-1;
	debug("Row $linenum, ".($seat-1)." places (total $totseats).\n",3);
    }
    debug("Found $linenum rows for $totseats places from $filename\n",1);
    if ($linenum<2 || $totseats < 2) { 
	die "Too few rows ($linenum) or seats ($totseats) from $filename";}

    return 1;
}

# *** Reserve Class ***

sub reserve_AssureValid {    
    if(!defined(%Main::rr_reserve)) {die "Member (".(caller(1))[3].") called without calling _init() first";}
}    

sub reserve_GetValue {
    reserve_AssureValid();
    my($id,$key)=@_;
    return ($Main::rr_reserve{$id}{$key})    
}

sub reserve_SetSeated {
    reserve_AssureValid();
    my($id,@seats)=@_;
    if(defined($Main::rr_reserve{$id}{'seated'})) {error("Warning: $id was already set seated");}
    else {$Main::rr_reserve{$id}{'seated'}=(\@seats);}
    
    my($i)=0;
    debug("Seating $id on ",2);
    while(defined($seats[$i])) {debug("M(".$seats[$i]{'line'}.",".$seats[$i++]{'index'}.") ",2);}
    debug("\n",2);
			   
}

sub reserve_IsSeated {
    my($id)=@_;
    return defined($Main::rr_reserve{$id}{'seated'});
}

sub reserve_Shuffler {
    my(@key)=@_;
    my(@new)=();
    debug("Shuffler: old=@key\n",3);
    while($#key>=0) {push(@new,splice(@key,int(rand($#key+1)),1)); }
    debug("Shuffler: new=@new\n",3);
    return @new;
}

#Sort by allocation size, [randomizing within the same sizes]
#Modes -1 Seated, 0 All, 1 Unseated
sub reserve_GetSorted {
    reserve_AssureValid();
    my($mode,$key,@resIds)=@_;
    if(!defined($key) || "$key" eq "") {$key="amount";}
    if($#resIds<0) {@resIds=reserve_AllIds();}
    my(@sorts)=@resIds;
    my(@ids)=();my($id);
    if("$key" eq "amount") {
	foreach $id (sort { "$Main::rr_reserve{$b}{$key}" <=> "$Main::rr_reserve{$a}{$key}" } @sorts) {
	    push(@ids,$id) unless (($mode<0 && !reserve_IsSeated($id)) || ($mode>0 && reserve_IsSeated($id)) );
	}
    } else {
	foreach $id (sort { uc("$Main::rr_reserve{$a}{$key}") cmp uc("$Main::rr_reserve{$b}{$key}") } @sorts) {
	    push(@ids,$id) unless (($mode<0 && !reserve_IsSeated($id)) || ($mode>0 && reserve_IsSeated($id)) );
	}
    }	
    return @ids;
}

#Return all ids in randomized order
sub reserve_AllIds {
   return reserve_Shuffler(sort keys %Main::rr_reserve)
}

#Modes -1 Seated, 0 All, 1 Unseated
#Return in randomized orders
sub reserve_GetMatching {
    reserve_AssureValid();
    my($mode,$key,$value,@resIds)=@_;
    if($#resIds<0) {@resIds=reserve_AllIds();}
    my(@ids)=();my($id);
    foreach $id ( @resIds ) {
	if(defined($Main::rr_reserve{$id}{$key}) && "$Main::rr_reserve{$id}{$key}" eq "$value") {
	    push(@ids,$id)  unless (($mode<0 && !reserve_IsSeated($id)) || ($mode>0 && reserve_IsSeated($id)) );
	}
    }
    return @ids
}

sub reserve_Init {
    places_AssureValid();
    %Main::rr_reserve=();
    my($filename)=@_;

    open_data(\*LFILE,"$filename")||error("Couldn't open $filename");
    my($total,$entries)=(0,0);
    my($line);
    my(@tags)=('a' .. 'z', 'A' .. 'Z');
    my($idcount,$count)=(0,1);
    while(($line=getLine(\*LFILE)) ne "EOF") {
	if(length($line)<3) {next;};
	my(@seats)=();
	my($id,$name,$assoc,$amount,$list)=(0,0,0,"");
	my($info)="";
	#Find and mark fixed keywords
	if($line =~ s/ LOVE//g) { $info.="LOVE"; }
	#Match entry with pre-reserved list
	if(     $line =~ /\s*([^,]+?)\s*,\s*([^,]+?)\s*,\s*(\d+)=([\d\s]+,[\d,\s]+)/) {
	    ($id,$name,$assoc,$amount,$list)=($1,$1,$2,$3,$4); }
        #Match entry with plain amount instead
	elsif(  $line =~ /\s*([^,]+?)\s*,\s*([^,]+?)\s*,\s*(\d+)/) {
	    ($id,$name,$assoc,$amount,$list)=($1,$1,$2,$3,""); }
	else {
	    error("Unrecognized line $line",0);
	}
	if("$id" ne "") {
	    while(defined($Main::rr_reserve{$id})) {
		error("Warning: Duplicate entry for $name ($assoc,$amount) vs. $name ($Main::rr_reserve{$id}{'assoc'} $Main::rr_reserve{$id}{'amount'})",0);
		$id="${id}_";
	    }

	    $Main::rr_reserve{"$id"}{'name'}="$name";
	    $Main::rr_reserve{"$id"}{'assoc'}="$assoc";

	    if("$list" ne "") {
		@seats=places_ConvertToMachine(seats_Create(split(/,/,$list)));
		if($amount != $#seats+1) {error("Warning: Mismatch at pre-reservation count : $line\n",0);}
		$amount=$#seats+1;
		debug("Pre-set reservation for $id, list ($list) of amount $amount\n",2);
	    }	    
	    $Main::rr_reserve{"$id"}{'amount'}="$amount";
	    $Main::rr_reserve{"$id"}{'info'}="$info";
	    $Main::rr_reserve{"$id"}{'idcount'}=sprintf("%03d",$count++);
	    if($amount>=1 && $amount <=9) {$Main::rr_reserve{"$id"}{"colour"}=$Main::COLOUR[$amount];}
	    else { $Main::rr_reserve{"$id"}{"colour"}=$Main::COLOUR[0];}
	    
	    my($tag)="#";

	    if($idcount<=$#tags && $amount!=1 && $amount!=2 ) {$tag=$tags[$idcount++];}
	    elsif($amount>=0 && $amount<=9) {$tag="$amount";}
	    else {$tag="?";}
	    $Main::rr_reserve{"$id"}{'tag'}="$tag";
	    
	    $total+=$amount;$entries++;
	    if(@seats) {
		places_Reserve($id,@seats) ||
		    error("Failed to reserve pre-reservation for $id, list ($list) of amount $amount");
		reserve_SetSeated($id,@seats);
		#$Main::rr_reserve{"$id"}{'seated'}=(\@seats);
	    }
	} 	
    }
    debug("Found $entries entries for $total tickets from $filename\n",1);
    if($entries < 2|| $total < 2) {
	die "Too few entries ($entries/$total) from $filename";}
    return 1;
}



#--- The base functions ---

sub open_data {
    my($HANDLE_ref,$source)=@_;
    my($type)="file";
    if( $source =~ /\Ahttp:\/\//) {
	$type="http";
	$source =~ s/[^\w -+:=\#\@\/\.]//g;
	debug("Cleaned http-url to <$source>\n",1);
	my($tempfile)="/tmp/temp_od_".basename($source)."_$$";
	qx { HOME=/tmp/ /usr/bin/lynx --dump "$source" >"$tempfile" 2>>"$Main::DEBUG" } && return 0;
	$source=$tempfile;
    } elsif($source =~ /\Aftp:\/\//) {
	$type="ftp";	
	$source =~ s/[^\w -+:=\#\@\/\.]//g;
	debug("Cleaned ftp-url to <$source>\n",1);
	qx {cd /tmp; ncftpget -VZ "$source" ; cd -};
	$source="/tmp/".basename($source);
    } 
    debug("Opening $type($source)\n",1);
    if(-s "$source" && open($HANDLE_ref,"<$source")) { return 1; }
    return 0;

}

sub read_file {
    my($filename)=@_;
    my($buf,$tmp)=("","");
    open (RFILE,"<$filename")|| error("Couldn't open $filename");
    
    debug("Reading from $filename...",3);
    my($len)=(stat($filename))[7];
    if($len) {
        if(($tmp = read(RFILE,$buf,$len)) != $len) {
            error("Got only $tmp bytes out of $len while reading \"$filename\"")
;}          
        close(RFILE);   
    } else {
        debug("waiting for input...",3);
        while(<RFILE>) {$buf.=$_;}
        $tmp=length($buf);
    }
    debug("got $tmp bytes\n",3);
    return $buf;
}

# Return next no-comment line from parameter line. If eof, return empty
# string.
# Inputs: FILE-handle
# Output: next line from parameter file without newline, or EOF
# Globals(IN): 
# Globals(OUT): 
sub getLine
{
    my($fh)=shift;
    while(<$fh>) 
    { 
        chomp($_);
        #Remove all doublequotes
        $_ =~ tr/\"//d; 
        
        # We must chomp "^M" too for DOS-texts!
        $/=chr(13);chomp($_);$/="\n";
        
        # Strip whitespaces from beginning and end of line
        /^\s*(.*)\s*$/; $_ = $1;
        
        if (/^\#/) {next;} # Is this a comment line?
        else {
            debug("getLine: Got : $_\n",4);
            return $_; 
        }
    }
    return "EOF";
}

sub save_file {
    my($filename,$data)=@_;
    my($tmp);
    
    open (SFILE,">$filename")|| return -2;
    $tmp = syswrite(SFILE,$data,length($data));
    if($tmp != length($data)) {
        error("Wrote $tmp of ".length($data)." bytes to $filename",0);
        return -3;
    }
    close(SFILE);
    return 0;
}

# Print error message and exit if error level > 1
# Inputs: Error message, [Error level]
# Output: -
# Globals(IN): -
# Globals(OUT): -
sub error {
    my($msg,$error)=@_;
    if(defined($error) && ($error < 1)) {
        print STDERR $msg."\n";
    } else {
        die("\n$msg\n$!\n");
    }
}


# Print given message if current verbose level allows it
#
# Inputs: Message to be printed, [priority level of the message (default=1)]
# Output: None
# Globals(IN) : $Main::verbose, $Main::OUTPUT
# Globals(OUT): -
sub debug {
    if(!defined($Main::OUTPUT)) {$Main::OUTPUT=\*STDOUT;}
    my($data,$level)=@_;
    if(!defined($level)) {my($level)=1;}
    if($Main::verbose>=$level) {
        printf { $Main::OUTPUT } $data;
    }
}

sub info {
    debug(@_,1);
}

sub calls_Show {
    my($key);
    foreach $key (keys %Main::cc_calls) {
	print "Calls: $key=$Main::cc_calls{$key}\n";
    }
}

sub calls_Count {
    my($p1,$p2,$p3)=("","","");
    if(defined((caller(1))[3])) {
	$p1=(caller(1))[3];
	if(defined((caller(2))[3])) {
	    $p2="<-".(caller(2))[3];				     
	    if(defined((caller(3))[3])) {$p3="<-".(caller(3))[3]; }
	}
    }
	       
    if(!defined($Main::cc_calls{"$p1$p2$p3"})) {$Main::cc_calls{"$p1$p2$p3"}=1;}
    else {$Main::cc_calls{"$p1$p2$p3"}++;}
}
		
sub basename {
    my($name)=@_;
    $name =~ /(.*\/)*(.*?)$/;
    return $2;
}
				    
## Local Variables:
## mode: perl
## make-backup-files: t
## End:
