#!/usr/bin/perl
#
# File:    signup.pl
# Purpose: Handle emailing form output for an activity signup form.
# Author:  G. Wade Johnson
#
# Dependencies:
#     CGI.pm
#     CGI::Carp.pm
#     sendmail
#

use CGI qw/:standard/;
use CGI::Carp;

use strict;
use vars qw/$SendMail $sep $listsep $To $CC $ReplyTo $Subject $From
            %text_format %html_format @RequiredParameters
	    $MailTemplate $PageTemplate $ErrorTemplate $GroupDescr/;

my $VERSION = 0.5;

my $cfgdir    = 'conf';
my $defconfig = "$cfgdir/default.conf";

my %Groups        = ();

#--------------------------------------------------------
#  The actual program starts here
my $q          = CGI->new();
my $DebugLevel = $q->param( '_debug' );

if(-e $defconfig)
 {
  unless(eval{ do $defconfig })
   {
    exit_errmsg( "Unable to read default configuration.: $!\n" );
   }
 }
 
my $config = $q->param( 'cfg' );
if($config)
 {
  $config =~ tr/-a-zA-Z._//cd;
  $config = "$cfgdir/$config.conf";

  unless(eval { do $config })
   {
    exit_errmsg( "Unable to read configuration.: $!\n" );
   }
 }

eval { parse_group_description( $GroupDescr ) };
if($@)
 {
  exit_errmsg( "Error parsing group descriptions: $!\n" );
 }


# Test for required parameters
check_required_parameters( $q, @RequiredParameters );
my $isHtml = is_html( $MailTemplate );
my $fmt = $isHtml ? \%html_format : \%text_format;

eval {
  # Send mail message
  my %Message = 
     ( from    => $From,
       to      => expand_macro_list( $To ),
       cc      => expand_macro_list( $CC ),
       replyto => expand_macro_list( $ReplyTo ),
       subject => expand_macros( $Subject ),
       msg     => expand_macros( $MailTemplate, $fmt ),
     );
  $Message{type} = "text/html" if $isHtml;

  if($DebugLevel)
   {
    foreach my $p (qw(from to cc replyto subject type msg))
     {
      printf "%-8.8s: %s\n", $p, $Message{$p} if exists $Message{$p};
     }
   }
  else
   {
    mail_message( %Message );
   }
  };
if($@)
 {
  send_errmsg( "Unable to send email, try again later." );
  die $@;
 }

# Send confirmation page
print "Content-Type: text/html\r\n\r\n",
      expand_macros( $PageTemplate, \%html_format );

exit( 0 );


#-------------------------------------------
#  Subroutines
sub  expand_macros
 {
  my $output = shift;
  my $format = shift;

  eval {
      $output =~ s/{{([^}]+)}}/format_value( $format, $1 )/gems;
   };
  if($@)
   {
    send_errmsg( "Formatting problem, try again later." );
    die $@;
   }
  
  $output;
 }

sub expand_macro_list
 {
  my $output = expand_macros( @_ );

  # clean out extra commas.
  $output =~ s/^(\s*,\s*)+//;
  $output =~ s/(\s*,\s*)+$//;
  $output =~ s/(,\s*){2,}/, /;

  $output;
 }

sub format_value
 {
  my $format = shift;
  my $key    = shift;
  my @vals   = ();

  if($key =~ /email\[([^]]+)\]/)
   {
    my $grp = $q->param( $1 );
    if(exists $Groups{$grp} and defined $Groups{$grp}->{emails})
     {
      @vals = @{$Groups{$grp}->{emails}}
     }
    elsif(exists $Groups{'DEFAULT'} and defined $Groups{'DEFAULT'}->{emails})
     {
      @vals = @{$Groups{'DEFAULT'}->{emails}}
     }
   }
  elsif($key =~ /group\[([^]]+)\]/)
   {
    my $grp = $q->param( $1 );
    @vals = $Groups{$grp}->{long}
              if exists $Groups{$grp} and defined $Groups{$grp}->{long};
   }
  elsif($key =~ /groupcontacts\[([^]]+)\]/)
   {
    my $grp = $q->param( $1 );
    @vals = @{$Groups{$grp}->{names}}
              if exists $Groups{$grp} and defined $Groups{$grp}->{names};
   }
  else
   {
    @vals = $q->param( $key );
   }

  return '' unless @vals;

  return join( $listsep, clean_values( @vals ) ) unless defined $format;

  if($vals[0] =~ m/$sep/)
   {
    format_tree( build_tree( clean_values( @vals ) ), $format );
   }
  else
   {
    join( $format->{-listsep}, clean_values( @vals ) );
   }
 }


sub  clean_values
 {
  map { s/</&lt;/g; s/>/&gt;/g; $_ } @_;
 }

sub  build_tree
 {
  my $tree = {};
  
  foreach my $item (@_)
   {
    _build_tree( $tree, split( $sep, $item ) );
   }

  $tree;
 }


sub  _build_tree
 {
  my $tree  = shift;
  my $name  = shift;
  my $value = shift || '';

  if(@_)
   {
    $tree->{$name} = {} unless exists $tree->{$name};
    _build_tree( $tree->{$name}, $value, @_ );
   }
  elsif(exists $tree->{$name})
   {
    if(ref $tree->{$name})
     {
      push @{$tree->{$name}}, $value;
     }
    else
     {
      $tree->{$name} = [ $tree->{$name}, $value ];
     }
   }
  else
   {
    $tree->{$name} = $value;
   }
 }


sub  format_tree
 {
  my $tree   = shift;
  my $format = shift;

  $format->{-pretree}._format_tree( $tree, %{$format} ).$format->{-posttree};
 }


sub  _format_tree
 {
  my $tree   = shift;
  my %parms  = @_;
  my $lead   = $parms{-preitem};
  my $output = '';

  foreach my $item (sort keys %{$tree})
   {
    $output .= $parms{-pretopitem} unless $parms{-level};
    if('HASH' eq ref $tree->{$item})
     {
      $output .= "$lead$item:";
      $output .= $parms{-prechildren};
      $output .= _format_tree( $tree->{$item},
                               %parms,
                               -preitem => $parms{-addpre}.$lead,
			       -level => $parms{-level}+1
                             );
      $output .= "$parms{-postchildren}$parms{-postitem}";
     }
    elsif('ARRAY' eq ref $tree->{$item})
     {
      $output .= join( "", map { "$lead$item: $_$parms{-postitem}" } @{$tree->{$item}} );
     }
    else
     {
      $output .= "$lead$item: $tree->{$item}$parms{-postitem}";
     }
   }

  $output;
 }



sub  check_required_parameters
 {
  my $q = shift;

  foreach my $parm (@_)
   {
    my @vals = $q->param( $parm );
    if(!@vals or '' eq $vals[0])
     {
      exit_errmsg( "Missing required parameter '$parm', go back and try again." );
     }
   }
 } 



sub  send_errmsg
 {
  my $msg = shift;

  my $output = $ErrorTemplate;
  $output =~ s/{\$errormsg\$}/$msg/smg;
  
  eval { $output = expand_macros( $output, \%html_format ) };
  
  print "Content-Type: text/html\r\n\r\n$output";
 }



sub mail_message
 {
  my %params = @_;
  local *MAIL;
  
  open( MAIL, "|$SendMail -oi -t" ) or die "Unable to fork sendmail: $!";

  print MAIL "From: $params{from}\n"         if $params{from};
  print MAIL "To: $params{to}\n"             if $params{to};
  print MAIL "Cc: $params{cc}\n"             if $params{cc};
  print MAIL "Reply-To: $params{replyto}\n"  if $params{replyto};
  print MAIL "Subject: $params{subject}\n"   if $params{subject};
  print MAIL "Content-Type: $params{type}\n" if $params{type};
  print MAIL "\n$params{msg}\n";

  close( MAIL ) or die "Unable to close sendmail: $!";
 }



sub  parse_group_description
 {
  my $descr = shift;

  my $key = '';
  foreach my $line (split $/, $descr )
   {
    $line =~ s/#.*//;
    next if $line =~ /^\s*$/;

    my ($first,$second) = map { trim( $_ ) } split( /:/, $line, 2 );
    unless($line =~ /^\s+/ and $first)
     {
      $key = $first;
      $Groups{$key}->{long} = $second || $first;
     }
    elsif($first)
     {
      push @{$Groups{$key}->{emails}}, $first;
      push @{$Groups{$key}->{names}}, $second || $first;
     }
   }
 }

sub  trim
 {
  my $str = shift;

  $str =~ s/^\s+//;
  $str =~ s/\s+$//;

  $str;
 }


sub  exit_errmsg
 {
  send_errmsg( @_ );
  exit( 0 );
 }


sub  load_file
 {
  my $filename = shift;
  my $fh;
  my $out = '';

  open( $fh, $filename ) or die "Unable to load '$filename': $!";
  local $/ = undef;
  $out = <$fh>;
  close( $fh ) or die "Unable to close '$filename': $!";
  
  $out;
 }


sub  is_html
 {
  $_[0] =~ /<html[^>]*>/ism and
  $_[0] =~ /<\/html>/ism;
 }

__DATA__

=head1 NAME

signup.pl - a script for automating on-line signup for volunteer events.

=head1 DESCRIPTION

This script was written to simplify the use of an on-line signup form for
volunteer participation in events. This script does not support scheduling
or conflict resolution through any database. It's only purpose was to automate
the email-based system my wife was already using for this job.

The only action this script takes is to call the sendmail program to mail
the results of this signup request to the listed recipients. It also returns
an HTML page with the same information to the user.

=head1 PREREQUISITES

This script require the C<CGI> and C<CGI::Carp> modules. It also explicitly
depends on access to sendmail.

=head1 COREQUISITES

None

=head1 OSNAMES

any, provided access to a sendmail program

=head1 SCRIPT CATEGORIES

unknown

=head1 INSTALLATION

Installation of the B<signup.pl> script is a simple 4 step process.

=over 4

=item 1.

Copy the B<signup.pl> file to an appropriate CGI directory on your web server.

=item 2.

Create a directory named C<conf> in the directory where B<signup.pl> will run.

=item 3.

Copy the C<default.conf> file to the C<conf> directory.

=item 4.

Change the configuration parameters to match your application. 

=back

=head1 USAGE

The signup.pl script is designed to be called from an HTML form. The ACTION
attribute of the FORM should point to the signup.pl script you installed. For
example, if you installed B<signup.pl> in the directory referenced by
C</cgi-bin/> on the server I<www.volunteer.org>, you would set the ACTION
attribute to the following:

	http://www.volunteer.org/cgi-bin/signup.pl

When the results of a signup form are directed to the B<signup.pl> script, it
sends a customized email to a list of addresses where the submission is
processed. The script also returns a customized confirmation page to the
volunteer that lists the submitted information.

The signup.pl script can be used for multiple independent events by building a
configuration file for each event. All of the information common to all events
would still reside in default.conf. All of the event-specific information would
be placed in separate configuration files.

To access an alternate configuration file, provide a I<cfg> parameter providing
the name of the appropriate file (without the I<.conf> extension). The
B<signup.pl> script will read this file after reading C<default.conf>, modifying
the configuration accordingly.

=head1 CONFIGURATION

The B<signup.pl> script has several configurable options. These allow you to
specify the look of the confirmation page sent to the volunteer and the format
and recipients of the submission email.

The configuration files are loaded from the C<conf> subdirectory under the
directory the script runs in. Configuration files located in other locations
will not be found.

There are two ways to determine the configuration files that are loaded.

First, the file C<default.conf> in the C<conf> subdirectory is always loaded if
it exists. This allows for default configuration parameters even if you use
B<signup.pl> for several different projects.

In addition, a second file is named by the I<cfg> parameter to the B<signup.pl>
script. The value of this parameter is the name of the file without the
C<.conf> extension. If the value of I<cfg> is I<conference>, the file read will
be C<conf/conference.conf>. This file is read after C<default.conf> and allows
overriding of the configuration parameters as necessary for a particular
application.

The configuration files must be valid Perl code. If you receive compile errors
from Perl when running the script, you likely have syntax errors in your
configuration file.

All of the configuration files must return I<TRUE> in order for Perl to use
them properly. The easiest way to accomplish this is to end the script with
the line

	1;

=head2 CONFIGURATION VARIABLES

=over 4

=item $SendMail

This is the complete path to the sendmail program.

=item $sep

Define the separator string used in determining the fields of the schedule
shift fields.

=item $listsep

Define the output separator string used for writing the output of the various
fields.

=item $To

This string lists the I<To> addresses for the sendmail program. It may contain
replaceable parameters of the form {{name}}. See L</"REPLACEABLE PARAMETERS">
for details.

=item $CC

This string lists the I<CC> addresses for the sendmail program. It may contain
replaceable parameters of the form {{name}}. See L</"REPLACEABLE PARAMETERS">
for details.

=item $ReplyTo

This string lists the I<ReplyTo> addresses for the sendmail program. It may
contain replaceable parameters of the form {{name}}. See L</"REPLACEABLE PARAMETERS">
for details.

=item $Subject

This string lists the subject field for the mail to be sent by sendmail. It
may contain replaceable parameters of the form {{name}}. See L</"REPLACEABLE PARAMETERS">
for details.

=item $From

This string contains the I<From> address for the sent email. It must not contain
replaceable parameters.

=item %text_format

This hash contains instructions for converting the schedule descriptions into
a text format. See L</"FORMATTING"> for details.

=item %html_format

This hash contains instructions for converting the schedule descriptions into
an HTML format. See L</"FORMATTING"> for details.

=item @RequiredParameters

This array contains the names of the CGI parameters that are required for
submission. If one or more of these parameters is missing, an error page is
returned to the user and no email is sent.

=item $MailTemplate

This string contains a the general format of the email messages. The text
will be sent as the body of the email message after replacing any parameters
of the form {{name}} with the appropriate text. See L</"REPLACEABLE PARAMETERS">
for details. The value of this parameter may also be a call of the form
C<load_file( "conf/htmlmail.tmpl" );>. This call sets the variable to the
contents of the file B<conf/htmlmail.tmpl>.

The contents of this string may be either straight text for a simple plain
text email or valid HTML. If the string is HTML, an HTML email message is
sent instead of plain text. This allows for more formatting options. The
B<signup.pl> script determines the whether or not the text is HTML by looking
for both the C<< <html> >> and C<< </html> >> tags.

=item $PageTemplate

This string contains a the general format of the confirmation page as HTML. The
page will be returned to the user's browser after replacing any parameters
of the form {{name}} with the appropriate text. See L</"REPLACEABLE PARAMETERS">
for details. The value of this parameter may also be a call of the form
C<load_file( "conf/confirm.tmpl" );>. This call sets the variable to the
contents of the file B<conf/confirm.tmpl>.

=item $ErrorTemplate

This string contains a the general format of the error messages as HTML. Upon
detecting an error, B<signup.pl> returns this page to the user's browser after
replacing any parameters of the form {{name}} with the appropriate text. See
L</"REPLACEABLE PARAMETERS"> for details. The token {$errormsg$} is replaced
with the actual text of the error message. The value of this parameter may
also be a call of the form C<load_file( "conf/error.tmpl" );>. This call sets
the variable to the contents of the file B<conf/error.tmpl>.

=item $GroupDescr

This string contains the I<group descriptor>. This is a list of the groups
participating in the event, the full group names, and the group's contact
people. This information may be used to help customize the email used to
report the volunteer and the confirmation page. The value of this parameter
may also be a call of the form C<load_file( "conf/groups.desc" );>. This
call sets the variable to the contents of the file B<conf/groups.desc>.
See L</"GROUPS"> for details.

=back

=head2 FORMATTING

The signup script has a capability for nice formatting of structured
parameters. If a parameter value has the defined separator character embedded
(; by default) in it, B<signup.pl> splits the value into fields on that
character and formats it in an outline form. The formatting is controlled
through the use of one of two hashes, C<%text_format> and C<%html_format>.
These hashes define a list of strings for use in different portions of the
formatting process. These strings are

=over 4

=item -listsep

output separator for simple list items

=item -pretree

write before tree output

=item -posttree

write after tree output

=item -preitem

before each item in the tree

=item -postitem

after each item in the tree

=item -addpre

prepended to the -preitem for a new level

=item -pretopitem

written before -preitem on the upper-most items

=item -posttopitem

written after -postitem on the upper-most items

=item -prechildren

written before output of child elements

=item -postchildren

written after output of child elements

=back

The default version of C<%text_format> generates a tab-indented outline format.
The default version of C<%html_format> generates a nested I<unordered list>
format.

=head2 GROUPS

In some volunteer events, a person may wish to represent a particular group
when signing up. The Group Description variable gives B<signup.pl> the
capability of dealing with this kind of information. The contents of the
C<$GroupDescr> variable must be a multiline string that looks like the
following:

  BFC:Bob's Fone Company
     bob@bfc.com
     edna@bfc.com:Edna C. Potts
  SPCA:SPCA
     coordinator@spca.org:Myra Katz
  DEFAULT
     info@example.org


Each group is defined by a line containing an abbreviation that is used
in any parameters sent by the script. Following that may be a colon followed
by the group's full name. After that line is zero or more indented lines
ginving contact information, one contact per line. Each line is an email address
followed by an optional colon and person's name.

There may also be a special entry with a value of C<DEFAULT>. The contacts
under the default entry are used in any case where no group or an unrecognized
group is supplied.

=head2 REPLACEABLE PARAMETERS

The confirmation page, confirmation email, and error page have the capability
of supporting replaceable parameters. These parameters customize the page (or
mail headers) based on choices made by the volunteer. There are three different
forms of these parameters:

=over 4

=item C<{{param}}>

This kind of parameter will be replaced by the value of the named parameter.
For instance, if the form used with B<signup.pl> has a parameter called I<name>
and the string I<{{name}}> is used in the email, the value of the name parameter
will replace the string I<{{name}}> in the email.

If the value of a parameter contains the special C<$sep> value the output will
be formatted as a list.

=item C<{{set[param]}}>

This kind of parameter uses the value of the supplied parameter to look up a
value in one a few sets of information related to groups. The legal values for
the I<set> are I<email>, I<group>, or I<groupcontacts>. These correspond to the
group contact email list, the full group name, and the group contacts. The
string in square brackets is used as a form parameter name. The value of this
parameter is used to look up the information supplied in the group description.

For example, given a parameter of C<grp> with a value of I<BFC>, the following
results would be returned using the group descriptor from the previous section.

=over 4

=item C<{{email[grp]}}>

bob@bfc.com, edna@bfc.com

=item C<{{group[grp]}}>

Bob's Fone Company

=item C<{{groupcontacts[grp]}}>

bob@bfc.com, Edna C. Potts

=back

In the last case, the email address is used for the first contact because no
name was given. By the same token, the abbreviated name would be used for the
group if no full name were given.

=item C<{$errormsg$}>

This parameter only is used in the error page. It is replaced with the actual
text of the error message.

=back

=cut