# ==================================================================
# DBman SQL - enhanced database management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   Revision : $Id: MassMailer.pm,v 1.6 2002/02/09 00:17:59 bao 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 Dbsql::MassMailer;
# ==================================================================
# This package contains some builtin functions useful in your templates.
#
    use Dbsql 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/;

sub parse {
    my ($file, $vars, $opts) = @_;
    $opts ||= {};
    $opts->{print} = defined $opts->{print} ? $opts->{print} : 1;
    $opts->{root}  = $CFG->{admin_root_path} . '/templates/admin';
    GT::Template->parse ($file, $vars, $opts);
}

# (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('Dbsql_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'),
#       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('Dbsql_EmailTemplates');
    if ($table->count({ Name => $name })) {
        $table->update(
            {
                MsgFrom => $from,
                MsgFromName => $fromname,
                Subject => $subject,
                Message => $message,
                MessageFormat => $format
            },
            {
                Name => $name
            }
        );
    } else {
        $table->insert(
            {
                Name => $name,
                MsgFrom => $from,
                MsgFromName => $fromname,
                Subject => $subject,
                Message => $message,
                MessageFormat => $format             
            }
        );
    }
}
    
# 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')
sub get_template ($) {
    return @{$DB->table('Dbsql_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('Dbsql_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]);
}

sub table_list {
#   Load list user table and browse log
#
    my $selected_file = shift || '';
    $DB->table('Dbsql')->select_options('order by Tablename');
    my $sth = $DB->table('Dbsql')->select({'Type' => '1'},['Tablename']);
    my $user_tables = '';
    while (my $rs = $sth->fetchrow_hashref ) {
        ($selected_file eq $rs->{Tablename}) ? ($user_tables .= "<option selected value='" . $rs->{Tablename} . "'>$rs->{Tablename}") : ($user_tables .= "<option value='$rs->{Tablename}'>$rs->{Tablename}");
    }
    return $user_tables;
}

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


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

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

# * -> "Save" (template)
sub DBACTIONS::Save {
    my $name = $IN->param('name');
    return $DBACTIONS::{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);
    $DBACTIONS::{$IN->param('previous')}->($name,(get_template($name))[0..4],"Template saved successfully")
        if exists $DBACTIONS::{$IN->param('previous')} and ref *{$DBACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
}

# * -> "Save as..." (template)
sub DBACTIONS::SaveAs {
    $IN->delete('name');
    my $user_table = $IN->param('user_table') || $CFG->{default_user_table};

    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') : "",
        ID            => defined $IN->param('ID') ? scalar $IN->param('ID') : "",
        hidden_fields => ""
    );
    $IN->delete('from');
    $IN->delete('fromname');
    $IN->delete('subject');
    $IN->delete('message');
    $IN->delete('messageformat');
    $IN->delete('action');
    $IN->delete('ID');
    chomp($substitutions{from});
    if ($substitutions{from} !~ /^[\x21-\x7e]+\@$VALID_HOST\Z/) {
        $DBACTIONS::{$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 $DBACTIONS::{$IN->param('previous')} and ref *{$DBACTIONS::{$IN->param('previous')}}{CODE} eq 'CODE';
        return;
    }
    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/"/&nbsp;/g;
     #   $substitutions{$_} =~ s/>/&gt;/g;
     #   $substitutions{$_} =~ s/</&lt;/g;
   # }
    $substitutions{tbl_name} = $user_table;
    parse(
        "email_newtemp_save_as.html",        
        \%substitutions
    );
}

# * -> (Template) "Save as..." or "Save" with "(New template)" selected -> "Add Template"
sub DBACTIONS::email_newtemp {
    my $new_name = $IN->param('name');
    my $previous = $IN->param('previous');
    $new_name =~ s/^\s+//;
    $new_name =~ s/\s+$//;

    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'));

    $DBACTIONS::{$previous}->($new_name,(get_template($new_name))[0..4],"Template saved successfully");
}

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

# "All Users",'Newsletter" -> "Send" (mail)
sub DBACTIONS::Send {
    my $to = $IN->param('emailsto');
    return unless $to and ($to eq 'EVERYONE');
    $IN->param('from') or return;
    my $sth;
   
    my $cond = new GT::SQL::Condition;
    my $user_table = $IN->param('user_table') || $CFG->{default_user_table};
    $cond->add(Email => Like => '%_%');
    $cond->add(ReceiveMail => 'Yes');    
    $sth = $DB->table($user_table)->select($cond, ['Email']);   
    
    my $mailingnum = $DB->table('Dbsql_MailingIndex')->insert(
        mailfrom => $IN->param('from'),
        name     => $IN->param('fromname'),
        subject  => $IN->param('subject'),
        message  => $IN->param('message'),
        messageformat => $IN->param('messageformat'),
        user_table_use => $user_table
    )->insert_id;
    my $emailtable = $DB->table('Dbsql_EmailMailings');
    while (my $mail = $sth->fetchrow_arrayref()) {
        $emailtable->insert(
            Mailing => $mailingnum,
            Email => $mail->[0],
            Sent => 0);
    }
    $DBACTIONS::{mailings}->('Mailing queued for sending. To send, select "Start mailing" below beside the mailing you just queued.');
}

# * -> "x recipients"
sub DBACTIONS::list_addresses {
    my $to = $IN->param('emailsto');
    my $user_table = $IN->param('user_table') || $CFG->{default_user_table};
    return unless defined $to;
    if ($to eq 'EVERYONE') {
        my $cond = new GT::SQL::Condition;
        $cond->add(Email => Like => '%_%');
        $cond->add(ReceiveMail => 'Yes');
        parse(
            "email_list.html",
            {   
                addresses => join "<br>\n", map { $_->[0] =~ /\S/ ? ($_->[0]) : () }
                @{$DB->table($user_table)->select($cond,['Email'])->fetchall_arrayref()}
            }
        );
    } elsif ($to eq 'SELECTEDUSERS') {
        my $table = $DB->table($user_table);
        $IN->delete("action");
        my $sth = $table->query_sth($IN);
        my @emails;       
        while ($_ = $sth->fetchrow_hashref) {
            push @emails, $_->{Email};
        }        
        parse(
            "email_list.html",
            {
                addresses => join("<br>\n", @emails)
            }
        );
    } elsif ($to eq 'CUSTOMLIST') {
        my $id = $IN->param('ID');
        parse(
            "email_list.html",
            {
                addresses => join "<br>\n", map $_->[0],
                @{$DB->table('Dbsql_MailingList')->select({ ID => $id },['Email'])->fetchall_arrayref()}
            }
        );
    }
    else {
        parse(
            "email_list.html",
            {
                addresses => join "<br>\n", map $_->[0],
                @{$DB->table('Dbsql_EmailMailings')->select({ Mailing => $to },['Email'])->fetchall_arrayref()}
            }
        );
    }
}

# "All Users"
sub DBACTIONS::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');
    my $user_table = $IN->param('user_table') || $CFG->{default_user_table};
    my $table_list = &table_list($user_table);
    parse(
        "email_everyone.html",
        {
            number    => $DB->table($user_table)->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),
            tbl_name  => $user_table,
            table_list=> $table_list,
            messageformat => make_opts([qw/text html/],$format),
            error     => $error || ""
        }
    );
}

# "Selected Users"
sub DBACTIONS::selected_users {
    my $user_table = $IN->param('user_table') || $CFG->{default_user_table};
    my $table_list = &table_list($user_table);
    my $html = $DB->html($DB->table($user_table), $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}};
    parse(
        "email_selected_users.html",
        {
            message     => "@_",
            tbl_name    => $user_table,
            table_list  => $table_list,
            form        => $html->form({ mode => 'search_form', search_opts => 1,extra_table=>0,table=>0 }),
        }
    );
}

# "Selected Users" -> "Search"
sub DBACTIONS::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 $user_table = $IN->param('user_table') || $CFG->{default_user_table};
    my $sth = $DB->table($user_table)->query_sth($IN);

    my $list_addrs_url = $IN->url;
    
    $list_addrs_url .= "&user_table=$user_table&action=list_addresses&emailsto=SELECTEDUSERS";
    my $count = $sth->rows;
    return $DBACTIONS::{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};
    }
    parse(
        "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,
            tbl_name    => $user_table,
            messageformat => make_opts([qw/text html/],$format),
            error       => $error || ""
        }
    );
}

# "Selected Users" -> "Search" -> "Send"
sub DBACTIONS::selected_users_send {
    my $user_table = $IN->param('user_table') || $CFG->{default_user_table};   
    my $sth = $DB->table($user_table)->query_sth($IN);
    my $emailtable = $DB->table('Dbsql_EmailMailings');
    my $mailingnum = $DB->table('Dbsql_MailingIndex')->insert(
        mailfrom => $IN->param('from'),
        name     => $IN->param('fromname'),
        subject  => $IN->param('subject'),
        message  => $IN->param('message'),
        messageformat => $IN->param('messageformat'),
        user_table_use => $user_table
    )->insert_id;
    while ($_ = $sth->fetchrow_hashref) {
        $emailtable->insert(
            Mailing => $mailingnum,
            Email   => $_->{Email}
        );
    }
    $DBACTIONS::{mailings}->('Mailing queued for sending. To send, select "Start mailing" below beside the mailing you just queued.');
}

# Custom List "List"
sub DBACTIONS::list_list {
    my @list = @{$DB->table('Dbsql_MailingListIndex')->select({ },[qw/ID Name DateCreated DateModified/])->fetchall_arrayref};
    my $output = "<ul>\n";
    for (@list) {
        my $count = $DB->table('Dbsql_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";
    parse(
        "email_list_of_lists.html",
        {
            lists => $output
        }
    );
}

# Custom List "List" -> click one
sub DBACTIONS::list_addresslist {
    my $id = $IN->param('ID');
    my %index = %{$DB->table('Dbsql_MailingListIndex')->select({ ID => $id })->fetchrow_hashref};
    my @addresses = map html_escape($_->[0]), @{$DB->table('Dbsql_MailingList')->select({ ID => $id }, ['Email'])->fetchall_arrayref};
    local $" = "<br>\n";
    parse(
        "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 DBACTIONS::list_add {
    parse(
        "email_list_add.html",
        {
            message => "@_",
            addresses => $IN->param('addresses')
        }
    );
}

# Custom List "Add" -> "Add List"
sub DBACTIONS::add_new_list {
    my $name = $IN->param('name');
    $name =~ s/^\s+//;
    $name =~ s/\s+$//;
    unless ($name =~ /\S/) {
        $DBACTIONS::{list_add}->("Invalid name entered");
        return;
    } elsif ($DB->table('Dbsql_MailingListIndex')->select({ Name => $name })->fetchrow_arrayref) {
        $DBACTIONS::{list_add}->("List `$name' already exists");
        return;
    }
    my $now = time;
    my $insert_id = $DB->table('Dbsql_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('Dbsql_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.";
    }
    parse(
        "email_list_added.html",
        {
            status => $output
        }
    );
}

# Custom List "Modify"
sub DBACTIONS::list_modify {
    my @list = @{$DB->table('Dbsql_MailingListIndex')->select({ }, ['ID','Name'])->fetchall_arrayref};
    return DBACTIONS::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";
    parse(
        "email_list_modify.html",
        {
            list => $output
        }
    );
}

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

# Custom List "Modify" -> "Modify" -> "Modify List"
sub DBACTIONS::list_modify_existing_list {
    my $id = $IN->param('ID');
    my $MailingList = $DB->table('Dbsql_MailingList');
    $MailingList->delete({ ID => $id });
    my $now = time;
    my $MailingListIndex = $DB->table('Dbsql_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";
        }
    }
    parse(
        "email_list_moded.html",
        {
            status => $output
        }
    );
}

# Custom List "Delete"
sub DBACTIONS::list_delete {
    my @list = @{$DB->table('Dbsql_MailingListIndex')->select({ }, ['ID','Name'])->fetchall_arrayref};
    return DBACTIONS::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";
    parse(
        "email_list_delete.html",
        {
            list => $output
        }
    );
}

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

# Custom List "Mail"
sub DBACTIONS::list_mail {
    my @list = @{$DB->table('Dbsql_MailingListIndex')->select({ }, ['ID','Name'])->fetchall_arrayref};
    return DBACTIONS::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";
    parse(
        "email_list_mail.html",
        {
            list => $output
        }
    );
}

# Custom List "Mail" -> "Next"
sub DBACTIONS::list_mail_list {
    my ($selected,$from,$fromname,$subject,$message,$format,$error) = splice @_,0,7;
    my $id = $IN->param('ID');
    parse(
        "email_list_mail_list.html",
        {
            number    => $DB->table('Dbsql_MailingList')->count({ ID => $id }),
            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),
            ID        => $id,
            error     => $error || ""
        }
    );
}

# Custom List "Mail" -> "Next" -> "Send Emails"
sub DBACTIONS::list_mail_Send {
    my $id = $IN->param('ID');
    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('Dbsql_MailingList')->select({ ID => $id },['Email']);
    my $mailingnum = $DB->table('Dbsql_MailingIndex')->insert(        
        mailfrom => $from,
        name     => $fromname,
        subject  => $subject,
        message  => $message,
        messageformat => $format
    )->insert_id;
    my $emailtable = $DB->table('Dbsql_EmailMailings');
    while (my $mail = $sth->fetchrow_arrayref()) {
        $emailtable->insert(
            Mailing => $mailingnum,
            Email => $mail->[0]
        );
    }
    $DBACTIONS::{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 DBACTIONS::mailings {
    my $error = shift;
    my @mailings;
    my $sth = $DB->table('Dbsql_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('Dbsql_MailingIndex')->count($completed_condition);
    my ($total,$done);
    unless ($completed) {
        $total = $DB->table('Dbsql_EmailMailings')->count({ Mailing => $$_{Mailing} });
        $done = $DB->table('Dbsql_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.";
    parse(
    "email_mailings.html",
    {
        mailings => $mailstr,
        error    => $error || ""
    }
    );
}

# "View Mailings" -> "Details"
sub DBACTIONS::show_mailing_detail {
    my $mailing = $IN->param('mailing');
    my %info = %{$DB->table('Dbsql_MailingIndex')->select({ Mailing => $mailing })->fetchrow_hashref()};
    my $count = $DB->table('Dbsql_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};
    parse(
    "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 DBACTIONS::cancel_mailing {
    my $mailing = $IN->param('mailing');
    my %info = %{$DB->table('Dbsql_MailingIndex')->select({ Mailing => $mailing })->fetchrow_hashref()};
    my $count = $DB->table('Dbsql_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};
    parse(
        "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,
            messageformat => $info{messageformat}
        }
    );
}

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

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

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

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

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