#!/usr/bin/perl

use strict;
use warnings;
no warnings "uninitialized";

BEGIN { chdir("Registration"); }

use lib "lib";

use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Mail::Sendmail;

my $MAIL_SENDER = 'registration@kakehashi.com';
my $MAIL_RECIP = 'registration@kakehashi.com';
my $MAIL_SERVER = 'mail.kakehashi.com';

my $cgi = CGI->new;
$cgi->charset("utf-8");

main();

sub main {
	my $cmd  = $cgi->param("cmd");
	my $ctx  = { cmd => $cmd, recipient => $MAIL_RECIP };
	my $page = "";
	
	if ($cmd eq "check") {
		$page = page_check($ctx);
	} elsif ($cmd eq "submit") {
		$page = page_submit($ctx);
	} elsif ($cmd eq "sent") {
		$page = page_process($ctx, "sent.html");
	} else {
		$page = page_process($ctx, "front.html");
	}
	
	if ($ctx->{redirect}) {
		print $cgi->redirect($ctx->{redirect});
		return;
	}
	
	print $cgi->header;
	print $page;
	
	return;
}


sub strip {
	my($s) = @_;
	$s =~ s/^\s*//;
	$s =~ s/\s*$//;
	return $s;
}


sub page_check {
	my($ctx) = @_;
	
	for my $opt (qw(name address email type year month day)) {
		if ($cgi->param($opt) =~ /^\s*$/) {
			$ctx->{error} = "赤の部分のところがたりません。ご記入ください。";
			$ctx->{cmd} = "reinput";
			return page_process($ctx, "front.html");
		}
	}
	
	if ($cgi->param("type") eq "special") {
		$ctx->{special} = 1;
		$ctx->{type} = "特別会員 (" . $cgi->param("times") . "口希望する)";
	} else {
		$ctx->{type} = "一般会員";
	}
		
	return page_process($ctx, "check.html");
}


sub page_submit {
	my($ctx) = @_;
	$ctx->{redirect} = $cgi->url . "?cmd=sent";

	my $mail = page_process($ctx, "mail.txt");
	sendmail(To => $MAIL_RECIP,
	         From => $MAIL_SENDER,
			 Subject => "Registration",
			 "Content-Type" => "text/plain; charset=utf-8",
			 "Content-Transfer-Encoding" => "7bit",
			 Message => $mail) or die $Mail::Sendmail::error;
	
	return;
}


sub page_process {
	my($ctx, $path) = @_;
	
	my $page;
	open(my $fh, $path) or die "$path: $!\n";
	{ local $/ = undef; $page = <$fh>; }
	close $fh;
	
	$page =~ s/{{(\w+)\s*(.*?)}}/process_directive($ctx, $1, $2)/sge;
	
	return $page;
}


sub parse_opts {
	my($opts) = @_;
	my %opts;
	
	while ($opts =~ s/^([^=]+)="(.*?)"\s*// || $opts =~ s/^([^=]+)=(\S+)\s*//) {
		$opts{$1} = $2;
	}
	
	return %opts;
}


sub process_directive {
	my($ctx, $func, $args) = @_;
	
	no strict "refs";
	"process_dir_$func"->($ctx, $args);
}


sub process_dir_start_form {
	return $cgi->start_form;
}


sub process_dir_end_form {
	return $cgi->end_form;
}


sub process_dir_input {
	my($ctx, $args) = @_;
	my %opts = parse_opts($args);
	my $s;
	
	if ($opts{reqvar}) {
		$opts{required} = $ctx->{$opts{reqvar}};
	}
	
	if ($ctx->{cmd} eq "check") {
		$s .= $cgi->hidden(-name      => $opts{name});
		$s .= $cgi->escapeHTML($cgi->param($opts{name}));
	} else {
		$s .= $cgi->textfield(-name      => $opts{name},
							  -size      => $opts{size} || 40,
							  -maxlength => $opts{maxlength} || 200);
	}

	if ($opts{atitle}) {
		if ($ctx->{cmd} eq "reinput" &&
			$opts{required} &&
			strip($cgi->param($opts{name})) eq "")
		{
			$s .= "<span style=\"color: #f00\">" . $cgi->escapeHTML($opts{atitle}) . "</span>";
		} else {
			$s .= $cgi->escapeHTML($opts{atitle});
		}
	}
	
	return $s;
}


sub process_dir_tinput {
	my($ctx, $args) = @_;
	my %opts = parse_opts($args);
	
	if ($ctx->{cmd} eq "check" && $cgi->param($opts{name}) =~ /^\s*$/) {
		return "";
	}
	
	my $s = "<tr><td>";
	if ($ctx->{cmd} eq "reinput" &&
		$opts{required} &&
	    $cgi->param($opts{name}) =~ /^\s*$/)
	{
		$s .= "<span style=\"color: #f00\">" . $cgi->escapeHTML($opts{title}) . "</span>";
	} else {
		$s .= $cgi->escapeHTML($opts{title});
	}
	$s .= "</td><td>";
	

	if ($ctx->{cmd} eq "check") {
		$s .= $cgi->hidden(-name => $opts{name});
		$s .= $cgi->escapeHTML($cgi->param($opts{name}));
	} else {
		$s .= $cgi->textfield(-name      => $opts{name},
							  -size      => $opts{size} || 40,
							  -maxlength => $opts{maxlength} || 200);
	}

	$s    .= "</td></tr>";
	
	return $s;
}


sub process_dir_include {
	my($ctx, $args) = @_;
	my($path, $opts) = split /\s+/, $args, 2;
	
	$ctx = { %$ctx, parse_opts($opts) };

	while ($opts =~ s/^([^=]+)="(.*?)"\s*// || $opts =~ s/^([^=]+)=(\S+)\s*//) {
		$ctx->{$1} = $2;
	}
	
	$path =~ s/\W//g;
	return page_process($ctx, "$path.html");
}


sub process_dir_var {
	my($ctx, $var) = @_;
	return $cgi->escapeHTML($ctx->{$var});
}


sub process_dir_param {
	my($ctx, $var) = @_;
	return $cgi->escapeHTML($cgi->param($var));
}


sub process_dir_error {
	my($ctx) = @_;
	return "" unless ($ctx->{error});
	return "<p style=\"color: #f00\">".$cgi->escapeHTML($ctx->{error})."</p>";
}


sub process_dir_reqspan {
	my($ctx, $args) = @_;
	my %opts = parse_opts($args);
	
	if ($ctx->{cmd} eq "reinput" &&
	    $cgi->param($opts{name}) =~ /^\s*$/)
	{
		return "style=\"color: #f00\"";
	}
	
	return "";
}