# ==================================================================
# Links SQL - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,070,083,087,091 
#   Revision : $Id: MassMailer.pm,v 1.6 2001/08/30 22:41:21 jagerman Exp $
# 
# Copyright (c) 2001 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

package Links::MassMailer;
# ==================================================================
# This package contains some builtin functions useful in your templates.
#
    use Links qw/$DB $IN $CFG/;
    use GT::SQL::Condition;
    use GT::Mail::BulkMail qw/$VALID_HOST/;

    use strict;
    use vars qw( %ACTIONS $NEW_TEMPLATE @MONTH @DAY @WEEKDAY );

    use constant DEFAULT_NEWSLETTER_TEMPLATE => <<TEMPLATE;

Title: <%Title%>
URL: <%URL%>
Description
-----------
<%Description%>

TEMPLATE
$NEW_TEMPLATE = '(New template)';

    @MONTH  =   qw/January February March April May June July August September October November December/;
    @DAY    =   qw/blank 1st 2nd 3rd 4th 5th 6th 7th 8th 9th 10th 11th 12th 13th 14th 15th 16th 17th 18th 19th 20th 21st 22nd 23rd 24th 25th 26th 27th 28th 29th 30th 31st/;
    @WEEKDAY =  qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;

# (See _save_template for arguments)
sub add_template ($$$$$$;$) {
    _save_template(@_);
}
# (See _save_template for arguments)
sub save_template ($$$$$$;$) {
    _save_template(@_);
}

# Deletes a template based on its name
sub del_template ($) {
    $DB->table('EmailTemplates')->delete(shift);
}

# Updates (or creates) a row for the template given in EmailTemplates
# Takes up to 6 args:
#   name, from, fromname, subject, message, message format ('text' or 'html'),
#       link template (for newsletter template)
sub _save_template {
    my ($name,$from,$fromname,$subject,$message,$format,$template) = @_;
    for ($name,$from,$fromname,$subject,$message,$template) {
        defined $_ or $_ = "";
    }
    $format = 'text' unless defined $format and $format eq 'html';

    my $table = $DB->table('EmailTemplates');
    if ($table->count({ Name => $name })) {
        $table->update(
            {
                MsgFrom => $from,
                MsgFromName => $fromname,
                Subject => $subject,
                Message => $message,
                MessageFormat => $format,
                LinkTemplate => $template
            },
            {
                Name => $name
            }
        );
    }
    else {
        $table->insert(
            {
                Name => $name,
                MsgFrom => $from,
                MsgFromName => $fromname,
                Subject => $subject,
                Message => $message,
                MessageFormat => $format,
                LinkTemplate => $template
            }
        );
    }
}
    
# Returns a template with the name given by the provided argument.
# Returns a 6 element list of: from, fromname, subject, message, message format ('text' or 'html'), link template for newsletter
sub get_template ($) {
    return @{$DB->table('EmailTemplates')->get(shift,"ARRAY") or [("") x 5, 'text', ""]}[1..6];
}

# Optionally takes a 4 letter prefix of addresses to return.
# Valid prefixes are: LTPL, CSTM.
# The prefix will be stripped
sub template_names (;$) {
    my $prefix = shift || "";
    my @return = map {
        (
            $_->[0] ne 'NWSLTRTMPLT' # ignore the newsletter template
            and (
                ($prefix eq 'LTPL' or substr($_->[0],0,4) ne 'LTPL')
                and
                ($prefix eq 'CSTM' or substr($_->[0],0,4) ne 'CSTM')
            )
        )
        ? $_->[0]
        : ()
    } @{$DB->table('EmailTemplates')->select({ },['Name'])->fetchall_arrayref};
    if ($prefix) {
        return grep s/^\Q$prefix//, @return;
    }
    else {
        return @return;
    }
}

# Returns an HTML option string ("<option value="a">a</option>...") based on the provided arguments.
# Takes 1 to 3 arguments:
#   - an array reference of options
#   - a "selected" option. Any matching option will be given a "selected" tag.
#   - a prefix string. This prefix will be prepended to each value, but not to the option itself.
sub make_opts {
    my $opts = shift;
    my $selected = shift || "";
    my $prefix = shift || "";
    return join "\n", map {
        my $escaped = html_escape($_);
        qq|<option@{[$prefix.$_ eq $selected ? " selected" : ""]} value="$prefix$escaped">$escaped</option>|
    } @$opts;
}

# Returns the HTML escaped version of the provided string.
sub html_escape {
    my $toescape = shift;
    return "" unless defined $toescape;
    $toescape =~ s/&/&amp;/g; # This MUST happen first
    $toescape =~ s/"/&quot;/g;
    $toescape =~ s/</&lt;/g;
    $toescape =~ s/>/&gt;/g;
    return $toescape;
}

# Returns a string such as "Saturday, January 1st, 2000, 00:00:00" for a integral time such as 946713600
sub make_date_string ($) {
    my $date = shift;
    my @lt = localtime($date);
    return "$WEEKDAY[$lt[6]], $MONTH[$lt[4]] $DAY[$lt[3]], ".
    ($lt[5]+1900).", ".sprintf("%02d:%02d:%02d",@lt[2,1,0]);
}

# =========================================
#                  Actions
# =========================================
#
# These subroutines (in the ACTIONS namespace) are called directly when a CGI
# option of: action=option is made.
#

# The default frames page
sub ACTIONS::frames {
    Links::admin_page(
        "email_frames.html",
        {
            version  => $Links::VERSION,
            main     => "admin.cgi?action=main",
            contents => "admin.cgi?action=contents"
        }
    );
}

# A generic error page
sub ACTIONS::error {
    Links::admin_page(
        "email_error.html",
        {
            error => "@_"
        }
    );
}

# The main body page (to be displayed by ACTIONS::frames)
sub ACTIONS::main {
    Links::admin_page(
        "email_default.html",
        { }
    );
}

# The contents page (to be displayed by ACTIONS::frames)
sub ACTIONS::contents {
    Links::admin_page(
        "email_contents.html",
        { }
    );
}

# * -> "Load" (template)
sub ACTIONS::Load {
    my $name = $IN->param('name');
    $ACTIONS::{$IN->param('previous')}->($name,get_template($name))
        if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
}

# * -> "Save" (template)
sub ACTIONS::Save {
    my $name = $IN->param('name');
    return $ACTIONS::{SaveAs}->() if $name eq $NEW_TEMPLATE or $name eq "LTPL$NEW_TEMPLATE"
                                     or $name eq "CSTM$NEW_TEMPLATE";
    my $from     = $IN->param('from');
    my $fromname = $IN->param('fromname');
    my $subject  = $IN->param('subject');
    my $message  = $IN->param('message');
    my $format   = $IN->param('messageformat');
    save_template($name,$from,$fromname,$subject,$message,$format);
    $ACTIONS::{$IN->param('previous')}->($name,(get_template($name))[0..4],"Template saved successfully")
        if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
}

# * -> "Save as..." (template)
sub ACTIONS::SaveAs {
    my $extra = $IN->param('extra');
    my $extraval = $IN->param($extra);
    $IN->delete('name');
    my %substitutions = (
        notes         => "@_",
        from          => defined $IN->param('from') ? scalar $IN->param('from') : "",
        fromname      => defined $IN->param('fromname') ? scalar $IN->param('fromname') : "",
        subject       => defined $IN->param('subject') ? scalar $IN->param('subject') : "",
        message       => defined $IN->param('message') ? scalar $IN->param('message') : "",
        messageformat => defined $IN->param('messageformat') ? scalar $IN->param('messageformat') : "text",
        previous      => defined $IN->param('previous') ? scalar $IN->param('previous') : "",
        hidden_fields => ""
    );
    $IN->delete('from');
    $IN->delete('fromname');
    $IN->delete('subject');
    $IN->delete('message');
    $IN->delete('messageformat');
    $IN->delete('action');
    chomp($substitutions{from});
    if ($substitutions{from} !~ /^[\x21-\x7e]+\@$VALID_HOST\Z/) {
        $ACTIONS::{$IN->param('previous')}->(undef,"",@substitutions{qw/fromname subject message messageformat/},"<font color=red>Invalid e-mail address entered. Correct it before saving the template</font>")
            if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
        return;
    }
    if (defined $extra) {
        $substitutions{extra} = $extra;
        $substitutions{extraval} = $extraval;
    }
    if ($IN->param('previous') and substr($IN->param('previous'),0,8) eq 'selected') {
        $substitutions{hidden_fields} = join "\n", map '<input type=hidden name="'.html_escape($_).'" value="'.html_escape($IN->param($_)).'">', $IN->param;
    }
    for (keys %substitutions) {
        $substitutions{$_} =~ s/&/&amp;/g;
        $substitutions{$_} =~ s/"/&quot;/g;
        $substitutions{$_} =~ s/>/&gt;/g;
        $substitutions{$_} =~ s/</&lt;/g;
    }
    Links::admin_page(
        "email_newtemp_save_as.html",
        \%substitutions
    );
}

# * -> (Template) "Save as..." or "Save" with "(New template)" selected -> "Add Template"
sub ACTIONS::email_newtemp {
    my $new_name = $IN->param('name');
    my $previous = $IN->param('previous');
    my $extra = $IN->param('extra');
    my $extraval = $IN->param($extra);
    $new_name =~ s/^\s+//;
    $new_name =~ s/\s+$//;
    if ($previous eq 'all_links' or $previous eq 'selected_links_search') {
        $new_name = "LTPL".$new_name;
    }
    elsif ($previous eq 'list_mail_list') {
        $new_name = "CSTM".$new_name;
    }
    if ($new_name !~ /\S/ or $new_name eq 'NWSLTRTMPLT' or ($previous ne 'all_links' and 
        $previous ne 'selected_links_search' and substr($new_name,0,4) eq 'LTPL') or
        ($previous ne 'list_mail_list' and substr($new_name,0,4) eq 'CSTM')) {
        $ACTIONS::{SaveAs}->(qq|Bad input: Invalid template name ($new_name)!|);
    }
    else {
        my $from = $IN->param('from');
        chomp($from);
        add_template($new_name,($from =~ /^[\x20-\x7e]+\@$VALID_HOST$/ ? $from : ''),
                     $IN->param('fromname'),$IN->param('subject'),$IN->param('message'),$IN->param('messageformat'));
        $IN->param($extra => $extraval) if defined $extra;
        $ACTIONS::{$previous}->($new_name,(get_template($new_name))[0..4],"Template saved successfully");
    }
}

# * -> "Delete" (template)
sub ACTIONS::Delete {
    del_template($IN->param('name')) if $IN->param('name') and $IN->param('name') ne $NEW_TEMPLATE;
    $ACTIONS::{$IN->param('previous')}->() if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
}

# "All Users","All Links","Newsletter" -> "Send" (mail)
sub ACTIONS::Send {
    my $to = $IN->param('emailsto');
    return unless $to and ($to eq 'EVERYONE' or $to eq 'NEWSLETTER' or $to eq 'LINKOWNERS');

    unless ($IN->param('from') and $IN->param('from') =~ /^[\x21-\x7e]+\@$VALID_HOST\Z/) {
        my %substitutions = (
            notes         => "@_",
            from          => defined $IN->param('from') ? scalar $IN->param('from') : "",
            fromname      => defined $IN->param('fromname') ? scalar $IN->param('fromname') : "",
            subject       => defined $IN->param('subject') ? scalar $IN->param('subject') : "",
            message       => defined $IN->param('message') ? scalar $IN->param('message') : "",
            messageformat => defined $IN->param('messageformat') ? scalar $IN->param('messageformat') : "text",
            previous      => defined $IN->param('previous') ? scalar $IN->param('previous') : "",
            hidden_fields => ""
        );
        $IN->delete('from');
        $IN->delete('fromname');
        $IN->delete('subject');
        $IN->delete('message');
        $IN->delete('messageformat');
        $IN->delete('action');
        $ACTIONS::{$IN->param('previous')}->(undef,"",@substitutions{qw/fromname subject message messageformat/},"<font color=red>Invalid from e-mail address entered. You must correct it before sending the e-mails</font>")
            if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
        return;
    }

    my $sth;
    if ($to eq 'LINKOWNERS') {
        my $cond = new GT::SQL::Condition;
        my $email_cond = new GT::SQL::Condition;
        $email_cond->add( $GT::SQL::PREFIX . 'Links.Contact_Email' => LIKE => '%_%');
        $email_cond->add( $GT::SQL::PREFIX . 'Users.Email' => LIKE => '%_%');
        $email_cond->boolean('OR');
        $cond->add($email_cond);
        $cond->add($GT::SQL::PREFIX . 'Users.ReceiveMail' => 'Yes');
        $sth = $DB->table('Links','Users')->select($cond,[$GT::SQL::PREFIX . 'Links.Contact_Email',$GT::SQL::PREFIX . 'Users.Email',$GT::SQL::PREFIX . 'Links.ID']);
    }
    else {
        my $cond = new GT::SQL::Condition;
        $cond->add(Email => Like => '%_%');
        $cond->add(ReceiveMail => 'Yes');
        $cond->add(Newsletter => 'Yes') if $to eq 'NEWSLETTER';
        $sth = $DB->table('Users')->select($cond, ['Email']);
    }
    my $mailingnum = $DB->table('MailingIndex')->insert(
        extra    => ($to eq 'LINKOWNERS' ? 'Links' : 'Users'),
        mailfrom => $IN->param('from'),
        name     => $IN->param('fromname'),
        subject  => $IN->param('subject'),
        message  => $IN->param('message'),
        messageformat => $IN->param('messageformat')
    )->insert_id;
    my $emailtable = $DB->table('EmailMailings');
    while (my $mail = $sth->fetchrow_arrayref()) {
        $emailtable->insert(
            Mailing => $mailingnum,
            Email => ($to eq 'LINKOWNERS' ? ($mail->[0] || $mail->[1]) : $mail->[0]),
            Sent => 0,
            (@$mail > 1 ? (LinkID => $mail->[2]) : ())
        );
    }
    $ACTIONS::{mailings}->('Mailing queued for sending. To send, select "Start mailing" below beside the mailing you just queued.');
}

# * -> "x recipients"
sub ACTIONS::list_addresses {
    my $to = $IN->param('emailsto');
    return unless defined $to;
    if ($to eq 'EVERYONE' or $to eq 'NEWSLETTER' or $to eq 'LINKOWNERS') {
        my $cond = new GT::SQL::Condition;
        if ($to eq 'LINKOWNERS') {
            my $email_cond = new GT::SQL::Condition;
            $email_cond->add($GT::SQL::PREFIX . "Links.Contact_Email" => LIKE => '%_%');
            $email_cond->add($GT::SQL::PREFIX . "Users.Email" => LIKE => '%_%');
            $email_cond->boolean("OR");
            $cond->add($email_cond);
            $cond->add($GT::SQL::PREFIX . "Users.ReceiveMail" => 'Yes');
        }
        else {
            $cond->add(Email => Like => '%_%');
            $cond->add(ReceiveMail => 'Yes');
            $cond->add(Newsletter => 'Yes') if $to eq 'NEWSLETTER';
        }
        my @t = $to eq 'LINKOWNERS' ? ('Links','Users') : ('Users');
        Links::admin_page(
            "email_list.html",
            {
                addresses => join "<br>\n",
                    map { $_->[0] =~ /\S/ ? ($_->[0]) : ($to eq 'LINKOWNERS' ? $_->[1] : ()) }
                        @{$DB->table(@t)->select($cond,[$to eq 'LINKOWNERS' ? ($GT::SQL::PREFIX . 'Links.Contact_Email', $GT::SQL::PREFIX . 'Users.Email') : $GT::SQL::PREFIX . 'Users.Email'])->fetchall_arrayref}
            }
        );
    }
    elsif ($to eq 'CUSTOMLIST') {
        my $id = $IN->param('ID');
        Links::admin_page(
            "email_list.html",
            {
                addresses => join "<br>\n", map $_->[0],
                @{$DB->table('MailingList')->select({ ID => $id },['Email'])->fetchall_arrayref}
            }
        );
    }
    elsif ($to eq 'SELECTEDUSERS' or $to eq 'SELECTEDLINKS') {
        my $tablename = $to eq 'SELECTEDUSERS' ? 'Users' : 'Links';
        my $table = $DB->table($tablename);
        $IN->delete("action");
        my $sth = $table->query_sth($IN);
        my @emails;
        if ($tablename eq 'Links') {
            my $Users = $DB->table('Users');
            while ($_ = $sth->fetchrow_hashref) {
                my ($Email, $ReceiveMail) = $Users->select({ Username => $_->{'LinkOwner'} }, ['Email','ReceiveMail'])->fetchrow_array;
                push @emails, $_->{Contact_Email} || $Email if $ReceiveMail and $ReceiveMail eq 'Yes';
            }
        }
        else {
            while ($_ = $sth->fetchrow_hashref) {
                push @emails, $_->{Email};
            }
        }
        Links::admin_page(
            "email_list.html",
            {
                addresses => join("<br>\n", @emails)
            }
        );
    }
    else {
        Links::admin_page(
            "email_list.html",
            {
                addresses => join "<br>\n", map $_->[0],
                @{$DB->table('EmailMailings')->select({ Mailing => $to },['Email'])->fetchall_arrayref()}
            }
        );
    }
}

# "All Users"
sub ACTIONS::email_everyone {
    my ($selected,$from,$fromname,$subject,$message,$format,$error) = splice @_,0,7;
    my $cond = new GT::SQL::Condition;
    $cond->add(Email => Like => '%_%');
    $cond->add(ReceiveMail => '=' => 'Yes');
    Links::admin_page(
        "email_everyone.html",
        {
            number    => $DB->table('Users')->count($cond),
            templates => make_opts([$NEW_TEMPLATE,template_names()],$selected),
            from      => html_escape($from),
            fromname  => html_escape($fromname),
            subject   => html_escape($subject),
            message   => html_escape($message),
            messageformat => make_opts([qw/text html/],$format),
            error     => $error || ""
        }
    );
}

# "All Links"
sub ACTIONS::all_links {
    my ($selected,$from,$fromname,$subject,$message,$format,$error) = splice @_,0,7;
    my $cond = new GT::SQL::Condition;
    my $email_cond = new GT::SQL::Condition;
    $email_cond->add($GT::SQL::PREFIX . 'Links.Contact_Email' => 'LIKE' => '%_%');
    $email_cond->add($GT::SQL::PREFIX . 'Users.Email' => LIKE => '%_%');
    $email_cond->bool('OR');
    $cond->add($email_cond);
    $cond->add($GT::SQL::PREFIX . "Users.ReceiveMail" => 'Yes');
    Links::admin_page(
        "email_link_owners.html",
        {
            number    => ($DB->table('Links','Users')->count($cond)),
            templates => make_opts([$NEW_TEMPLATE,template_names('LTPL')],$selected,"LTPL"),
            from      => html_escape($from),
            fromname  => html_escape($fromname),
            subject   => html_escape($subject),
            message   => html_escape($message),
            messageformat => make_opts([qw/text html/],$format),
            error     => $error || ""
        }
    );
}

# "Selected Users"
sub ACTIONS::selected_users {
    my $html = $DB->html($DB->table('Users'), $IN);
    $html->{code}{ReceiveMail} = sub {qq{<tr><td valign=top align=left width='20%'><font face="Tahoma,Arial,Helvetica" size=2>ReceiveMail</font></td><td valign=top align=left width='70%'><font face="Tahoma,Arial,Helvetica" size=2><input type=hidden name=ReceiveMail value=Yes>Yes\n</font></td><td valign=top align=left width="10%"><font face="Tahoma,Arial,Helvetica" size=2>&nbsp;</font></td>\n}};
    Links::admin_page(
        "email_selected_users.html",
        {
            message => "@_",
            form => $html->form({ mode => 'search_form', search_opts => 1 }),
        }
    );
}

# "Selected Users" -> "Search"
sub ACTIONS::selected_users_search {
    my ($selected,$from,$fromname,$subject,$message,$format,$error) = splice @_,0,7;
    $IN->delete('action');
    $IN->delete('name');
    $IN->delete('from');
    $IN->delete('fromname');
    $IN->delete('subject');
    $IN->delete('message');
    $IN->delete('messageformat');
    $IN->delete('action');
    my $sth = $DB->table('Users')->query_sth($IN);
    my $list_addrs_url = $IN->url;
    $list_addrs_url .= "&action=list_addresses&emailsto=SELECTEDUSERS";
    my $count = $sth->rows;
    return $ACTIONS::{selected_users}->("No matches found") unless $count;
    my $hidden_fields = "";
    for ($IN->param) {
        $hidden_fields .= qq{<input type=hidden name="}.html_escape($_).qq{" value="}
                          . html_escape($IN->param($_)).qq{">\n};
    }
    Links::admin_page(
        "email_selected_users_mail.html",
        {
            number      => $count,
            address_list_url    => $list_addrs_url,
            hidden_fields   => $hidden_fields,
            templates       => make_opts([$NEW_TEMPLATE,template_names()],$selected),
            from        => $from,
            fromname        => $fromname,
            subject     => $subject,
            message     => $message,
            messageformat => make_opts([qw/text html/],$format),
            error       => $error || ""
        }
    );
}

# "Selected Users" -> "Search" -> "Send"
sub ACTIONS::selected_users_send {
    my $sth = $DB->table('Users')->query_sth($IN);
    my $emailtable = $DB->table('EmailMailings');
    
    unless ($IN->param('from') and $IN->param('from') =~ /^[\x21-\x7e]+\@$VALID_HOST\Z/) {
        my %substitutions = (
            notes         => "@_",
            from          => defined $IN->param('from') ? scalar $IN->param('from') : "",
            fromname      => defined $IN->param('fromname') ? scalar $IN->param('fromname') : "",
            subject       => defined $IN->param('subject') ? scalar $IN->param('subject') : "",
            message       => defined $IN->param('message') ? scalar $IN->param('message') : "",
            messageformat => defined $IN->param('messageformat') ? scalar $IN->param('messageformat') : "text",
            previous      => defined $IN->param('previous') ? scalar $IN->param('previous') : "",
            hidden_fields => ""
        );
        $IN->delete('from');
        $IN->delete('fromname');
        $IN->delete('subject');
        $IN->delete('message');
        $IN->delete('messageformat');
        $IN->delete('action');
        $ACTIONS::{$IN->param('previous')}->(undef,"",@substitutions{qw/fromname subject message messageformat/},"<font color=red>Invalid from e-mail address entered. You must correct it before sending the e-mails</font>")
            if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
        return;
    }

    
    my $mailingnum = $DB->table('MailingIndex')->insert(
        extra    => 'Users',
        mailfrom => $IN->param('from'),
        name     => $IN->param('fromname'),
        subject  => $IN->param('subject'),
        message  => $IN->param('message'),
        messageformat => $IN->param('messageformat')
    )->insert_id;
    while ($_ = $sth->fetchrow_hashref) {
        $emailtable->insert(
            Mailing => $mailingnum,
            Email   => $_->{Email}
        );
    }
    $ACTIONS::{mailings}->('Mailing queued for sending. To send, select "Start mailing" below beside the mailing you just queued.');
}

# "Selected Links"
sub ACTIONS::selected_links {
    Links::admin_page(
        "email_selected_links.html",
        {
            message => "@_",
            form => $DB->html($DB->table('Links'), $Links::IN)->form({ mode => 'search_form', search_opts => 1 }),
        }
    );
}

# "Selected Links" -> "Search"
sub ACTIONS::selected_links_search {
    my ($selected,$from,$fromname,$subject,$message,$format,$error) = splice @_,0,7;
    $IN->delete('action');
    $IN->delete('name');
    $IN->delete('from');
    $IN->delete('fromname');
    $IN->delete('subject');
    $IN->delete('message');
    $IN->delete('messageformat');
    my $sth = $DB->table('Links')->query_sth($IN);
    my $Users = $DB->table('Users');
    my $count;
    while ($_ = $sth->fetchrow_hashref) {
        ++$count if $Users->select({ Username => $_->{LinkOwner} },['ReceiveMail'])->fetchrow_array eq 'Yes';
    }
    return $ACTIONS::{selected_links}->("No matches found") unless $count;
    my $list_addrs_url = $IN->url;
    $list_addrs_url .= "&action=list_addresses&emailsto=SELECTEDLINKS";
    my $hidden_fields = "";
    for ($IN->param) {
        $hidden_fields .= qq{<input type=hidden name="}.html_escape($_).qq{" value="}
                          . html_escape($IN->param($_)).qq{">\n};
    }
    Links::admin_page(
        "email_selected_links_mail.html",
        {
            number      => $count,
            address_list_url    => $list_addrs_url,
            hidden_fields   => $hidden_fields,
            templates       => make_opts([$NEW_TEMPLATE,template_names('LTPL')],$selected,"LTPL"),
            from        => $from,
            fromname    => $fromname,
            subject     => $subject,
            message     => $message,
            messageformat => make_opts([qw/text html/],$format),
            error       => $error || ""
        }
    );
}

# "Selected Links" -> "Search" -> "Send"
sub ACTIONS::selected_links_send {
    my $sth = $DB->table('Links')->query_sth($IN);

    unless ($IN->param('from') and $IN->param('from') =~ /^[\x21-\x7e]+\@$VALID_HOST\Z/) {
        my %substitutions = (
            notes         => "@_",
            from          => defined $IN->param('from') ? scalar $IN->param('from') : "",
            fromname      => defined $IN->param('fromname') ? scalar $IN->param('fromname') : "",
            subject       => defined $IN->param('subject') ? scalar $IN->param('subject') : "",
            message       => defined $IN->param('message') ? scalar $IN->param('message') : "",
            messageformat => defined $IN->param('messageformat') ? scalar $IN->param('messageformat') : "text",
            previous      => defined $IN->param('previous') ? scalar $IN->param('previous') : "",
            hidden_fields => ""
        );
        $IN->delete('from');
        $IN->delete('fromname');
        $IN->delete('subject');
        $IN->delete('message');
        $IN->delete('messageformat');
        $IN->delete('action');
        $ACTIONS::{$IN->param('previous')}->(undef,"",@substitutions{qw/fromname subject message messageformat/},"<font color=red>Invalid from e-mail address entered. You must correct it before sending the e-mails</font>")
            if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
        return;
    }

    my $emailtable = $DB->table('EmailMailings');
    my $mailingnum = $DB->table('MailingIndex')->insert(
        extra    => 'Links',
        mailfrom => $IN->param('from'),
        name     => $IN->param('fromname'),
        subject  => $IN->param('subject'),
        message  => $IN->param('message'),
        messageformat => $IN->param('messageformat')
    )->insert_id;
    my $Users = $DB->table('Users');
    while ($_ = $sth->fetchrow_hashref) {
        my $user = $Users->select({ Username => $_->{LinkOwner} },['ReceiveMail','Email'])->fetchrow_hashref;
        if ($user->{ReceiveMail} eq 'Yes') {
            $emailtable->insert(
                Mailing => $mailingnum,
                Email   => $_->{Contact_Email} || $user->{Email},
                Sent    => 0,
                LinkID  => $_->{ID}
            );
        }
    }
    $ACTIONS::{mailings}->('Mailing queued for sending. To send, select "Start mailing" below beside the mailing you just queued.');
}

# "Newsletter"
sub ACTIONS::email_newsletter {
    my ($from,$fromname,$subject,$message,$format,$template,$error);
    if (@_) {
        (undef,$from,$fromname,$subject,$message,$format,$error) = splice @_,0,7;
        ($template) = (get_template('NWSLTRTMPLT'))[5];
    }
    else {
        ($from,$fromname,$subject,$message,$format,$template) = get_template('NWSLTRTMPLT');
    }
    my $news = "";
#    my ($from,$fromname,$subject,$message,$format,$template) = get_template('NWSLTRTMPLT');
    unless ($error) {
        $message .= "\n<%news%>" unless defined $message and $message =~ /<%news%>/;
        $template ||= DEFAULT_NEWSLETTER_TEMPLATE;
        my $sth = $DB->table('Links')->select({ isNew => 'Yes', isValidated => 'Yes' });
        while (my $row=$sth->fetchrow_hashref) {
            $news .= GT::Template->parse ('New item template',
                                 {   map { ($_ => $$row{$_}) } keys %$row   }, # 
                                 {   string => $template, compress => 0   }
                     )
                     . "\n";
        }
        $message =~ s/<%news%>/$news/g;
    }
    $error = "Template saved successfully" if $IN->param('newslettermessage');
    my $cond = new GT::SQL::Condition;
    $cond->add(Email => LIKE => '%_%');
    $cond->add(ReceiveMail => '=' => 'Yes');
    $cond->add(Newsletter => '=' => 'Yes');
    Links::admin_page(
        "email_newsletter.html",
        {
            number   => ($DB->table('Users')->count($cond)),
            from     => html_escape($from),
            fromname => html_escape($fromname),
            subject  => html_escape($subject),
            message  => html_escape($message),
            messageformat => make_opts([qw/text html/],$format),
            error    => $error || ""
        }
    );
}

# "Newsletter" -> "Edit newsletter template"
sub ACTIONS::email_newsletter_edit_template {
    my ($from,$fromname,$subject,$message,$format,$template,$bad_email);
    if (@_) {
        ($from,$fromname,$subject,$message,$format,$template) = @_;
        $bad_email = 1;
    }
    else {
        ($from,$fromname,$subject,$message,$format,$template) = get_template('NWSLTRTMPLT');
    }
    Links::admin_page(
        "email_newsletter_edit_template.html",
        {
            from     => html_escape($from),
            fromname => html_escape($fromname),
            subject  => html_escape($subject),
            message  => html_escape($message),
            messageformat => make_opts([qw/text html/],$format),
            template => html_escape($template || DEFAULT_NEWSLETTER_TEMPLATE),
            bad_email => $bad_email,
        }
    );
}

# "Newsletter" -> "Edit newsletter template" -> "Save Newsletter Template"
sub ACTIONS::email_newsletter_save_template {
    unless ($IN->param('from') and $IN->param('from') =~ /^[\x21-\x7e]+\@$VALID_HOST\Z/) {
        $ACTIONS::{email_newsletter_edit_template}->(map $IN->param($_), qw/from fromname subject message messageformat template/);
        return;
    }
    save_template(
        'NWSLTRTMPLT', $IN->param('from'), $IN->param('fromname'), $IN->param('subject'),
        $IN->param('message'), $IN->param('messageformat'), $IN->param('template')
    );
    $ACTIONS::{email_newsletter}->();
}

# Custom List "List"
sub ACTIONS::list_list {
    my @list = @{$DB->table('MailingListIndex')->select({ },[qw/ID Name DateCreated DateModified/])->fetchall_arrayref};
    my $output = "<ul>\n";
    for (@list) {
        my $count = $DB->table('MailingList')->count({ ID => $_->[0] });
        my $created = make_date_string($_->[2]);
        my $modified = make_date_string($_->[3]);
        $output .= qq+  <li><a href="admin.cgi?action=list_addresslist&ID=$_->[0]" target=_blank>$_->[1]</a> - $count e-mail address@{[$count == 1 ? "" : "es"]}</li>\n+;
    }
    $output .= "</ul>\n";
    $output = "No lists have been created" if $output eq "<ul>\n</ul>\n";
    Links::admin_page(
        "email_list_of_lists.html",
        {
            lists => $output
        }
    );
}

# Custom List "List" -> click one
sub ACTIONS::list_addresslist {
    my $id = $IN->param('ID');
    my %index = %{$DB->table('MailingListIndex')->select({ ID => $id })->fetchrow_hashref};
    my @addresses = map html_escape($_->[0]), @{$DB->table('MailingList')->select({ ID => $id }, ['Email'])->fetchall_arrayref};
    local $" = "<br>\n";
    Links::admin_page(
        "email_list_list.html",
        {
            DateCreated => make_date_string($index{DateCreated}),
            DateModified => make_date_string($index{DateModified}),
            Name => $index{Name},
            ID => $index{ID},
            addresses => "@addresses<br>\n"
        }
    );
}

# Custom List "Add"
sub ACTIONS::list_add {
    Links::admin_page(
        "email_list_add.html",
        {
            message => "@_",
            addresses => scalar $IN->param('addresses')
        }
    );
}

# Custom List "Add" -> "Add List"
sub ACTIONS::add_new_list {
    my $name = $IN->param('name');
    $name =~ s/^\s+//;
    $name =~ s/\s+$//;
    unless ($name =~ /\S/) {
        $ACTIONS::{list_add}->("Invalid name entered");
        return;
    }
    elsif ($DB->table('MailingListIndex')->select({ Name => $name })->fetchrow_arrayref) {
        $ACTIONS::{list_add}->("List `$name' already exists");
        return;
    }
    my $now = time;
    my $insert_id = $DB->table('MailingListIndex')->insert({ Name => $name, DateCreated => $now, DateModified => $now })->insert_id;
    my $output;
    if (defined $insert_id) {
        $output = "Added mailing list ".html_escape($name).".<br><br>\n";
        my %addr;
        for (grep !$addr{$_}++, split ' ',$IN->param('addresses')) {
            chomp;
            if (/^[\x21-\x7e]+\@$VALID_HOST$/) {
                $output .= "Added ".html_escape($_)." to mailing list.<br>\n";
                $DB->table('MailingList')->insert({ ID => $insert_id, Email => $_ });
            }
            else {
                $output .= "<font color=red>".html_escape($_)." ($_) is not a valid email address.</font><br>\n";
            }
        }
    }
    else {
        $output = "An error occured while attempting to add mailing list ".html_escape($name).": $GT::SQL::error.";
    }
    Links::admin_page(
        "email_list_added.html",
        {
            status => $output
        }
    );
}

# Custom List "Modify"
sub ACTIONS::list_modify {
    my @list = @{$DB->table('MailingListIndex')->select({ }, ['ID','Name'])->fetchall_arrayref};
    return ACTIONS::list_add("No mailing lists exist! You must add a list before any can be modified") unless @list;
    my $output = "<select name=ID size=1>\n";
    for (@list) {
        $output .= "  <option value=$$_[0]>$$_[1]</option>\n";
    }
    $output .= "</select>\n";
    Links::admin_page(
        "email_list_modify.html",
        {
            list => $output
        }
    );
}

# Custom List "Modify" -> "Modify"
sub ACTIONS::list_modify_list {
    my $id = $IN->param('ID');
    my $name = $DB->table('MailingListIndex')->select({ ID => $id },['Name'])->fetchrow_arrayref->[0];
    my @addresses = map $$_[0], @{$DB->table('MailingList')->select({ ID => $id },['Email'])->fetchall_arrayref};
    local $" = "\n";
    Links::admin_page(
        "email_list_modify_list.html",
        {
            Name => $name,
            ID => $id,
            addresses => "@addresses"
        }
    );
}

# Custom List "Modify" -> "Modify" -> "Modify List"
sub ACTIONS::list_modify_existing_list {
    my $id = $IN->param('ID');
    my $MailingList = $DB->table('MailingList');
    $MailingList->delete({ ID => $id });
    my $now = time;
    my $MailingListIndex = $DB->table('MailingListIndex');
    $MailingListIndex->update({ DateModified => $now }, { ID => $id });
    my $name = $MailingListIndex->select({ ID => $id },['Name'])->fetchrow_arrayref->[0];
    my $output = "Modifying ".html_escape($name).".<br><br>\n";
    my %addr;
    for (grep !$addr{$_}++, split ' ',$IN->param('addresses')) {
        chomp;
        if (/^[\x21-\x7e]+\@$VALID_HOST$/) {
            $output .= "Added ".html_escape($_)." to mailing list.<br>\n";
            $MailingList->insert({ ID => $id, Email => $_ });
        }
        else {
            $output .= "<font color=red>".html_escape($_)." is not a valid email address.</font><br>\n";
        }
    }
    Links::admin_page(
        "email_list_moded.html",
        {
            status => $output
        }
    );
}

# Custom List "Delete"
sub ACTIONS::list_delete {
    my @list = @{$DB->table('MailingListIndex')->select({ }, ['ID','Name'])->fetchall_arrayref};
    return ACTIONS::list_add("No mailing lists exist! You must add a list before any can be deleted") unless @list;
    my $output = "<select name=ID size=1>\n";
    for (@list) {
        $output .= "  <option value=$$_[0]>$$_[1]</option>\n";
    }
    $output .= "</select>\n";
    Links::admin_page(
        "email_list_delete.html",
        {
            list => $output
        }
    );
}

# Custom List "Delete" -> "Delete List"
sub ACTIONS::list_delete_list {
    my $id = $IN->param('ID');
    my $MailingListIndex = $DB->table('MailingListIndex');
    my $name = $MailingListIndex->select({ ID => $id },['Name'])->fetchrow_arrayref->[0];
    $MailingListIndex->delete({ ID => $id });
    $DB->table('MailingList')->delete({ ID => $id });
    Links::admin_page(
        "email_list_delete_list.html",
        {
            Name => $name
        }
    );
}

# Custom List "Mail"
sub ACTIONS::list_mail {
    my @list = @{$DB->table('MailingListIndex')->select({ }, ['ID','Name'])->fetchall_arrayref};
    return ACTIONS::list_add("No mailing lists exist! You must add a list before any mail can be sent to a list") unless @list;
    my $output = "<select name=ID size=1>\n";
    for (@list) {
        $output .= "  <option value=$_->[0]>".html_escape($_->[1])."</option>\n";
    }
    $output .= "</select>\n";
    Links::admin_page(
        "email_list_mail.html",
        {
            list => $output
        }
    );
}

# Custom List "Mail" -> "Next"
sub ACTIONS::list_mail_list {
    my ($selected,$from,$fromname,$subject,$message,$format,$error) = splice @_,0,7;
    my $id = $IN->param('ID');
    Links::admin_page(
        "email_list_mail_list.html",
        {
            number    => $DB->table('MailingList')->count({ ID => $id }),
            templates => make_opts([$NEW_TEMPLATE,template_names('CSTM')],$selected,'CSTM'),
            from      => html_escape($from),
            fromname  => html_escape($fromname),
            subject   => html_escape($subject),
            message   => html_escape($message),
            messageformat => make_opts([qw/text html/],$format),
            ID        => $id,
            error     => $error || ""
        }
    );
}

# Custom List "Mail" -> "Next" -> "Send Emails"
sub ACTIONS::list_mail_Send {
    my $id = $IN->param('ID');
    
    unless ($IN->param('from') and $IN->param('from') =~ /^[\x21-\x7e]+\@$VALID_HOST\Z/) {
        my %substitutions = (
            notes         => "@_",
            from          => defined $IN->param('from') ? scalar $IN->param('from') : "",
            fromname      => defined $IN->param('fromname') ? scalar $IN->param('fromname') : "",
            subject       => defined $IN->param('subject') ? scalar $IN->param('subject') : "",
            message       => defined $IN->param('message') ? scalar $IN->param('message') : "",
            messageformat => defined $IN->param('messageformat') ? scalar $IN->param('messageformat') : "text",
            previous      => defined $IN->param('previous') ? scalar $IN->param('previous') : "",
            hidden_fields => ""
        );
        $IN->delete('from');
        $IN->delete('fromname');
        $IN->delete('subject');
        $IN->delete('message');
        $IN->delete('messageformat');
        $IN->delete('action');
        $ACTIONS::{$IN->param('previous')}->(undef,"",@substitutions{qw/fromname subject message messageformat/},"<font color=red>Invalid from e-mail address entered. You must correct it before sending the e-mails</font>")
            if exists $ACTIONS::{$IN->param('previous')} and ref *{$ACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
        return;
    }
    
    my $fromname = $IN->param('fromname');
    my $from = $IN->param('from');
    my $subject = $IN->param('subject');
    my $message = $IN->param('message');
    my $format = $IN->param('messageformat');
    $from or return;
    my $sth = $DB->table('MailingList')->select({ ID => $id },['Email']);
    my $mailingnum = $DB->table('MailingIndex')->insert(
        extra    => 'none',
        mailfrom => $from,
        name     => $fromname,
        subject  => $subject,
        message  => $message,
        messageformat => $format
    )->insert_id;
    my $emailtable = $DB->table('EmailMailings');
    while (my $mail = $sth->fetchrow_arrayref()) {
        $emailtable->insert(
            Mailing => $mailingnum,
            Email => $mail->[0]
        );
    }
    $ACTIONS::{mailings}->('Mailing queued for sending. To send, select "Start mailing" below beside the mailing you just queued.');
}

# "View mailings" (Also shown immediately after queuing a message)
sub ACTIONS::mailings {
    my $error = shift;
    my @mailings;
    my $sth = $DB->table('MailingIndex')->select();
    my $row;
    push @mailings, $row while $row = $sth->fetchrow_hashref();
    my $mailstr;
    for (@mailings) {
    my $completed_condition = new GT::SQL::Condition;
    $completed_condition->add('Mailing' => '=' => $$_{Mailing});
    $completed_condition->add('done' => 'IS NOT' => \"NULL");
    my $completed = $DB->table('MailingIndex')->count($completed_condition);
    my ($total,$done);
    unless ($completed) {
        $total = $DB->table('EmailMailings')->count({ Mailing => $$_{Mailing} });
        $done = $DB->table('EmailMailings')->count({ Sent => 1, Mailing => $$_{Mailing} });
    }
    $mailstr .= <<MAILING;
  <li>
    ID: $$_{Mailing}
    |
    Subject: @{[html_escape($$_{subject})]}
    |
    @{[$completed ? "This mailing has been completed." : "$done/$total sent."]}
    |
    <a href="admin.cgi?action=show_mailing_detail&mailing=$$_{Mailing}" target=_blank>Details</a>
    |
    @{[$completed ? "" : qq~<a href="nph-email.cgi?emailsto=$$_{Mailing}">@{[$done ? "Continue" : "Start"]}&nbsp;mailing</a>
    |~]}
    <a href="admin.cgi?action=cancel_mailing&mailing=$$_{Mailing}">@{[$completed ? "Delete" : "Cancel"]}&nbsp;mailing</a>
  </li>

MAILING
    }
    $mailstr ||= "There are no mailings to display.";
    Links::admin_page(
    "email_mailings.html",
    {
        mailings => $mailstr,
        error    => $error || ""
    }
    );
}

# "View Mailings" -> "Details"
sub ACTIONS::show_mailing_detail {
    my $mailing = $IN->param('mailing');
    my %info = %{$DB->table('MailingIndex')->select({ Mailing => $mailing })->fetchrow_hashref()};
    my $count = $DB->table('EmailMailings')->count({ Mailing => $mailing });
    ($info{message} = html_escape($info{message})) =~ s/(\r?\n)/<br>$1/g;
    my $finished = make_date_string($info{done}) if defined $info{done};
    Links::admin_page(
    "email_mailing_detail.html",
    {
        map({ ($_ => html_escape($info{$_})) } qw{ mailfrom name subject messageformat }),
        message => $info{message},
        id => $mailing,
        count => $count,
        finished => $finished
    }
    );
}

# "View Mailings" -> "Cancel mailing","Delete mailing"
sub ACTIONS::cancel_mailing {
    my $mailing = $IN->param('mailing');
    my %info = %{$DB->table('MailingIndex')->select({ Mailing => $mailing })->fetchrow_hashref()};
    my $count = $DB->table('EmailMailings')->count({ Mailing => $mailing });
    ($info{message} = html_escape($info{message})) =~ s/\r?\n/<br>\n/g;
    my $finished = make_date_string($info{done}) if defined $info{done};
    Links::admin_page(
        "email_confirm_cancel_mailing.html",
        {
            Verbtion => defined $info{done} ? "Deletion" : "Cancellation",
            verbed => defined $info{done} ? "deleted" : "cancelled",
            map({ ($_ => html_escape($info{$_})) } qw{ mailfrom name subject }),
            message => $info{message},
            id => $mailing,
            count => $count,
            finished => $finished
        }
    );
}

# "View Mailings" -> "Cancel mailing","Delete mailing" -> "Confirm Mailing Deletion","Confirm Mailing Cancellation"
sub ACTIONS::confirmed_cancel_mailing {
    my $mailing = $IN->param('mailing');
    $DB->table('MailingIndex')->delete({ Mailing => $mailing });
    $DB->table('EmailMailings')->delete({ Mailing => $mailing });
    $ACTIONS::{mailings}->("Selected mailing has been ".$IN->param('verbed'));
}

# "View Mailings" -> "Delete all completed mailings"
sub ACTIONS::delete_finished_mailings {
    my $cond = new GT::SQL::Condition;
    $cond->add('done' => 'IS NOT' => \'NULL');
    Links::admin_page(
        "email_confirm_delete_finished_mailings.html",
        {
            count => $DB->table('MailingIndex')->count($cond)
        }
    );
}

# "View Mailings" -> "Delete all completed mailings" -> "Confirm Delete All Finished Mailings"
sub ACTIONS::confirmed_delete_finished_mailings {
    my $cond = new GT::SQL::Condition;
    $cond->add('done' => 'IS NOT' => \'NULL');
    my @mailing = map $_->[0], @{$DB->table('MailingIndex')->select($cond,['Mailing'])->fetchall_arrayref};
    for (@mailing) {
        $DB->table('EmailMailings')->delete({ Mailing => $_ });
        $DB->table('MailingIndex')->delete({ Mailing => $_ });
    }
    $ACTIONS::{mailings}->("All finished mailings have been deleted");
}

# "View Mailings" -> "Cancel/Delete all mailings"
sub ACTIONS::delete_all_mailings {
    Links::admin_page(
        "email_confirm_delete_all_mailings.html",
        {
            count => $DB->table('MailingIndex')->count()
        }
    );
}

# "View Mailings" -> "Cancel/Delete all mailings" -> "Confirm Delete All Mailings"
sub ACTIONS::confirmed_delete_all_mailings {
    $DB->table('EmailMailings')->delete_all;
    $DB->table('MailingIndex')->delete_all;
    $ACTIONS::{mailings}->("All mailings have been cancelled and/or deleted");
}

1;