#!/usr/local/bin/perl

# TODO:  Require either email or phone

#=============================================================================#
#									      #
#  This CGI script submits feedback to the transportation feedback board.     #
#									      #
#=============================================================================#
#									      #
#  Both old and new feedback files must be world-writeable.		      #
#  									      #
#=============================================================================#
#  Author:  Don Thomson							      #
#=============================================================================#

use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser confess);
use IO::File;

my($Feedback_Dir, $Feedback_File, $Mail_To, $Test, $Title, %Fields,
   %Streets);

my $SEND_MAIL = 1;
my $TRANSPORTATION_DIR = 'transportation';
my $NO_STREET = '--- No Street ---';


#=============================================================================#
#  Main body								      #
#=============================================================================#

my $q = new CGI;

initialize();

print $q->header;

print $q->start_html(-title=>$Title,
		     -bgcolor=>'#FFFFCC',
		     -link=>'#008000',
		     -vlink=>'#800080'), "\n";

display_file('header.html');

if ($q->param('submit')) 
    {
    submit_form();
    } 
else 
    {
    display_form();
    }

display_file('footer.shtml', '<!--#');

print $q->end_html;

exit;


#=============================================================================#
#  Perform initializations						      #
#=============================================================================#

sub initialize
    {
    my $local_host;

    chop($local_host = `hostname`);
    $local_host =~ s/\..*//;

    my $path_info = $q->path_info();

    $Test = 1 if $path_info =~ m|/test/*|;

    my $test_host = $local_host eq 'zack';

    $Mail_To = 
	$test_host || $Test
	    ? 'dthomson@fammed.wisc.edu'
	    : 'dthomson@fammed.wisc.edu, murriley@msn.com';

    $Feedback_Dir = 
	$test_host
	    ? "/home/httpd/html/$TRANSPORTATION_DIR"
	    : "/home/fullfeed/dmna/html/$TRANSPORTATION_DIR";

    $Feedback_File = 
	$Test 
	    ? 'test.shtml'
            : 'feedback.shtml';

    $Title = 'Transportation Feedback';

    %Streets =
	(
         a              => $NO_STREET, 
	 arbor          => 'Arbor Drive',
	 baltzell       => 'Baltzell Street',
	 briar_hill     => 'Briar Hill Road',
	 chapman        => 'Chapman Street',
	 commonwealth   => 'Commonwealth Avenue',
	 copeland       => 'Copeland Street',
	 crandall       => 'Crandall Street',
	 cross          => 'Cross Street',
	 edgewood_ave   => 'Edgewood Avenue',
	 edgewood_drv   => 'Edgewood Drive',
	 fox	        => 'Fox Avenue',
	 gilmore        => 'Gilmore Street',
	 glenway        => 'Glenway Street',
	 glenwood       => 'Glenwood Street',
	 gregory        => 'Gregory Street',
	 harrison       => 'Harrison Street',
	 keyes	        => 'Keyes Avenue',
	 knickerbocker  => 'Knickerbocker Street',
	 leonard        => 'Leonard Street',
	 lewis	        => 'Lewis Court',
	 minakwa        => 'Minakwa Drive',
	 monroe	        => 'Monroe Street',
	 odana	        => 'Odana Road',
	 pickford       => 'Pickford Street',
	 roberts        => 'Roberts Court',
	 south_prospect => 'South Prospect Avenue',
	 sheldon	=> 'Sheldon Street',
	 spooner	=> 'Spooner Street',
	 sprague	=> 'Sprague Street',
	 stockton	=> 'Stockton Street',
	 terry		=> 'Terry Place',
	 west_lawn	=> 'West Lawn Avenue',
	 western	=> 'Western Avenue',
	 woodrow	=> 'Woodrow Street',
	 wyota		=> 'Wyota Avenue',
	 );

    %Fields =
	(
	#    label      Label as it will appear on request form
        #    prompt     Longer prompt to be used in place of above on request
	#               form, but not on confirmation or emailed request
        #    composite  Field contains subfields (i.e. date pulldown menus)
	#    required   Set to 1 if field is required (or if it has 'select')
	#    str_sub    Subroutine that returns formatted field string
        #    newline    Print newline before contents when sending request
	#    order      Order in which field will appear on request form

	submitter_name => 
	     {
	     prompt   => 'Your name',
	     label    => 'Submitter Name',
	     required => 1,
	     order    => 1,
	     },

	submitter_email => 
	     {
	     prompt   => 'Email address',
	     label    => 'Submitter Email',
	     required => 0,
	     order    => 2,
	     },

	submitter_phone => 
	     {
	     label    => 'Phone number',
	     required => 0,
	     order    => 3,
	     },

	date => 
	     {
	     label     => 'Incident date', 
	     required  => 1,
	     composite => 1,
	     str_sub   => \&date_param,
	     order     => 4,
	     }, 

	time => 
	     {
	     label    => 'Incident time',
	     required => 1,
	     order    => 5,
	     },

	street1 => 
	     {
	     label    => 'Street at which incident occurred',
	     str_sub   => \&street_param,
	     order    => 6,
	     },

	street2 => 
	     {
	     label    => 'Nearest intersecting street',
	     str_sub   => \&street_param,
	     order    => 7,
	     },

	location => 
	     {
	     label    => 'Additional location description',
	     required => 0,
	     order    => 8,
	     newline  => 1,
	     },

	description => 
	     {
	     label    => 'Incident description',
	     required => 1,
	     order    => 9,
	     newline  => 1,
	     },
	 );
    }


#=============================================================================#
#  Open and display specifed file					      #
#=============================================================================#

sub display_file
    {
    my($file_name, $skip) = @_;

    $file_name = join('/', $ENV{DOCUMENT_ROOT}, $file_name);

    open(FILE,$file_name) || die "*** Unable to open file '$file_name' ***\n";

    my $line;

    while (defined($line = <FILE>)) 
	{
	next if $skip && $line =~ /$skip/;

	print $line;
	}

    close(FILE);
    }


#=============================================================================#
#  Display feedback submission form				              #
#=============================================================================#

sub display_form
    {
    my $col_width = 50;

    my $submit_buttons = 
	$q->center($q->submit(-name=>'submit',
			      -value=>'Submit Feedback') . "\n" . 
		   $q->reset(-value=>'Reset Form') . "\n") . "\n";
	
    my $street_values = [sort keys %Streets];

    print $q->center($q->h2($Title)), "\n",

          $Test ? $q->center($q->h3('...test...')) ."\n" : '',

          $q->startform, "\n",
          
          $submit_buttons, 

          '(', $q->strong('*'), ') Required Field', "\n",

          $q->p, "\n",

          $q->center($q->small("Your phone number and email address\n" .
                               "will not be made publicly available."), "\n",
		     ), "\n",

          $q->p, "\n",

          $q->table("\n",
		    $q->TR("\n",
			   label('submitter_name'),

			   $q->td($q->textfield(-name=>'submitter_name',
						-size=>$col_width)), "\n",
			   ), "\n",

		    $q->TR("\n",
			   label('submitter_email'),

			   $q->td($q->textfield(-name=>'submitter_email',
						-size=>$col_width)), "\n",
			   ), "\n",

		    $q->TR("\n",
			   label('submitter_phone'),

			   $q->td($q->textfield(-name=>'submitter_phone',
						-size=>20)), "\n",
			   ), "\n",

		    $q->TR("\n",
			   label('date'),

			   $q->td(date_popup_menu('date')), "\n",
			   ), "\n",

		    $q->TR("\n",
			   label('time'),

			   $q->td($q->textfield(-name=>'time',
						-size=>$col_width)), "\n",
			   ), "\n",

		    $q->TR("\n",
			   label('street1'),

			   $q->td($q->scrolling_list(-name=>'street1',
						     -values=>$street_values,
						     -labels=>\%Streets,
						     -size=> 1)),"\n",
			   ), "\n",

		    $q->TR("\n",
			   label('street2'),

			   $q->td($q->scrolling_list(-name=>'street2',
						     -values=>$street_values,
						     -labels=>\%Streets,
						     -size=> 1)),"\n",
			   ), "\n",

		    $q->TR("\n",
			   label('location'),

			   $q->td($q->textarea(-name=>'location',
					       -rows=>2,
					       -columns=>$col_width,
					       -wrap=>'physical')), "\n",
			   ), "\n",

		    $q->TR("\n",
			   label('description', 1),

			   $q->td($q->textarea(-name=>'description',
					       -rows=>10,
					       -columns=>$col_width,
					       -wrap=>'physical')), "\n",
			   ), "\n",
		    ), "\n",
          $submit_buttons,
	
          $q->endform;

    print $q->h4("What We'll Do With Your Information"), "\n",

"The Transportation Committee will discuss each concern registered here, and
determine what can realistically be done. We must caution you that many
problems are not entirely solvable, may run afoul of laws or city policies,
or may have to wait many years until a street is reconstructed. However, we
do have some short-term tools, the great cooperation of the new traffic
enforcement unit (TEST) of the Police Department, access to the small City
traffic calming (physically altering the street to slow cars) budget, and
cooperation of the City traffic engineering folks where a problem can be
solved with something simple like a sign. Often one of the best depends on
volunteer energy of people like yourself to educate travelers through our
neighborhood with signs and activities.\n";
    }


#=============================================================================#
#  Construct HTML label for a field					      #
#=============================================================================#

sub label
    {
    my($field, $top, $suppress_required) = @_;

    my $str = prompt_str($field);

    $str .= ':' if $str !~ /\?$/;

    $str .= ' ';

    my $valign = $top ? 'top' : 'center';

    return $q->td({-valign=>$valign},
		  ! $suppress_required && $Fields{$field}{required} 
		      ? $q->strong('*') : ' '
		  ) . "\n" .

	   $q->td({-valign=>$valign}, $q->strong($str)) . "\n";
    }


#=============================================================================#
#  Return the prompt string for a given field				      #
#=============================================================================#

sub prompt_str
    {
    my($field) = @_;

    my $str = $Fields{$field}{prompt};

    $str = $Fields{$field}{label} if ! $str;

    return $str;
    }


#=============================================================================#
#  Submit feedback submission form			                      #
#=============================================================================#

sub submit_form
    {
    my @missing_fields = check_required_fields();

    if (@missing_fields)
	{
	print $q->br, "\n",

	      $q->h3('Your feedback submission is missing the ' . 
		     'following required fields:'), "\n", $q->p, "\n",

              "<UL>\n";

	foreach my $field (@missing_fields)
	    { 
	    print $q->strong(prompt_str($field)), "\n", $q->p, "\n";
	    }

	print "</UL>\n",

	      $q->h3("Please use your browser's BACK button to go back " . 
		     "and fill in the required fields."),

              "\n";
	} 
    
    else 
	{
	submit_feedback();

	print $q->center($q->h3('Your feedback has been submitted.'), 
                         "\n",

			 $q->h3($q->i('Thank you!')), "\n",

			 $q->p, "\n",

			 $q->a({-href =>join('/', 
					     '',
					     $TRANSPORTATION_DIR, 
					     $Feedback_File)},
			       'View Feedback'), "\n",
			 ), "\n",

	      $q->p, "\n";
	}
    }


#=============================================================================#
#  Check query for inclusion of all required fields	      		      #
#=============================================================================#

sub check_required_fields
    {
    my($empty_value, $value, @missing_fields);

    foreach my $field 
	(sort { $Fields{$a}{order} <=> $Fields{$b}{order} } keys %Fields)
        {
	if ($Fields{$field}{composite})
	    {
	    $empty_value = 0;
	    }

	else
	    {
	    $value = trim_whitespace($q->param($field));

	    $empty_value = $value eq '';
	    }

	if ($Fields{$field}{required} && $empty_value)
	    { 
	    push(@missing_fields, $field);
	    }
	}

    return @missing_fields;
    }


#=============================================================================#
#  Submit feedback					                      #
#=============================================================================#

sub submit_feedback
    {
    my($label, $line, $newline, $sub, $value);

    my $date_time = date_time(time);

    my $old_feedback_file = join('/', $Feedback_Dir, $Feedback_File);
    my $new_feedback_file = 
	join('/', $Feedback_Dir, join('.', $Feedback_File, 'new'));

    my $submitter_name = trim_whitespace($q->param('submitter_name'));

    my $submitter_email = trim_whitespace($q->param('submitter_email'));

    open(OLD_FH, $old_feedback_file) || 
	die "Can't open '$old_feedback_file' ($!)";

    my $new_fh = 
	new IO::File "+< $new_feedback_file" or
	    die "Can't open '$new_feedback_file' ($!)";

    flock $new_fh, 2;
    seek $new_fh, 0, 0;
    truncate $new_fh, 0;

    while ($line = <OLD_FH>)
	{
	print $new_fh $line;

	last if $line =~ /<!-- start -->/;
	}

    print $new_fh $q->hr, "\n",
                  $q->p, "\n",

                  $q->table("\n",
			    $q->TR("\n",
				   label('date', 1, 1),

				   $q->td(date_param($q->param('date'))), "\n",
				   ), "\n",


			    $q->TR("\n",
				   label('time', 1, 1),

				   $q->td(trim_whitespace(
					  $q->param('time'))), "\n",
				   ), "\n",

			    $q->TR("\n",
				   label('description', 1, 1),

				   $q->td(trim_whitespace(
					  $q->param('description'))), "\n",
				   ), "\n",

			    empty_param('street1')
			        ? ''
			        : $q->TR("\n",
					 label('street1', 1, 1),
					 
					 $q->td(street_param('street1')), "\n",
					 ) . "\n",

			    empty_param('street2')

			        ? ''
			        : $q->TR("\n",
					 label('street2', 1, 1),
					 
					 $q->td(street_param('street2')), "\n",
					 ) . "\n",

			    empty_param('location')
			        ? ''
			        : $q->TR("\n",
					 label('location', 1, 1),
					 
					 $q->td(trim_whitespace(
						$q->param('location'))), "\n",
					 ) . "\n",
			    ), "\n",

                  $q->p({-align=>'right'},
			$q->font({-size=>'-1'}, $date_time), "\n",
			), "\n\n";

    while ($line = <OLD_FH>)
	{
	print $new_fh $line;
	}

    close $new_fh;

    system("/bin/cp $new_feedback_file $old_feedback_file") &&
	die "Can't copy '$new_feedback_file' to '$old_feedback_file' ($!)";

    if ($SEND_MAIL)
	{
	my $sendmail = '/usr/lib/sendmail -t';

	open(MAIL, "| $sendmail") || die "Can't fork $sendmail: $!\n";

	print MAIL "To: $Mail_To\n",
	           "Subject: Transportation Feedback Submission\n\n",

	           "Transportation Feedback Submission\n\n",
	           '    (Submitted: ', $date_time, ' from: "', 
	           $q->remote_host, '")', "\n";

	foreach my $field 
	    (sort { $Fields{$a}{order} <=> $Fields{$b}{order} } keys %Fields)
		{
		next if empty_param($field);

		$label = $Fields{$field}{label};
		
		$label = uc $label;

		if ($sub = $Fields{$field}{str_sub})  # Call sub to construct 
		                                      # string
		    { 
		    $value = &$sub($field);
		    }

		else
		    { 
		    $value = trim_whitespace($q->param($field));
		    }

		$newline = $Fields{$field}{newline};

		$label .= ': ';
		$label .= "\n\n" if $newline;

		print MAIL "\n", $label, $value;
		    
		print MAIL "\n" if $value !~ /\n$/;
		}
	
	close(MAIL);
	}
    }


#=============================================================================#
#  Determine whether this parameter is empty				      #
#=============================================================================#

sub empty_param
    {
    my($param) = @_;

    my $val = $q->param($param);

    my $empty;

    if ($param eq 'street1' || $param eq 'street2')
	{
	$empty = $Streets{$val} eq $NO_STREET;
	}

    elsif (! $Fields{$param}{composite})
	{
	$empty = trim_whitespace($val) eq '';
	}

    return $empty;
    }


#=============================================================================#
#  Trim leading and trailing whitespace from string			      #
#=============================================================================#

sub trim_whitespace
    {
    my($str) = @_;
    
    $str =~ s/^\s+|\s+$//g;

    return $str;
    }


#=============================================================================#
#  Create formatted date/time string from time value                          #
#=============================================================================#

sub date_time
    {
    my($time) = @_;

    my @MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @DAYS   = qw(Sun Mon Tue Wed Thu Fri Sat);

    my($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime($time);

    return sprintf("%s-%02d-%d (%s) %02d:%02d", $MONTHS[$mon], $mday, 
		   $year + 1900, $DAYS[$wday], $hour, $min);
    }


#=============================================================================#
#  Build a set of month/date selection popup menus			      #
#=============================================================================#

sub date_popup_menu
    {
    my($param_name) = @_;

    my %month_names = 
	(
	1  => 'January',
	2  => 'February',
	3  => 'March',
	4  => 'April',
	5  => 'May',
	6  => 'June',
	7  => 'July',
	8  => 'August',
	9  => 'September',
	10 => 'October',
	11 => 'November',
	12 => 'December',
	);

    my($current_day, $current_month, $current_year) = (localtime)[3, 4, 5];
    $current_year += 1900;
    $current_month += 1;

    my $month_button = 
	$q->popup_menu(-name=>join('_', $param_name, 'month'),
		       -values=>[1..12],
		       -labels=>\%month_names,
		       -default=>$current_month);
    my $day_button = 
	$q->popup_menu(-name=>join('_', $param_name, 'day'),
		       -values=>[1..31],
		       -default=>$current_day);
    my $year_button = 
	$q->popup_menu(-name=>join('_', $param_name, 'year'),
		       -values=>[$current_year .. $current_year + 1],
		       -default=>$current_year);

    return $month_button . $day_button . $year_button;
    }


#=============================================================================#
#  Convert args from pop-up dates to DD-MON-YY format 			      #
#=============================================================================#

sub date_param
    {
    my $param_name = 'date';

    return sprintf "%02d/%d/%d", 
                   $q->param(join('_', $param_name, 'month')),
                   $q->param(join('_', $param_name, 'day')),
                   $q->param(join('_', $param_name, 'year'));
    }


#=============================================================================#
#  Get street name					                      #
#=============================================================================#

sub street_param
    {
    my($param) = @_;

    my $street = $Streets{$q->param($param)};
    }