#!/usr/bin/perl
use locale;
use utf8;
use open ':utf8', ':std';
use Encode qw/ encode /;
use POSIX qw/ strftime /;
use Time::Local qw/ timelocal_nocheck /;

my $CHARSET="utf-8";

# set up debugging
my $debug="<!-- -->\n"; # <!-- env cfg par res -->

#use CGI qw/ -no_xhtml -compile -utf8 :standard :cgi-lib *table *div *ol *ul *Tr *td *dl *dd *img /;
use CGI qw/ -no_xhtml :standard :cgi-lib *table *div *ol *ul *Tr *td *dl *dd *img /;

$author='zdenek@precek.cz';
$dead_sec='2147483647';
$deadline='(never)';
$date='1.1.2000';

@pages= qw/ EDITACE NOVINKY ROZPIS PŘIHLÁŠKY POKYNY VÝSLEDKY /;
@funcs= (
	sub{ pg_edit(1) },																# EDITACE
	sub{ pg_file( $cfg->{fnov}, "Zatím nic") },				# NOVINKY
	sub{ pg_file( $cfg->{froz}, "Zatím není") },			# ROZPIS
	sub{ pg_edit(0) },																# PŘIHLÁŠKY
	sub{ pg_file( $cfg->{fpok}, "Zatím nejsou") },		# POKYNY
	sub{ pg_file( $cfg->{fvys}, "Budou po závodě") },	# VÝSLEDKY
);

# start data processing
#
$now= time;
@now= localtime($now);
$ts= strftime('%y%m%d.%H%M', localtime((stat $0)[9]));

# save CGI parameters
#
param( 'page','1' ) unless param( 'page' );
$par= Vars;
$par->{page}= 0 if $par->{page}=~ /^Edit$/;
$par->{page}= 1 unless $par->{page}=~ /\d+/ && ($par->{page} <= $#pages);

# import the configuration
#
if( open IN, "pzl.cfg" ) {
	restore_parameters( \*IN ) ;
	close IN;
	$cfg= Vars;
}

# cleanup the CGI parameters
if( open IN, "/dev/null" ) {
	restore_parameters( \*IN ) ;
	close IN;
}

# debug: environment
if($debug=~/^[^\n]*env[^\n]*\n/){
	my $e=""; for (sort keys %ENV) { $e.= Tr(th($_),td($ENV{$_})); };
	$debug.= Tr(td(dl(dt('environment'),dd(table({-class=>"formular"},$e)))));
}

# debug: konfigurace
if($debug=~/^[^\n]*cfg[^\n]*\n/){
	my $c=""; for (sort keys %$cfg) { $c.= Tr(th($_),td($cfg->{$_})); };
	$debug.= Tr(td(dl(dt('konfigurace'),dd(table({-class=>"formular"},$c)))));
}

# debug: parametry
if($debug=~/^[^\n]*par[^\n]*\n/){
	my $p=""; for (sort keys %$par) { $p.= Tr(th($_),td($par->{$_})); };
	$debug.= Tr(td(dl(dt('parametry'),dd(table({-class=>"formular"},$p)))));
}

# download přihlášek
if( exists $par->{save} ){
	my $cs= $par->{cset};
	if( open(IN, $cfg->{fpri}) ) {
		binmode STDOUT;
		print "Content-disposition: attachment; filename=\"prihlasky.csv\"\n\n";
		while(<IN>){
			next if /^#/;			# vynechat zrušené a změněné záznamy
			chomp;
			s/^([^;]*;){2}//;	# odstranit heslo a čas
			print encode( $cs, $_ ),"\r\n";
		}
		close IN;
	}
	exit 1;
}

# konfigurace: datum konání
if( exists $cfg->{date} ){
	my($y,$m,$d,$H,$M)= split '[-:/\s]', $cfg->{date};
	$date= join '.', 0+$d, 0+$m, $y ;
}

# konfigurace: tratě
if( exists $cfg->{trat} ){
	@trat= split "\0", $cfg->{trat};
	for (@trat) {
		my $kat=  (split)[0];
		push @kat, $kat;
		$trat{$kat}= $_;
	}
}

# konfigurace: deadline přihlášek
if( exists $cfg->{dead} ){
	my($y,$m,$d,$H,$M)= split '[-:/\s]', $cfg->{dead};
	$dead_sec= timelocal_nocheck 0,$M,$H,$d,$m-1,$y-1900;
	$deadline= strftime('%d.%m.%Y-%H:%M', localtime $dead_sec);
}

# generování HTML
#
print
	do_head()."\n".
	do_page()."\n".
	do_tail()."\n";

################################################################################
# funkce
################################################################################

################################################################################
# tělo stránky
#
sub do_page {
	my $s="";

# data stránky
	$s.= Tr(td($funcs[$par->{page}]()));

	return $s;
}

################################################################################
# Hlavičky HTTP, HTML a stránky
#
sub do_head {
	my $s="$pages[$par->{page}] - PZL $date";
	chomp( $s ); $s=

# Hlavička HTTP
	header(
		-type=>						"text/html",
		-charset=>				"$CHARSET",
		-expires=>				"+1m",
	).
# Hlavička HTML
	start_html(
		-lang=>						"cs_CZ",
		-encoding=>				"$CHARSET",
		-head=> [
			meta({
				-http_equiv=>	"Content-Type",
				-content=>		"text/html; charset=$CHARSET",
			}),
			meta({
				-http_equiv=>	"Cache-Control",
				-content=>		"max-age=60, must-revalidate",
			}),
		],
		-style=> {
			-src=>					"pzl.css",
		},
		-author=>					$author,
		-title=>					$s,
	).
# Hlavička stránky
	start_table(
		{-style=>					'width:760px;margin-left:auto;margin-right:auto;'},
	).
# logo
	Tr(td(a(
		{-href=>					'http://www.sk-praga.cz/pzl'},
		img({
			-src=>					$cfg->{logo},
			-alt=>					$cfg->{name},
		}),
	))).
# navigace
	start_Tr.
	start_td.
	hr;
	for ( 1 .. $#pages ) {
		$s.=
			a({-href=> "?page=$_"},
				$pages[$_],
			).'&nbsp;';
	};
# nadpis
	$s.=
		hr.
		h1($pages[$par->{page}]).
		end_td.
		end_Tr;
	return $s;
}

################################################################################
## Patička stránky
##
sub footer {
  my $s=
	Tr(td(hr,
# W3C ikony
		div({-style=> 'margin-left:0;margin-right:auto;text-align:left;float:left;vertical-align:top'},
			'
			<a href="http://validator.w3.org/check?uri=referer">
			<img src="https://www.w3.org/Icons/valid-html401" alt="Valid HTML 4.01 Transitional"
				style="border:0;width:88px;height:31px">
			</a>
			<a href="http://jigsaw.w3.org/css-validator/check/referer">
			<img src="https://jigsaw.w3.org/css-validator/images/vcss" alt="Ověřit CSS!"
				style="border:0;width:88px;height:31px">
			</a>
			'
		),
# moje ikony
		div({-style=> 'margin-left:auto;margin-right:0;text-align:right;float:right;vertical-align:top'},
			a({-href=> 'http://www.vim.org'},
				img({-src=> 'img/html_by_vim.gif',
					-alt=> 'vytvořeno pomocí editoru &quot;vim&quot;',
					-style=> 'border:0;width:88px;height:31px',
				}),
			),
			img({-src=> 'img/anybrowser.gif',
					-alt=> 'optimalizováno pro jakýkoli prohlížeč',
					-style=> 'border:0;width:88px;height:31px',
				},),
			p({-style=> 'font-size:x-small;'}, 'ing Zdeněk Přeček', '&lt;'.$ts.'&gt;'),
		)
	));

	return $s;
}

################################################################################
# Konec stránky a dokumentu
#
sub do_tail {
	my $s= footer();
# debug
	$s.= $debug;
# konec stránky
	$s.= end_table;
# konec HTML
	$s.= end_html;
	return $s;
}

################################################################################
# načtení stránky ze souboru
#
sub pg_file {
	my ($file, $text)= @_;
	open IN, $file or return dt($text);
	$ts= strftime('%y%m%d.%H%M', localtime((stat $file)[9]));
	return join('', (<IN>));
}

################################################################################
# PŘIHLÁŠKY
#
sub pg_edit {

	my $edit= shift;
	my @e= ();															# chybové hlášky
	my @list= ();														# editované přihlášky
	my @fpri= ();														# seznam přihlášek

	my $mail= $author;
	if( exists $cfg->{mail} ) {
		$mail= $cfg->{mail} ;
	}

	my $hash= '*';
	if( exists $par->{hash} ) {
		$hash= $par->{hash} ;
	}

# Uzamčení seznamu přihlášek
	my @SCRIPT_NAME= split '/', $ENV{'SCRIPT_NAME'};
	pop @SCRIPT_NAME;
	my $lock= join '_', '/tmp/LOCK', @SCRIPT_NAME;
	my $lock_cnt= 10;
	while( not mkdir $lock ) {
		my $e= $!;
		unless( $e=~ /^File exists/ ) {
			return dl(dt(span({-class=>'error'},"Error while creating lock ($lock): $e")));
		}
		if( --$lock_cnt == 0 ) {
			rmdir $lock;
			$lock_cnt= 10;
		}
		else {
			sleep 1;
		}
	}

# Načtení seznamu přihlášek
	if( open IN, "$cfg->{fpri}" ){
		while(<IN>){
			next unless $_;
			chomp $_;
			push @fpri, $_;
		}
		$ts= strftime('%y%m%d.%H%M', localtime((stat $cfg->{fpri})[9]));
	} else {
		push @e, 'Nelze načíst seznam přihlášek.';
	}

# Zrušení editace přihlášky
	if( exists $par->{reset} ) {
		delete $par->{list};
		delete $par->{hash};
		delete $par->{fmod};
		delete $par->{kat};
		delete $par->{reg};
		delete $par->{jme};
	}

# Rozpracovaná přihláška
	if( exists $par->{list} ) {
		@list= split "<br>", $par->{list};
		delete $par->{list};
	}

# Editace celého seznamu přihlášek
	elsif( $edit ) {
		for(my $i=0;$i<@fpri;$i++) {
			push @list, $i . ";" . $fpri[$i]
				unless $fpri[$i]=~ /^#/;
		}
	}

# Editace části přihlášky podle hesla
	elsif( exists $par->{edit} ) {
		if( exists $par->{pass} && length $par->{pass} ) {
			my $pass= $par->{pass};
			for(my $i=0;$i<@fpri;$i++) {
				$fpri[$i]=~ /^([^;]*);/ ;
				my $hash= $1;
				if( crypt( $pass, $hash ) eq $hash ){
					push @list, $i . ";" . $fpri[$i];
					$par->{hash}= $hash;
					$par->{fmod}= 0;
				}
			}
		}
		push @e, 'Špatné heslo' unless @list;
	}

# Aktualizace seznamu přihlášek
	if( exists $par->{set} ) {
# Kontrola zadání hesla
		if( $hash eq "*" ) {
			$hash= crypt( $par->{pass}, substr( crypt( "hash", rand(100)."ab"), 2, 2) );
			push @e, "Kontrolní heslo není stejné."
				unless $hash eq crypt( $par->{pwck}, $hash );
		}
# Vlastní aktualizace
		unless( @e ) {
			if( open OUT, ">", $cfg->{fpri} ) {
				while( my $p= shift @list ) {
					my ($i,$h,$d)= ($p=~ /^([^;]*);([^;]*);(.*)$/);
# nová položka v seznamu změn: dohláška
					if( $i=~ /^N/ ) {
						push @fpri, (($h eq "*") ? $hash : $h) . ";" . $d ;
					}
# změna existující přihlášky znamená odhlášku
					elsif( $h=~ /^#/ ) {
            my $now_ts= strftime("%Y%m%d%H%M", @now);
						$fpri[$i]=~ s/^[^;]*;/#$now_ts;/;
					}
				}
				my $i= 0;
				for (@fpri)	{
					print OUT "$_\n";
					if( $edit ){
						push @list, ++$i . ";" . $_
							unless /^#/;
					}
				}
				close OUT;
				delete $par->{hash};
				$par->{fmod}= 0;
			} else {
				push @e, "Přihlášku nelze odeslat: $!.";
			}
		}
	}

# Přidání do přihlášky
	elsif( exists $par->{add} ) {
		push @e, 'Chybí příjmení a jméno'
			unless $par->{jme};
		push @e, 'Chybí registračka nebo rok narození'
			unless $par->{reg};
		my $kat= $par->{kat};
		my $reg= uc $par->{reg}; delete $par->{reg}; $reg=~ s/\s+//g;
		my $jme= $par->{jme}; delete $par->{jme}; $jme=~ s/^\s*(.*)\s*$/$1/;
		my @data= ($kat, $reg, $jme); # data přihlášky
		unless( @e ) {
			my $when= strftime '%Y%m%d%H%M', @now;
			push @list, join( ";", "N", $hash, $when, @data);
			$par->{fmod}= 1;
		}
		delete $par->{hash} if $edit;
	}

# Úprava přihlášky
	else {
		for (keys %$par) {
			next unless /^([md])(\d{3})\.x/;
			my ($f, $n)= ($1, $2);
			if( $list[$n]=~ /^N;/ ) {
				@p= split( '\s*;\s*', (splice(@list, $n, 1))[0] );
			} else {
				@p= split( '\s*;\s*', $list[$n] );
				$par->{hash}= $p[1];
				$p[1]= "#";
				$list[$n]= join ";", @p;
			}
# pro úpravu už nebudeme potřebovat:
			shift @p;	# index to @fpri
			shift @p;	# hash
			shift @p;	# when
			$par->{fmod}= 1 unless $par->{fmod};
			if( $f=~/^m/ ) {
				$par->{fmod}= 2;
# ale budeme potřebovat data přihlášky
				( $par->{kat}, $par->{reg}, $par->{jme} )= @p;
			}
		}
	}

# uvolneni zamku
	rmdir $lock;

# debug: výsledek zpracování
	if($debug=~/^[^\n]*res[^\n]*\n/){
		my $p="";
		$p.= Tr(th("list"),td(join("<br>",@list)));
		$p.= Tr(th("fpri"),td(join("<br>",@fpri)));
		$debug.= Tr(td(dl(dt('výsledek zpracování'),dd(table({-class=>"formular"},$p)))));
	}

# Generování formuláře
	my $s= 
		dt(($edit or (@list and $par->{hash}))?'Úprava přihlášky:':'Nová přihláška:');

# Zacatek vstupniho formulare
	if( $edit or (time <= $dead_sec) ) { $s.=
		start_dd() .
		start_multipart_form() .
		((exists $par->{hash}) ? hidden('hash', $par->{hash}) : "") .
		((exists $par->{fmod}) ? hidden('fmod', $par->{fmod}) : "") .
		hidden('list', join("<br>", @list)) .
		hidden('page', $edit ? 'Edit' : $par->{page});

# Vstupni radek
		$s.= table({-width=>'100%'},
			Tr([
				th(
					['trať','reg./r.nar.','příjmení a jméno'],
				).
				td({-style=>'text-align:right'}, em("Přihlášky do:") . b($deadline)),
				td([
					popup_menu(
						-name=> 'kat',
						-values=> \@kat,
						-default=> $par->{kat},
						-labels=> \%trat,
					),
					textfield(
						-name=> 'reg',
						-default=> $par->{reg},
						-size=> 7,
						-maxlength=> 8,
					),
					textfield(
						-name=> 'jme',
						-default=> $par->{jme},
						-size=> 26,
						-maxlength=> 32,
					),
				]).
				td({-style=>'text-align:right'}, submit('add', 'Přidat do přihlášky')),
			]),
		);

# Zobrazeni seznamu prihlasek pro editaci
		if( @list or $edit or $par->{hash} ) {
			my $fmod= (exists $par->{fmod} && $par->{fmod} == 2);
			my $r="";
			my $i= 0;
			my $k= 1;
			for (@list){
				my ($n, $hash, $when, $kat, $reg, $jme)= split( '\s*;\s*', $_  );
				$r.= Tr(
					td({-style=>'text-align:center'},
					  ($fmod) ? "" :
					  image_button(sprintf("m%03d",$i),'img/icons/modify_12.png','MIDDLE'),
					  image_button(sprintf("d%03d",$i),'img/icons/delete_12.png','MIDDLE'),
					),
					td({-style=>'text-align:right'},$k++.'.'),
					td({-style=>'text-align:center'},$kat),
					td({-style=>'text-align:left'},$reg),
					td({-style=>'text-align:left'},$jme),
				) unless $hash=~ /^#/;
				$i++;
			};
			$s.= hr.table({class=>'formular', -width=>'100%'},
				Tr(
					th({-width=>'5%'},  '&nbsp;'),
					th({-width=>'5%'},  'poř.'),
					th({-width=>'5%'},  'trať'),
					th({-width=>'12%'}, 'reg./r.nar.'),
					th(					'příjmení a jméno'),
				),$r
			);
		}

		if ( $edit || $par->{hash} ) {
			$s.= hr.table({-width=>'100%'},
				Tr(
					td({-style=>'text-align:left'},
						img({
							-src=> 'img/icons/modify_12.png',
							-alt=> 'Upravit',
						}),"= upravit",
						img({
							-src=> 'img/icons/delete_12.png',
							-alt=> 'Smazat',
						}),"= smazat",
						"&nbsp;",
						submit('reset', 'Zrušit úpravy',),
					),
					td({-style=>'text-align:right'},
						(exists $par->{fmod} && $par->{fmod} == 1) ?
							submit('set', 'Uložit změny',) : '&nbsp;',
					),
				),
			);
		}
		elsif( @list ) {
			$s.= hr.
			table({-width=>'100%'},
				Tr(
				  td({-style=>'text-align:left'},
					password_field(
						-name=>					'pass',
						-default=>			'',
						-size=>					12,
						-maxlength=>		80,
					),
					"Heslo pro úpravy této přihlášky",
				  ),
				  td({-style=>'text-align:left'},
					password_field(
						-name=>					'pwck',
						-default=>			'',
						-size=>					12,
						-maxlength=>		80,
					),
					"Totéž heslo ještě jednou pro kontrolu",
				  ),
				),
				Tr(
				  td({-style=>'text-align:left'},
						submit('reset', 'Zrušit přihlášku',)
				  ),
				  td({-style=>'text-align:right'},
						submit('set', 'Odeslat přihlášku',)
				  ),
				),
			);
		}

# Konec formulare
		$s.=
			end_multipart_form().
			end_dd;
	}

# Po terminu prihlasek misto formulare jen hlaska:
	else {
		$s.=
			dd(p({-class=>"error"},"Termín přihlášek $deadline již vypršel."));
	}

# Chybove hlaseni
	if( @e ) {
		$s.=
		dt( 'Chyba:' ).
		dd( p({-class=>'error'}, \@e ));
	}

# V prubehu editace prihlasky nezobrazujeme seznam prihlasek
	return dl($s) if @list || $edit || $par->{hash} ;

# Seznam prihlasenych:
# data
	my $d= "";
	my $i= 1;
	for (@fpri) {
		next unless $_;
		next if /^#/; # smazané přihlášky vynecháváme
		my ($hash, $when, $kat, $reg, $jme)= split( '\s*;\s*', $_ );
		$when=~ s/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/$3.$2.$1-$4:$5/;
		$d.=
			Tr(
				td({-style=>'text-align:right'},$i++ . '.'),
				td({-style=>'text-align:left'},$when),
				td({-style=>'text-align:center'},$kat),
				td({-style=>'text-align:left'},$reg),
				td({-style=>'text-align:left'},$jme),
			);
	};
# jsou-li nějaká data, zobrazíme tabulku
	if( $d ) { $s.=
		dd(hr).
		dt('Seznam přihlášených').
		dd(
			table({-class=>'formular', -width=>'100%'},
				Tr(
				th({-width=>'5%'},  'poř.'),
				th({-width=>'20%'}, 'čas přihlášky'),
				th({-width=>'5%'},  'trať'),
				th({-width=>'12%'}, 'reg./r.nar.'),
				th(                 'příjmení a jméno'),
				),
				$d,
			) . hr
		);

# instrukce pro dohlášky, odhlášky a změny
		if( $edit or (time <= $dead_sec) ){ $s.=
			dt(
				'Pro změny a odhlášky zadejte svoje heslo nebo použijte',
				a({-href=>'mailto:'.$mail.'?subject=PZL '.$cfg->{date}.', změna'},
				'e-mail'), ".",
			).
			dd( start_multipart_form() .
				hidden('page', $par->{page}) .
				table({-width=>'100%'},
					Tr(
					td({-style=>'text-align:left'},
						password_field(
							-name=>					'pass',
							-default=>			'',
							-size=>					12,
							-maxlength=>		80,
						),
						"Heslo zvolené při odesílání přihlášky",
					),
					td({-style=>'text-align:right'},
						submit('edit', 'Upravit přihlášku' ),
					),
					),
				).
			end_multipart_form());
		} else { $s.=
			dt(
				'Pro změny a odhlášky použijte, prosím,',
				a({-href=>'mailto:'.$mail.'?subject=PZL '.$cfg->{date}.', změna'},
				'e-mail'), ".",
			);
		}

# download prihlasky
		$s.=
		  dt('Soubor s přihláškami ve formátu CSV (pro import do Excelu)') .
		  dd( start_multipart_form() .
			hidden('page', $par->{page}) .
			table({-width=>'100%'},
			  Tr(
					td({-style=>'text-align:left'},
						"Znaková sada: ",
						radio_group(
							-name=>		'cset',
							-values=>	[ 'windows-1250', 'iso-8859-2', 'utf-8', ],
						),
					),
					td({-style=>'text-align:right'},
						submit('save', 'Stáhnout soubor' ),
					),
			  ),
			) .
		  end_multipart_form());
	}
	return dl($s);
}

# vim: set ts=2 sw=2 sts=2 noet ai si filetype=perl: