package CGI::Application::Mailform; # Always use strict! use strict; # This is a CGI::Application module use CGI::Application; @CGI::Application::Mailform::ISA = qw/CGI::Application/; # Required, but not enforced by Makefile.PL! use Net::SMTP; use Carp; ############################################# ## OVERRIDE METHODS ## # Run when new() is called sub setup { my $self = shift; $self->mode_param('rm'); $self->start_mode('showform'); # Set up run-mode table. In a typical CGI::Application module, this would # contain multiple run-modes -- one for each think your app can do. # We're using sub-ref instead of name-ref to display more intuitive errors. # $self->run_modes( 'showform' => \&redirect_to_mailform, 'submitform' => \&submitform_and_sendmail, ); } # Called when run() is called. sub cgiapp_prerun { my $self = shift; my $runmode = shift; # Make sure the instance script is correct $self->validate_runtime(); } ############################################# ## RUN-MODE METHODS ## sub redirect_to_mailform { my $self = shift; # Set up the HTTP redirect my $redirect_url = $self->param('HTMLFORM_REDIRECT_URL'); return $self->do_redirect($redirect_url); } sub submitform_and_sendmail { my $self = shift; # Actually send out the email message $self->sendmail(); # Set up the HTTP redirect my $redirect_url = $self->param('SUCCESS_REDIRECT_URL'); return $self->do_redirect($redirect_url); } ############################################# ## PRIVATE METHODS ## # Perform an HTTP redirect sub do_redirect { my $self = shift; my $redirect_url = shift; $self->header_type( 'redirect' ); $self->header_props( -url => $redirect_url ); # Return HTML to the web browser my $redirect_html = "Continue: $redirect_url"; return $redirect_html; } # This method is to verify that the instance script (i.e., "mailform.cgi") # contains the correct configuration parameters. sub validate_runtime { my $self = shift; ## CHECK REQUIRED PARAMETERS # my $req_failed = 0; my @required_params = qw/ MAIL_FROM MAIL_TO HTMLFORM_REDIRECT_URL SUCCESS_REDIRECT_URL FORM_FIELDS /; foreach my $req_param (@required_params) { # Check each req param to verify that it is there unless ( defined($self->param($req_param)) && length($self->param($req_param)) ) { $req_failed++; carp("Required parameter '$req_param' not specified"); } else { # Especially check that FORM_FIELDS is an array-ref if (($req_param eq 'FORM_FIELDS') && (ref($self->param('FORM_FIELDS')) ne 'ARRAY')) { $req_failed++; carp("Required parameter 'FORM_FIELDS' is not an array reference"); } } } # Die if we have an invalid run-time configuration croak("Missing or invalid required parameters") if ($req_failed); ## CHECK OPTIONAL PARAMETERS / SET DEFAULT VALUES # my $opt_failed = 0; ## ENV_FIELDS # If undefined, define as null $self->param('ENV_FIELDS', []) unless (defined($self->param('ENV_FIELDS'))); # Now, check for validity unless (ref($self->param('ENV_FIELDS')) eq 'ARRAY') { $opt_failed++; carp("Parameter 'ENV_FIELDS' is not an array reference"); } ## SUBJECT my $subject = $self->param('SUBJECT'); unless (defined($subject) && length($subject)) { $subject = 'Form submission from ' . ($ENV{HTTP_REFERER} || $ENV{SCRIPT_NAME}); $self->param('SUBJECT', $subject); } ## SMTP_HOST $self->param('SMTP_HOST', '') unless (defined($self->param('SMTP_HOST'))); # Expect a scalar for SMTP_HOST. Other values will be deemed errors, # to prevent problems when interfacing with Net::SMTP. unless (ref($self->param('SMTP_HOST')) eq '') { $opt_failed++; carp("Parameter 'SMTP_HOST' is not a scalar"); } # Die if we have an invalid run-time configuration croak("Invalid optional parameters") if ($opt_failed); } # Establish SMTP connection sub connect_smtp { my $self = shift; my $smtp_host = $self->param('SMTP_HOST'); my $smtp_connection; if (length($smtp_host)) { # Use provided host $smtp_connection = Net::SMTP->new($smtp_host); croak("Unable to connect to '$smtp_host'") unless (defined($smtp_connection)); } else { # Use default host $smtp_connection = Net::SMTP->new(); croak("Unable to establish SMTP connection") unless (defined($smtp_connection)); } return $smtp_connection; } # This method actually generates and sends the email message via # SMTP, or die()s trying. sub sendmail { my $self = shift; # Get the CGI query object my $q = $self->query(); my $mailfrom = $self->param('MAIL_FROM'); my $mailto = $self->param('MAIL_TO'); my $subject = $self->param('SUBJECT'); # Get the message body my $msgbody = $self->build_msgbody(); # Connect to SMTP server my $smtp_connection = $self->connect_smtp(); # Here's where we "do the deed"... $smtp_connection->mail($mailfrom); $smtp_connection->to($mailto); # Enter data mode $smtp_connection->data(); # Send the message content (header + body) $smtp_connection->datasend("From: $mailfrom\n"); $smtp_connection->datasend("To: $mailto\n"); $smtp_connection->datasend("Subject: $subject\n"); $smtp_connection->datasend("\n"); $smtp_connection->datasend($msgbody); $smtp_connection->datasend("\n"); # Exit data mode $smtp_connection->dataend(); # Be polite -- disconnect from the server! $smtp_connection->quit(); } # Here's where the majority of the work gets done. # Based on the settings in the instance script and # the CGI form data, an email message body is created. sub build_msgbody { my $self = shift; # Get the CGI query object my $q = $self->query(); # The longest journey begins with a single step... my $msgbody = ''; ## Populate message body with form data # my $form_fields = $self->param('FORM_FIELDS'); my $ff_count = 1; $msgbody .= "The following data has been submitted:\n\n"; foreach my $field (@$form_fields) { $msgbody .= "$ff_count\. $field\:\n" . $self->clean_data($q->param($field)). "\n\n\n"; $ff_count++; } $msgbody .= "\n"; ## Populate message body with environment data # my $env_fields = $self->param('ENV_FIELDS'); # Do we actually have any env data requested? if (@$env_fields) { my $ef_count = 1; $msgbody .= "Form environment data:\n\n"; foreach my $field (@$env_fields) { $msgbody .= "$ef_count\. $field\:\n" . $self->clean_data($ENV{$field}). "\n\n\n"; $ef_count++; } } # Send back the complete message body return $msgbody; } # This method cleans up data for inclusion into the email message sub clean_data { my $self = shift; my $field_data = shift; # Set undef strings to a null string $field_data = '' unless (defined($field_data)); # Strip leading & trailing white space $field_data =~ s/^\s*//; $field_data =~ s/\s$//; # If we have no answer, put "[n/a]" in there. $field_data = '[n/a]' unless (length($field_data)); return $field_data; } ############################################# ## POD ## =pod =head1 NAME CGI::Application::Mailform - A simple HTML form to email system =head1 SYNOPSIS ## In "mailform.cgi" -- use CGI::Application::Mailform; # Create a new Mailform instance... my $mf = CGI::Application::Mailform->new(); # Configure your mailform $mf->param('MAIL_FROM' => 'webmaster@your.domain'); $mf->param('MAIL_TO' => 'form_recipient@your.domain'); $mf->param('HTMLFORM_REDIRECT_URL' => '/uri/or/url/to/mailform.html'); $mf->param('SUCCESS_REDIRECT_URL' => '/uri/or/url/to/thankyou.html'); $mf->param('FORM_FIELDS' => [qw/name address comments etc/]); # Optional variables $mf->param('SMTP_HOST' => 'mail.your.domain'); $mf->param('SUBJECT' => 'New form submission'); $mf->param('ENV_FIELDS' => [qw/REMOTE_ADDR HTTP_USER_AGENT/]); # Now run... $mf->run(); exit(0); ## In "mailform.html" --
## In "thankyou.html" --We have received your form, and we will get back to you shortly.
NOTE: It is not necessary that your HTML file be called 'thankyou.html'. You may name this file anything you like. The only naming limitation is that the name of this file should be correctly referenced in your 'mailform.cgi', in the variable 'SUCCESS_REDIRECT_URL'. =head2 Create 'mailform.cgi' The file 'mailform.cgi' is where all the functionality of CGI::Application::Mailform is configured. This file is referred to as a "CGI instance script" because it creates an "instance" of your form. A single website may have as many instance scripts as needed. All of these instance scripts may use CGI::Application::Mailform. They may each use a different form (with different fields, etc.) if desired. The ability to create multiple instances of a single application, each with a different configuration is one of the benefits of building web-based applications using the CGI::Application framework. Your instance script, 'mailform.cgi', must be created in such a way that it is treated by your web server as an executable CGI application (as opposed to a document). Generally (on UNIX), this entails setting the "execute bit" on the file and configuring your web server to treat files ending ".cgi" as CGI applications. Please refer to your particular web server's manual for configuration details. Your instance script 'mailform.cgi' must start with the following: #!/usr/bin/perl -w use CGI::Application::Mailform; my $mf = CGI::Application::Mailform->new(); These lines invoke the Perl interpreter, include the CGI::Application::Mailform module, and instantiate a Mailform object, respectively. (The author assumes your Perl binary is located at "/usr/bin/perl". If it is not, change the first line to refer to the correct location of your Perl binary.) Once you have a Mailform object ($mf), you have to configure the Mailform for your particular application. This is done by using the param() method to set a number of variables. These variables are specified as follows. B