#!/usr/local/bin/perl
#
#    Copyright (c) 1994  San Diego Supercomputer Center (SDSC)
#                  A division of General Atomics
#                    San Diego, California, USA
#
#  Users and possessors of this source code are hereby granted a
#  nonexclusive, royalty-free copyright and design patent license to
#  use this code in individual software.  License is not granted for
#  commercial resale, in whole or in part, without prior written
#  permission from SDSC.  This source is provided "AS IS" without express
#  or implied warranty of any kind.
#
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.
#
#
# **************************************************************
#      ___             ___  _                  ___           
#     / __> ___ ._ _  | . \<_> ___  ___  ___  | . > ___  _ _ 
#     \__ \<_> || ' | | | || |/ ._>/ . |/ . \ | . \<_> || | |
#     <___/<___||_|_| |___/|_|\___.\_. |\___/ |___/<___|`_. |
#                                  <___'                <___'
#      ___            _             _   
#     | . \ _ _  ___ <_> ___  ___ _| |_ 
#     |  _/| '_>/ . \| |/ ._>/ | ' | |  
#     |_|  |_|  \___/| |\___.\_|_. |_|  
#                   <__'                
#                                      
#   Program name:          Enter.cgi
#   Description:           Edits and Views metadata files.
#                          
#                                    
#   Written by:            David Martinez   
#
#   Latest revision:       12/16/97
#                                       
#   If you have any questions/comments, you can contact
#   me via email: damartin@sdsc.edu 
#
# **************************************************************

require 5.001;
require "cgi-lib.pl";
##require '/misc/www/projects/ecodata/cgi-bin/Subroutines/diehtml.cgi';



MAIN:
{

# **************************************************************
#
# In a post form, the length of the input is given in the environment
# variable CONTENT_LENGTH.  The method does NOT send an EOF at the end
# of the input, so the length must be used to determine when the
# end of input has been reached.
#
# **************************************************************
# Static variables
#

    $debug=1;
    $TRUE = 1;
    $FALSE = 0;
# **************************************************************

if ( $ENV{REQUEST_METHOD} eq "POST" ) {

    read (STDIN, $GN_QUERY, $ENV{CONTENT_LENGTH}); # Read data

    # The fields defined/named in your FORM input directives are delimited
    # in the $GN_QUERY variable by ampersands "&". The following statement
    # creates the @QUERY_LIST array.

    @QUERY_LIST = split( /&/, $GN_QUERY); # Split data into different fields

    foreach $item (@QUERY_LIST) {
        $item =~ s/\+/ /g;                   # Convert plus's into spaces
        $item =~ s/%(..)/pack("c",hex($1))/ge; # Convert %XX from hex to char

        # I can't use ($param, $value) = split (/=/, $item)
        # because the key or value might contain an equal sign which will cause
        # a problem.

        $loc=index($item,"=");
        $param=substr($item, 0, $loc);

	
	# **************************************************************
	#	I	Build list of keywords from the input form
	#
	# **************************************************************

        $value=substr($item, $loc+1);

    	if (($value =~ /^\s*$/)||($value eq "")) { ## test for white space or null characters
            $value = "TBD";
            ##print "keyword=$param, value=$value##<br>\n";
    	}

	$QUERY_ARRAY{$param} .= $value;
	if ($debug) {
	    print FORMDATA "keyword=$param, value=$value\n";
	}

        if ( (! grep( /$param/, @keywords)) && (! grep( /$param/, @omit)) ) {
            push (@keywords, $param );
	    if ($debug) {
		print FORMDATA "keyword=$param, value=$value\n";
	    }
	}
    } # end foreach $item (@QUERY_LIST)
}


    # Load packages
    use CGI;
    use Mail::Internet;
    use Mail::Address;
    use Net::SMTP;
    use LWP::UserAgent;
    
    # output NOT buffered
    $| = 1;   

    # Set the SMTP mailhost 
    $mailhost = "mailserver.sdsc.edu";

    # Create a new CGI object
    $message = new CGI;

    # Create a new mail object
    $mail = new Mail::Internet;

    # Create a Net::SMTP object which opens an SMTP
    # connection to the mailhost (mailserver.sdsc.edu)
    # This sends the SMTP 'HELO' command.
    $smtp = Net::SMTP->new( $mailhost );


    $param="from_name";
    $fromname=$QUERY_ARRAY{$param};
    $param="from_address";
    $fromaddr=$QUERY_ARRAY{$param};

    ##$realaddr="hellyj\@sdsc.edu";
    $realaddr="damartin\@genie.sdsc.edu";
    $sender="";
    $subject="REVIEWER'S FORMS";


    if ($fromaddr eq "TBD") { 
        &PrintHTMLHead;
        print $message->p( "Sorry, you must enter a valid email address.");
        print $message->end_html;
        exit;
    }
    else {
        $sender = $fromname."<".$fromaddr.">";
        $mail->add( From=> "$sender" );
    }

    $to =  $realaddr;
    $mail->add( To=> "$to" ); 

    $replyto = ""; 
    $mail->add( 'Reply-To'=> "$replyto" ); 

    $cc = ""; 
    $mail->add( Cc=> "$cc" ); 

    $subject = "REVIEWER'S FORMS";
    $mail->add( Subject=> "$subject" ); 


    # Assign message body 
    $body= "";
    $body_html="";
    foreach $item (@QUERY_LIST) {
        $body = $body.$item."\n";
    }
 

    # Push the message body into an array 
    # The Mail::Internet package body function 
    # requires an array as input 
    push( @text, $body );

    # Store @text in the message body
    $mail->body( \@text );

    # Assign the From address
    $smtp->mail( "$sender" ) 
           || die $smtp->message;

    # Assign the To:, Reply-To:, Cc:, and Bcc: addresses
    my @rcpt = ( $mail->get('To', 'Reply-To', 'Cc', 'Bcc'));

    # Objectify  the address(es) so that they 
    # are digestible by the SMTP object
    my @addr = map( $_->address, Mail::Address->parse(@rcpt));

    # Tell the SMTP object the recipient address
    $smtp->to(@addr) 
           || die $smtp->message;

    # Create the message as a single chunk of text
    my $text = join( "", @{$mail->header},
           "\n", @{$mail->body});

    # Send the message to the SMTP server
    $smtp->data( $text ) 
           || die $smtp->message;

    # Close the SMTP connection
    $smtp->quit;


    print "Content-type: text/html\n";
    print "\n";
    print "<HTML>\n";
    print "<HEAD>\n";
    print "<TITLE>Ecological Archives Reviewer Forms<\/TITLE>\n";
    print "<\/HEAD>\n";
    print "<BODY BGCOLOR=\"#c1c1c1\">\n";
    print "Your information has been successfully submitted<br>\n";

    $realfrom = $ENV{'REMOTE_HOST'};
    $realfrom = $ENV{'REMOTE_ADDR'};
    exit( 0 );


} # End MAIN





##############################################################################
#                                  SUBROUTINES
##############################################################################

##############################################################################
# Print HTTP header and HTML and BODY tags
sub PrintHTMLHead {
   print $message->header;
   print $message->start_html(-title =>'sendmail.cgi output', -bgcolor=>'#ffffff', -text => '#000000'), "\n";
}

##############################################################################
# Print transaction report and trailing BODY and HTML tags
sub PrintHTMLReport {

   print $message->start_html(-title =>'WWW Mail Transaction Report',
                              -bgcolor=>'#ffffff',
                              -text => '#000000',
                              -link => '#0000ff',
                              -vlink => '#b00000'
                             ), "\n";

   print $message->h1({align=>'center'}, "WWW Mail Transaction Report");
   print $message->h3("The sendmail.cgi gateway sent the following information to the SMTP server.");
   print $message->p("From: $sender");
   print $message->p("To: $to");
   if( $message->param( 'sm_replyto' ) ) { print $message->p("Reply-To: $replyto"); }
   if( $message->param( 'sm_cc' ) ) { print $message->p("Cc: $cc"); }
   if( $message->param( 'sm_bcc' ) ) { print $message->p("Bcc: $bcc"); }
   foreach $xheader ( keys( %xheaders ) ) {
     print $message->p( "$xheader: ", $message->param( "$xheader" ) ); 
   }
   if( $message->param( 'sm_subject' ) ) { print $message->p("Subject: $subject"); }
   if( $message->param( 'sm_body' ) ) { print $message->p("Body: $body"); }
   
   # Print trailing BODY and HTML tags 
   print $message->end_html;
}

##############################################################################
# Pass the parameter stream to another CGI script.
sub PassCGI( @passcgi ) {

   local( @passcgi = @_ );
   local( $location, $date, $server );
   $passcgi = pop( @passcgi );

   # Create an LWP::UserAgent object
   $ua = new LWP::UserAgent();
   $ua->agent("sendmail.cgi/0.1");

   # Create an HTTP::Request object
   my $request = new HTTP::Request 'POST', "$passcgi";

   $request->content_type('application/x-www-form-urlencoded');
   $request->content("$urlencodedstream");

   # Pass request to the user agent and 
   # store the response in a response object 
   my $response = $ua->request($request);

   # Check the outcome of the response
   if($response->is_success) {
     print $message->header;
     print( $response->content );
   } elsif( $response->is_info) {
     print $message->header;
     print( $response->as_string );
   } elsif( $response->is_redirect) { 
     # I'm positive this could be much cleaner
     # There has got to be a better way!!!
     $date     = $response->header( 'Date' );
     $server   = $response->header( 'Server' );
     $location = $response->header( 'Location' );
     print( "Date: $date\nServer: $server\nLocation: $location\n\n" );
   } elsif( $response->is_error) {
     print $message->header;
     print( $response->error_as_HTML );
   } else {
     &PrintHTMLHead;
     print $message->p( "This should never happen." );
   }
   exit( 0 );
}