#!/usr/local/bin/perl

#=============================================================================#
#									      #
#  This CGI script submits comments to the Ken Kopp's comment board.	      #
#									      #
#=============================================================================#
#									      #
#  Both old and new comments files must be world-writeable.		      #
#  									      #
#=============================================================================#
#  Author:  Don Thomson							      #
#=============================================================================#

use strict;

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

my($Comment_Dir, $Comment_File, $Mail_To, $Test, $Title, %Fields);

my $SEND_MAIL = 1;
my $KEN_KOPPS_DIR = 'ken_kopps';


#=============================================================================#
#  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
	    ? 'dthomson@fammed.wisc.edu'
	    : 'webmaster@dmna.org';

    $Mail_To = 'dthomson@fammed.wisc.edu';  #debug

    $Comment_Dir = 
	$test_host
	    ? "/home/httpd/html/$KEN_KOPPS_DIR"
	    : "/home/fullfeed/dmna/html/$KEN_KOPPS_DIR";


    $Comment_File = 
	$Test 
	    ? 'test.shtml'
            : 'comments.shtml';

    $Title = "Submit a Comment about Ken Kopp's Closing";

    %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   => 'Your Email Address',
	     label    => 'Submitter Email',
	     required => 0,
	     order    => 2,
	     },

	comment => 
	     {
	     label    => 'Comment',
	     required => 1,
	     order    => 3,
	     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 comment submission form				              #
#=============================================================================#

sub display_form
    {
    my $col_width = 50;

    my $submit_buttons = 
	$q->center($q->submit(-name=>'submit',
			      -value=>'Submit Comment') . "\n" . 
		   $q->reset(-value=>'Reset Form') . "\n") . "\n";
	
    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->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('comment', 1),

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

		    ), "\n",

          $submit_buttons,
	
          $q->endform;
    }


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

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

    my $str = prompt_str($field);

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

    $str .= ' ';

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

    return $q->td({-valign=>$valign},
		  $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 comment submission form			                      #
#=============================================================================#

sub submit_form
    {
    my @missing_fields = check_required_fields();

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

	      $q->h3('Your comment 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_comment();

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

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

			 $q->p, "\n",

			 $q->a({-href =>join('/', 
					     '',
					     $KEN_KOPPS_DIR, 
					     $Comment_File)},
			       'View Comments'), "\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 comment					                      #
#=============================================================================#

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

    my $date_time = date_time(time);

    my $old_comment_file = join('/', $Comment_Dir, $Comment_File);
    my $new_comment_file = 
	join('/', $Comment_Dir, join('.', $Comment_File, 'new'));

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

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

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

    my $new_fh = 
	new IO::File "+< $new_comment_file" or
	    die "Can't open '$new_comment_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->b(trim_whitespace($q->param('comment'))), "\n",
                  $q->p, "\n",
                  $q->param('submitter_name'), "\n";

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

    if ($submitter_email)
	{
	print $new_fh $q->br, "\n", 
	              $q->a({-href=>"mailto:$submitter_email"}, 
			    $submitter_email) , "\n";
	}

    print $new_fh $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_comment_file $old_comment_file") &&
	die "Can't copy '$new_comment_file' to '$old_comment_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: Ken Kopp's Comment Submission\n\n",

	           "Ken Kopp's Comment Submission\n\n",
	           '    (Submitted: ', $date_time, ' from: "', 
	           $q->remote_host, '")', "\n";

	foreach my $field 
	    (sort { $Fields{$a}{order} <=> $Fields{$b}{order} } keys %Fields)
		{
		$label = $Fields{$field}{label};
		
		$label = uc $label;

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

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

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

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

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


#=============================================================================#
#  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);
    }