use strict;
use warnings;
use CGI qw( -unique_headers );
use CGI::Carp qw( fatalsToBrowser );
use Mail::Mailer;

my $recipient_email = 'someone@anywhere.org';
my $recipient_name = 'John Doe';
my $doc_title = "Contact".$recipient_name;
my $script = "selfmailer.cgi";
my ($top_form, $bottom_form);

BEGIN {
    my ($tof_file, 
        $bof_file) = (    '',
                        '../site_templates/bof.shtml' );
    my @templates;
    foreach ($tof_file, $bof_file) {
        if ( $_ ) {
            my $fh;
            local $/ = undef;
            open $fh, "<$_" or die "Can't open $_: $!\n";
            my $template = <$fh>;
            close $fh or die "Can't close $_: $!\n";
            push @templates, $template;
        } else {
            push @templates, '';
        }
    }
    ($top_form, $bottom_form) = @templates;    
    
    sub carp_error {
        my $error_message = shift;
        my $err = new CGI;
        print    $err->header( "text/html" ),
                $err->start_html( "Error" ),
                $err->h1 ( "Error" ),
                $err->p( "Sorry, the following error occurred: "),
                $err->p( $err->i( $error_message ) ),
                $err->br,
                $err->p( $bottom_form ),
                $err->end_html;
    }
    CGI::Carp::set_message( \&carp_error );
}

$ENV{PATH} = '';
my $q = new CGI;

SWITCH: {
    !$q->param() && do {
        print_mail_form( $q, $doc_title, 
                         $recipient_name, $bottom_form );
        last SWITCH;
    };
    $q->param('Send') && do {
        if ( validate_input($q) ) {
            send_message(    $q,
                            $recipient_email,
                            $q->param("Sender"),
                            $q->param("From"),
                            $q->param("Subject"),
                            $q->param("Message")    );
            success ( $q, $bottom_form, $recipient_name );
        } else {
            output_error( $q, $doc_title, 
                          "All fields must be filled in.",
                          $bottom_form );
        }
        last SWITCH;
    };
    output_error( $q, $doc_title,
                  "Unrecognized form data.",
                  $bottom_form );
}
$q->delete_all();


sub print_mail_form {
    my ( $q, $title, $recipient, $bof ) = @_;
    print    $q->header( "text/html" ),
            $q->start_html( $title ),
            $q->h1( $title ),
            $q->hr,
            $q->p(    "You may use this form to send an email message 
+",
                    "to $recipient.  Please include your name and ",
                    "email address." ),
            $q->start_form( -action => $q->url(), -method => "POST" ),
            $q->p(    "Name: ", 
                    $q->textfield(    -name => "Sender",
                                    -size => 20,
                                    -maxlength => 40)),
            $q->p(    "Email Address: ", 
                    $q->textfield(    -name => "From",
                                    -size => 40,
                                    -maxlength => 80 )),
            $q->p(    "Subject: ",
                    $q->textfield(    -name => "Subject",
                                    -size => 60,
                                    -maxlength =>80 ) ),
            $q->p(    "Message:" ),
            $q->textarea(    -name => "Message",
                            -cols => 60,
                            -rows => 16 ),
            $q->submit(    -name => "Send",
                        -value => "Send" ),
            $q->reset(),
            $q->p( $bof ),
            $q->end_html;
}

sub output_error {
    my ( $q, $title, $text, $bof ) = @_;
    print    $q->header( "text/html" ),
            $q->start_html( "$title Error" ),
            $q->h1( "Error:" ),
            $q->br,
            $q->p( "The $title form encountered an error." ),
            $q->p( $text ),
            $q->p( "If you wish you may ",
                    $q->a( { -href => $q->url() },
                        "return to the mailer." )),
            $q->p( $bof ),
            $q->end_html;
}


sub validate_input {
    my $q = shift;
    foreach my $parameter ( 'Sender', 'From', 'Subject', 'Message' ) {
        return 0 if not $q->param( $parameter );
        my $param = $q->param($_);
        if ( $_ eq 'From' ) {
            $param =~ s/[~`#]//;
            $q->param($_,$param);
        }
    }
    return 1;
}


sub send_message {
    my (    $q, 
            $recipient_addr, 
            $sender_name, 
            $sender_email, 
            $subject,
            $message )        = @_;
    my $mail = new Mail::Mailer;
    $mail->open( {
        To        => $recipient_addr,
        From    => $sender_email,
        Subject    => "[Perlmonk Contact] " . $subject
    } ) or die "Can't open mail transport system: $!\n";
    print $mail $message;
    close $mail or die "Can't close mail transport session: $!\n";
}

sub success {
    my ( $q, $bof, $recipient_name )= @_;
    print    $q->header( "text/html" ),
            $q->start_html( "Success" ),
            $q->h1("Success"),
            $q->h3("Here is how your message appeared."),
            $q->p("To: $recipient_name"),
            $q->p("From: ",$q->param('Sender')," <",
                  $q->param('From'),">"),
            $q->p("Subject: [Perlmonk Contact] ",
                  $q->param('Subject')),
            $q->p("Message:",$q->br, $q->param('Message')),
            $q->p($bof),
            $q->end_html;
}
[download]