# ==================================================================
# Gossamer List - enhanced mailing list management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info :                     
#   Revision : $Id: List.pm,v 1.48 2004/07/15 16:36:32 bao Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited.  Please
# see LICENSE file for full details.
# ==================================================================
#

package GList::List;
# ==================================================================

use strict;
use GList qw/:objects :user_type $DEBUG/;
use GT::AutoLoader;

sub process {
#-------------------------------------------------------------------
# Setermine what to do
#
    my $do = shift;

    my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
    my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);

    $tpl ||= 'lst_home.html';
    $MN_SELECTED = 2;
    GList::display($tpl, $results);
}

$COMPILE{lst_home} = __LINE__ . <<'END_OF_SUB';
sub lst_home {
#--------------------------------------------------------------------
# Print home page
#
    my $msg = shift;
    my $cgi = $IN->get_hash;
    if (defined $cgi->{do} and $cgi->{do} =~ /^lst_add|lst_modify|lst_html/) {
        foreach ( $DB->table('Lists')->cols ) { $cgi->{$_} = ''; }
    }
    my $search_check = ($IN->param('do') eq 'lst_search') ? 1 : 0;
    my $query = '';
    if ($cgi->{'lst_date_created-ge'} or $cgi->{'lst_date_created-le'}) {
        my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
        my ($valid_from, $valid_to) = (1, 1);
        require GT::Date;
        if ($cgi->{'lst_date_created-ge'}) {
            $query .= "lst_date_created-ge=$cgi->{'lst_date_created-ge'};";
            $valid_from = GList::date_to_time($cgi->{'lst_date_created-ge'}, $format);
            $cgi->{'lst_date_created-ge'} = GT::Date::date_get($valid_from, $format);
        }
        if ($cgi->{'lst_date_created-le'}) {
            $query .= "lst_date_created-le=$cgi->{'lst_date_created-le'};";
            $valid_to = GList::date_to_time($cgi->{'lst_date_created-le'}, $format);
            $cgi->{'lst_date_created-le'} = GT::Date::date_get($valid_to, $format);
        }

        if ($search_check and (!$valid_from or !$valid_to)) {
            $format =~ s/\%//g;
            return lst_search_form(GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')));
        }
    }
    my $results = GList::search(
        cgi         => $cgi,
        db          => $DB->table('Lists'),
        prefix      => 'lst',
        sb          => 'lst_title',
        so          => 'ASC',
        search_check=> $search_check,
        select_all  => $cgi->{select_all}
    );

    if (ref $results ne 'HASH') {
        ($IN->param('do') eq 'lst_search') ? return (lst_search_form($results))
                                           : return ('lst_home.html', { msg => $results });
    }
    elsif ($results->{error} and $search_check) {
        return lst_search_form($results->{error});
    }

    require GT::SQL::Condition;
    my $subs   = $DB->table('Subscribers');
    my $output = $results->{results};
    my @lists  = map $_->{lst_id}, @$output;

    $subs->select_options("GROUP BY sub_list_id_fk");
    my %subscribers = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists })->fetchall_list;

    $subs->select_options("GROUP BY sub_list_id_fk");
    my %validateds  = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists, sub_validated => 1 })->fetchall_list;

    $subs->select_options("GROUP BY sub_list_id_fk");
    my %bounceds    = $subs->select(sub_list_id_fk => 'COUNT(*)', GT::SQL::Condition->new(sub_list_id_fk => 'IN' => \@lists, sub_bounced => '>=' => 1))->fetchall_list;

    foreach my $rs (@$output) {
        $rs->{subscribers} = $subscribers{$rs->{lst_id}};
        $rs->{validateds}  = $validateds{$rs->{lst_id}};
        $rs->{bounceds}    = $bounceds{$rs->{lst_id}};
    }

    if ($cgi->{select_all}) {
        my $sorted = _qsort($results->{results}, $cgi->{sb}, ($cgi->{so} eq 'ASC') ? 1 : 0);
        my @sorted;
        my $mh = $results->{mh};
        my $nh = $results->{nh} || 1;
        my $bg = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh;
        my $count = 0;
        if ( $bg < $results->{hits} ) {
            foreach my $i (0..($results->{hits} - 1)) {
                if ($i >= $bg) {
                    push @sorted, $sorted->[$i];
                    last if ($#sorted == $mh - 1);
                }
            }
            $results->{results} = \@sorted;
        }
        else {
            $results->{results} = [];
        }
    }
    $results->{msg} = $msg if ($msg);
    return ('lst_home.html', { %$results, toolbar_query => $query });
}
END_OF_SUB

$COMPILE{lst_add} = __LINE__ . <<'END_OF_SUB';
sub lst_add {
#--------------------------------------------------------------------
#
    return ('lst_add_form.html') if ($IN->param('form'));

# Check account limit if it's a limited user
    if ($USER->{usr_type} == LIMITED_USER and GList::check_limit('list')) {
        return lst_home($GList::error);
    }

    my $ret = GList::add('Lists', 'lst');
    return ('lst_add_form.html', { msg => "<font color=red>$GList::error</font>", help => 'lists_add.html' }) if ( $GList::error );

    my $name = $IN->param('lst_title');
    return lst_home(GList::language('LST_ADD_SUCCESS', $name));
}
END_OF_SUB

$COMPILE{lst_modify_form} = __LINE__ . <<'END_OF_SUB';
sub lst_modify_form {
#--------------------------------------------------------------------
# Print modify form
#
    my $msg = shift;

    return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));

    my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
    return home($info) if (ref $info ne 'HASH');

    return ('lst_modify_form.html', { msg => $msg, %$info, help => 'lists_add.html' });
}
END_OF_SUB

$COMPILE{lst_modify} = __LINE__ . <<'END_OF_SUB';
sub lst_modify {
#--------------------------------------------------------------------
#
    GList::modify('Lists', 'lst');
    return lst_modify_form("<font color=red>$GList::error</font>") if ( $GList::error );

    my $title = $IN->param('lst_title');
    lst_home(GList::language('LST_MOD_SUCCESS', $title));
}
END_OF_SUB

$COMPILE{lst_search_form} = __LINE__ . <<'END_OF_SUB';
sub lst_search_form {
#--------------------------------------------------------------------
# Print add form
#
    my $msg = shift;
    return ('lst_search_form.html', { msg => $msg });
}
END_OF_SUB

$COMPILE{lst_delete} = __LINE__ . <<'END_OF_SUB';
sub lst_delete {
#--------------------------------------------------------------------
# Delete lists
#
    return lst_home(GList::delete('Lists', 'lst'));
}
END_OF_SUB

$COMPILE{lst_html} = __LINE__ . <<'END_OF_SUB';
sub lst_html {
#-----------------------------------------------------------------
#
    return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));

    my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
    return lst_home($info) if (ref $info ne 'HASH');

    my $msg  = $CFG->{html_code};
    $msg =~ s/<%name%>/$info->{lst_title}/;
    $msg =~ s/<%id%>/$info->{lst_id}/;
    $msg =~ s/<%url%>/$CFG->{cgi_url}\/glist.cgi/;
    return ('lst_html.html', { msg => $msg, lst_title => $info->{lst_title} });
}
END_OF_SUB

$COMPILE{lst_import} = __LINE__ . <<'END_OF_SUB';
sub lst_import {
#-----------------------------------------------------------------
# Import data into subcribers table
#
    return ('lst_import_form.html', { help => 'lists_import.html' }) if ($IN->param('form'));

    my $data = $IN->param('sub_file') || $IN->param('sub_data');
    return ('lst_import_form.html', { msg => GList::language('LST_IPT_INVALID'), help => 'lists_import.html' })    unless ($data);
    return ('lst_import_form.html', { msg => GList::language('LST_IPT_LIST_EMPTY'), help => 'lists_import.html' }) unless ($IN->param('import_to'));

    my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
    my $fd = $IN->param('fd') || ',';
    my $fe = $IN->param('fe') || '\\';
    my $rd = $IN->param('rd') || '\n';
    my $rl = $IN->param('rl') || 0;

# Setup the language for GT::SQL.
    local $GT::SQL::ERRORS->{UNIQUE}     = GList::language('LST_IPT_DUPLICATE_EMAIL');
    local $GT::SQL::ERRORS->{NOTNULL}    = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
    local $GT::SQL::ERRORS->{ILLEGALVAL} = '';

    my (@data, @results);
    if ($IN->param('sub_file')) { # from a text file
        my $file_name = $data;
        $file_name    =~ s/.*?([^\\\/:]+)$/$1/;
        $file_name    =~ s/[\[\]\s\$\#\%'"]/\_/g;
        $file_name    = "$CFG->{priv_path}/tmp/$file_name";
        open (OUTFILE, "> $file_name") ;
        binmode(OUTFILE);
        my ($bytesread, $buffer, $count);
        while ($bytesread = read($data, $buffer, 1024)) {
            $buffer =~ s,\r\n,\n,g;
            print OUTFILE $buffer;
        }
        close OUTFILE;

        if (!-T $file_name) {
            unlink $file_name;
            return lst_import_form(GList::language('LST_IPT_INVALID_FILE'));
        }

        open (DATA, "< $file_name");
            my @lines = <DATA>;
        close DATA;
        unlink $file_name;

        LINE: foreach (@lines) {
            $count++;
            ( /^#/ )            and next LINE;
            ( /^\s*$/ )         and next LINE;
            ( $count eq $rl )   and next LINE;
            push @data, $_;
        }
    }
    else { # from listings
        @data = split(/$rd/, $data);
    }
    foreach my $id (@$import_to) {
        my $results = _import_subscriber($id, \@data);
        if (ref $results eq 'HASH') {
            push @results, $results;
        }
        else {
            push @results, { lst_id => $id, error => $results };
        }
    }
    return ('lst_import_success.html', { import_results => \@results });
}
END_OF_SUB

$COMPILE{_import_subscriber} = __LINE__ . <<'END_OF_SUB';
sub _import_subscriber {
#-----------------------------------------------------------------
#
    my ($list_id, $data) = @_;

# Verify data before importing    
    return GList::language('LST_INVALID') if (!$list_id or !$data);

    my $info = GList::check_owner('Lists', 'lst', $list_id);
    return $info if (ref $info ne 'HASH');

    if (GList::check_limit('sublist', $list_id)) {
        return { list_name => $info->{lst_title}, overlimit => 1 };
    }
    my $db = $DB->table('Subscribers');
    my $fd = $IN->param('fd') || ',';
    my $fe = $IN->param('fe') || '\\';
    my $rd = $IN->param('rd') || '\n';
    my $rl = $IN->param('rl') || 0;

# Create stoplist database and load wild cards 
    my $db_stl     = $DB->table('StopLists');
    my $wild_cards = GList::wild_cards();

    my @results;
    my ($invalid, $duplicate) = (0, 0);
    foreach my $row ( @$data ) {
        $row =~ s/[\r\n\"]//g;  # Remove Windows linefeed character.
        if ($IN->param('cname')) {
            my ($n, $e) = split(/$fd/, $row);
            $e = $1 if ($e =~ /<([^> ]+)>/);
            $e = lc $e;
            my $error = _check_subscriber($e, $list_id, $db_stl, $wild_cards);
            if ($error) {
                push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => $error };
                $invalid++;
            }
            else {
                push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => '' };
                if ($db->count({ sub_email => $e, sub_list_id_fk => $list_id })) {
                    $results[-1]->{status} = GList::language('SYS_DUPLICATE');
                    $duplicate++;
                }
                else {
                    $db->insert({ sub_email => $e, sub_name => $n, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
                }
            }
        }
        else {
            $row = $1 if ($row =~ /<([^> ]+)>/);
            $row = lc $row;
            my $error = _check_subscriber($row, $list_id, $db_stl, $wild_cards);
            if ($error) {
                push @results, { list_name => $info->{lst_title}, sub_email => $row, status => $error };
                $invalid++;
            }
            else {
                push @results, { list_name => $info->{lst_title}, sub_email => $row, status => '' };
                if ($db->count({ sub_email => $row, sub_list_id_fk => $list_id })) {
                    $results[-1]->{status} = GList::language('SYS_DUPLICATE');
                    $duplicate++;
                }
                else {
                    $db->insert({ sub_email => $row, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
                }
            }
        }
    }

    return {
        list_name  => $info->{lst_title},
        results    => \@results,
        invalid    => $invalid,
        duplicate  => $duplicate,
        hits       => scalar @results,
        successful => scalar @results - $invalid - $duplicate,
        declined   => $invalid + $duplicate
    };
}
END_OF_SUB

$COMPILE{_check_subscriber} = __LINE__ . <<'END_OF_SUB';
sub _check_subscriber {
#-----------------------------------------------------------------
#    
    my ($email, $lst_id, $db_stl, $wild_cards) = @_;
    return GList::language('LST_IPT_OVERLIMIT')     if (GList::check_limit('sublist', $lst_id));
    return GList::language('LST_IPT_INVALID_EMAIL') if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ );
    return GList::language('LST_IPT_ON_STOPLIST')   if ($db_stl->count({ stl_email => $email }));
    foreach (@$wild_cards) {
        my $e = $_->[0];
        my $re = quotemeta $e;
        $re =~ s/\\\*/.*/;
        $re =~ s/\\\?/./;
        return GList::language('LST_IPT_ON_STOPLIST') if ($email =~ /$re/i);
    }
}
END_OF_SUB

$COMPILE{lst_subscribers} = __LINE__ . <<'END_OF_SUB';
sub lst_subscribers {
#--------------------------------------------------------------------
# Print add form
#
    my $do = shift || 0;

    my $msg = ($do and $do =~ /^\d+$/) ? _sub_modify($do) : $do;
    if ($do =~ /^\d+$/ and ($do == 3 or ($do == 1 and $IN->param('unbounced_form')))) { # Reset bounced emails
        return lst_unsub_bounced($msg);
    }
    return ('lst_subscriber_form.html') if ($IN->param('form'));

    my $alpha;
    my $cgi = $IN->get_hash();

# Create condition for subscriber's quick search bar    
    require GT::SQL::Condition;
    my $cd   = GT::SQL::Condition->new(lst_user_id_fk => '=' => $USER->{usr_username});
    my $cols = $DB->table('Subscribers')->cols;
    my $url  = 'glist.cgi?do=lst_subscribers';
    my $query= '';
    foreach my $c (keys % $cols) {
        next if (!$cgi->{$c});
        if ($c eq 'sub_list_id_fk') {
            $cd->add($c => '=' => $cgi->{$c});
        }
        else {
            $cd->add($c => 'like' => "%$cgi->{$c}%");
        }
        $url .= ";$c=$cgi->{$c}";
    }

# Do a search from the main page
    if ($IN->param('sub_search') and $IN->param('search_val')) {
        $cgi->{$cgi->{search_col}} = $cgi->{search_val};
        $url   .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
        $query .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
    }
# And from quick search bar
    if ($IN->param('alpha') and $IN->param('alpha') ne 'all') {
        $alpha = $IN->param('alpha');
        $query .= ";alpha=$alpha";
    }

# Search on date fields
    my $search_check = ($IN->param('search_form')) ? 1 : 0;
    if ($cgi->{'sub_created-ge'} or $cgi->{'sub_created-le'}) {
        my $format     = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
        my ($valid_from, $valid_to) = (1, 1);

        require GT::Date;
        if ($cgi->{'sub_created-ge'}) {
            $valid_from = GList::date_to_time($cgi->{'sub_created-ge'}, $format);
            $cgi->{'sub_created-ge'} = GT::Date::date_get($valid_from, $format) if ($valid_from);
        }
        if ($cgi->{'sub_created-le'}) {
            $valid_to = GList::date_to_time($cgi->{'sub_created-le'}, $format);
            $cgi->{'sub_created-le'} = GT::Date::date_get($valid_to, $format) if ($valid_to);
        }
        if ($search_check and (!$valid_from or !$valid_to)) {
            $format =~ s/\%//g;
            return ('lst_subscriber_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
        }
    }
    if ($cgi->{sub_bounced}) {
        $cgi->{'sub_bounced-opt'} = '>=';
    }
    my $results = GList::search(
        cgi         => $cgi,
        db          => $DB->table('Subscribers'),
        prefix      => 'sub',
        sb          => 'sub_email',
        so          => 'ASC',
        search_alpha=> $alpha,
        search_col  => 'sub_email',
        search_check=> $search_check,
        show_user   => $cgi->{show_user},
        return_msg  => 'LST_SUB_RESULTS',
    );

    my $page    = ($IN->param('mn_disable')) ? 'lst_subscribers_preview.html' : 'lst_subscribers.html';
    my $subs_db = $DB->table('Lists', 'Subscribers');
    $subs_db->select_options('ORDER BY letter');

    my $sth = $subs_db->select($cd, ['DISTINCT SUBSTRING(sub_email, 1, 1) as letter']);
    if (ref $results ne 'HASH') {
        $page = 'lst_subscriber_form.html' if ($search_check);
        return ($page, { msg => $msg || $results, search_bar => _search_bar($sth, $url) });
    }
    elsif ($results->{error} and $search_check) {
        return ('lst_subscriber_form.html', { msg => $results->{error} });
    }

    if ($IN->param('mn_disable')) {
        $results->{msg} = '';
    }
    else {
        $results->{msg} = $msg if ($msg);
    }
    return ($page, { search_bar => _search_bar($sth, $url), toolbar_query => $query, %$results });
}
END_OF_SUB

$COMPILE{_sub_modify} = __LINE__ . <<'END_OF_SUB';
sub _sub_modify {
#--------------------------------------------------------------------
# Validate/delete subscribers user
#
    my $do = shift;

# If they selected only one record to search we still need an array ref
    my $mod = ( ref $IN->param('modify') eq 'ARRAY' ) ? $IN->param('modify') : [$IN->param('modify')];
    my $db  = $DB->table('Subscribers');
    my $cgi = $IN->get_hash;

    my ($msg, $rec_modified) = ('', 0);
    if ($do == 1) {  # Delete subscribers
        foreach my $rec_num ( @{$mod} ) {
            my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
            next if (!$info);

            my $ret = $db->delete({ sub_id => $info->{sub_id} });
            if (defined $ret and $ret != 0) {
                $rec_modified++;
            }
        }
        $msg = GList::language('LST_SUB_DELETED', $rec_modified);
    }
    elsif ($do == 2) { # Validate subscribers
        foreach my $rec_num ( @{$mod} ) {
            my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
            next if (!$info);

            if ($db->count({ sub_id => $info->{sub_id}, sub_validated => 0 })) {
                $db->update({ sub_validated => 1 }, { sub_id => $info->{sub_id} });
                $rec_modified++;
            }
        }
        $msg = GList::language('LST_SUB_VALIDATED', $rec_modified);
    }
    elsif ($do == 3) { # Unbounced subscribers
        require GT::SQL::Condition;
        foreach my $rec_num ( @{$mod} ) {
            my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
            next if (!$info);

            if ($db->count(GT::SQL::Condition->new(sub_id => '=' => $info->{sub_id}, sub_bounced => '>=' => 1))) {
                $db->update({ sub_bounced => '0' }, { sub_id => $info->{sub_id} });
                $rec_modified++;
            }
        }
        $msg = GList::language('LST_SUB_UNBOUNCED', $rec_modified);
    }
}
END_OF_SUB

$COMPILE{lst_unsub_bounced} = __LINE__ . <<'END_OF_SUB';
sub lst_unsub_bounced {
#--------------------------------------------------------------------
# Let you to unsubscribe all bounced users
#
    my $msg = shift;

    my $cgi = $IN->get_hash();
    my %hash;
    $hash{sub_list_id_fk} = $cgi->{sub_list_id_fk} || '';

    if ($cgi->{sub_bounced} and $cgi->{sub_bounced} eq '*') {
        $hash{sub_bounced} = 1;
        $hash{'sub_bounced-opt'} = '>=';
    }
    else {
        if ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<') {
            $hash{'sub_bounced-lt'} = $cgi->{sub_bounced};
            $hash{'sub_bounced-ge'} = 1;
        }
        elsif ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<=') {
            $hash{'sub_bounced-le'} = $cgi->{sub_bounced};
            $hash{'sub_bounced-ge'} = 1;
        }
        else {
            $hash{sub_bounced}       = $cgi->{sub_bounced}       || 1;
            $hash{'sub_bounced-opt'} = $cgi->{'sub_bounced-opt'} || '>=';
        }
    }
    my $results = GList::search(
        cgi         => \%hash,
        db          => $DB->table('Subscribers'),
        prefix      => 'sub',
        sb          => 'sub_email',
        so          => 'ASC',
        return_msg  => 'LST_BOUNCED_RESULTS',
        int_field   => 1,
    );
    if (ref $results ne 'HASH') {
        return ('lst_unsub_bounced.html', { msg => $msg || $results });
    }

    $results->{msg} = $msg if ($msg);
    return ('lst_unsub_bounced.html', $results);
}
END_OF_SUB

$COMPILE{lst_sub_add} = <<'END_OF_SUB';
sub lst_sub_add {
#-------------------------------------------------------------------
# Add a subscriber
#
    return ('lst_sub_add.html') if ($IN->param('form'));
    return ('lst_sub_add.html', { msg => GList::language('LST_IPT_LIST_EMPTY') }) if (!$IN->param('import_to'));

    my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
    my $email     = $IN->param('new_email');
    my $name      = $IN->param('new_name');
    if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/) { # check email address
        return ('lst_sub_add.html', { msg => GList::language('LST_IPT_INVALID_EMAIL') });
    }
    $email = lc $email;

# Create stoplist database and load wild cards 
    my $db         = $DB->table('Subscribers');
    my $db_stl     = $DB->table('StopLists');
    my $wild_cards = GList::wild_cards();

# Setup the language for GT::SQL.
    local $GT::SQL::ERRORS->{UNIQUE}     = GList::language('SYS_DUPLICATE');
    local $GT::SQL::ERRORS->{NOTNULL}    = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
    local $GT::SQL::ERRORS->{ILLEGALVAL} = '';

    my @results;
    foreach my $id (@$import_to) {
        my $info = GList::check_owner('Lists', 'lst', $id);
        push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => lst_subscribers($info) } if ( ref $info ne 'HASH' );

        push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => '' };
        my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
        if ($error) {
            $results[-1]->{status} = $error;
        }
        elsif ($db->count({ sub_email => $email, sub_list_id_fk => $id })) {
            $results[-1]->{status} = GList::language('SYS_DUPLICATE');
        }
        else {
            $db->insert({ sub_email => $email, sub_name => $name, sub_list_id_fk => $id, sub_user_id_fk => $info->{lst_user_id_fk} });
        }
    }
    return ('lst_sub_success.html', { results => \@results, msg => GList::language('LST_SUB_ADDED', $email) });
}
END_OF_SUB

$COMPILE{lst_sub_modify} = <<'END_OF_SUB';
sub lst_sub_modify {
#-------------------------------------------------------------------
# Modify a subscriber
#
    my $sub_id   = $IN->param('subid');
    my $old_data = $DB->table('Lists', 'Subscribers')->select({ sub_id => $sub_id }, [ 'lst_title', 'sub_email as new_email', 'sub_name as new_name', 'sub_validated as new_validated', 'sub_bounced as new_bounced', 'sub_list_id_fk'])->fetchrow_hashref;
    return lst_subscribers(GList::language('LST_INVALID')) if (!$old_data);

    my $info = GList::check_owner('Lists', 'lst', $old_data->{sub_list_id_fk});
    return lst_subscribers($info) if (ref $info ne 'HASH');

    return ('lst_sub_modify.html', $old_data) if ($IN->param('form'));

    my $new_email = $IN->param('new_email');
    my $name      = $IN->param('new_name');
    my $validated = ($IN->param('new_validated')) ? '1' : '0';
    my $bounced   = $IN->param('new_bounced') || 0;

    if ($new_email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $new_email =~ /\s/) { # check email address
        return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_INVALID_EMAIL'), %$info });
    }

    require GT::SQL::Condition;
    if ($DB->table('Subscribers')->count( GT::SQL::Condition->new(
            sub_email      => '=' => $new_email,
            sub_list_id_fk => '=' => $old_data->{sub_list_id_fk},
            sub_id         => '<>'=> $sub_id,
        )) == 1 ) {
        return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_DUPLICATE_EMAIL'), %$info });
    }
    else {
        $DB->table('Subscribers')->update({
            sub_email       => $new_email,
            sub_name        => $name,
            sub_validated   => $validated,
            sub_bounced     => $bounced,
        }, { sub_id => $sub_id });
    }
    return lst_subscribers(GList::language('LST_SUB_MODIFIED', $old_data->{new_email}));
}
END_OF_SUB


$COMPILE{lst_sub_delete} = <<'END_OF_SUB';
sub lst_sub_delete {
#-------------------------------------------------------------------
# Delete the subscribers
#
    return lst_subscribers(1);
}
END_OF_SUB

$COMPILE{lst_sub_validate} = <<'END_OF_SUB';
sub lst_sub_validate {
#-------------------------------------------------------------------
# Validate the subscribers
#
    return lst_subscribers(2);
}
END_OF_SUB

$COMPILE{lst_sub_unbounced} = <<'END_OF_SUB';
sub lst_sub_unbounced {
#-------------------------------------------------------------------
# Validate the subscribers
#
    return lst_subscribers(3);
}
END_OF_SUB

$COMPILE{_qsort} = __LINE__ . <<'END_OF_SUB';
sub _qsort {
#------------------------------------------------------------------
    my ($list_file, $orderby, $sortdown)  = @_;
    my $sorted;
    @$sorted =
               sort {
                    my $da = lc $a->{$orderby};         #lower case
                    my $db = lc $b->{$orderby};
                    my $res;
                    if ($orderby eq 'size' or $orderby eq 'date') {
                        $res = $db <=> $da;
                    }
                    else {
                        $res = $db cmp $da;
                    }
                    if ($res == 0 and $orderby ne 'name') {
                        lc $b->{name} cmp lc $a->{name};
                    }
                    else {
                        $res;
                    }
               } @$list_file;
    ($sortdown) and @$sorted = reverse @$sorted;
    return $sorted;
}
END_OF_SUB

$COMPILE{_search_bar} = __LINE__ . <<'END_OF_SUB';
sub _search_bar {
#---------------------------------------------------------------------
# create quick search bar
#
    my ($sth, $url) = @_;
    my $current = $IN->param('alpha') || '';
    my @alpha   = ('All', 'A'..'Z', '0..9', 'Other');

    my ($search_bar, $items);
    $items->{All} = 'all';
    while (my ($letter) = $sth->fetchrow_array) {
        $letter = uc $letter;
        if ($letter =~ /\d/) {
            exists $items->{'0..9'} or $items->{'0..9'} = 'number';
        }
        elsif ($letter =~ /[\W_]/) {
            exists $items->{Other} or $items->{Other} = 'other';
        }
        else {
            exists $items->{$letter} or $items->{$letter} = $letter;
        }
    }
    foreach (@alpha) {
        if ($_ eq 'All') {
            $search_bar .= ( (!$current or $current eq 'all') and !$IN->param('bsearch') ) ? "<b>$_</b> " : "<a href='$url&alpha=all'>$_</a> ";
        }
        elsif ($items->{$_}) {
            my $l = ($_ eq '0..9') ? 'number' : lc $_;
            $search_bar .= ( lc $current eq lc $l ) ? "<b>$_</b> " : "<a href='$url;alpha=$l'>$_</a> ";
        }
        else {
            $search_bar .= "$_ ";
        }
    }
    return $search_bar;
}
END_OF_SUB

$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
sub _determine_action {
#----------------------------------------------------------------------------
# Check valid action
#
    my $action = shift || undef;
    return            if (!$action);
    return 'lst_home' if ($action eq 'lst_search' );

    my %valid = (
        map { $_ => 1 } qw(
            lst_home
            lst_add
            lst_modify_form
            lst_modify
            lst_search_form
            lst_delete
            lst_html
            lst_import
            lst_subscribers
            lst_sub_add
            lst_sub_modify
            lst_sub_delete
            lst_sub_validate
            lst_sub_unbounced
            lst_unsub_bounced
        )
    );
    exists $valid{$action} and return $action;
    return;
}
END_OF_SUB

1;