#!/usr/bin/perl
# Linux Picnic RSVP interface
# Copyright (c) 2006 by Ian Kluft
# Contributed to the South Bay Community Network (sbay.org) for the
# Linux Picnic
#
# This is free software released by the author under the GNU General Public
# License (GPL).  See the license at http://www.gnu.org/licenses/gpl.txt
#

use strict;
use lib "/usr/local/etc/picnx/perl";
use CGI qw( :standard :cgi-lib );
use CGI::Untaint;
use LinuxPicnic::RSVP;
use LinuxPicnic::RSVPQueries;

# check if any required CGI parameters are missing
sub missing_params
{
	my $cgi = shift;
	my @names = @_;
	my %params = $cgi->Vars;
	my ( @missing, $name );

	foreach $name ( @names ) {
		if (( !exists $params{$name} ) or length($params{$name}) == 0 )
		{
			push @missing, $name;
		}
	}
	return @missing;
}

# generate a random confirmation key string
sub gen_confirmation_key
{
	my ( $loop, $confirm_key );
	$loop = 0;
	START: if ( open ( RANDOM, "/dev/urandom" )) {
		my ( $random_bits );
		read RANDOM, $random_bits, 10;
		close RANDOM;
		$confirm_key = unpack "h20", $random_bits;
	}
	if ( ! defined $confirm_key ) {
		my $i;
		$confirm_key = "";
		for ( $i=0; $i<5; $i++ ) {
			$confirm_key .= sprintf "%04x",
				int(rand(65536))^int(rand(65536));
		}
	}

	if ( $loop > 100 ) {
		die "infinite loop detected in confirmation key generation\n";
	}

	# Make sure no duplicates are generated.
	# Barring coding errors, odds of this are worse than being struck
	# by lightning twice *and* winning the Lottery.  Make sure the code
	# above works in order to avoid the possibility of an infinite loop.
	if ( LinuxPicnic::RSVP::RSVP->search("confirm_key" => $confirm_key)) {
		$loop++;
		goto START;
	}

	# assumption at this point is that $confirm_key is unique

	return $confirm_key;
}

# process RSVP request
# parameters: ref to %params, which may be modified to send data to template
# returns array with template name and page title
sub process_rsvp
{
	my $cgi = shift;
	my $params_ref = shift;

	# look up unconfirmed status id
	my @status = LinuxPicnic::RSVP::Status->search( name => "unconfirmed" );
	my $status = $status[0];

	# insert RSVP record
	my $rsvp = LinuxPicnic::RSVP::RSVP->insert({
		"confirm_key" => gen_confirmation_key(),
		"status" => $status->id,
		"email" => $params_ref->{email},
		"city" => $params_ref->{city},
		"comment" => $params_ref->{comment},
		"travel_mode" => $params_ref->{travel_mode},
		(( exists $params_ref->{arr_time} )
			and $params_ref->{arr_time} ne "unknown" )
			? ( "arr_time" => $params_ref->{arr_time})
			: (),
		(( exists $params_ref->{dep_time} )
			and $params_ref->{dep_time} ne "unknown" )
			? ( "dep_time" => $params_ref->{dep_time})
			: (),
		( exists $params_ref->{open_seats} )
			? ( "open_seats" => $params_ref->{open_seats})
			: (),
		"need_shuttle" =>
			(( exists $params_ref->{need_shuttle} )
			and length($params_ref->{need_shuttle}) > 1 )
			? $params_ref->{need_shuttle} : "n",
		"need_ride" =>
			(( exists $params_ref->{need_ride} )
			and length($params_ref->{need_ride}) > 1 )
			? $params_ref->{need_ride} : "n",
		( exists $params_ref->{shuttle_loc} )
			? ( "shuttle_loc" => $params_ref->{shuttle_loc})
			: (),
		});

	# insert primary guest record
	my @guests;
	$guests[0] = LinuxPicnic::RSVP::Guest->insert({
		"rsvp" => $rsvp,
		"first_name" => $params_ref->{first_name},
		"last_name" => $params_ref->{last_name},
		"is_rsvp_contact" => "true",
		"grill" => $params_ref->{grill},
		"tshirt" => $params_ref->{tshirt},
		( exists $params_ref->{nickname} )
			? ( "nickname" => $params_ref->{nickname}) : (),
		( exists $params_ref->{callsign} )
			? ( "callsign" => $params_ref->{callsign}) : (),
		});

	# insert additional guest records, if any
	my ( $i, $key, $max );
	$max = 9;
	if (( exists $params_ref->{additional_guests})
		and $params_ref->{additional_guests} < 9 )
	{
		$max = $params_ref->{additional_guests};
	}
	GUEST: for ( $i=1; $i<=$max; $i++ ) {
		my %fields;

		# if there's no guest data for this slot then no more guests
		foreach $key ( "first_name", "last_name", "grill", "tshirt" ) {
			if ( !exists $params_ref->{"g".$i."_".$key}) {
				last GUEST;
			}
			$fields{$key} = $params_ref->{"g".$i."_".$key};
		}

		# optional fields
		foreach $key ( "nickname", "callsign" ) {
			if ( exists $params_ref->{"g".$i."_".$key}) {
				$fields{$key} = $params_ref->{"g".$i."_".$key};
			}
		}

		# insert guest record
		my $guest = LinuxPicnic::RSVP::Guest->insert({
			"rsvp" => $rsvp,
			"first_name" => $fields{first_name},
			"last_name" => $fields{last_name},
			"is_rsvp_contact" => "false",
			"grill" => $fields{grill},
			"tshirt" => $fields{tshirt},
			( exists $fields{nickname} )
				? ( "nickname" => $fields{nickname}) : (),
			( exists $fields{callsign} )
				? ( "callsign" => $fields{callsign}) : (),
			});
		push @guests, $guest;

		# look up numeric parameters  so we can report readable status
		foreach ( [ "LinuxPicnic::RSVP::GrillSelection", "grill" ],
			[ "LinuxPicnic::RSVP::TShirtSize", "tshirt" ],
		) {
			my ( $class, $var ) = @$_;
			if ( exists $fields{$var}) {
				my @var_recs = $class->search( "id" => $fields{$var});
				if ( @var_recs
					and $var_recs[0]->name ne "none selected" )
				{
					$params_ref->{"g$i\_$var\_expanded"}
						= $var_recs[0]->name;
				}
			}
		}

	}

	# save a parameter to tell Template Toolkit how many guests we found
	# note: subtract out the primary guest
	$params_ref->{"guests_defined"} = scalar(@guests) - 1;

	# save a function to help Template Toolkit look up guest info
	$params_ref->{"guest"} = sub {
		return $params_ref->{"g".$_[0]."_".$_[1]};
	};

	# create log entry
	my $log = LinuxPicnic::RSVP::RecordLog->insert({
		"rsvp" => $rsvp,
		"is_modify" => "false",
		"time" => "now",
		"ip" => $params_ref->{remote_addr},
		});

	# send confirmation e-mail
	my %vars = (
		"to" => $params_ref->{email},
		"subject" => "Picn*x 16 RSVP confirmation",
		"bcc" => "picnx16_rsvp\@linuxpicnic.org",
		"confirm_url" => $cgi->url()."?mode=confirm&key="
			.$rsvp->confirm_key."&id=".$rsvp->id,
	);

	# make CGI parameters available but don't allow them to overwrite stuff
	my ( $name, $value );
	while (( $name, $value ) = each %$params_ref ) {
		if ( $name eq "to" or $name eq "cc" or $name eq "bcc"
			or $name eq "subject" or $name eq "confirm_url" )
		{
			next;
		}
		if ( !exists $vars{$name}) {
			$vars{$name} = $value;
		}
	}
	LinuxPicnic::RSVP->send_email(
		"template" => "confirm_email",
		"vars" => \%vars );

	# return with page to display
	return ( "guest_form3", "Picn*x 16 RSVP - Confirm Via E-mail" );
}

# process city and possible insertion of a new city into the database
sub process_city
{
	my $params_ref = shift;
	my @none_city = LinuxPicnic::RSVP::City->search( name => "none selected" );
	my $none_city = $none_city[0];

	# process city
	if (( exists $params_ref->{city}) or exists $params_ref->{new_city}) {
		if ( $params_ref->{city} == $none_city->id
			and exists $params_ref->{new_city}
			and length $params_ref->{new_city} > 0)
		{
			my $new_city = $params_ref->{new_city};

			# collapse whitespace
			$new_city =~ s/\s+$//;
			$new_city =~ s/^\s+//;
			$new_city =~ s/\s+/ /g;

			# reject illegal characters
			if ( $new_city =~ /[^a-z0-9,. -]/i ) {
				delete $params_ref->{new_city};
				return;
			}

			# correct all-caps or all-lower
			if ( $new_city =~ /^[A-Z\s,]*$/
				or  $new_city =~ /^[a-z\s,]*$/ )
			{
				$new_city = ucfirst(lc($new_city));
				if ( $new_city =~ /, ([A-Z][a-z])$/i ) {
					my $uc_state = uc($1);
					$new_city =~ s/, ([A-Z][a-z])$/, $uc_state/i;
				}
			}

			# parse for a state/province/country
			my $default_state = LinuxPicnic::RSVP::Config->get_var( "default_state" ) or "CA";
			if ( $new_city =~ /,/ ) {
				# got something
				my ( $local, $region ) = split ( /, */,
					$new_city, 2 );
				# capitalize only first letter of words
				$local = lc($local);
				$local =~ s/\b(\w)/uc($1)/eg;
				if ( $region =~ /^[a-z]{2}$/i ) {
					$region = uc($region);
				} else {
					# capitalize only first letter of words
					$region = lc($region);
					$region =~ s/\b(\w)/uc($1)/eg;
				}
				$new_city = $local.", ".$region;
			} else {
				# no state?

				# capitalize only first letter of words
				$new_city = lc($new_city);
				$new_city =~ s/\b(\w)/uc($1)/eg;
				
				# assume default state
				$new_city .= ", $default_state";
			}

			# check if this exists
			my @matches = LinuxPicnic::RSVP::City->search(
				name => $new_city );
			if ( @matches ) {
				$params_ref->{city} = $matches[0]->id;
			} else {
				my $city = LinuxPicnic::RSVP::City->insert({ name => $new_city });
				$params_ref->{city} = $city->id;
			}
		}
	}

}

#
# main
#

# set up CGI environment
my $cgi = CGI->new();
my $untaint_vars = CGI::Untaint->new( $cgi->Vars );
my $path = $cgi->path_info();
$path =~ s=/$==;
my @path = split( '/', $path );
shift @path;
my ( $page, $title, @warnings, @missing, @add_vars );
my %vars = $cgi->Vars();

# assemble list of field names and their types to untaint from CGI input
my ( %params, $var, @fields, $i );
foreach $var ( "mode", "first_name", "last_name", "email", "city",
	"new_city", "comment", "arr_time", "dep_time", "key", "nickname",
	"callsign" )
{
	push @fields, [ $var => "printable" ];
}
foreach $var ( "grill", "tshirt", "additional_guests", "travel_mode",
	"open_seats", "need_ride", "need_shuttle", "shuttle_loc", "id" )
{
	push @fields, [ $var => "integer" ];
}
for ( $i=1; $i<=9; $i++ ) {
	push @fields, [ "g".$i."_first_name" => "printable" ];
	push @fields, [ "g".$i."_last_name" => "printable" ];
	push @fields, [ "g".$i."_grill" => "integer" ];
	push @fields, [ "g".$i."_tshirt" => "integer" ];
	push @fields, [ "g".$i."_nickname" => "printable" ];
	push @fields, [ "g".$i."_callsign" => "printable" ];
}
foreach $var ( @fields ) {
	if ( exists $vars{$var->[0]}) {
		$params{$var->[0]} = $untaint_vars->extract( 
			"-as_".$var->[1] => $var->[0]);
	}
}
$params{remote_host} = $cgi->remote_host();
$params{remote_addr} = $cgi->remote_addr();

# determine which pages to print and set up data
if ( !exists $params{mode} ) {
	# initial form
	$page = "guest_form1";
	$title = "Picn*x 16 RSVP Form";
} elsif ( $params{mode} eq "guest_entry" ) {
	# we got a sumbission from a form

	# look up numeric parameters  so we can report readable status
	foreach ( [ "LinuxPicnic::RSVP::City", "city" ],
		[ "LinuxPicnic::RSVP::GrillSelection", "grill" ],
		[ "LinuxPicnic::RSVP::TShirtSize", "tshirt" ],
		[ "LinuxPicnic::RSVP::TravelMode", "travel_mode" ],
		[ "LinuxPicnic::RSVP::ShuttleLoc", "shuttle_loc" ],
	) {
		my ( $class, $var ) = @$_;
		if ( exists $params{$var}) {
			my @var_recs = $class->search( "id" => $params{$var});
			if ( @var_recs
				and $var_recs[0]->name ne "none selected" )
			{
				$params{$var."_expanded"} = $var_recs[0]->name;
			}
		}
	}

	# use submitted variables to determine which page/form to display
	my @dups;
	if ( @missing = missing_params( $cgi, "first_name", "last_name",
		"email", "grill", "additional_guests" ))
	{
		# form is incomplete
		$page = "guest_form1";
		$title = "Picn*x 16 RSVP Form - Enter Guest Information";
		push @warnings,
			"Missing fields need to be filled in: "
				.join( ", ", @missing );
	} elsif ( @dups = LinuxPicnic::RSVP::RSVP->search( email => $params{email})) {
		# e-mail address already exists
		$page = "guest_form1";
		$title = "Picn*x 16 RSVP Form - Enter Guest Information";
		push @warnings,
			"e-mail address ".$params{email}
				." already registered - send mail to "
				.LinuxPicnic::RSVP::Config->get_var("admin_mail")
				." to update or cancel";

	} elsif (( exists $params{additional_guests})
		and ( ! exists $params{key})
		and $params{additional_guests} > 0
		and @missing = missing_params( $cgi, "g1_first_name",
			"g1_last_name", "g1_grill" ))
	{
		# completed first page but need additional guest info

		# handle new city if necessary
		process_city( \%params );

		# need info on additional guests
		$page = "guest_form2";
		$title = "Picn*x 16 RSVP Form - Enter Additional Guests";
		push @add_vars,
			"guests" => $params{additional_guests};
	} else {
		# RSVP data submission

		# handle new city if necessary
		process_city( \%params );

		# got everything - process the RSVP
		( $page, $title ) = process_rsvp( $cgi, \%params );
	}
} elsif ( $params{mode} eq "confirm" ) {
	# handle confirmation
	my @c_rsvps;
	if ( @missing = missing_params( $cgi, "key", "id" )) {
		# parameters are missing
		$page = "confirm_error";
		$title = "Missing Parameters - Confirmation not complete";
	} elsif ( @c_rsvps = LinuxPicnic::RSVP::RSVP->search(
			"confirm_key" => $params{key}, "id" => $params{id}))
	{
		# got some results - only valid if we found one
		if (( scalar @c_rsvps ) == 1 ) {
			# got one - results are valid
			my @status = LinuxPicnic::RSVP::Status->search( name => "confirmed" );
			my $status = $status[0];
			$c_rsvps[0]->status( $status );
			$page = "confirm_complete";
			$title = "Confirmation complete";
		} else {
			# got more than one record?  bail out...
			$page = "confirm_error";
			$title = "Too many records - Confirmation not complete";
		}
	} else {
		# no matching confirmation was found
		$page = "confirm_error";
		$title = "Record not found - Confirmation not complete";
	}
	
} elsif ( $params{mode} eq "guest_list" ) {
	# display the guest list
	$page = "guest_list";
	$title = "Picn*x 16 Guest List";

	# perform the query for a web guest list
	my @guest_list = LinuxPicnic::RSVP::RSVP->search_guest_list_web();
	push @add_vars, "guest_list" => \@guest_list;

	# set the template
	$page = "guest_list";
	$title = "Picn*x 16 Guest List";
} else {
	# unknown command parameter
	$page = "unknown";
	$title = "Software error - unknown page content selected";
}

# give the template access to all the filtered (untainted) CGI parameters
while (( my $key, my $value ) = each %params ) {
	push @add_vars, $key => $value;
}

# if there are any warning messages, add them to the page
if ( @warnings ) {
	push @add_vars,
		"warnings" => \@warnings;
}

# print selected page
$cgi->cache(1);	# set no-cache flag
print $cgi->header()."\n";
#foreach my $key ( sort keys %params ) {
#	print "$key = ".$params{$key}."<br>\n";
#}
my %vars = (
	"cgi" => $cgi,
	"title" => $title,
	@add_vars,
);
print LinuxPicnic::RSVP->output(
	"template" => "$page",
	"vars" => \%vars,
);