#!/usr/bin/perl -w

# email_list.cgi
# This script uses CGI.pm to generate an html form.  This form
# allows the user to subscribe to or unsubscribe from an email list.
# The data is lightly screened.  If there are problems, the form is
# reposted with suggested corrections.
# The form data is saved in a file and emailed to someone.

use CGI qw(:standard);
use CGI::Pretty qw( :html3 );
use CGI::Carp qw(fatalsToBrowser);

# Initialize Script
my $template_top    = "top.ht";
my $template_bottom = "bottom.ht";
my $title           = "NumbersAndKabbalah.org";
my $base_url        = "NumbersAndKabbalah.org";

#my $style = "nak.css";
my $owner     = "Kathy Bernstein";
my $contact   = "kathy0123\@cox.net";
# my $directory = "../../data/";
my $directory = "../data/";
my $list_file = "list.txt";
my $backup    = "old_list.txt";

# Get localtime to format and print current date
my $todayis = localtime;

#  Variables for use throughout script
my $name    = param('name');
my $email   = lc( param('email') );
my $message = "";                     # for use in notification

my $choice = lc( param("submit") );   # get choice, lowercased

# Start html output for form and feedback
print header (),
  start_html(
    -title  => "$title email list",
    -author => "$contact",
    -xbase  => "http://$base_url"
  );

# Print beginning of html page from top of template
top();

# Review form request and process accordingly
if ( $choice eq "" )    # display initial form
  {
    display_form();
  }
elsif ( $choice eq "submit" )    # process form request
  {
    process_form();
  }
else                             # deal with anything else
  {
    print p ( escapeHTML("Logic error, unknown choice: $choice \n") );
  }

sub display_form
  {
    print h3 ( { -align => "center" }, "Email Announcement List" ),

      p(
"Occasionally I send out announcements via email of my upcoming workshops, and other events of interest. Your email address will only be used for these announcements; this is a very low volume one-way (no posting) email list!"
      );

    print p (
"You can use this form to join or leave the announcement list. Names are optional."
    );

    print start_form ( -action => url() ),
      hidden( -name => "date", -value => "$todayis" ),

      table(
        { -align => "center" },
        Tr(
            td("Name:"),
            td(
                textfield( -name => "name", -size => 30, -maxlength => 50 ),
                "(optional)"
            )
        ),

        Tr(
            td("Email address:"),
            td( textfield( -name => "email", -size => 60, -maxlength => 80 ) )
        ),

        Tr(
            td(""),
            td(
                radio_group(
                    -name   => "action",
                    -values => [ "subscribe", "unsubscribe" ],
                    -labels => {
                        "subscribe"   => "Subscribe",
                        "unsubscribe" => "Unsubscribe"
                    },
                    -rows    => "2",
                    -default => "subscribe"
                )
            )
        ),

        Tr(
            td(
                { -colspan => "2", -align => "center" },
                submit( -name => "submit", -value => "Submit" )
            )
        )
      ),
      end_form();

    bottom();
  }

# Check form fields for data and a proper email address
# display error messages and repost form with data if
# there is a problem

sub process_form
  {

    # Determine which key fields are present from form
    my @names = param();    # get list of parameter names

    my @errors = ();        # array to collect error messages about form data
    my $value    = param('email');    # get email address for special check
    my $checkval = "1";               # 0/1 email is bad/good

    # perform a field-specific check on email
    $value = "" unless defined($value);    # convert undef to empty string
    $value = trim($value);                 # trim whitespace from front and back
    $value = collapse_whitespace($value);  # trim whitespace from front and back
    param( -name => $test, -value => $value )
      ;    # put modified values back into environment
    push( @errors, "email" ) if $value eq "";

    $checkval = looks_like_email($value);
    if ( !$checkval && $value )
      {
        $test = "Are you sure that $value is an email address?";
        push( @errors, $test );
      }

    # Print error mesages or continue if all is well
    if ( !@names )    # initial script invocation
      {
        print p ("(no elements present)");
        display_form();    # redisplay entry form
        return;
      }
    elsif ( (@errors) )    # subsequent script invocation
      {

        # Print errors, redisplay form
        if (@errors)
          {
            print p (
                font(
                    { color => "red" },
                    "There was a problem with your submission. ",
                    "Please review the following field(s):"
                )
              ),
              ul( li( font( { color => "red" }, \@errors ) ) );

            display_form();    # redisplay entry form
            return;
          }
      }
    else
      {

        # print h2(
        #    "Thank you for your interest in our mailing list.",
        #    br("We will get back to you soon.")
        #  ),

        print h3( "Thank you.", br("Result:") ),

          p( "Date:" . $todayis ),
          p(
            blockquote(
                strong( "\"" . param('name') ) . "\"" . "<"
                  . param('email') . ">",
                br(),
                strong("Action: ") . param('action')
            )
          ),
          hr();

        save_address();
      }
  }

# Subscribe or unsubscribe individuals
sub save_address
  {

    # Initialize arrays, old and new, for unsubscription
    my @addresses = ();
    my @new_list  = ();

    # Subscribe individual to list
    if ( param('action') eq 'subscribe' )
      {
        if ( find() )
          {
            print h3 (
                "There's no need to subscribe your address, ",
                b($email), ", is already in the list."
            );
            bottom();
            $message =
"$name, $email, attempted to subscribe but was already on the list.";
          }
        else
          {

            # Begin recording address
            open( LIST, ">>$directory$list_file" )
              || ERROR( 'append to', 'email list for subscription' );

            print LIST qq(\n"$name" <$email>);

            close(LIST)
              || ERROR( 'close', 'appended email list following subscription' );

            # End recording address

            print h3 ( "Your address was successfully subscribed to the list.",
            );

            bottom();
            $message = "$name, $email, subscribed to the list successfully.";
          }
      }

    # Unsubscribe individual from list
    elsif ( param('action') eq 'unsubscribe' )
      {
        if ( find() )
          {

            # open address list, read to array
            open( LIST, "$directory$list_file" )
              || ERROR( 'read', 'email list' );
            @addresses = <LIST>;
            close(LIST) || ERROR( 'close', 'email list it just read' );

            # search address list for individual to unsubscribe
            foreach (@addresses)
              {
                unless ( $_ =~ m/$email/i )
                  {
                    push( @new_list, $_ );
                  }
              }

            # back up address list, overwrite, before unsubscription
            open( OLDLIST, ">$directory$backup" )
              || ERROR( 'over write',
                'backup email last following unsubscription' );
            print OLDLIST @addresses;
            close(OLDLIST)
              || ERROR( 'close', 'backup email list' );

            # overwrite addresses to list after unsubscribing
            open( NEWLIST, ">$directory$list_file" )
              || ERROR( 'over write', 'email list following unsubscription' );
            print NEWLIST @new_list;
            close(NEWLIST)
              || ERROR( 'close',
                'overwritten email list following unsubscription' );

            print h3 ( "Your address was successfully removed.", );

            bottom();
            $message =
              "$name, $email, unsubscribed from the list successfully.";

          }
        else
          {
            print h3 (
                "No need to unsubscribe your address, ",
                b($email), ", was not in the list.",
            );
            bottom();
            $message =
"$name, $email, attempted to unsubscribe but was not on the list.";

          }
      }

    # deal with any wierd stuff
    else
      {
        print h3 ( "Sorry, I don't know how to handle your request.", );
        bottom();
      }
    mail_form();
  }

# notify someone that this form has been used
sub mail_form
  {

    # mail_form.cgi

    # bundle up form output and mail it to the specified address

    # configuration:

    my $sendmail  = '/usr/sbin/sendmail';       # where is sendmail?
    my $recipient = qq("$owner" <$contact>);    # who gets the form data?
    my $sender    = "$contact";                 # default sender?
    my $subject = "Email list: " . param('action') . "$name";

    # bundle up form submissions into a mail_body

    # set an appropriate From: address

    if ($email)
      {

        # the user supplied an email address
        $email =~ s/\n/ /g;
        $sender = $email;
      }

    # send the email message

    open MAIL, "|$sendmail -oi -t" or die "Can't open pipe to $sendmail: $!\n";

    print MAIL "To: $recipient \n";
    print MAIL "From: $sender \n";
    print MAIL "Subject: $subject \n\n";

    print MAIL "$message";

    close MAIL or die "Can't close pipe to $sendmail: $!\n";

  }

# print top of page from top template
sub top
  {

    # open top.ht file to read and print the contents
    open( TOP, "$template_top" ) || ERROR( 'open', 'file' );
    my @top = <TOP>;
    close(TOP) || ERROR( 'close', 'file' );

    print @top;

  }

# print bottom of page from bottom template
sub bottom
  {

    # open bottom.ht file to read and print the contents
    open( BOTTOM, "$template_bottom" ) || ERROR( 'open', 'file' );
    my @bottom = <BOTTOM>;
    close(BOTTOM) || ERROR( 'close', 'file' );

    print @bottom;

  }

# check to see if a given email address is in the list (1) or not (0)
sub find
  {
    my @addresses = ();
    my $group     = "";

    # open address list, read to array
    open( LIST, "$directory$list_file" ) || ERROR( 'read', 'file for review' );
    @addresses = <LIST>;
    close(LIST) || ERROR( 'close', 'file after review' );

    # search address list for individual to unsubscribe
    foreach (@addresses)
      {
        chomp;
        $group .= $_;
      }
    return ( $group =~ m/$email/i );
  }

# Show a more innocuous error message:
sub ERROR
  {
    print "The server can't $_[0] the $_[1]: $! \n";

    #print "Msg007 $_[0] $_[1] $1 \n";
    exit;
  }

# Trim leading/trailing whitespace from string.
# Also converts undef to the empty string.  This suppresses warnings
# for undefined values that would result if -w is specified on the
# script's #! line.

#@ TRIM
sub trim
  {
    my $str = shift;

    return "" if !defined $str;
    $str =~ s/^\s+//;
    $str =~ s/\s+$//;
    return ($str);
  }

#@ TRIM

# Collapse runs of white space in string to single spaces

#@ COLLAPSE_WHITESPACE
sub collapse_whitespace
  {
    my $str = shift;

    return "" if !defined $str;
    $str =~ s/\s+/ /g;
    return ($str);
  }

#@ COLLAPSE_WHITESPACE

# Check a string to see whether or not it looks like an email address.
# The test uses a rudimentary pattern that requires a user name, an @
# character, and a hostname containing at least two components.
# Return true/false if string does/does not pass test.

#@ LOOKS_LIKE_EMAIL
sub looks_like_email
  {
    my $str = shift;

    return ( $str =~ /^[^@]+@[^.]+\.[^.]/ );
  }

#@ LOOKS_LIKE_EMAIL