"Fossies" - the Fresh Open Source Software Archive

Member "formmail_modules-3.14m1/lib/CGI/NMS/Script/FormMail.pm" (11 Aug 2004, 38753 Bytes) of package /linux/www/old/formmail_modules-3.14m1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "FormMail.pm" see the Fossies "Dox" file reference documentation.

    1 package CGI::NMS::Script::FormMail;
    2 use strict;
    3 
    4 use vars qw($VERSION);
    5 $VERSION = substr q$Revision: 1.12 $, 10, -1;
    6 
    7 use Socket;  # for the inet_aton()
    8 
    9 use CGI::NMS::Script;
   10 use CGI::NMS::Validator;
   11 use CGI::NMS::Mailer::ByScheme;
   12 use base qw(CGI::NMS::Script CGI::NMS::Validator);
   13 
   14 =head1 NAME
   15 
   16 CGI::NMS::Script::FormMail - FormMail CGI script
   17 
   18 =head1 SYNOPSIS
   19 
   20   #!/usr/bin/perl -wT
   21   use strict;
   22 
   23   use base qw(CGI::NMS::Script::FormMail);
   24 
   25   use vars qw($script);
   26   BEGIN {
   27     $script = __PACKAGE__->new(
   28       'DEBUGGING'     => 1,
   29       'postmaster'    => 'me@my.domain',
   30       'allow_mail_to' => 'me@my.domain',
   31     );
   32   }
   33 
   34   $script->request;
   35 
   36 =head1 DESCRIPTION
   37 
   38 This module implements the NMS plugin replacement for Matt Wright's
   39 FormMail.pl CGI script.
   40 
   41 =head1 CONFIGURATION SETTINGS
   42 
   43 As well as the generic NMS script configuration settings described in
   44 L<CGI::NMS::Script>, the FormMail constructor recognizes the following
   45 configuration settings:
   46 
   47 =over
   48 
   49 =item C<allow_empty_ref>
   50 
   51 Some web proxies and office firewalls may strip certain headers from the
   52 HTTP request that is sent by a browser.  Among these is the HTTP_REFERER
   53 that FormMail uses as an additional check of the requests validity - this
   54 will cause the program to fail with a 'bad referer' message even though the
   55 configuration seems fine.
   56 
   57 In these cases, setting this configuration setting to 1 will stop the
   58 program from complaining about requests where no referer header was sent
   59 while leaving the rest of the security features intact.
   60 
   61 Default: 1
   62 
   63 =item C<max_recipients>
   64 
   65 The maximum number of e-mail addresses that any single form should be
   66 allowed to send copies of the e-mail to.  If none of your forms send
   67 e-mail to more than one recipient, then we recommend that you improve
   68 the security of FormMail by reducing this value to 1.  Setting this
   69 configuration setting to 0 removes all limits on the number of recipients
   70 of each e-mail.
   71 
   72 Default: 5
   73 
   74 =item C<mailprog>
   75 
   76 The system command that the script should invoke to send an outgoing email.
   77 This should be the full path to a program that will read a message from
   78 STDIN and determine the list of message recipients from the message headers.
   79 Any switches that the program requires should be provided here.
   80 
   81 For example:
   82 
   83   'mailprog' => '/usr/lib/sendmail -oi -t',
   84 
   85 An SMTP relay can be specified instead of a sendmail compatible mail program,
   86 using the prefix C<SMTP:>, for example:
   87 
   88   'mailprog' => 'SMTP:mailhost.your.domain',
   89 
   90 Default: C<'/usr/lib/sendmail -oi -t'>
   91 
   92 =item C<postmaster>
   93 
   94 The envelope sender address to use for all emails sent by the script.
   95 
   96 Default: ''
   97 
   98 =item C<referers>
   99 
  100 This configuration setting must be an array reference, holding a list  
  101 of names and/or IP address of systems that will host forms that refer
  102 to this FormMail.  An empty array here turns off all referer checking.
  103 
  104 Default: [] 
  105 
  106 =item C<allow_mail_to>
  107 
  108 This configuration setting must be an array reference.
  109 
  110 A list of the email addresses that FormMail can send email to. The
  111 elements of this list can be either simple email addresses (like
  112 'you@your.domain') or domain names (like 'your.domain'). If it's a
  113 domain name then any address at that domain will be allowed.
  114 
  115 Default: []
  116 
  117 =item C<recipients>
  118 
  119 This configuration setting must be an array reference.
  120 
  121 A list of Perl regular expression patterns that determine who the
  122 script will allow mail to be sent to in addition to those set in
  123 C<allow_mail_to>.  This is present only for compatibility with the
  124 original FormMail script.  We strongly advise against having anything
  125 in C<recipients> as it's easy to make a mistake with the regular
  126 expression syntax and turn your FormMail into an open SPAM relay.
  127 
  128 Default: []
  129 
  130 =item C<recipient_alias>
  131 
  132 This configuration setting must be a hash reference.
  133 
  134 A hash for predefining a list of recipients in the script, and then
  135 choosing between them using the recipient form field, while keeping
  136 all the email addresses out of the HTML so that they don't get
  137 collected by address harvesters and sent junk email.
  138 
  139 For example, suppose you have three forms on your site, and you want
  140 each to submit to a different email address and you want to keep the
  141 addresses hidden.  You might set up C<recipient_alias> like this:
  142 
  143   %recipient_alias = (
  144     '1' => 'one@your.domain',
  145     '2' => 'two@your.domain',
  146     '3' => 'three@your.domain',
  147   );
  148 
  149 In the HTML form that should submit to the recipient C<two@your.domain>,
  150 you would then set the recipient with:
  151 
  152   <input type="hidden" name="recipient" value="2" />
  153 
  154 Default: {}
  155 
  156 =item C<valid_ENV>
  157 
  158 This configuration setting must be an array reference.
  159 
  160 A list of all the environment variables that you want to be able to
  161 include in the email.
  162 
  163 Default: ['REMOTE_HOST','REMOTE_ADDR','REMOTE_USER','HTTP_USER_AGENT']
  164 
  165 =item C<date_fmt>
  166 
  167 The format that the date will be displayed in, as a string suitable for
  168 passing to strftime().
  169 
  170 Default: '%A, %B %d, %Y at %H:%M:%S'
  171 
  172 =item C<date_offset>
  173 
  174 The empty string to use local time for the date, or an offset from GMT
  175 in hours to fix the timezone independent of the server's locale settings.
  176 
  177 Default: ''
  178 
  179 =item C<no_content>
  180 
  181 If this is set to 1 then rather than returning the HTML confirmation page
  182 or doing a redirect the script will output a header that indicates that no
  183 content will be returned and that the submitted form should not be
  184 replaced.  This should be used carefully as an unwitting visitor may click
  185 the submit button several times thinking that nothing has happened.
  186 
  187 Default: 0
  188 
  189 =item C<double_spacing>
  190 
  191 If this is set to 1 then a blank line is printed after each form value in
  192 the e-mail.  Change this value to 0 if you want the e-mail to be more
  193 compact.
  194 
  195 Default: 1
  196 
  197 =item C<join_string>
  198 
  199 If an input occurs multiple times, the values are joined to make a
  200 single string value.  The value of this configuration setting is
  201 inserted between each value when they are joined.
  202 
  203 Default: ' '
  204 
  205 =item C<wrap_text>
  206 
  207 If this is set to 1 then the content of any long text fields will be
  208 wrapped at around 72 columns in the e-mail which is sent.  The way that
  209 this is done is controlled by the C<wrap_style> configuration setting.
  210 
  211 Default: 0
  212 
  213 =item C<wrap_style>
  214 
  215 If C<wrap_text> is set to 1 then if this is set to 1 then the text will
  216 be wrapped in such a way that the left margin of the text is lined up
  217 with the beginning of the text after the description of the field -
  218 that is to say it is indented by the length of the field name plus 2.
  219 
  220 If it is set to 2 then the subsequent lines of the text will not be
  221 indented at all and will be flush with the start of the lines.  The
  222 choice of style is really a matter of taste although you might find
  223 that style 1 does not work particularly well if your e-mail client
  224 uses a proportional font where the spaces of the indent might be
  225 smaller than the characters in the field name.
  226 
  227 Default: 1
  228 
  229 =item C<address_style>
  230 
  231 If C<address_style> is set to 0 then the full address for the user who filled
  232 in the form will be used as "$email ($realname)" - this is also what the
  233 format will be if C<emulate_matts_code> is true.
  234 
  235 If it is set to 1 then the address format will be "$realname <$email>".
  236 
  237 Default: 0
  238 
  239 =item C<force_config_*>
  240 
  241 Configuration settings of this form can be used to fix configuration
  242 settings that would normally be set in hidden form fields.  For
  243 example, to force the email subject to be "Foo" irrespective of what's
  244 in the C<subject> form field, you would set:
  245 
  246   'force_config_subject' => 'Foo',
  247 
  248 Default: none set
  249 
  250 =item C<include_config_*>
  251 
  252 Configuration settings of this form can be used to treat particular
  253 configuration inputs as normal data inputs as well as honoring their
  254 special meaning.  For example, a user might use C<include_config_email>
  255 to include the email address as a regular input as well as using it in
  256 the email header.
  257 
  258 Default: none set
  259 
  260 =back
  261 
  262 =head1 COMPILE TIME METHODS
  263 
  264 These methods are invoked at CGI script compile time only, so long as
  265 the new() call is placed inside a BEGIN block as shown above.
  266 
  267 =over
  268 
  269 =item default_configuration ()
  270 
  271 Returns the default values for the configuration passed to the new()
  272 method, as a key,value,key,value list.
  273 
  274 =cut
  275 
  276 sub default_configuration {
  277   return ( 
  278     allow_empty_ref        => 1,
  279     max_recipients         => 5,
  280     mailprog               => '/usr/lib/sendmail -oi -t',
  281     postmaster             => '',
  282     referers               => [],
  283     allow_mail_to          => [],
  284     recipients             => [],
  285     recipient_alias        => {},
  286     valid_ENV              => [qw(REMOTE_HOST REMOTE_ADDR REMOTE_USER HTTP_USER_AGENT)],
  287     date_fmt               => '%A, %B %d, %Y at %H:%M:%S',
  288     date_offset            => '',
  289     no_content             => 0,
  290     double_spacing         => 1,
  291     join_string            => ' ',
  292     wrap_text              => 0,
  293     wrap_style             => 1,
  294     address_style          => 0,
  295   );
  296 }
  297 
  298 =item init ()
  299 
  300 Invoked from the new() method inherited from L<CGI::NMS::Script>,
  301 this method performs FormMail specific initialization of the script
  302 object.
  303 
  304 =cut
  305 
  306 sub init {
  307   my ($self) = @_;
  308 
  309   if ($self->{CFG}{wrap_text}) {
  310     require Text::Wrap;
  311     import  Text::Wrap;
  312   }
  313 
  314   $self->{Valid_Env} = {  map {$_=>1} @{ $self->{CFG}{valid_ENV} }  };
  315 
  316   $self->init_allowed_address_list;
  317 
  318   $self->{Mailer} = CGI::NMS::Mailer::ByScheme->new($self->{CFG}{mailprog});
  319 }
  320 
  321 =item init_allowed_address_list ()
  322 
  323 Invoked from init(), this method sets up a hash with a key for each
  324 allowed recipient email address as C<Allow_Mail> and a hash with a
  325 key for each domain at which any address is allowed as C<Allow_Domain>.
  326 
  327 =cut
  328 
  329 sub init_allowed_address_list {
  330   my ($self) = @_;
  331 
  332   my @allow_mail = ();
  333   my @allow_domain = ();
  334 
  335   foreach my $m (@{ $self->{CFG}{allow_mail_to} }) {
  336     if ($m =~ /\@/) {
  337       push @allow_mail, $m;
  338     }
  339     else {
  340       push @allow_domain, $m;
  341     }
  342   }
  343 
  344   my @alias_targets = split /\s*,\s*/, join ',', values %{ $self->{CFG}{recipient_alias} };
  345   push @allow_mail, grep /\@/, @alias_targets;
  346 
  347   # The username part of email addresses should be case sensitive, but the
  348   # domain name part should not.  Map all domain names to lower case for
  349   # comparison.
  350   my (%allow_mail, %allow_domain);
  351   foreach my $m (@allow_mail) {
  352     $m =~ /^([^@]+)\@([^@]+)$/ or die "internal failure [$m]";
  353     $m = $1 . '@' . lc $2;
  354     $allow_mail{$m} = 1;
  355   }
  356   foreach my $m (@allow_domain) {
  357     $m = lc $m;
  358     $allow_domain{$m} = 1;
  359   }
  360 
  361   $self->{Allow_Mail}   = \%allow_mail;
  362   $self->{Allow_Domain} = \%allow_domain;
  363 }
  364 
  365 =back
  366 
  367 =head1 RUN TIME METHODS
  368 
  369 These methods are invoked at script run time, as a result of the call
  370 to the request() method inherited from L<CGI::NMS::Script>.
  371 
  372 =over
  373 
  374 =item handle_request ()
  375 
  376 Handles the core of a single CGI request, outputting the HTML success
  377 or error page or redirect header and sending emails.
  378 
  379 Dies on error.
  380 
  381 =cut
  382 
  383 sub handle_request {
  384   my ($self) = @_;
  385 
  386   $self->{Hide_Recipient} = 0;
  387 
  388   my $referer = $self->cgi_object->referer;
  389   unless ($self->referer_is_ok($referer)) {
  390     $self->referer_error_page;
  391     return;
  392   }
  393 
  394   $self->check_method_is_post    or return;
  395 
  396   $self->parse_form;
  397 
  398   $self->check_recipients( $self->get_recipients ) or return;
  399 
  400   my @missing = $self->get_missing_fields;
  401   if (scalar @missing) {
  402     $self->missing_fields_output(@missing);
  403     return;
  404   }
  405 
  406   my $date     = $self->date_string;
  407   my $email    = $self->get_user_email;
  408   my $realname = $self->get_user_realname;
  409 
  410   $self->send_main_email($date, $email, $realname);
  411   $self->send_conf_email($date, $email, $realname);
  412 
  413   $self->success_page($date);
  414 }
  415 
  416 =item date_string ()
  417 
  418 Returns a string giving the current date and time, in the configured
  419 format.
  420 
  421 =cut
  422 
  423 sub date_string {
  424   my ($self) = @_;
  425 
  426   return $self->format_date( $self->{CFG}{date_fmt},
  427                              $self->{CFG}{date_offset} );
  428 }
  429 
  430 =item referer_is_ok ( REFERER )
  431 
  432 Returns true if the referer is OK, false otherwise.
  433 
  434 =cut
  435 
  436 sub referer_is_ok {
  437   my ($self, $referer) = @_;
  438 
  439   unless ($referer) {
  440     return ($self->{CFG}{allow_empty_ref} ? 1 : 0);
  441   }
  442 
  443   if ($referer =~ m!^https?://([^/]*\@)?([\w\-\.]+)!i) {
  444     my $refhost = $2;
  445     return $self->refering_host_is_ok($refhost);
  446   }
  447   else {
  448     return 0;
  449   }
  450 }
  451 
  452 =item refering_host_is_ok ( REFERING_HOST )
  453 
  454 Returns true if the host name REFERING_HOST is on the list of allowed
  455 referers, or resolves to an allowed IP address.
  456 
  457 =cut
  458 
  459 sub refering_host_is_ok {
  460   my ($self, $refhost) = @_;
  461 
  462   my @allow = @{ $self->{CFG}{referers} };
  463   return 1 unless scalar @allow;
  464 
  465   foreach my $test_ref (@allow) {
  466     if ($refhost =~ m|\Q$test_ref\E$|i) {
  467       return 1;
  468     }
  469   }
  470 
  471   my $ref_ip = inet_aton($refhost) or return 0;
  472   foreach my $test_ref (@allow) {
  473     next unless $test_ref =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
  474 
  475     my $test_ref_ip = inet_aton($test_ref) or next;
  476     if ($ref_ip eq $test_ref_ip) {
  477       return 1;
  478     }
  479   }
  480 }
  481 
  482 =item referer_error_page ()
  483 
  484 Invoked if the referer is bad, this method outputs an error page
  485 describing the problem with the referer.
  486 
  487 =cut
  488 
  489 sub referer_error_page {
  490   my ($self) = @_;
  491 
  492   my $referer = $self->cgi_object->referer || '';
  493   my $escaped_referer = $self->escape_html($referer);
  494 
  495   if ( $referer =~ m|^https?://([\w\.\-]+)|i) {
  496     my $host = $1;
  497     $self->error_page( 'Bad Referrer - Access Denied', <<END );
  498 <p>
  499   The form attempting to use this script resides at <tt>$escaped_referer</tt>,
  500   which is not allowed to access this program.
  501 </p>
  502 <p>
  503   If you are attempting to configure FormMail to run with this form,
  504   you need to add the following to \@referers, explained in detail in the
  505   README file.
  506 </p>
  507 <p>
  508   Add <tt>'$host'</tt> to your <tt><b>\@referers</b></tt> array.
  509 </p>
  510 END
  511   }
  512   elsif (length $referer) {
  513     $self->error_page( 'Malformed Referrer - Access Denied', <<END );
  514 <p>
  515   The referrer value <tt>$escaped_referer</tt> cannot be parsed, so
  516   it is not possible to check that the referring page is allowed to
  517   access this program.
  518 </p>
  519 END
  520   }
  521   else {
  522     $self->error_page( 'Missing Referrer - Access Denied', <<END );
  523 <p>
  524   Your browser did not send a <tt>Referer</tt> header with this
  525   request, so it is not possible to check that the referring page
  526   is allowed to access this program.
  527 </p>
  528 END
  529   }
  530 }
  531 
  532 =item check_method_is_post ()
  533 
  534 Unless the C<secure> configuration setting is false, this method checks
  535 that the request method is POST.  Returns true if OK, otherwise outputs
  536 an error page and returns false.
  537 
  538 =cut
  539 
  540 sub check_method_is_post {
  541   my ($self) = @_;
  542 
  543   return 1 unless $self->{CFG}{secure};
  544 
  545   my $method = $self->cgi_object->request_method || '';
  546   if ($method ne 'POST') {
  547     $self->error_page( 'Error: GET request', <<END );
  548 <p>
  549   The HTML form fails to specify the POST method, so it would not
  550   be correct for this script to take any action in response to
  551   your request.
  552 </p>
  553 <p>
  554   If you are attempting to configure this form to run with FormMail,
  555   you need to set the request method to POST in the opening form tag,
  556   like this:
  557   <tt>&lt;form action=&quot;/cgi-bin/FormMail.pl&quot; method=&quot;post&quot;&gt;</tt>
  558 </p>
  559 END
  560     return 0;
  561   }
  562   else {
  563     return 1;
  564   }
  565 }
  566 
  567 =item parse_form ()
  568 
  569 Parses the HTML form, storing the results in various fields in the
  570 C<FormMail> object, as follows:
  571 
  572 =over
  573 
  574 =item C<FormConfig>
  575 
  576 A hash holding the values of the configuration inputs, such as
  577 C<recipient> and C<subject>.
  578 
  579 =item C<Form>
  580 
  581 A hash holding the values of inputs other than configuration inputs.
  582 
  583 =item C<Field_Order>
  584 
  585 An array giving the set and order of fields to be included in the
  586 email and on the success page.
  587 
  588 =back
  589 
  590 =cut
  591 
  592 sub parse_form {
  593   my ($self) = @_;
  594 
  595   $self->{FormConfig} = { map {$_=>''} $self->configuration_form_fields };
  596   $self->{Field_Order} = [];
  597   $self->{Form} = {};
  598 
  599   foreach my $p ($self->cgi_object->param()) {
  600     if (exists $self->{FormConfig}{$p}) {
  601       $self->parse_config_form_input($p);
  602     }
  603     else {
  604       $self->parse_nonconfig_form_input($p);
  605     }
  606   }
  607 
  608   $self->substitute_forced_config_values;
  609 
  610   $self->expand_list_config_items;
  611 
  612   $self->sort_field_order;
  613   $self->remove_blank_fields;
  614 }
  615 
  616 =item configuration_form_fields ()
  617 
  618 Returns a list of the names of the form fields which are used
  619 to configure formmail rather than to provide user input, such
  620 as C<subject> and C<recipient>.  The specially treated C<email>
  621 and C<realname> fields are included in this list.
  622 
  623 =cut
  624 
  625 sub configuration_form_fields {
  626   qw(
  627     recipient
  628     subject
  629     email
  630     realname
  631     redirect
  632     bgcolor
  633     background
  634     link_color
  635     vlink_color
  636     text_color
  637     alink_color
  638     title
  639     sort
  640     print_config
  641     required
  642     env_report
  643     return_link_title
  644     return_link_url
  645     print_blank_fields
  646     missing_fields_redirect
  647   );
  648 }
  649 
  650 =item parse_config_form_input ( NAME )
  651 
  652 Deals with the configuration form input NAME, incorporating it into
  653 the C<FormConfig> field in the blessed hash.
  654 
  655 =cut
  656 
  657 sub parse_config_form_input {
  658   my ($self, $name) = @_;
  659 
  660   my $val = $self->strip_nonprint($self->cgi_object->param($name));
  661   if ($name =~ /return_link_url|redirect$/) {
  662     $val = $self->validate_url($val);
  663   }
  664   $self->{FormConfig}{$name} = $val;
  665   unless ($self->{CFG}{emulate_matts_code}) {
  666     $self->{Form}{$name} = $val;
  667     if ( $self->{CFG}{"include_config_$name"} ) {
  668       push @{ $self->{Field_Order} }, $name;
  669     }
  670   }
  671 }
  672 
  673 =item parse_nonconfig_form_input ( NAME )
  674 
  675 Deals with the non-configuration form input NAME, incorporating it into
  676 the C<Form> and C<Field_Order> fields in the blessed hash.
  677 
  678 =cut
  679 
  680 sub parse_nonconfig_form_input {
  681   my ($self, $name) = @_;
  682 
  683   my @vals = map {$self->strip_nonprint($_)} $self->cgi_object->param($name);
  684   my $key = $self->strip_nonprint($name);
  685   $self->{Form}{$key} = join $self->{CFG}{join_string}, @vals;
  686   push @{ $self->{Field_Order} }, $key;
  687 }
  688 
  689 =item expand_list_config_items ()
  690 
  691 Converts the form configuration values C<required>, C<env_report> and
  692 C<print_config> from strings of comma separated values to arrays, and
  693 removes anything not in the C<valid_ENV> configuration setting from
  694 C<env_report>.
  695 
  696 =cut
  697 
  698 sub expand_list_config_items {
  699   my ($self) = @_;
  700 
  701   foreach my $p (qw(required env_report print_config)) {
  702     if ($self->{FormConfig}{$p}) {
  703       $self->{FormConfig}{$p} = [split(/\s*,\s*/, $self->{FormConfig}{$p})];
  704     }
  705     else {
  706       $self->{FormConfig}{$p} = [];
  707     }
  708   }
  709 
  710   $self->{FormConfig}{env_report} =
  711      [ grep { $self->{Valid_Env}{$_} } @{ $self->{FormConfig}{env_report} } ];
  712 }
  713 
  714 =item substitute_forced_config_values ()
  715 
  716 Replaces form configuration values for which there is a forced value
  717 configuration setting with the forced value.  Sets C<Hide_Recipient>
  718 true if the recipient config value is forced.
  719 
  720 =cut
  721 
  722 sub substitute_forced_config_values {
  723   my ($self) = @_;
  724 
  725   foreach my $k (keys %{ $self->{FormConfig} }) {
  726     if (exists $self->{CFG}{"force_config_$k"}) {
  727       $self->{FormConfig}{$k} = $self->{CFG}{"force_config_$k"};
  728       $self->{Hide_Recipient} = 1 if $k eq 'recipient';
  729     }
  730   }
  731 }
  732 
  733 =item sort_field_order ()
  734 
  735 Modifies the C<Field_Order> field in the blessed hash according to
  736 the sorting scheme set in the C<sort> form configuration, if any.
  737 
  738 =cut
  739 
  740 sub sort_field_order {
  741   my ($self) = @_;
  742 
  743   my $sort = $self->{FormConfig}{'sort'};
  744   if (defined $sort) {
  745     if ($sort eq 'alphabetic') {
  746       $self->{Field_Order} = [ sort @{ $self->{Field_Order} } ];
  747     }
  748     elsif ($sort =~ /^\s*order:\s*(.*)$/s) {
  749       $self->{Field_Order} = [ split /\s*,\s*/, $1 ];
  750     }
  751   }
  752 }
  753 
  754 =item remove_blank_fields ()
  755 
  756 Removes the names of blank or missing fields from the C<Field_Order> array
  757 unless the C<print_blank_fields> form configuration value is true.
  758 
  759 =cut
  760 
  761 sub remove_blank_fields {
  762   my ($self) = @_;
  763 
  764   return if $self->{FormConfig}{print_blank_fields};
  765 
  766   $self->{Field_Order} = [
  767     grep { defined $self->{Form}{$_} and $self->{Form}{$_} !~ /^\s*$/ } 
  768     @{ $self->{Field_Order} }
  769   ];
  770 }
  771 
  772 =item get_recipients ()
  773 
  774 Determines the list of configured recipients from the form inputs and the
  775 C<recipient_alias> configuration setting, and returns them as a list.
  776 
  777 Sets the C<Hide_Recipient> field in the blessed hash to a true value if
  778 one or more of the recipients were aliased and so should be hidden to
  779 foil address harvesters.
  780 
  781 =cut
  782 
  783 sub get_recipients {
  784   my ($self) = @_;
  785 
  786   my $recipient = $self->{FormConfig}{recipient};
  787   my @recipients;
  788 
  789   if (length $recipient) {
  790     foreach my $r (split /\s*,\s*/, $recipient) {
  791       if (exists $self->{CFG}{recipient_alias}{$r}) {
  792         push @recipients, split /\s*,\s*/, $self->{CFG}{recipient_alias}{$r};
  793         $self->{Hide_Recipient} = 1;
  794       }
  795       else {
  796         push @recipients, $r;
  797       }
  798     }
  799   }
  800   else {
  801     return $self->default_recipients;
  802   }
  803 
  804   return @recipients;
  805 }
  806 
  807 =item default_recipients ()
  808 
  809 Invoked from get_recipients if no C<recipient> input is found, this method
  810 returns the default recipient list.  The default recipient is the first email
  811 address listed in the C<allow_mail_to> configuration setting, if any.
  812 
  813 =cut
  814 
  815 sub default_recipients {
  816   my ($self) = @_;
  817 
  818   my @allow = grep {/\@/} @{ $self->{CFG}{allow_mail_to} };
  819   if (scalar @allow > 0 and not $self->{CFG}{emulate_matts_code}) {
  820     $self->{Hide_Recipient} = 1;
  821     return ($allow[0]);
  822   }
  823   else {
  824     return ();
  825   }
  826 }
  827 
  828 =item check_recipients ( @RECIPIENTS )
  829 
  830 Works through the array of recipients passed in and discards any the the script
  831 is not configured to allow, storing the list of valid recipients in the
  832 C<Recipients> field in the blessed hash.
  833 
  834 Returns true if at least one (and not too many) valid recipients are found,
  835 otherwise outputs an error page and returns false.
  836 
  837 =cut
  838 
  839 sub check_recipients {
  840   my ($self, @recipients) = @_;
  841 
  842   my @valid = grep { $self->recipient_is_ok($_) } @recipients;
  843   $self->{Recipients} = \@valid;
  844 
  845   if (scalar(@valid) == 0) {
  846     $self->bad_recipient_error_page;
  847     return 0;
  848   }
  849   elsif ($self->{CFG}{max_recipients} and scalar(@valid) > $self->{CFG}{max_recipients}) {
  850     $self->too_many_recipients_error_page;
  851     return 0;
  852   }
  853   else {
  854     return 1;
  855   }
  856 }
  857 
  858 =item recipient_is_ok ( RECIPIENT )
  859 
  860 Returns true if the recipient RECIPIENT should be allowed, false otherwise.
  861 
  862 =cut
  863 
  864 sub recipient_is_ok {
  865   my ($self, $recipient) = @_;
  866 
  867   return 0 unless $self->validate_email($recipient);
  868 
  869   $recipient =~ /^(.+)\@([^@]+)$/m or die "regex failure [$recipient]";
  870   my ($user, $host) = ($1, lc $2);
  871   return 1 if exists $self->{Allow_Domain}{$host};
  872   return 1 if exists $self->{Allow_Mail}{"$user\@$host"};
  873 
  874   foreach my $r (@{ $self->{CFG}{recipients} }) {
  875     return 1 if $recipient =~ /(?:$r)$/;
  876     return 1 if $self->{CFG}{emulate_matts_code} and $recipient =~ /(?:$r)$/i;
  877   }
  878 
  879   return 0;
  880 }
  881 
  882 =item bad_recipient_error_page ()
  883 
  884 Outputs the error page for a bad or missing recipient.
  885 
  886 =cut
  887 
  888 sub bad_recipient_error_page {
  889   my ($self) = @_;
  890 
  891   my $errhtml = <<END;
  892 <p>
  893   There was no recipient or an invalid recipient specified in the
  894   data sent to FormMail. Please make sure you have filled in the
  895   <tt>recipient</tt> form field with an e-mail address that has
  896   been configured in <tt>\@recipients</tt> or <tt>\@allow_mail_to</tt>.
  897   More information on filling in <tt>recipient/allow_mail_to</tt>
  898   form fields and variables can be found in the README file.
  899 </p>
  900 END
  901 
  902   unless ($self->{CFG}{force_config_recipient}) {
  903     my $esc_rec = $self->escape_html( $self->{FormConfig}{recipient} );
  904     $errhtml .= <<END;
  905 <hr size="1" />
  906 <p>
  907  The recipient was: [ $esc_rec ]
  908 </p>
  909 END
  910   }
  911 
  912   $self->error_page( 'Error: Bad or Missing Recipient', $errhtml );
  913 }
  914 
  915 =item too_many_recipients_error_page ()
  916 
  917 Outputs the error page for too many recipients configured.
  918 
  919 =cut
  920 
  921 sub too_many_recipients_error_page {
  922   my ($self) = @_;
  923 
  924   $self->error_page( 'Error: Too many Recipients', <<END );
  925 <p>
  926   The number of recipients configured in the form exceeds the
  927   maximum number of recipients configured in the script.  If
  928   you are attempting to configure FormMail to run with this form
  929   then you will need to increase the <tt>\$max_recipients</tt>
  930   configuration setting in the script.
  931 </p>
  932 END
  933 }
  934 
  935 =item get_missing_fields ()
  936 
  937 Returns a list of the names of the required fields that have not been
  938 filled in acceptably, each one possibly annotated with details of the
  939 problem with the way the field was filled in.
  940 
  941 =cut
  942 
  943 sub get_missing_fields {
  944   my ($self) = @_;
  945 
  946   my @missing = ();
  947 
  948   foreach my $f (@{ $self->{FormConfig}{required} }) {
  949     if ($f eq 'email') {
  950       unless ( $self->get_user_email =~ /\@/ ) {
  951         push @missing, 'email (must be a valid email address)';
  952       }
  953     }
  954     elsif ($f eq 'realname') { 
  955       unless ( length $self->get_user_realname ) {
  956         push @missing, 'realname';
  957       }
  958     }
  959     else {
  960       my $val = $self->{Form}{$f};
  961       if (! defined $val or $val =~ /^\s*$/) {
  962         push @missing, $f;
  963       }
  964     }
  965   }
  966 
  967   return @missing;
  968 }
  969 
  970 =item missing_fields_output ( @MISSING )
  971 
  972 Produces the configured output (an error page or a redirect) for the
  973 case when there are missing fields.  Takes a list of the missing
  974 fields as arguments.
  975 
  976 =cut
  977 
  978 sub missing_fields_output {
  979   my ($self, @missing) = @_;
  980 
  981   if ( $self->{FormConfig}{'missing_fields_redirect'} ) {
  982     print $self->cgi_object->redirect($self->{FormConfig}{'missing_fields_redirect'});
  983   }
  984   else {
  985     my $missing_field_list = join '',
  986                              map { '<li>' . $self->escape_html($_) . "</li>\n" }
  987                              @missing;
  988     $self->error_page( 'Error: Blank Fields', <<END );
  989 <p>
  990     The following fields were left blank in your submission form:
  991 </p>
  992 <div class="c2">
  993    <ul>
  994      $missing_field_list
  995    </ul>
  996 </div>
  997 <p>
  998     These fields must be filled in before you can successfully
  999     submit the form.
 1000 </p>
 1001 <p>
 1002     Please use your back button to return to the form and
 1003     try again.
 1004 </p>
 1005 END
 1006   }
 1007 }
 1008 
 1009 =item get_user_email ()
 1010 
 1011 Returns the user's email address if they entered a valid one in the C<email>
 1012 form field, otherwise returns the string C<nobody>.
 1013 
 1014 =cut
 1015 
 1016 sub get_user_email {
 1017   my ($self) = @_;
 1018 
 1019   my $email = $self->{FormConfig}{email};
 1020   $email = $self->validate_email($email);
 1021   $email = 'nobody' unless $email;
 1022 
 1023   return $email;
 1024 }
 1025 
 1026 =item get_user_realname ()
 1027 
 1028 Returns the user's real name, as entered in the C<realname> form field.
 1029 
 1030 =cut
 1031 
 1032 sub get_user_realname {
 1033   my ($self) = @_;
 1034 
 1035   my $realname = $self->{FormConfig}{realname};
 1036   if (defined $realname) {
 1037     $realname = $self->validate_realname($realname);
 1038   } else {
 1039     $realname = '';
 1040   }
 1041 
 1042   return $realname;
 1043 }
 1044 
 1045 =item send_main_email ( DATE, EMAIL, REALNAME )
 1046 
 1047 Sends the main email.  DATE is a date string, EMAIL is the
 1048 user's email address if they entered a valid one and REALNAME
 1049 is the user's real name if entered.
 1050 
 1051 =cut
 1052 
 1053 sub send_main_email {
 1054   my ($self, $date, $email, $realname) = @_;
 1055 
 1056   my $mailer = $self->mailer;
 1057   $mailer->newmail($self->name_and_version, $self->{CFG}{postmaster}, @{ $self->{Recipients} });
 1058 
 1059   $self->send_main_email_header($email, $realname);
 1060   $mailer->print("\n");
 1061 
 1062   $self->send_main_email_body_header($date);
 1063 
 1064   $self->send_main_email_print_config;
 1065 
 1066   $self->send_main_email_fields;
 1067 
 1068   $self->send_main_email_footer;
 1069 
 1070   $mailer->endmail;
 1071 }
 1072 
 1073 =item build_from_address( EMAIL, REALNAME )
 1074 
 1075 Creates the address that will be used for the user that filled in the form,
 1076 if the address_style configuration is 0 or emulate_matts_code is true then
 1077 the format will be "$email ($realname)" if it is set to a true value then 
 1078 the format will be "$realname <$email>".
 1079 
 1080 =cut
 1081 
 1082 sub build_from_address
 1083 {
 1084    my ( $self, $email, $realname ) = @_;
 1085 
 1086    my $from_address = $email;
 1087    if ( length $realname )
 1088    {
 1089       if (!$self->{CFG}{emulates_matts_code} and $self->{CFG}{address_style})
 1090       {
 1091          $from_address = "$realname <$email>";
 1092       }
 1093       else
 1094       {
 1095          $from_address = "$email ($realname)";
 1096       }
 1097    }
 1098 
 1099    return $from_address;
 1100 }
 1101 
 1102 =item send_main_email_header ( EMAIL, REALNAME )
 1103 
 1104 Sends the email header for the main email, not including the terminating
 1105 blank line.
 1106 
 1107 =cut
 1108 
 1109 sub send_main_email_header {
 1110   my ($self, $email, $realname) = @_;
 1111 
 1112   my $subject = $self->{FormConfig}{subject} || 'WWW Form Submission';
 1113   if ($self->{CFG}{secure}) {
 1114     $subject = substr($subject, 0, 256);
 1115   }
 1116   $subject =~ s#[\r\n\t]+# #g;
 1117 
 1118   my $to = join ',', @{ $self->{Recipients} };
 1119   my $from = $self->build_from_address($email ,$realname);
 1120 
 1121   $self->mailer->print(<<END);
 1122 X-Mailer: ${\( $self->name_and_version )}
 1123 To: $to
 1124 From: $from
 1125 Subject: $subject
 1126 END
 1127 }
 1128 
 1129 =item send_main_email_body_header ( DATE )
 1130 
 1131 Invoked after the blank line to terminate the header is sent, this method
 1132 outputs the header of the email body.
 1133 
 1134 =cut
 1135 
 1136 sub send_main_email_body_header {
 1137   my ($self, $date) = @_;
 1138 
 1139   my $dashes = '-' x 75;
 1140   $dashes .= "\n\n" if $self->{CFG}{double_spacing};
 1141 
 1142   $self->mailer->print(<<END);
 1143 Below is the result of your feedback form.  It was submitted by
 1144 $self->{FormConfig}{realname} ($self->{FormConfig}{email}) on $date
 1145 $dashes
 1146 END
 1147 }
 1148 
 1149 =item send_main_email_print_config ()
 1150 
 1151 If the C<print_config> form configuration field is set, outputs the configured
 1152 config values to the email.
 1153 
 1154 =cut
 1155 
 1156 sub send_main_email_print_config {
 1157   my ($self) = @_;
 1158 
 1159   if ($self->{FormConfig}{print_config}) {
 1160     foreach my $cfg (@{ $self->{FormConfig}{print_config} }) {
 1161       if ($self->{FormConfig}{$cfg}) {
 1162         $self->mailer->print("$cfg: $self->{FormConfig}{$cfg}\n");
 1163     $self->mailer->print("\n") if $self->{CFG}{double_spacing};
 1164       }
 1165     }
 1166   }
 1167 }
 1168 
 1169 =item send_main_email_fields ()
 1170 
 1171 Outputs the form fields to the email body.
 1172 
 1173 =cut
 1174 
 1175 sub send_main_email_fields {
 1176   my ($self) = @_;
 1177 
 1178   foreach my $f (@{ $self->{Field_Order} }) {
 1179     my $val = (defined $self->{Form}{$f} ? $self->{Form}{$f} : '');
 1180 
 1181     $self->send_main_email_field($f, $val);
 1182   }
 1183 }
 1184 
 1185 =item send_main_email_field ( NAME, VALUE )
 1186 
 1187 Outputs a single form field to the email body.
 1188 
 1189 =cut
 1190 
 1191 sub send_main_email_field {
 1192   my ($self, $name, $value) = @_;
 1193   
 1194   my ($prefix, $line) = $self->build_main_email_field($name, $value);
 1195 
 1196   my $nl = ($self->{CFG}{double_spacing} ? "\n\n" : "\n");
 1197 
 1198   if ($self->{CFG}{wrap_text} and length("$prefix$line") > $self->email_wrap_columns) {
 1199     $self->mailer->print( $self->wrap_field_for_email($prefix, $line) . $nl );
 1200   }
 1201   else {
 1202     $self->mailer->print("$prefix$line$nl");
 1203   }
 1204 }
 1205 
 1206 =item build_main_email_field ( NAME, VALUE )
 1207 
 1208 Generates the email body text for a single form input, and returns
 1209 it as a two element list of prefix and remainder of line.  The return
 1210 value is split into a prefix and remainder of line because the text
 1211 wrapping code may need to indent the wrapped line to the length of the
 1212 prefix.
 1213 
 1214 =cut
 1215 
 1216 sub build_main_email_field {
 1217   my ($self, $name, $value) = @_;
 1218 
 1219   return ("$name: ", $value);
 1220 }
 1221 
 1222 =item wrap_field_for_email ( PREFIX, LINE )
 1223 
 1224 Takes the prefix and rest of line of a field as arguments, and returns them
 1225 as a text wrapped paragraph suitable for inclusion in the main email.
 1226 
 1227 =cut
 1228 
 1229 sub wrap_field_for_email {
 1230   my ($self, $prefix, $value) = @_;
 1231 
 1232   my $subs_indent = '';
 1233   $subs_indent = ' ' x length($prefix) if $self->{CFG}{wrap_style} == 1;
 1234 
 1235   local $Text::Wrap::columns = $self->email_wrap_columns;
 1236 
 1237   # Some early versions of Text::Wrap will die on very long words, if that
 1238   # happens we fall back to no wrapping.
 1239   my $wrapped;
 1240   eval { local $SIG{__DIE__} ; $wrapped = wrap($prefix,$subs_indent,$value) };
 1241   return ($@ ? "$prefix$value" : $wrapped);
 1242 }
 1243 
 1244 =item email_wrap_columns ()
 1245 
 1246 Returns the number of columns to which the email should be wrapped if the
 1247 text wrapping option is in use.
 1248 
 1249 =cut
 1250 
 1251 sub email_wrap_columns { 72; }
 1252 
 1253 =item send_main_email_footer ()
 1254 
 1255 Sends the footer of the main email body, including any environment variables
 1256 listed in the C<env_report> configuration form field.
 1257 
 1258 =cut
 1259 
 1260 sub send_main_email_footer {
 1261   my ($self) = @_;
 1262 
 1263   my $dashes = '-' x 75;
 1264   $self->mailer->print("$dashes\n\n");
 1265 
 1266   foreach my $e (@{ $self->{FormConfig}{env_report}}) {
 1267     if ($ENV{$e}) {
 1268       $self->mailer->print("$e: " . $self->strip_nonprint($ENV{$e}) . "\n");
 1269     }
 1270   }
 1271 }
 1272 
 1273 =item send_conf_email ( DATE, EMAIL, REALNAME )
 1274 
 1275 Sends a confirmation email back to the user, if configured to do so and the
 1276 user entered a valid email addresses.
 1277 
 1278 =cut
 1279 
 1280 sub send_conf_email {
 1281   my ($self, $date, $email, $realname) = @_;
 1282 
 1283   if ( $self->{CFG}{send_confirmation_mail} and $email =~ /\@/ ) {
 1284     my $to = $self->build_from_address($email, $realname);
 1285     $self->mailer->newmail("NMS FormMail.pm v$VERSION", $self->{CFG}{postmaster}, $email);
 1286     $self->mailer->print("To: $to\n$self->{CFG}{confirmation_text}");
 1287     $self->mailer->endmail;
 1288   }
 1289 }
 1290 
 1291 =item success_page ()
 1292 
 1293 Outputs the HTML success page (or redirect if configured) after the email
 1294 has been successfully sent.
 1295 
 1296 =cut
 1297 
 1298 sub success_page {
 1299   my ($self, $date) = @_;
 1300 
 1301   if ($self->{FormConfig}{'redirect'}) {
 1302     print $self->cgi_object->redirect( $self->{FormConfig}{'redirect'} );
 1303   }
 1304   elsif ( $self->{CFG}{'no_content'}) {
 1305     print $self->cgi_object->header(Status => 204);
 1306   }
 1307   else {
 1308     $self->output_cgi_html_header;
 1309     $self->success_page_html_preamble($date);
 1310     $self->success_page_fields;
 1311     $self->success_page_footer;
 1312   }
 1313 }
 1314 
 1315 =item success_page_html_preamble ( DATE )
 1316 
 1317 Outputs the start of the HTML for the success page, not including the
 1318 standard HTML headers dealt with by output_cgi_html_header().
 1319 
 1320 =cut
 1321 
 1322 sub success_page_html_preamble {
 1323   my ($self, $date) = @_;
 1324 
 1325   my $title = $self->escape_html( $self->{FormConfig}{'title'} || 'Thank You' );
 1326   my $torecipient = 'to ' . $self->escape_html($self->{FormConfig}{'recipient'});
 1327   $torecipient = '' if $self->{Hide_Recipient};
 1328   my $attr = $self->body_attributes;
 1329 
 1330     print <<END;
 1331   <head>
 1332      <title>$title</title>
 1333 END
 1334 
 1335     $self->output_style_element;
 1336 
 1337     print <<END;
 1338      <style>
 1339        h1.title {
 1340                    text-align : center;
 1341                 }
 1342      </style>
 1343   </head>
 1344   <body $attr>
 1345     <h1 class="title">$title</h1>
 1346     <p>Below is what you submitted $torecipient on $date</p>
 1347     <p><hr size="1" width="75%" /></p>
 1348 END
 1349 }
 1350 
 1351 =item success_page_fields ()
 1352 
 1353 Outputs success page HTML output for each input field.
 1354 
 1355 =cut
 1356 
 1357 sub success_page_fields {
 1358   my ($self) = @_;
 1359 
 1360   foreach my $f (@{ $self->{Field_Order} }) {
 1361     my $val = (defined $self->{Form}{$f} ? $self->{Form}{$f} : '');
 1362     $self->success_page_field( $self->escape_html($f), $self->escape_html($val) );
 1363   }
 1364 }
 1365 
 1366 =item success_page_field ( NAME, VALUE ) {
 1367 
 1368 Outputs success page HTML for a single input field.  NAME and VALUE
 1369 are the HTML escaped field name and value.
 1370 
 1371 =cut
 1372 
 1373 sub success_page_field {
 1374   my ($self, $name, $value) = @_;
 1375 
 1376   print "<p><b>$name:</b> $value</p>\n";
 1377 }
 1378 
 1379 =item success_page_footer ()
 1380 
 1381 Outputs the footer of the success page, including the return link if
 1382 configured.
 1383 
 1384 =cut
 1385 
 1386 sub success_page_footer {
 1387   my ($self) = @_;
 1388 
 1389   print qq{<p><hr size="1" width="75%" /></p>\n};
 1390   $self->success_page_return_link;
 1391   print <<END;
 1392         <hr size="1" width="75%" />
 1393         <p align="center">
 1394            <font size="-1">
 1395              <a href="http://nms-cgi.sourceforge.net/">FormMail</a>
 1396              &copy; 2001  London Perl Mongers
 1397            </font>
 1398         </p>
 1399         </body>
 1400        </html>
 1401 END
 1402 }
 1403 
 1404 =item success_page_return_link ()
 1405 
 1406 Outputs the success page return link if any is configured.
 1407 
 1408 =cut
 1409 
 1410 sub success_page_return_link {
 1411   my ($self) = @_;
 1412 
 1413   if ($self->{FormConfig}{return_link_url} and $self->{FormConfig}{return_link_title}) {
 1414     print "<ul>\n";
 1415     print '<li><a href="', $self->escape_html($self->{FormConfig}{return_link_url}),
 1416        '">', $self->escape_html($self->{FormConfig}{return_link_title}), "</a>\n";
 1417     print "</li>\n</ul>\n";
 1418   }
 1419 }
 1420 
 1421 =item body_attributes ()
 1422 
 1423 Gets the body attributes for the success page from the form
 1424 configuration, and returns the string that should go inside
 1425 the C<body> tag.
 1426 
 1427 =cut
 1428 
 1429 sub body_attributes {
 1430   my ($self) = @_;
 1431 
 1432   my %attrs = (bgcolor     => 'bgcolor',
 1433                background  => 'background',
 1434                link_color  => 'link',
 1435                vlink_color => 'vlink',
 1436                alink_color => 'alink',
 1437                text_color  => 'text');
 1438 
 1439   my $attr = '';
 1440 
 1441   foreach my $at (keys %attrs) {
 1442     my $val = $self->{FormConfig}{$at};
 1443     next unless $val;
 1444     if ($at =~ /color$/) {
 1445       $val = $self->validate_html_color($val);
 1446     }
 1447     elsif ($at eq 'background') {
 1448       $val = $self->validate_url($val);
 1449     }
 1450     else {
 1451       die "no check defined for body attribute [$at]";
 1452     }
 1453     $attr .= qq( $attrs{$at}=") . $self->escape_html($val) . '"' if $val;
 1454   }
 1455 
 1456   return $attr;
 1457 }
 1458 
 1459 =item error_page( TITLE, ERROR_BODY )
 1460 
 1461 Outputs a FormMail error page, giving the HTML document the title
 1462 TITLE and displaying the HTML error message ERROR_BODY.
 1463 
 1464 =cut
 1465 
 1466 sub error_page {
 1467   my ($self, $title, $error_body) = @_;
 1468 
 1469   $self->output_cgi_html_header;
 1470 
 1471   my $etitle = $self->escape_html($title);
 1472   print <<END;
 1473   <head>
 1474     <title>$etitle</title>
 1475 END
 1476 
 1477 
 1478   print <<END;
 1479     <style type="text/css">
 1480     <!--
 1481        body {
 1482               background-color: #FFFFFF;
 1483               color: #000000;
 1484              }
 1485        table {
 1486                background-color: #9C9C9C;
 1487              }
 1488        p.c2 {
 1489               font-size: 80%;
 1490               text-align: center;
 1491             }
 1492        tr.title_row  {
 1493                         background-color: #9C9C9C;
 1494                       }
 1495        tr.body_row   {
 1496                          background-color: #CFCFCF;
 1497                       }
 1498 
 1499        th.c1 {
 1500                text-align: center;
 1501                font-size: 143%;
 1502              }
 1503        p.c3 {font-size: 80%; text-align: center}
 1504        div.c2 {margin-left: 2em}
 1505      -->
 1506     </style>
 1507 END
 1508 
 1509   $self->output_style_element;
 1510 
 1511 print <<END;
 1512   </head>
 1513   <body>
 1514     <table border="0" width="600" summary="">
 1515       <tr class="title_row">
 1516         <th class="c1">$etitle</th>
 1517       </tr>
 1518       <tr class="body_row">
 1519         <td>
 1520           $error_body
 1521           <hr size="1" />
 1522           <p class="c3">
 1523             <a href="http://nms-cgi.sourceforge.net/">FormMail</a>
 1524             &copy; 2001-2003 London Perl Mongers
 1525           </p>
 1526         </td>
 1527       </tr>
 1528     </table>
 1529   </body>
 1530 </html>
 1531 END
 1532 }
 1533 
 1534 =item mailer ()
 1535 
 1536 Returns an object satisfying the definition in L<CGI::NMS::Mailer>,
 1537 to be used for sending outgoing email.
 1538 
 1539 =cut
 1540 
 1541 sub mailer {
 1542   my ($self) = @_;
 1543 
 1544   return $self->{Mailer};
 1545 }
 1546 
 1547 =back
 1548 
 1549 =head1 SEE ALSO
 1550 
 1551 L<CGI::NMS::Script>
 1552 
 1553 =head1 MAINTAINERS
 1554 
 1555 The NMS project, E<lt>http://nms-cgi.sourceforge.net/E<gt>
 1556 
 1557 To request support or report bugs, please email
 1558 E<lt>nms-cgi-support@lists.sourceforge.netE<gt>
 1559 
 1560 =head1 COPYRIGHT
 1561 
 1562 Copyright 2003 London Perl Mongers, All rights reserved
 1563 
 1564 =head1 LICENSE
 1565 
 1566 This module is free software; you are free to redistribute it
 1567 and/or modify it under the same terms as Perl itself.
 1568 
 1569 =cut
 1570 
 1571 1;
 1572