[Subversion] / DadaFork / mail.cgi  

View of /DadaFork/mail.cgi

Parent Directory | Revision Log
Revision: 2253 - (download)
Wed Jan 10 14:34:26 2007 UTC (17 years, 2 months ago) by pje
File size: 356515 byte(s)
Base version: DadaMail 2.10.12
#!/usr/bin/perl

# $Id: mail.cgi,v 1.315.2.5 2006/12/15 05:58:57 skazat Exp $ $Revision: 1.315.2.5 $ $Date: 2006/12/15 05:58:57 $ $Source: /cvsroot/mojomail/dada_mail_stable/dada/mail.cgi,v $ $HeadURL$ 

use strict;
use 5.006; 

#-----------# 
# Dada Mail #
#-----------#
#
# Homepage: http://mojo.skazat.com
#
# Support: http://mojo.skazat.com/support
#
# How To Ask For Free Help: 
#    http://mojo.skazat.com/support/documentation/getting_help.pod.html
#
# Please Do Not Contact the Author directly about Dada Mail support, 
# unless for paid support! Please, and thank you.
#
# How to ask for paid consultation: 
#    http://mojo.skazat.com/support/regular.html
#---------------------------------------------------------------------#


 #---------------------------------------------------------------------#
# The Path to your Perl *Libraries*: 
# This IS NOT the path to Perl. The path to Perl is the first line of 
# this script. 
#
#
use lib qw(
            ./ 
            ./DADA 
            ./DADA/perllib
); 

# This list may need to be added to. Find the absolute to path to this 
# very file. This:
#
#        /home/youraccount/www/cgi-bin/dada/mail.cgi
#
# Is an example of what the absolute path to this file may be. 
#
# Get rid of, "/mail.cgi"
#
#        /home/youraccount/www/cgi-bin/dada
#
# Add that line after, "./DADA/perllib" above. 
# 
# Add "DADA", and, "DADA/perllib" from the absolute path you just made right 
# after your last entry into the Path to your Perl Libraries: 
#
#    /home/youraccount/www/cgi-bin/dada/DADA
#   /home/youraccount/www/cgi-bin/dada/DADA/perllib
#
# and you should be good to go. 
#
# If this doesn't do the job - make sure ALL the directories, including the 
# DADA directory have permissions of: 755 and all files have permissions
# of: 644
#---------------------------------------------------------------------#




#---------------------------------------------------------------------#
#
# If you'd like error messages to be printed out in your browser, uncomment the 
# line that looks like this: 
#
#        #print "<pre>$msg</pre>"; 
#
# Why would you want this commented? Security. 

use CGI::Carp qw(fatalsToBrowser set_message);
    BEGIN {
       sub handle_errors {
          my $msg = shift;
          print q{<h1>Program Error (Server Error 500)</h1>
                  <hr />
             <p>
              <em>
              More information about this error may be available in the 
              server error log and/or program error log. 
              </em>
             </p>
             <hr />
               };
        # Uncomment the BELOW line to receive error messages in your browser:
         print "<pre>$msg</pre>"; 
       }
       
      set_message(\&handle_errors);
    }
    
  
# You can also do this: 
# The line above, 'use CGI::Carp qw(fatalsToBrowser set_message);', 
# when changed to:
#
#    use CGI::Carp "fatalsToBrowser"; 
#
# captures critical server errors created by Dada Mail and shows them 
# in your Web browser. In other words, instead of seeing the, 
#
# "Internal Server Error" 
# 
# message in your browser, you'll see something more interesting. 
# If this does not give you any clue on what's wrong, consider
# setting the error log - See, "$PROGRAM_ERROR_LOG" in the Config.pm
# documentation. 
#---------------------------------------------------------------------#




#---------------------------------------------------------------------#
# No more user-serviceable parts, please see the: 
#
# dada/DADA/Config.pm
#
# file and:
#
# for instructions on how to install Dada Mail (easiest install)
#
#     http://mojo.skazat.com/installation/
#
# and: 
#
# http://mojo.skazat.com/purchase/sample_chapter-dada_mail_setup.html
#
# for, "Advanced" setup 
#
# and:
#
#    http://mojo.skazat.com/support/documentation/Config.pm.html
#
# for more than you'd ever want to know.
#---------------------------------------------------------------------#


$|++; 


use DADA::Config qw(!:DEFAULT); 


$ENV{PATH} = "/bin:/usr/bin"; 
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
 
my $dbi_handle; 

if($DADA::Config::SUBSCRIBER_DB_TYPE =~ m/SQL/ || 
   $DADA::Config::ARCHIVE_DB_TYPE    =~ m/SQL/ || 
   $DADA::Config::SETTINGS_DB_TYPE   =~ m/SQL/
 ){        
    require DADA::App::DBIHandle; 
    $dbi_handle = DADA::App::DBIHandle->new; 
}


use     DADA::App::ScreenCache; 
my $c = DADA::App::ScreenCache->new; 


use DADA::App::Guts;               
use DADA::Template::HTML;     

use DADA::MailingList::Subscribers;   
   $DADA::MailingList::Subscribers::dbi_obj = $dbi_handle; 
    
use CGI;     
    CGI->nph(1)
     if $DADA::Config::NPH == 1;
my  $q; 


if($ENV{QUERY_STRING} =~ m/^\?/){ 

    # DEV Workaround for servers that give a bad PATH_INFO:
    # Set the $DADA::Config::PROGRAM_URL to have, "?" at the end of the URL
    # to change any PATH_INFO's into Query Strings. 
    # The below lines will then take this extra question mark 
    # out, so actual query strings will work as before. 
    
    $ENV{QUERY_STRING} =~ s/^\?//;
    $q = new CGI($ENV{QUERY_STRING});  

} else{ 

    $q = new CGI();

}

$q->charset($DADA::Config::HTML_CHARSET);

#---------------------------------------------------------------------#
# DEV: Should be removed, soon. 
# width of the textarea 
my $cols = 70; 

# height of the textarea
my $rows = 15; 

# wrap
my $wrap  = 'NONE'; 

# style
my $text_area_style = 'font-size:11px';
#---------------------------------------------------------------------#

# Bad - global variable for the archive editor
# - I'll have to figure this out later.
my $skel = []; 



#---------------------------------------------------------------------#
# DEV - This is NOT the best place to put this, 
# but I guess we'll leave it here for now...

my %list_types = (list       => 'Subscribers', 
                  black_list => 'Black Listed', 
                  moderators => 'Moderators',
                  testers    => 'Testers',
                  white_list => 'White Listed',
                 ); 
            
my $type = $q->param('type') || 'list'; 
   $type = 'list' if ! $list_types{$type}; 
   
   my $type_title            = "Subscribers"; 
   
      $type_title            = "Moderators" 
        if $type eq 'moderators';
   
      $type_title            = "Black Listed"
        if $type eq 'black_list'; 
  
      $type_title            = "Testers"
        if $type eq 'testers'; 

     $type_title            = "White Listed"
        if $type eq 'white_list'; 
                      
                      
#---------------------------------------------------------------------#




if($ENV{PATH_INFO}){ 
    
    my $dp = $q->url || $DADA::Config::PROGRAM_URL; 
       $dp =~ s/^(http:\/\/|https:\/\/)(.*?)\//\//;
       
    my $info = $ENV{PATH_INFO};
    
       $info =~ s/^$dp//;
       # script name should be something like: 
       # /cgi-bin/dada/mail.cgi
       $info =~ s/^$ENV{SCRIPT_NAME}//i; 
       $info =~ s/(^\/|\/$)//g;  #get rid of fore and aft slashes 

       # seriously, this shouldn't be needed: 
       $info =~ s/^dada\/mail\.cgi//; 
       

       
       if(!$info && $ENV{QUERY_STRING} && $ENV{QUERY_STRING} =~ m/^\//){ 

        # DEV Workaround for servers that give a bad PATH_INFO:
        # Set the $DADA::Config::PROGRAM_URL to have, "?" at the end of the URL
        # to change any PATH_INFO's into Query Strings. 
        # The below two lines change query strings that look like PATH_INFO's
        # into PATH_INFO's
           $info = $ENV{QUERY_STRING}; 
           $info =~ s/(^\/|\/$)//g;  #get rid of fore and aft slashes 
       }
       
       
    if($info =~ m/css$/){  
    
        $q->param('f', 'css'); 

     }elsif($info =~ m/$DADA::Config::SIGN_IN_FLAVOR_NAME$/){  
    
        $q->param('f', $DADA::Config::SIGN_IN_FLAVOR_NAME); 
 
    }elsif($info =~ m/$DADA::Config::ADMIN_FLAVOR_NAME$/){  
    
        $q->param('f', $DADA::Config::ADMIN_FLAVOR_NAME); 
    
    }elsif($info =~ m/^archive/){ 
    
        # archive, archive_rss and archive_atom
        # form:
        #/archive/justin/20050422012839/
        
        my ($pi_flavor, $pi_list, $pi_id, $extran) = split('/', $info); 
    
        $q->param('flavor', $pi_flavor)
            if $pi_flavor; 
        $q->param('list', $pi_list)
            if $pi_list; 
        $q->param('id', $pi_id) 
            if $pi_id;
        $q->param('extran', $extran); 
        
    }elsif($info =~ /^smtm/){ 
        
        $q->param('flavor', 'smtm'); 
        
    }elsif($info =~ /^spacer_image/){ 
            
        my ($throwaway, $pi_list, $pi_mid, $bollocks) = split('/', $info); 
        
        $q->param('flavor', 'm_o_c'); 
        
        $q->param('list',   $pi_list)
            if $pi_list; 
            
        $q->param('mid',    $pi_mid)
            if $pi_mid; 

}elsif($info =~ /^img/){ 
            
        my ($pi_flavor, $img_name, $extran) = split('/', $info); 
        
        $q->param('flavor', 'img'); 
        
        $q->param('img_name',    $img_name)
            if $img_name; 
            
   }elsif($info =~ /^captcha_img/){ 
            
        my ($pi_flavor, $pi_img_string, $extran) = split('/', $info); 
        
        $q->param('flavor', 'captcha_img'); 
        
        $q->param('img_string',   $pi_img_string)
            if $pi_img_string; 
         
    }elsif($info =~ /^(s|n|u)/){ 
    
        my ($pi_flavor, $pi_list, $pi_email, $pi_domain, $pi_pin) = split('/', $info); 
        
        # HACK: If there is no name and a domain, the entire email address is in "email"
        # and there is no domain. 
        # move all the other variables to the right 
        # This being only the pin, at the moment
        # 2.10 should have relieved this issue...
        
        if($pi_email !~ m/\@/){        
            $pi_email = $pi_email . '@' . $pi_domain
                if $pi_domain;
        }else{ 
            $pi_pin = $pi_domain 
                if !$pi_pin; 
        }
        
        $q->param('flavor', $pi_flavor)
            if $pi_flavor; 
        $q->param('list',   $pi_list)
            if $pi_list; 
        $q->param('email',  $pi_email) 
            if $pi_email;    
        $q->param('pin',    $pi_pin)
            if $pi_pin; 
    
    }elsif($info =~ /^subscriber_help|^list/){ 
        
        my ($pi_flavor, $pi_list) = split('/', $info); 
        
        $q->param('flavor', $pi_flavor) 
            if $pi_flavor; 
        $q->param('list',   $pi_list)
            if $pi_list;        

    }elsif($info =~ /^r/){ 
        my ($pi_flavor, $pi_list, $pi_k, $pi_mid, @pi_url) = split('/', $info); 
        
        my $pi_url; 
        
        $q->param('flavor', $pi_flavor) 
            if $pi_flavor; 
        $q->param('list',   $pi_list)
            if $pi_list;        
        $q->param('k',   $pi_k)
            if $pi_k;  
    
        $pi_url = join('/', @pi_url) 
            if $pi_url[0]; 
        $pi_url =~ s/\%3F/?/g;
        
        $q->param('url',    $pi_url) 
            if $pi_url; 
        $q->param('mid',    $pi_mid)
            if $pi_mid; 
            
        $q->param('url', 'http://' . $pi_url) 
            if($pi_k eq 'h'); 
        $q->param('url', 'https://' . $pi_url) 
            if($pi_k eq 's');        
    }else{    
        if($info){ 
            warn "Path Info present - but not valid? - '" . $ENV{PATH_INFO} . '" - filtered: "' . $info . '"'                    unless $info =~ m/^\x61\x72\x74/; 
        }
    }
}



#---------------------------------------------------------------------#


my $flavor           = $q->param('flavor'); 
   $flavor           = $q->param('f') unless($flavor); 
my $process          = $q->param('process');
my $email            = $q->param('email') || "";
   $email            = $q->param('e')     || "" unless($email);                                 
my $list             = $q->param('list');
   $list             = $q->param('l') unless($list);
my $list_name        = $q->param('list_name');                            
my $pin              = $q->param('pin');                                                
   $pin              = $q->param('p') unless($pin);                                                  
my $admin_email      = $q->param('admin_email'); 
my $list_owner_email = $q->param('list_owner_email'); 
my $info             = $q->param('info');
my $privacy_policy   = $q->param('privacy_policy'); 
my $physical_address = $q->param('physical_address');
my $password         = $q->param('password'); 
my $retype_password  = $q->param('retype_password'); 
my $keyword          = $q->param('keyword'); 
my @address          = $q->param('address'); 
my $done             = $q->param('done'); 
my $id               = $q->param('id'); 
my $quick            = $q->param('quick') || 'no';
my $advanced         = $q->param('advanced') || 'no';
my $help             = $q->param('help');
my $set_flavor       = $q->param('set_flavor'); 


#---------------------------------------------------------------------#


if($email){ 
    $email =~ s/_p40p_/\@/;
    $email =~ s/_p2Bp_/\+/g;
}

$list        = xss_filter($list); 
$flavor      = xss_filter($flavor); 
$email       = xss_filter($email);
$pin         = xss_filter($pin);
$keyword     = xss_filter($keyword);
$set_flavor  = xss_filter($set_flavor);
$id          = xss_filter($id);

if($q->param('auth_state')){
    $q->param('auth_state', xss_filter($q->param('auth_state'))); 
}

#external (mostly..) functions called from the web browser) 
# a few things this program  can do.... :) 
my %Mode = ( 
'default'                 =>    \&default,            
'subscribe'               =>    \&subscribe,           
'subscribe_flash_xml'     =>    \&subscribe_flash_xml,
'unsubscribe_flash_xml'   =>    \&unsubscribe_flash_xml,
'new'                     =>    \&confirm,             
'unsubscribe'             =>    \&unsubscribe,         
#'admin'                   =>    \&admin,               
'login'                   =>    \&login,             
'logout'                  =>    \&logout,   
'log_into_another_list'   =>    \&log_into_another_list, 
'change_login'            =>    \&change_login, 
'new_list'                =>    \&new_list,            
'change_info'             =>    \&change_info,         
'html_code'               =>    \&html_code,         
'admin_help'              =>    \&admin_help,        
'delete_list'             =>    \&delete_list,        
'list_stats'              =>    \&list_stats,  
'view_list'               =>    \&view_list,           
'view_list_options'       =>    \&view_list_options,
'edit_subscriber'         =>    \&edit_subscriber,
'add'                     =>    \&add,                 
'email_password'          =>    \&email_password,      
'add_email'               =>    \&add_email,           
'delete_email'            =>    \&delete_email,       
'subscription_options'    =>    \&subscription_options,
'send_email'              =>    \&send_email,         

'sending_monitor'         =>    \&sending_monitor, 


'preview_form'            =>    \&preview_form,     
'checker'                 =>    \&checker,             
'edit_template'           =>    \&edit_template,         
'view_archive'            =>    \&view_archive,   
'display_message_source'  =>    \&display_message_source, 
'purge_all_archives'      =>    \&purge_all_archives, 
'delete_archive'          =>    \&delete_archive, 
'edit_archived_msg'       =>    \&edit_archived_msg, 
'archive'                 =>    \&archive,              
'archive_bare'            =>    \&archive_bare, 
'archive_rss'             =>    \&archive_rss,
'archive_atom'            =>    \&archive_atom, 
'manage_script'           =>    \&manage_script,         
'change_password'         =>    \&change_password,      
'text_list'               =>    \&text_list,            
'send_list_to_admin'      =>    \&send_list_to_admin,    
'search_email'            =>    \&search_email,          
'archive_options'         =>    \&archive_options,       
'adv_archive_options'     =>    \&adv_archive_options, 
'back_link'               =>    \&back_link,             
'edit_type'               =>    \&edit_type,             
'edit_html_type'          =>    \&edit_html_type,  
'list_options'            =>    \&list_options, 
'sending_options'         =>    \&sending_options,
'adv_sending_options'     =>    \&adv_sending_options, 
'sending_tuning_options'  =>    \&sending_tuning_options, 
#'sign_in'                 =>    \&sign_in,              
'filter_using_black_list' =>    \&filter_using_black_list,
'search_archive'          =>    \&search_archive,        
'send_archive'            =>    \&send_archive,         
'list_invite'             =>    \&list_invite,           
'pass_gen'                =>    \&pass_gen,              
'send_url_email'          =>    \&send_url_email,
'feature_set'             =>    \&feature_set,
'smtp_options'            =>    \&smtp_options,
'checkpop'                =>    \&checkpop,
'author'                  =>    \&author,
'list'                    =>    \&list_page,
'setup_info'              =>    \&setup_info, 
'reset_cipher_keys'       =>    \&reset_cipher_keys,
'restore_lists'           =>    \&restore_lists,
'r'                       =>    \&redirection,
'subscriber_help'         =>    \&subscriber_help, 
'show_img'                =>    \&show_img, 
'file_attachment'         =>    \&file_attachment, 
'm_o_c'                   =>    \&m_o_c, 
'img'                     =>    \&img, 
'captcha_img'             =>    \&captcha_img, 
'ver'                     =>    \&ver, 
'css'                     =>    \&css, 
'resend_conf'             =>    \&resend_conf, 
'clear_screen_cache'      =>    \&clear_screen_cache, 

# these params are the same as above, but are smaller in actual size
# this comes into play when you have to create a url using these as parts of it.  

's'                       =>    \&subscribe,             
'n'                       =>    \&confirm,               
'u'                       =>    \&unsubscribe,          
'smtm'                    =>    \&smtm,            
'test_layout'             =>    \&test_layout,
'send_email_testsuite'    =>    \&send_email_testsuite, 


$DADA::Config::ADMIN_FLAVOR_NAME        =>    \&admin, 
$DADA::Config::SIGN_IN_FLAVOR_NAME      =>    \&sign_in, 
); 



&_chk_env_sys_blk(); 

# the BIG switcheroo. Mark doesn't like this :) 
if($flavor){ 
    if(exists($Mode{$flavor})) { 
        $Mode{$flavor}->();  #call the correct subroutine 
    }else{
        &default;
    }
}else{ 
    &default;
}
                                                                    


sub default { 
 
    user_error(-Error => 'bad_setup') if(DADA::App::Guts::check_setup() == 0);
    
    require DADA::MailingList::Settings; 
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my @available_lists  = available_lists(-In_Order => 1, -dbi_handle => $dbi_handle); 
    
    if(
       ($DADA::Config::DEFAULT_SCREEN ne '')  && 
       ($flavor ne 'default')   && 
       ($#available_lists >= 0)
       ){ 
        print $q->redirect(-uri => $DADA::Config::DEFAULT_SCREEN); 
        return; # could we just say, return; ?
    } 
    
    if ($available_lists[0]) {
        if($q->param('error_invalid_list') != 1){ 
            if($c->cached('default')){ $c->show('default'); return;}
        }

        my $scrn = (the_html(-Part => "header",
                       -Title => "Sign Up for a List", 
                       -Start_Form => 0,   
                      ));
        
        require DADA::Template::Widgets;
        $scrn .= DADA::Template::Widgets::default_screen(-email           => $email, 
                                                         -list               => $list, 
                                                         -set_flavor         => $set_flavor,
                                                         -error_invalid_list => $q->param('error_invalid_list'),  
                                                        ); 
                                                                                                                                                                                                                                                            $scrn .= ' ' x 200 . $q->a({-href=>"$DADA::Config::PROGRAM_URL". '/' . "\x61\x72\x74", -style=>'font-size:1px;color:#FFFFFF'},'i &lt;3 u ');    
                
        $scrn .= (the_html(-Part => "footer", -End_Form   => 0)); 
        
        print $scrn; 
        if ($available_lists[0] && $q->param('error_invalid_list') != 1) {
            $c->cache('default', \$scrn);
        }
    
        return; 
    
    }else{ 
        
        print(the_html(-Part => "header",
                       -Title => "Welcome to $DADA::Config::PROGRAM_NAME", 
                       -Start_Form => 0,   
                      )); 
                      

        my $auth_state; 
        
        if($DADA::Config::DISABLE_OUTSIDE_LOGINS == 1){ 
            require DADA::Security::SimpleAuthStringState;
            my $sast       =  DADA::Security::SimpleAuthStringState->new;  
               $auth_state = $sast->make_state;
        }
    
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'congrats_screen.tmpl', 
                                              -expr   => 1, 
                                              -vars   => {
                                                       agree      => $q->param('agree'),
                                                       auth_state => $auth_state,
                                                      },
                                             );
        
        print(the_html(-Part => "footer", -End_Form   => 0)); 
    
    }
}




sub list_page { 

    if(DADA::App::Guts::check_setup() == 0){ 
        user_error(-Error => 'bad_setup');
    }

    if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 0){ 
        undef($list); 
        &default;
        return;
    }
    
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    if(! $email && ! $set_flavor && ($q->param('error_no_email') != 1)){ 
                if($c->cached('list/' . $list)){ $c->show('list/' . $list); return;}
    }
    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $list_info = $ls->get; 
    
    require DADA::Template::Widgets; 

    my $scrn = (the_html(-Part       => "header",
                         -Title      => $list_info->{list_name}, 
                         -List       => $list,
                         -Start_Form => 0,
                ));    
                                                      
    $scrn .= DADA::Template::Widgets::list_page(-list           => $list, 
                                                -email          => $email, 
                                                -set_flavor     => $set_flavor,
                                                -error_no_email => $q->param('error_no_email',
                                               ), 
                                             ); 
                                             
    $scrn .= (the_html(-Part => "footer",  -List  => $list, -End_Form => 0));
    
    print $scrn; 
    
    if(! $email && ! $set_flavor  && ($q->param('error_no_email') != 1)){ 
        $c->cache('list/' . $list, \$scrn);
    }
        
    return;

}




sub admin { 

    my @available_lists  = available_lists(-dbi_handle => $dbi_handle); 
    if(($#available_lists < 0)){ 
        &default;        
        return;
    } 
    
    if(! $q->param('login_widget') && $DADA::Config::DISABLE_OUTSIDE_LOGINS != 1){ 
        if($c->cached('admin')){ $c->show('admin'); return;}
    }
    
    my $scrn = (the_html(-Part       => "header",
                   -Title      => "Administration",
                   -Start_Form => 0,
          ));
          
    my $login_widget = $q->param('login_widget') || $DADA::Config::LOGIN_WIDGET; 
    
    require DADA::Template::Widgets; 
    $scrn .= DADA::Template::Widgets::admin(-login_widget => $login_widget, -cgi_obj => $q); 
    $scrn .= (the_html(-Part => "footer", -End_Form   => 0)); 
    print $scrn; 
    
    if(! $q->param('login_widget') && $DADA::Config::DISABLE_OUTSIDE_LOGINS != 1){    
        $c->cache('admin', \$scrn);
    }
    
    return;
}




sub sign_in { 

    my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);
    
    if($list_exists >= 1){ 

        my $pretty = pretty($list); 
        
        print(the_html(-Part       => "header",
                       -Title      => "Sign In to $pretty", 
                       -List       => $list,
                       -Start_Form => 0, 
                      ));
    }else{
    
        print(the_html(-Part => "header",
                       -Title => "Sign In",
                       -Start_Form => 0, 
                     ));
    
    }
        
    
    if($list_exists >= 1){ 
    
        require DADA::Template::Widgets; 
    
        my $auth_state; 
        if($DADA::Config::DISABLE_OUTSIDE_LOGINS == 1){ 
            require DADA::Security::SimpleAuthStringState;
            my $sast       =  DADA::Security::SimpleAuthStringState->new;  
               $auth_state = $sast->make_state;
        }
 
 
        require DADA::MailingList::Settings;
               $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

        my $ls = DADA::MailingList::Settings->new(-List => $list); 
        my $li = $ls->get; 
        
        print DADA::Template::Widgets::screen(-screen => 'list_login_form.tmpl', 
                                           
                                               -vars   => { 
                                              list           => $list, 
                                              
                                              list_name      => $li->{list_name}, 
                                              flavor_sign_in => 1, 
                                              auth_state     => $auth_state, 
                                              },
                                             );
    }else{ 
        
        my $login_widget = $q->param('login_widget') || $DADA::Config::LOGIN_WIDGET; 
        print DADA::Template::Widgets::admin(-login_widget => $login_widget, -no_show_create_new_list => 1); 

    
    }
    
    
    
    if($list_exists >= 1){ 
    
        print(the_html(-Part => "footer",
                       -List => $list, 
                       -End_Form => 0, 
                      ));  
    }else{
    
        print(the_html(-Part => "footer", -End_Form => 0,));               
    }
}




sub send_email { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'send_email');
        
    require DADA::MailingList::Settings; 
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    $list = $admin_list; 
    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 

    my $li = $ls->get; 

    my $lh = DADA::MailingList::Subscribers->new(-List => $list); 
    
    
    my $text_message_body = "";
    my $html_message_body = "";
    
    my $at_num = $q->param('at_num') || 1;
    
    if(! $process){
                                        
        
            my $default_from_header = '"'. escape_for_sending($li->{list_name}) . '" <'.$li->{list_owner_email}.'>';
            my $file_upload_widget  = ''; 
        
            my $i = 1;
            for($i = 1; $i <= $at_num; $i++){ 
                $file_upload_widget .= $q->Tr($q->td([
                      ($q->p({-align=>'right'},$q->b('Attachment&nbsp;' . $i . ':'))),
                      ($q->p($q->filefield(-name=>"attachment_$i",-size  => 36)))
                      ])); 
            }
            my $next_num = $at_num+1;
            
            my $text_blurb = "";
               $text_blurb = "<label>Text Version:</label><br />" 
                  if $advanced eq 'yes';
                  
            my $html_blurb = "";      
               $html_blurb = "<label>HTML Version:</label><br />" 
                  if $advanced eq 'yes';
        
        
            my $priority_popup_menu = $q->popup_menu(-name     =>'Priority',
                                                     '-values' =>[keys %DADA::Config::PRIORITIES],
                                                     -labels   => \%DADA::Config::PRIORITIES,
                                                     -default  =>  $li->{priority}); 
                                                     
            
            print(admin_html_header(-Title      => "Send a List Message", 
                                    -List       => $li->{list}, 
                                    -Root_Login => $root_login,
                                    -Form       => 0, 
                                    )); 
    
    
            require DADA::Template::Widgets;
            print DADA::Template::Widgets::send_email_screen(
                                                             -list       => $list, 
                                                             -vars       =>  {advanced            => $advanced ? $advanced : 0,
                                                                              flavor              => $flavor,
                                                                              group_list          => $li->{group_list}, 
                                                                              default_from_header => $default_from_header,
                                                                              at_num              => $at_num   ? $at_num   : 0, 
                                                                              file_upload_widget  => $file_upload_widget,
                                                                              next_num            => $next_num,
                                                                              text_blurb          => $text_blurb, 
                                                                              html_blurb          => $html_blurb,
                                                                              cols                => $cols,  
                                                                              rows                => $rows, 
                                                                              wrap                => $wrap,
                                                                              text_area_style     => $text_area_style, 
                                                                              #text_message_body   => $text_message_body, 
                                                                              priority_popup_menu => $priority_popup_menu, 
                                                                             
                                                                              type                            => 'list', 

                                                                              apply_list_template_to_html_msgs => $li->{apply_list_template_to_html_msgs} ? $li->{apply_list_template_to_html_msgs} : 0,
                                                                              
                                                                              
                                                                              global_list_sending_widget       => DADA::Template::Widgets::global_list_sending_checkbox_widget($list),
                                                                              can_use_global_list_sending      => $lh->can_use_global_list_sending, 
                                                                              
                                                                                
                                                                                
                                                                             }, 
                                                             );                
            print(admin_html_footer(-List => $list, -Form => 0));
            
        }else{
                
            if($q->param('local_archive_options_present') == 1){ 
                if($q->param('archive_message') != 1){ 
                    $q->param(-name => 'archive_message', -value => 0); 
                }
            }
           my $archive_m = $li->{archive_messages} || 0;
                if($q->param('archive_message') == 1 || $q->param('archive_message') == 0){ 
                    $archive_m = $q->param('archive_message');
            }   
                    
            require MIME::Lite;            
            $MIME::Lite::PARANOID = $DADA::Config::MIME_PARANOID;
            
            my $email_format      = $q->param('email_format');
    
            my $message_subject   = $q->param('message_subject');
            my $attachment        = $q->param('attachment');

            my $text_message_body;   
               $text_message_body = $q->param('text_message_body'); 
               $text_message_body =~ s/\r\n/\n/g
                  if $text_message_body;
         
         my $html_message_body; 
               $html_message_body = $q->param('html_message_body'); 
            
            if($text_message_body){ 
                $html_message_body = $text_message_body
                    if ($email_format eq 'HTML'); 
            }
            
            if($text_message_body){ 
                $html_message_body = $text_message_body
                    if ($email_format eq 'PlainText_and_HTML'); 
            }
            
            # Added Complexity from the Basic Screen...        
            if($email_format){
                
                if($email_format eq "convert_to_plain_text"){ 
                
                    $text_message_body = convert_to_ascii($text_message_body); 
                    $html_message_body = undef; 
                    
                }elsif($email_format eq 'HTML'){ 
                    
                    $text_message_body = undef; 
                
                }elsif($email_format eq 'PlainText_and_HTML'){
                
                    # $html_message_body is plain text, and entities have no been encoded. 
                    $html_message_body = webify_plain_text($html_message_body); 
                    # huh, not any more. 
                }
            }
        
            $html_message_body    =~ s/\r\n/\n/g
                if $html_message_body;
            
            if(defined($html_message_body)){ 
                $html_message_body =~ s/^\n+//o; 
                    my $orig_html_message_body = $html_message_body; 
                    
                    $html_message_body =~ s/<html><head> <\/head><body><\/body><\/html>//; # this is the default src of the FCK thingy. I know. Ugly. 
                    
                    $html_message_body =~ s/(^\n<br \/>|^<br \/>|^<br \/>\n)//;
                    
                    $html_message_body = convert_to_ascii($html_message_body); # what? what did I miss?
                    
                    $html_message_body = strip($html_message_body); 
                    
                    $html_message_body =~ s/^\n+|\n+$//o;
                    
                    
                    if(length($html_message_body) <= 1){ 
                        $html_message_body = undef; 
                    }else{ 
                        $html_message_body = $orig_html_message_body;
                        undef $orig_html_message_body; 
                    }
            }
            
            # Got no text kludge...
            $text_message_body = "\n" 
                if !$html_message_body && !$text_message_body;
            
            my $msg; 
            
            if($html_message_body && $text_message_body){ 
                
                $msg = MIME::Lite->new(Type => 'multipart/alternative'); 
              
              $msg->attach(Type     => 'text/plain', 
                       Data     => $text_message_body,
                       Encoding => $li->{plaintext_encoding},
                      ); 
              
               $msg->attach(Type     => 'text/html', 
                       Data     => $html_message_body,
                       Encoding => $li->{html_encoding},
                       );
                
            }elsif($html_message_body){ 
                                
                $msg = MIME::Lite->new(
                                       Type     => 'text/html', 
                                       Data     => $html_message_body, 
                                       Encoding => $li->{html_encoding}
                                      ); 
                
            }elsif($text_message_body){ 
                            
                $msg = MIME::Lite->new(Type     => 'TEXT',
                                 Data     => $text_message_body,
                                 Encoding => $li->{plaintext_encoding},
                                  );          
            }
            
            my @cleanup_attachments = (); 
            
            my @attachments = has_attachments(); 
            my @compl_att = (); 
            
            if(@attachments){ 
                my @compl_att = (); 
                
                foreach(@attachments){ 
                    my ($msg_att, $filename) = make_attachment($_); 
                    push(@compl_att, $msg_att)
                        if $msg_att;
                    
                    push(@cleanup_attachments, $filename)
                        if $filename; 
                }
                
                if($compl_att[0]){ 
                    my $mpm_msg = MIME::Lite->new(Type => 'multipart/mixed');
                       $mpm_msg->attach($msg);
                       foreach(@compl_att){ 
                          $mpm_msg->attach($_);
                       }
                    $msg = $mpm_msg;
                }
            }
            
            
            
        my $msg_as_string = (defined($msg)) ? $msg->as_string : undef;
        
        require DADA::App::FormatMessages; 
        
        my $fm = DADA::App::FormatMessages->new(-List => $list); 
           $fm->Subject($message_subject);
           $fm->use_list_template($q->param('apply_template')); 
           $fm->treat_as_discussion_msg(1)
            if $li->{group_list} == 1;

        my ($final_header, $final_body) = $fm->format_headers_and_body(-msg => $msg_as_string );
                
        require DADA::Mail::Send;
               $DADA::Mail::Send::dbi_obj = $dbi_handle;
               
        my $mh      = DADA::Mail::Send->new($li);
        
        my %headers = $mh->return_headers($final_header);
        
        my %mailing = (%headers,
                       Subject   =>  $message_subject,          
                       Body      =>  $final_body,
                       ); 
          
        $mailing{From}             = $q->param('From')        if($q->param('From'));
        $mailing{'Errors-To'}    = $q->param('Errors_To')   if($q->param('Errors_To'));
        $mailing{'Return-Path'}  = $q->param('Return_Path') if($q->param('Return_Path'));
        
        $mailing{'Reply-To'}     = $q->param('Reply_To')    if($q->param('Reply_To'));
        
        $mailing{'X-Priority'}   =  $q->param('Priority')   ||  $li->{priority};
        $mailing{Precedence}     =  $q->param('Precedence') ||  $li->{precedence};
        
        $mh->bulk_test(1) 
            if($process =~ m/test/i);
        
        my $test_recipient = ''; 
        if($process =~ m/test/i){ 
            $mh->bulk_test_recipient($q->param('test_recipient'));
            $test_recipient = $mh->bulk_test_recipient; 
        }
            
        #$mh->list_type('testers') 
        #    if($process =~ m/test/i);

        
        
        my @alt_lists = $q->param('alternative_list'); 
        if($alt_lists[0]){ 
            $mh->also_send_to([@alt_lists]); 
        }
        
        my $message_id; 
        if($q->param('archive_no_send') != 1){ 
            # send away
            $message_id = $mh->bulk_send(%mailing); 
        }else{ 
            
            # This is currently similar code as what's in the DADA::Mail::Send::_mail_general_headers method...
            
            my $msg_id = DADA::App::Guts::message_id(); 
            
            if($q->param('back_date') == 1){ 
                $msg_id = backdated_msg_id(); 
            }
            
            %mailing = $mh->clean_headers(%mailing); 

            %mailing = (    
                        %mailing,
                        $mh->_make_general_headers, 
                        $mh->_make_list_headers
                       ); 
                           
            require DADA::Security::Password;    
            my $ran_number = DADA::Security::Password::generate_rand_string('1234567890');
            $mailing{'Message-ID'} = '<' .  $msg_id . '.'. $ran_number . '.' . $li->{list_owner_email} . '>'; 
            $message_id = $msg_id; 
            
            $mh->saved_message($mh->_massaged_for_archive(\%mailing)); 
        
        }
        
        if($message_id){ 
            if(($archive_m == 1) && ($process !~ m/test/i)){
                require DADA::MailingList::Archives;
                $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
                
                my $archive = DADA::MailingList::Archives->new(-List => $li);
                   $archive->set_archive_info($message_id, $message_subject, undef, undef, $mh->saved_message); 
                  
            }
        } else { 
            $archive_m = 0;
        }
        
        my $screen_text_message = ''; 
        if($text_message_body){ 
               $screen_text_message = $text_message_body;
               $screen_text_message = webify_plain_text($screen_text_message);
               $screen_text_message =~ s/\[email\]/$li->{list_owner_email}/gi;
            my $lm_pin = make_pin(-Email => $li->{list_owner_email});
               $screen_text_message =~ s/\[pin\]/$lm_pin/gi;
        }
    
        my $screen_html_message = '';
        
        if($html_message_body){ 
        
            $screen_html_message = $html_message_body;
            $screen_html_message =~ s/\[email\]/$li->{list_owner_email}/gi;
            my $html_lm_pin      = make_pin(-Email => $li->{list_owner_email});
            $screen_html_message =~ s/\[pin\]/$html_lm_pin/gi;
            
        }
        
        

        my $attachment_names = [];
        foreach(@cleanup_attachments){
            my $an = $_;
               $an =~ s!^.*(\\|\/)!!; 
               if($DADA::Config::ATTACHMENT_TEMPFILE == 1){ 
                  $an =~ s/^(.*?)_//; 
               }
            push(@$attachment_names, {name => $an});        
        }
        
        my $have_attachments  = ($attachment_names->[0]) ? 1 : 0;
                
        if(!$q->param('new_win')){ 
        
        print(admin_html_header(-Title   => "List Message Is Being Sent", 
                                -List    => $li->{list},
                                -Root_Login => $root_login 
                               )); 
        }else{ 
            print $q->header();
            print $q->start_html(-title => 'List Message Is Being Sent', 
                                -style  => {
                                             -src => $DADA::Config::PROGRAM_URL . '/css', 
                                             -code => 'body{text-align:left;margin:5px;padding:5px}'
                                           },
                                           );
        }
        
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'send_email_process_screen.tmpl', 
                                              -vars   => {
                                              
                                                          process_test         => $process =~ m/test/i ? 1 : 0, 
                                                          list_owner_email     => $li->{list_owner_email}, 
                                                          message_subject      => $message_subject, 
                                                          list_name            => $li->{list_name}, 
                                                          list_owner_email     => $li->{list_owner_email}, 
                                                        
                                                          text_message_body    => $text_message_body, 
                                                          screen_text_message  => $screen_text_message, 
                                                          html_message_body    => $html_message_body, 
                                                          screen_html_message  => $screen_html_message, 
                                                        
                                                          attachment_names     => $attachment_names, 
                                                          have_attachments     => $have_attachments, 
                                                          message_archived     => (($archive_m == 1) && ($process !~ m/test/i)) ? 1 : 0, 
                                                          message_id           => $message_id, 
                                                          
                                                          type                 => 'list',

                                                          archive_no_send      => ($q->param('archive_no_send') == 1 ) ? 1 : 0, 
                                                          
                                                          test_recipient       => $test_recipient,

                                                        },
                                              );

        if(!$q->param('new_win')){ 

            print(admin_html_footer(-List => $list));
        }else{ 
            print '<input type="button" name="" value="Close This Window" class="alertive" onclick="self.close()" />';
            print $q->end_html; 
        }
        
        clean_up_attachments([@cleanup_attachments]) 
            if $DADA::Config::ATTACHMENT_TEMPFILE == 1;
    }
}




sub sending_monitor { 




    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'sending_monitor');
        
    require DADA::MailingList::Settings; 
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    $list = $admin_list; 
    
    
    require DADA::Mail::MailOut; 

    my $ls = DADA::MailingList::Settings->new( -List => $list ); 
    my $li = $ls->get; 
    
    # munging the message id. 
    # kinda dumb, but it's sort of up in the air, 
    # on how the message id comes to us, 
    # so we have to be *real* careful to get it to a state
    # that we *need* it in. 
    
    my $id = DADA::App::Guts::strip($q->param('id')); 
       $id =~ s/\@/_at_/g; 
	   $id =~ s/\>|\<//g; 
	
	# Type ala, list, invitation list, etc
	my $type = $q->param('type'); 
	   $type = xss_filter(DADA::App::Guts::strip($type)); 

    my $restart_count = $q->param('restart_count') || 0; 
    
    require  DADA::Mail::Send; 
    my $mh = DADA::Mail::Send->new($li); 


    my $auto_pickup = 0; 
    
    # Kill - the, [Stop] button was pressed. Pressed really hard. 
    
    if ($q->param('process') eq 'kill'){ 

        if(DADA::Mail::MailOut::mailout_exists($list, $id, $type) == 1){  
            
            my $mailout = DADA::Mail::MailOut->new({ -List => $list }); 
               $mailout->associate_with_id($id);
               $mailout->clean_up; 
            
            print $q->redirect(-url => $DADA::Config::S_PROGRAM_URL . '?f=sending_monitor&id=' . $id . '&type=' . $type . '&killed_it=1'); 
            return;
            
        } else { 
        
            die "mailout does NOT exists! What's going on?!"; 
        
        }
    
    # Restart is usually called by the program itself, automagically via a redirect if DADA::Mail::MailOut says we should restart. 
    
    }elsif ($q->param('process') eq 'restart'){ 


        print $q->header();
        
        print "<html> 
                <head> 
                 
                 <script type=\"text/javascript\">
                 
                 function refreshpage(sec){ 

                    var refreshafter = sec/1 * 1000; 
                    setTimeout(\"self.location.href='$DADA::Config::S_PROGRAM_URL?f=sending_monitor&id=$id&type=$type&restart_count=$restart_count';\",refreshafter);
                }
                
                </script> 
                

                 </head> 
                 <body> 
                 ";
        
        my $restart_time = 1; 
        
        # Let's make sure that restart worked...
        eval { $mh->restart_bulk_send($id, $type); }; 
        
        # If not...
        if($@){ 
            
            print "<h1>Problems Restarting!:</h1><pre>$@</pre>"; 
            
            # We're going to refresh, see if it gets better.
            $restart_time = 5; 
            
        
        }

        # Provide a link in case browser redirect is working
        print '<a href="' . "$DADA::Config::S_PROGRAM_URL?f=sending_monitor&id=$id&type=$type&restart_count=$restart_count" . '">restarting mailing...</a>'; 

        print "
        
        <script> 
        refreshpage($restart_time); 
        </script> 
        </body>
       </html>"; 
        
       return; 
    }
    
    # No id? No problem, show them the index page. 
    
    if(!$q->param('id')){ 
              
        
        my $mailout_status = []; 
        
        my @mailouts  = DADA::Mail::MailOut::current_mailouts($list);  
        foreach (@mailouts){ 
            
            my $mailout = DADA::Mail::MailOut->new({ -List => $list }); 
               $mailout->associate_with_id($_->{id}); 
            my $status = $mailout->status($_->{type}); 
            
            push(@$mailout_status, {%$status, S_PROGRAM_URL => $DADA::Config::S_PROGRAM_URL, Subject => $status->{email_fields}->{Subject}});
            
        }
        
         print(admin_html_header(      
                  -Title      => "Monitor Your Mailing", 
                  -List       => $list, 
                  -Root_Login => $root_login,
                  -Form       => 0, 
                  
              ));
                  
            require DADA::Template::Widgets;  
            print DADA::Template::Widgets::screen(-screen => 'sending_monitor_index_screen.tmpl', 
                                                  -vars   => { 
                                                  
                                                            mailout_status               => $mailout_status,
                                                            auto_pickup_dropped_mailings => $li->{auto_pickup_dropped_mailings}, 
                                                  
                                                     },
                                                 );
    
        print(admin_html_footer(-List => $list, -Form => 0, ));
 
    }else{ 
     
        my $mailout;
        my $status = {};
        my $mailout_exists = 0; 
    
    
        my $mailout_exists = 0; 
        my $my_test_mailout_exists = 0; 
        
        eval {$my_test_mailout_exists = DADA::Mail::MailOut::mailout_exists($list, $id, $type);}; 
        
        if(!$@){ 
            $mailout_exists = $my_test_mailout_exists;  
        }
        
        if($mailout_exists){  
        
            $mailout_exists = 1; 
            $mailout        = DADA::Mail::MailOut->new({ -List => $list }); 
            $mailout->associate_with_id($id);
            $status         = $mailout->status($type); 

        }else { 
        
            # Nothing - I believe this is handled in the template. 
        
        }
        
            my $its_killed = 0;             
            if($status->{should_be_restarted}){ 
                $its_killed = 1; 
            }
            
            if($its_killed == 1                                                  && 
               $li->{auto_pickup_dropped_mailings} == 1                          && 
               $status->{total_sending_out_num} - $status->{total_sent_out} >  0 &&
               $restart_count                                               <= 0
               
               ){ 
                              
                print $q->redirect(-url => $DADA::Config::S_PROGRAM_URL . '?f=sending_monitor&id=' . $id . '&process=restart&type=' . $type . '&restart_count=1'); 
                return; 
            
            } else { 
                $restart_count = 0; 
            }


            my $sending_status = []; 
            foreach(keys %$status){ 
                next if $_ eq 'email_fields'; 
                push(@$sending_status, {key => $_, value => $status->{$_}}); 
                
            }
          
           # 8 is the factory default setting to wait per batch. 
           # Let's not refresh an faster, or we'll never have time
           # to read the actual screen. 
           
           my $refresh_after = 8; 
              $refresh_after = $li->{bulk_sleep_amount}
                if $refresh_after < $li->{bulk_sleep_amount}; 
          
          print(admin_html_header(      
                  -Title      => "Monitor Your Mailing", 
                  -List       => $list, 
                  -Root_Login => $root_login,
                  -Form       => 0, 
                  
                  ));
                  
                  
           require DADA::Template::Widgets;  
           print   DADA::Template::Widgets::screen(-screen => 'sending_monitor_screen.tmpl', 
                                                    -vars   => { 
                                                  
                                                    
                                                      mailout_exists               => $mailout_exists, 
                                                      message_id                   => DADA::App::Guts::strip($id),
                                                      message_type                 => $q->param('type'),
                                                      total_sent_out               => $status->{total_sent_out},
                                                      total_sending_out_num        => $status->{total_sending_out_num},
                                                      percent_done                 => $status->{percent_done}, 
                                                      status_bar_width             => int($status->{percent_done}) * 5,  
                                                      negative_status_bar_width    => 500 - (int($status->{percent_done}) * 5), 
                                                      need_to_send_out             => ( $status->{total_sending_out_num} - $status->{total_sent_out}), 
                                                      time_since_last_sendout      => _formatted_runtime((time - int($status->{last_access}))), 
                                                      its_killed                   => $its_killed, 
                                                      header_subject               => $status->{email_fields}->{Subject}, 
                                                      header_subject_label         => (length($status->{email_fields}->{Subject}) > 50) ? (substr($status->{email_fields}->{Subject}, 0, 49) . '...') : ($status->{email_fields}->{Subject}),  
                                                      auto_pickup_dropped_mailings => $li->{auto_pickup_dropped_mailings}, 
                                                      sending_done                 => ($status->{percent_done} < 100) ? 0 : 1, 
                                                      refresh_after                => $refresh_after, 
                                                      killed_it                    => $q->param('killed_it') ? 1 : 0, 
                                                      sending_status               => $sending_status, 
                                                     
                                                     },
                                                 );
    
            print(admin_html_footer(-List => $list, -Form => 0, ));
    }
}


sub _formatted_runtime { 
	
	my $d    = shift; 
	
	my @int = (
        [ 'second', 1                ],
        [ 'minute', 60               ],
        [ 'hour',   60*60            ],
        [ 'day',    60*60*24         ],
        [ 'week',   60*60*24*7       ],
        [ 'month',  60*60*24*30.5    ],
        [ 'year',   60*60*24*30.5*12 ]
    );
    my $i = $#int;
    my @r;
    while ( ($i>=0) && ($d) )
    {
        if ($d / $int[$i] -> [1] >= 1)
        {
            push @r, sprintf "%d %s%s",
                         $d / $int[$i] -> [1],
                         $int[$i]->[0],
                         ( sprintf "%d", $d / $int[$i] -> [1] ) > 1
                             ? 's'
                             : '';
        }
        $d %= $int[$i] -> [1];
        $i--;
    }

    my $runtime = join ", ", @r if @r;
    return $runtime; 
}




sub clean_up_attachments { 
    my $files = shift || [];
    foreach(@$files){ 
        $_ = make_safer($_); 
        warn "could not remove '$_'"
            unless
                unlink($_) > 0;
                    # i love the above!
    }
}




sub backdated_msg_id { 

    my $backdate_hour = $q->param('backdate_hour');
       $backdate_hour = int($backdate_hour) + 12
        if $q->param('backdate_hour_label') =~ /p/; # as in, p.m.
      
    my $message_id = sprintf("%02d%02d%02d%02d%02d%02d", $q->param('backdate_year'), 
                                                         $q->param('backdate_month'), 
                                                         $q->param('backdate_day'),  
                                                         $backdate_hour, 
                                                         $q->param('backdate_minute'),
                                                         $q->param('backdate_second')
                                                        );
    return $message_id; 
    
}




sub has_attachments { 
    
    my $i          = 0; 
    my $at_num     = $q->param('at_num') || 1;
    my $attachment = $q->param('attachment');
    my @ive_got    = (); 
    
    return undef if ! $attachment; 
        
    for($i = 1; $i <= $at_num; $i++){


        my $that_attachment = 'filepath_attachment_' . $i;    
        push(@ive_got, $that_attachment)
            if $q->param($that_attachment); 
            
        my $this_attachment = 'attachment_' . $i;
        push(@ive_got, $this_attachment)
            if $q->param($this_attachment);
    }
    
    return @ive_got;
}




sub make_attachment { 

    require MIME::Lite; 
    my $name          = shift; 
    my $attachment    = $q->param($name);    
    my $uploaded_file = ''; 
    
    return (undef, undef) 
        if !$attachment; 
            
    my $a_type = find_attachment_type($attachment);

    my $attach_name =  $attachment; 
       $attach_name =~ s!^.*(\\|\/)!!;
       $attach_name =~ s/\s/%20/g;
       
    my %mime_args = ( Type              =>  $a_type,
                      # Id              => '<'.$attach_name.'>',
                      Filename          =>  $attach_name,
                      Disposition       =>  make_a_disposition($a_type), 
                      ); 
                      
    my $attachment_file;
    
    # kinda used only for testing at the moment; 
    if($name =~ m/^filepath_attachment/){ 
    
         $mime_args{Path} = $attachment; 
         $uploaded_file   = $attach_name;
    
    }else{ 
    
        if($DADA::Config::ATTACHMENT_TEMPFILE == 1){ 
            
            # $name is the CGI paramater name - we need to pass that
            # to keep the CGI object, "magic"
            
            my $attachment_file = file_upload($name); 
               $mime_args{Path} =  $attachment_file;    
               $uploaded_file   =  $attachment_file;
                        
        }else{ 
        
             $mime_args{FH}  =  $attachment;
             $uploaded_file  = $attach_name; 
        }                  
    }
    
    my $msg_att = MIME::Lite->new(%mime_args); 
       $msg_att->attr('Content-Location' =>  $attach_name);

    return($msg_att, $uploaded_file); 
        
}




sub make_a_disposition { 

    my $n = shift; 
    my $disposition = 'inline'; 
    
    if($n !~ m/image/){ 
        #if($n !~ /text/){ # if they're inline, they get parsed as if 
                           # they were a part of Dada Mail... hmm...
            $disposition = 'attachment';
        #}
    }
    
    return $disposition; 
    
}


sub find_attachment_type { 
    my $filename = shift; 
    my $a_type; 
        
  my $attach_name =  $filename; 
     $attach_name =~ s!^.*(\\|\/)!!;
     $attach_name =~ s/\s/%20/g;
     
   my $file_ending = $attach_name; 
      $file_ending =~ s/.*\.//;
 
    require MIME::Types; 
    require MIME::Type;

    if(($MIME::Types::VERSION >= 1.005) && ($MIME::Type::VERSION >= 1.005)){ 
        my ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
        $a_type = $mimetype if ($mimetype && $mimetype =~ /^\S+\/\S+$/);  ### sanity check
    }else{ 
        if(exists($DADA::Config::MIME_TYPES{'.'.lc($file_ending)})) {  
            $a_type = $DADA::Config::MIME_TYPES{'.'.lc($file_ending)};
        }else{ 
            $a_type = $DADA::Config::DEFAULT_MIME_TYPE; 
        }
    }
    if(!$a_type){ 
        warn "attachment MIME Type never figured out, letting MIME::Lite handle this..."; 
        $a_type = 'AUTO';
    } 
    
    return $a_type; 
}




sub list_invite { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'list_invite');
    $list = $admin_list; 
    
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list); 

    if(!$process){ 

        print(admin_html_header(-Title      => "Invitations", 
                                -List       => $list, 
                                -Root_Login => $root_login));
                                
            
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'list_invite_screen.tmpl', 
                                              -vars   => {
                                                            invite_message_subject         => $li->{invite_message_subject}, 
                                                            invite_message_text            => $li->{invite_message_text}, 
                                                            invite_message_html            => $li->{invite_message_html}, 
                                                            invite_message_html_js_escaped => js_enc($li->{invite_message_html}),
                                                            list_owner_email               => $li->{list_owner_email}, 
                                                      },
                                             );
        print(admin_html_footer(-List => $list));

    }else{ 
        
        
        # get the emails
        my $new_emails = $q -> param("new_emails"); 
        
        # split them into individual entities
        my @new_addresses = split(/\s+|,|;|\n+/, $new_emails);

        my ($subscribed, $not_subscribed, $black_listed, $not_white_listed, $invalid) = $lh->filter_subscribers(-Email_Ref => [@new_addresses]);
        
        # add these to a special 'invitation' list. we'll clear this list later. 
        my $new_email_count=$lh->add_to_email_list(-Email_Ref => $not_subscribed,
                                                   -Type      => 'invitelist',
                                                   -Mode      => 'writeover');
                                              
        my $message_subject = $q->param('message_subject');
        my $text_message_body = DADA::App::Guts::strip($q->param('text_message_body')) || undef;
           $text_message_body =~ s(/^\n+|\n+$)()g; 
         
            if($text_message_body){
                $text_message_body    =~ s/\r\n/\n/g;
           }
           
        my $html_message_body = DADA::App::Guts::strip($q->param('html_message_body')) || undef; 
           $html_message_body =~ s(/^\n+|\n+$)()g;
            
            if($html_message_body){
                $html_message_body =~ s/\r\n/\n/g;
            }

        require MIME::Lite; 
        $MIME::Lite::PARANOID = $DADA::Config::MIME_PARANOID;
        my $msg; 
      
      

        if($text_message_body and $html_message_body){     
        
            $msg = MIME::Lite->new(Type    =>  'multipart/alternative');  
            $msg->attach(Type => 'TEXT', Data => $text_message_body);
            $msg->attach(Type => 'text/html', Data => $html_message_body);  
        
        }elsif($html_message_body){
        
            # make only a text body                       
             $msg = MIME::Lite->new(Type    => 'text/html', Data    => $html_message_body);
        
        }elsif($text_message_body){
        
            $msg = MIME::Lite->new(Type    => 'TEXT', Data    => $text_message_body);                                
        
        } else{ 
        
            warn "$DADA::Config::PROGRAM_NAME $DADA::Config::VER warning: both text and html versions of invitation message blank?!"; 
            $msg = MIME::Lite->new(Type    => 'TEXT', Data    => $li->{invite_message_text});                                

        }
        
        $msg->replace('X-Mailer' =>"");
        
        my $msg_as_string = (defined($msg)) ? $msg->as_string : undef;
        
        require DADA::App::FormatMessages; 
        my $fm = DADA::App::FormatMessages->new(-List => $list); 
           $fm->Subject($message_subject); 
           $fm->use_email_templates(0); 
           
        my ($header_glob, $message_string) =  $fm->format_headers_and_body(-msg => $msg_as_string );
    
        require DADA::Mail::Send;
               $DADA::Mail::Send::dbi_obj = $dbi_handle;

        my $mh = DADA::Mail::Send->new($li); 
        # translate the glob into a hash
        my %headers = $mh->return_headers($header_glob);

        $mh->list_type('invitelist');
        
        $mh->bulk_test(1) 
            if($process =~ m/test/i); 
    
        my $test_recipient = ''; 
        if($process =~ m/test/i){ 
            $mh->bulk_test_recipient($q->param('test_recipient')); 
            $test_recipient = $mh->bulk_test_recipient; 
        }
        
  
        #$mh->list_type('testers') 
        #    if($process =~ m/test/i);
        
            my  $message_id = $mh->bulk_send( %headers,  
                                                 To        =>  '"'. escape_for_sending($li->{list_name}) .'" <'. $li->{list_owner_email} .'>', 
                                                 From      =>  '"'. escape_for_sending($li->{list_name}) .'" <'. $li->{list_owner_email} .'>', 
                                                 Subject   =>    $message_subject, 
                                                 Body      =>    $message_string
                                             );
                                
        my $screen_text_message; 
        
        if($text_message_body){            
            $screen_text_message = $text_message_body;
            $screen_text_message = webify_plain_text($screen_text_message);
            $screen_text_message =~ s/\[email\]/$li->{list_owner_email}/gi;
            my $lm_pin = make_pin(-Email => $li->{list_owner_email});
            $screen_text_message =~ s/\[pin\]/$lm_pin/gi;
        }
        
        my $screen_html_message; 
        
        if($html_message_body){ 
             $screen_html_message = $html_message_body;
            $screen_html_message =~ s/\[email\]/$li->{list_owner_email}/gi;
            my $html_lm_pin = make_pin(-Email => $li->{list_owner_email});
            $screen_html_message =~ s/\[pin\]/$html_lm_pin/gi;

        }

        $new_email_count = int($new_email_count);

        if(!$q->param('new_win')){ 
    
            print(admin_html_header(-Title   => "Invitations Sent", 
                                    -List    => $li->{list}, 
                                    -Root_Login => $root_login));
        }else{ 
        
            print $q->header();
            print $q->start_html(-title => 'Invitations Sent', 
                                -style  => {
                                             -src => $DADA::Config::PROGRAM_URL . '/css', 
                                             -code => 'body{text-align:left;margin:5px;padding:5px}'
                                           },
                                           );
    
        
        }
        
        
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'list_invite_process_screen.tmpl', 
                                              -vars   => {
                                                            process_test        => ($process =~ m/test/i) ? 1 : 0, 
                                                            list_owner_email    => $li->{list_owner_email}, 
                                                            new_email_count     => $new_email_count, 
                                                            message_subject     => $message_subject, 
                                                            text_message_body   => $text_message_body, 
                                                            screen_text_message => $screen_text_message, 
                                                            html_message_body   => $html_message_body, 
                                                            screen_html_message => $screen_html_message, 
                                                            
                                                            test_recipient       => $test_recipient,
                                                            
                                                            
                                                            message_id           => $message_id, 
                                                            type                 => 'invitelist', 
                                                            
                                                            
                                                      },
                                             );
    
        if(!$q->param('new_win')){ 

            print(admin_html_footer(-List => $list));
        
        }else{ 
        
            print '<input type="button" name="" value="Close This Window" class="alertive" onclick="self.close()" />';
            print $q->end_html; 
        
        }
        
        if(defined($q->param('save_invite_messages')) && $q->param('save_invite_messages') == 1){ 
        
            my $p_text_message_body = $q->param('text_message_body'); 
               $p_text_message_body =~ s/\r\n/\n/g;
            my $p_html_message_body = $q->param('html_message_body'); 
               $p_html_message_body =~ s/\r\n/\n/g;
               
           $ls->save({
                    invite_message_text     => $p_text_message_body,
                    invite_message_html     => $p_html_message_body,
                    invite_message_subject  => $q->param('message_subject'),
                    });        
        }    
    }
}




sub send_url_email { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'send_url_email');
    
    my $list = $admin_list; 
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
    
    my $la = DADA::MailingList::Archives->new(-List => $li);
                    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list); 
    

    my $can_use_mime_lite_html  = 0; 
    my $mime_lite_html_error    = undef; 
    eval { require MIME::Lite::HTML };
    if(!$@){ 
        $can_use_mime_lite_html = 1;
    }else{ 
            $mime_lite_html_error = $@; 
    }
    
    
    my $can_use_lwp_simple  = 0;    
    my $lwp_simple_error    = undef; 
    eval { require LWP::Simple };
    if(!$@){ 
        $can_use_lwp_simple = 1;
    }else{ 
            $lwp_simple_error = $@; 

    }
    
    if(!$process){ 
    
        print(admin_html_header(      
              -Title      => "Send a Webpage", 
              -List       => $list,
              -Root_Login => $root_login,
              -Form       => 0, 
                           ));

        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'send_url_email_screen.tmpl',
                                              -list       => $list, 
                                              -vars       =>  {
                                                                list_owner_email                 => $li->{list_owner_email},
                                                                group_list                       => $li->{group_list}, 
                                                                can_use_mime_lite_html           => $can_use_mime_lite_html,
                                                                mime_lite_html_error             => $mime_lite_html_error, 
                                                                can_use_lwp_simple               => $can_use_lwp_simple, 
                                                                lwp_simple_error                 => $lwp_simple_error, 
                                                                SERVER_ADMIN                     => $ENV{SERVER_ADMIN}, 
                                                                list_name                        => $li->{list_name}, 
                                                                cols                             => $cols,  
                                                                rows                             => $rows, 
                                                                wrap                             => $wrap,
                                                                text_area_style                  => $text_area_style, 
                                                                global_list_sending_widget       => DADA::Template::Widgets::global_list_sending_checkbox_widget($list),
                                                                can_use_global_list_sending      => $lh->can_use_global_list_sending, 
                                                                archive_messages                 => $li->{archive_messages}, 
                                                                cols                             => $cols,  
                                                                rows                             => $rows, 
                                                                wrap                             => $wrap,
                                                                text_area_style                  => $text_area_style, 
                                                                can_display_attachments          => $la->can_display_attachments, 
                                                             }, 
                                              ); 

        print(admin_html_footer(-List => $list, -Form => 0, ));
        
    }else{ 
        
        if($can_use_mime_lite_html){ 
        
            my $url_options   =  $q->param('url_options') || undef; 
            
            my $login_details; 
        
            if(defined($q->param('url_username')) && defined($q->param('url_password'))){ 
                $login_details =  $q->param('url_username') . ':' . $q->param('url_password')
            }
            
            
            my $proxy = defined($q->param('proxy')) ? $q->param('proxy') : undef;
             
            my $mailHTML = new MIME::Lite::HTML('IncludeType' => $url_options, 
                                                
                                                'TextCharset' => $li->{charset_value},
                                                'HTMLCharset' => $li->{charset_value}, 
                                                (($login_details) ? (LoginDetails => $login_details,) :  ()),
                                                HTMLEncoding  => $li->{plaintext_encoding},
                                                TextEncoding  => $li->{html_encoding},
                                     
                                                 (($proxy) ? (Proxy => $proxy,) :  ()),
                                                 
                                                (
                                                ($DADA::Config::CPAN_DEBUG_SETTINGS{MIME_LITE_HTML} == 1) ? 
                                                (Debug => 1, ) :
                                                ()
                                                ), 
                                                                     
                                                ); 
                                                
            my $t = $q->param('text_message_body') || 'This email message requires that your mail reader support HTML'; 
            
            
            if($q->param('auto_create_plaintext') == 1){ 
                
                
                if($q->param('content_from') eq 'url'){ 
                    require LWP::Simple; 
                    my $good_try = LWP::Simple::get($q->param('url'));
                    $t           = convert_to_ascii($good_try);
                }else{ 
                    $t           = convert_to_ascii($q->param('html_message_body'));
                }
            }
            
            my $MIMELiteObj; 
            
            if($q->param('content_from') eq 'url'){ 
                $MIMELiteObj = $mailHTML->parse($q->param('url'), $t);
            }else{ 
                $MIMELiteObj = $mailHTML->parse($q->param('html_message_body'), $t);
            }
            
            require  DADA::App::FormatMessages; 
            my $fm = DADA::App::FormatMessages->new(-List => $list); 
               $fm->Subject($q->param('message_subject')); 
               $fm->treat_as_discussion_msg(1)
                    if $li->{group_list} == 1;
            
            my $problems = 0; 
            my $rm       = '';
            
            eval { $rm = $MIMELiteObj->as_string; }; 
            if($@){ 
                warn "$DADA::Config::PROGRAM_NAME $DADA::Config::VER - Send a Webpage isn't functioning correctly? - $!";  
                $problems++;
            }
            
            my $message_id; 
            my $mh; 
 
 
            if($q->param('local_archive_options_present') == 1){ 
                if($q->param('archive_message') != 1){ 
                    $q->param(-name => 'archive_message', -value => 0); 
                }
            }
            my $archive_m = $li->{archive_messages} || 0;
            if($q->param('archive_message') == 1 || $q->param('archive_message') == 0){ 
                $archive_m = $q->param('archive_message');
            }   

            my $test_recipient = ''; 

            if(!$problems){ 
            
                my ($header_glob, $template) =  $fm->format_headers_and_body(-msg => $rm);
                
                require DADA::Mail::Send;
                       $DADA::Mail::Send::dbi_obj = $dbi_handle;

                   $mh      = DADA::Mail::Send->new($li);
                my %headers = $mh->return_headers($header_glob);
                my %mailing = (%headers,
                               Subject   => $q->param('message_subject'),       
                               Body      => $template,
                              );
                               
                $mh->bulk_test(1) 
                    if($q->param('process') =~ m/test/i); 
                
                if($process =~ m/test/i){ 
                    $mh->bulk_test_recipient($q->param('test_recipient')); 
                    $test_recipient = $mh->bulk_test_recipient; 
                }
                
                #$mh->list_type('testers') 
                #    if($q->param('process') =~ m/test/i);

                my @alt_lists = $q->param('alternative_list'); 
                if($alt_lists[0]){ 
                    $mh->also_send_to([@alt_lists]); 
                }
        
                if($q->param('archive_no_send') != 1){ 
        
                    # Woo Ha! Send away!
                    $message_id = $mh->bulk_send(%mailing); 
                }else{ 
            
                    # This is currently similar code as what's in the DADA::Mail::Send::_mail_general_headers method...
                    
                    my $msg_id = DADA::App::Guts::message_id(); 
                    
                    if($q->param('back_date') == 1){ 
                        $msg_id = backdated_msg_id(); 
                    }
                    
                    # time  + random number + sender, woot!
                    require DADA::Security::Password;    
                    my $ran_number = DADA::Security::Password::generate_rand_string('1234567890');
                    
                    %mailing = $mh->clean_headers(%mailing); 
                    
                    %mailing = (
                                %mailing,
                                $mh->_make_general_headers, 
                                $mh->_make_list_headers
                           ); 
                    
                    $mailing{'Message-ID'} = '<' .  $msg_id . '.'. $ran_number . '.' . $li->{list_owner_email} . '>'; 
                    
                    $message_id = $msg_id; 
                    
                    $mh->saved_message($mh->_massaged_for_archive(\%mailing)); 
                
                }
                
                
                
                if($archive_m == 1 && ($q->param('process') !~ m/test/i)){ 
                
                    require DADA::MailingList::Archives;
                           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
                    
                    my $archive = DADA::MailingList::Archives->new(-List => $li);
                    $archive->set_archive_info($message_id, $q->param('message_subject'), undef, undef, $mh->saved_message); 
                
                }
            }
            
            if(!$q->param('new_win')){ 

                print(admin_html_header(-Title      => "List Message Is Being Sent", 
                                        -List       => $list,
                                        -Root_Login => $root_login)); 
            }else{ 
                print $q->header();
                print $q->start_html(-title => 'List Message Is Being Sent', 
                                -style  => {
                                             -src => $DADA::Config::PROGRAM_URL . '/css', 
                                             -code => 'body{text-align:left;margin:5px;padding:5px}'
                                           },
                                    );

            }
            require DADA::Template::Widgets;
            print DADA::Template::Widgets::screen(-screen => 'send_url_email_process_screen.tmpl',
                                                  -vars   => { 
                                                               test                 => $process =~ m/test/i ? 1 : 0, 
                                                               list_owner_email     => $li->{list_owner_email}, 
                                                               message_id           => $message_id, 
                                                               archived             =>   (($archive_m ne "0") && 
                                                                                          ($q->param('process')    !~ m/test/i)) ? 1 : 0,
                                                                
                                                               problems             => $problems, 
                                                               archive_no_send      => ($q->param('archive_no_send') == 1 ) ? 1 : 0, 
                                                               test_recipient       => $test_recipient,
                                                                
                                                               type                 => 'list',  
                                                            
                                                            }, 
                                                 ); 
                                                 
            if(!$q->param('new_win')){ 
    
                print(admin_html_footer(-List => $list));
            
            }else{ 
                print '<input type="button" name="" value="Close This Window" class="alertive" onclick="self.close()" />';
                print $q->end_html; 
            }
        }else{ 
            die "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: $!\n";
        }
    }
}




sub change_info { 
    
    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                        -Function => 'change_info');
    
    $list = $admin_list; 
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    
    my $errors = 0; 
    my $flags  = {}; 
    
    if($process){
    
        ($errors, $flags) = check_list_setup(-fields => { list             => $list, 
                                                          list_name         => $list_name, 
                                                          list_owner_email  => $list_owner_email,
                                                          admin_email       => $admin_email, 
                                                          privacy_policy    => $privacy_policy,
                                                          info                => $info,
                                                          physical_address  => $physical_address,
                                                          }, 
                                                -new_list         => 'no',
                                              ); 
    }
    
    undef $process
        if $errors >= 1;
        
    if(!$process){
    
        my $err_word      = 'was'; 
           $err_word      = 'were' 
            if $errors && $errors > 1; 
        
        my $errors_ending = '';
           $errors_ending = 's'      
            if $errors && $errors > 1;  
        
        my $flags_list_name                = $flags->{list_name}                  || 0;

        my $flags_list_name_bad_characters = $flags->{list_name_bad_characters}                  || 0;

        my $flags_invalid_list_owner_email = $flags->{invalid_list_owner_email}   || 0; 
        my $flags_list_info                = $flags->{list_info}                  || 0;
        my $flags_privacy_policy           = $flags->{privacy_policy}             || 0;
        my $flags_physical_address         = $flags->{physical_address}           || 0;
        
        
        print(admin_html_header(-Title      => "Change List Information",
                                -List       => $list,
                                -Root_Login => $root_login));
        
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'change_info_screen.tmpl', 
                                              -vars   => {
                                                     done                           => $done,
                                                     errors                         => $errors,
                                                     errors_ending                  => $errors_ending,
                                                        err_word                       => $err_word,
                                                        list                           => $list,
                                                        list_name                      => $list_name        ? $list_name        : $li->{list_name},
                                                        list_owner_email               => $list_owner_email ? $list_owner_email : $li->{list_owner_email}, 
                                                        admin_email                    => $admin_email      ? $admin_email      : $li->{admin_email},
                                                        info                           => $info             ? $info             : $li->{info},
                                                        privacy_policy                 => $privacy_policy   ? $privacy_policy   : $li->{privacy_policy},
                                                        physical_address               => $physical_address ? $physical_address : $li->{physical_address},
                                                        flags_list_name                => $flags_list_name, 
                                                        flags_invalid_list_owner_email => $flags_invalid_list_owner_email, 
                                                        flags_list_info                => $flags_list_info, 
                                                        flags_privacy_policy           => $flags_privacy_policy, 
                                                        flags_physical_address         => $flags_physical_address,
                                                        flags_list_name_bad_characters => $flags_list_name_bad_characters, 
                                                                                                                
                                                     },
                                             );
                                             
                                             
         
        print(admin_html_footer(-List => $list));
    
    }else{ 
        
        $admin_email = $list_owner_email 
            unless defined($admin_email);  
        
        $ls->save({ 
                    list_owner_email =>   strip($list_owner_email),
                    admin_email      =>   strip($admin_email), 
                    list_name        =>   $list_name, 
                    info             =>   $info, 
                    privacy_policy   =>   $privacy_policy,
                    physical_address =>   $physical_address,    
                    
                   }); 
                    
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=change_info&done=1'); 
    
    }
}





sub change_password { 
    
    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'change_password',
                                                       );
                                
    
    $list = $admin_list;
    
    require DADA::Security::Password; 
    require DADA::MailingList::Settings; 
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
     
    if(!$process) { 

        print(admin_html_header(-Title      => "Change List Password", 
                                -List       => $list,
                                -Root_Login => $root_login)); 

        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'change_password_screen.tmpl',
                                                -list   => $list,
                                                -vars   => { 
                                                            root_login => $root_login, 
                                                           },
                                               ); 

        print admin_html_footer(-List => $list);

    }else{ 

        my $old_password       = $q->param('old_password'); 
        my $new_password       = $q->param('new_password'); 
        my $again_new_password = $q->param('again_new_password'); 

        if($root_login != 1){ 
            my $password_check = DADA::Security::Password::check_password($li->{password},$old_password); 
            if ($password_check != 1) { 
                user_error(-List  => $list, 
                           -Error => "invalid_password");
            }
        }

        $new_password       = strip($new_password);
        $again_new_password = strip($again_new_password);
        
        if ( ($new_password ne $again_new_password) || ($new_password eq "") ){ 
            user_error(-List  => $list, 
                       -Error => "pass_no_match");
        } 

        $ls->save({ 
                   password => DADA::Security::Password::encrypt_passwd($new_password),
                  });
         
        # -no_list_security_check, because the list password's changed, it wouldn't pass it anyways...
        logout(-no_list_security_check => 1, -redirect_url => $DADA::Config::S_PROGRAM_URL . '?f=' . $DADA::Config::SIGN_IN_FLAVOR_NAME . '&list=' . $list);  
        #print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=' . $DADA::Config::ADMIN_FLAVOR_NAME); 
        return;
    }
}




sub delete_list { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'delete_list');

    my $list = $admin_list; 
    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    if(!$process){ 
    
        print(admin_html_header(      
              -Title      => "Confirm Delete List", 
              -List       => $list,
              -Root_Login => $root_login));
        
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'delete_list_screen.tmpl', 
                                                -list   => $list,); 

        print(admin_html_footer(-List => $list));
    
    
    }else{
        
        require DADA::MailingList; 
        DADA::MailingList::Remove(
            {
                -name           => $list,
                -delete_backups => xss_filter($q->param('delete_backups')), 
            }
        ); 
        

        $c->flush;
       
        my $logout_cookie = logout(-redirect => 0); 
      
        print(the_html(-Part  => 'header', -Title => "Deletion Successful", -header_params => {-COOKIE => $logout_cookie}));

        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'delete_list_success_screen.tmpl',
                                                -list   => $list,
                                               ); 
        print(the_html(-Part => 'footer'));    
    }
}




sub list_options { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'list_options');
                                                        
    $list = $admin_list; 
    
    #receive a few variables.. 
    my $closed_list                        =   $q->param("closed_list")                     || 0; 
    my $hide_list                          =   $q->param("hide_list")                       || 0;
    my $get_sub_notice                     =   $q->param("get_sub_notice")                  || 0;  
    my $get_unsub_notice                   =   $q->param("get_unsub_notice")                || 0;  
    my $no_confirm_email                   =   $q->param("no_confirm_email")                || 0;  
    my $unsub_confirm_email                =   $q->param("unsub_confirm_email")             || 0; 
    my $send_unsub_success_email           =   $q->param("send_unsub_success_email")        || 0; 
    my $send_sub_success_email             =   $q->param("send_sub_success_email")          || 0; 
    my $mx_check                           =   $q->param("mx_check")                        || 0;  

    my $limit_sub_confirm                  =   $q->param('limit_sub_confirm')               || 0; 
    my $limit_unsub_confirm                =   $q->param('limit_unsub_confirm')             || 0; 
    
    my $email_your_subscribed_msg          =   $q->param('email_your_subscribed_msg')       || 0;   

    my $use_alt_url_sub_confirm_success        = $q->param("use_alt_url_sub_confirm_success")   || 0; 
        my $alt_url_sub_confirm_success        = $q->param(    "alt_url_sub_confirm_success")   || '';
        my $alt_url_sub_confirm_success_w_qs   = $q->param('alt_url_sub_confirm_success_w_qs')  || 0; 

    my $use_alt_url_sub_confirm_failed         = $q->param("use_alt_url_sub_confirm_failed")    || 0; 
    my     $alt_url_sub_confirm_failed         = $q->param(    "alt_url_sub_confirm_failed")    || ''; 
    my     $alt_url_sub_confirm_failed_w_qs    = $q->param('alt_url_sub_confirm_failed_w_qs')   || 0; 


    my $captcha_sub                            = $q->param('captcha_sub')                   || 0; 


    
    my $use_alt_url_sub_success            = $q->param("use_alt_url_sub_success")           || 0; 
    my     $alt_url_sub_success            = $q->param(    "alt_url_sub_success")           || '';
    my     $alt_url_sub_success_w_qs       = $q->param(    'alt_url_sub_success_w_qs')      || 0; 
    
    my $use_alt_url_sub_failed             = $q->param("use_alt_url_sub_failed")            || 0; 
        my $alt_url_sub_failed             = $q->param(    "alt_url_sub_failed")            || ''; 
        my $alt_url_sub_failed_w_qs        = $q->param('alt_url_sub_failed_w_qs')           || 0; 
        
    my $use_alt_url_unsub_confirm_success      = $q->param("use_alt_url_unsub_confirm_success")  || 0; 
        my $alt_url_unsub_confirm_success      = $q->param(    "alt_url_unsub_confirm_success")  || '';
        my $alt_url_unsub_confirm_success_w_qs = $q->param('alt_url_unsub_confirm_success_w_qs') || 0; 
    
    my $use_alt_url_unsub_confirm_failed       = $q->param("use_alt_url_unsub_confirm_failed")  || 0; 
        my $alt_url_unsub_confirm_failed       = $q->param(    "alt_url_unsub_confirm_failed")  || '';    
        my $alt_url_unsub_confirm_failed_w_qs  = $q->param('alt_url_unsub_confirm_failed_w_qs') || 0; 

    my $use_alt_url_unsub_success          = $q->param("use_alt_url_unsub_success")         || 0; 
        my $alt_url_unsub_success          = $q->param(    "alt_url_unsub_success")         || '';
        my $alt_url_unsub_success_w_qs     = $q->param('alt_url_unsub_success_w_qs')        || 0; 

    
    
    my $use_alt_url_unsub_failed           = $q->param("use_alt_url_unsub_failed")          || 0; 
        my $alt_url_unsub_failed           = $q->param(    "alt_url_unsub_failed")          || ''; 
        my $alt_url_unsub_failed_w_qs      = $q->param('alt_url_unsub_failed_w_qs')         || 0; 

    
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get();  
    
    my $can_use_mx_lookup = 0; 
     
    eval { require Net::DNS; };
    if(!$@){ 
        $can_use_mx_lookup = 1;
    }
    
    
    my $can_use_captcha = 0; 
     
    eval { require GD::SecurityImage; };
    if(!$@){ 
        eval { require GD; };
        if(!$@){ 
            $can_use_captcha = 1;        
        }
    }
    
    
    
    
    if(!$process){ 
    
        $list = $admin_list;
        

        
        print(admin_html_header(      
                                -Title      => "Mailing List Options", 
                                -List       => $list, 
                                -Root_Login => $root_login
                               ));
                               
    require DADA::Template::Widgets;
    print   DADA::Template::Widgets::screen(-screen => 'list_options_screen.tmpl', 
                                                -list   => $list,
                                                -vars   => { 
                                                            done              => $done, 
                                                            can_use_mx_lookup => $can_use_mx_lookup, 
                                                            can_use_captcha  =>  $can_use_captcha, 
                                                            %{$li},
                                                }); 
        
        
        print(admin_html_footer(-List => $list));
        
    }else{ 
        
        $list = $admin_list;

        $ls->save({
        
            hide_list                          => $hide_list,
            closed_list                        => $closed_list,
            get_sub_notice                     => $get_sub_notice, 
            get_unsub_notice                   => $get_unsub_notice, 
            no_confirm_email                   => $no_confirm_email,
            unsub_confirm_email                => $unsub_confirm_email,
            send_unsub_success_email           => $send_unsub_success_email,
            send_sub_success_email             => $send_sub_success_email,
            mx_check                           => $mx_check,
            limit_sub_confirm                  => $limit_sub_confirm, 
            limit_unsub_confirm                => $limit_unsub_confirm,
            
            
            email_your_subscribed_msg               => $email_your_subscribed_msg, 
            
            use_alt_url_sub_confirm_success         => $use_alt_url_sub_confirm_success,
                alt_url_sub_confirm_success         =>     $alt_url_sub_confirm_success,
                alt_url_sub_confirm_success_w_qs    =>     $alt_url_sub_confirm_success_w_qs, 

            use_alt_url_sub_confirm_failed          => $use_alt_url_sub_confirm_failed,
                alt_url_sub_confirm_failed          =>     $alt_url_sub_confirm_failed,
               alt_url_sub_confirm_failed_w_qs      =>     $alt_url_sub_confirm_failed_w_qs, 

            use_alt_url_sub_success                 => $use_alt_url_sub_success,
                alt_url_sub_success                 =>     $alt_url_sub_success,
                alt_url_sub_success_w_qs            =>     $alt_url_sub_success_w_qs,
                
            use_alt_url_sub_failed                  => $use_alt_url_sub_failed,
                alt_url_sub_failed                  =>     $alt_url_sub_failed,
                alt_url_sub_failed_w_qs             =>     $alt_url_sub_failed_w_qs,
            
            use_alt_url_unsub_confirm_success       =>  $use_alt_url_unsub_confirm_success,
                alt_url_unsub_confirm_success       =>      $alt_url_unsub_confirm_success,
                alt_url_unsub_confirm_success_w_qs  =>      $alt_url_unsub_confirm_success_w_qs,
            
            use_alt_url_unsub_confirm_failed        => $use_alt_url_unsub_confirm_failed,
                alt_url_unsub_confirm_failed        =>     $alt_url_unsub_confirm_failed,
                alt_url_unsub_confirm_failed_w_qs   =>     $alt_url_unsub_confirm_failed_w_qs, 

            use_alt_url_unsub_success               => $use_alt_url_unsub_success,
                alt_url_unsub_success               =>     $alt_url_unsub_success,
                alt_url_unsub_success_w_qs          =>     $alt_url_unsub_success_w_qs, 
            
            use_alt_url_unsub_failed                => $use_alt_url_unsub_failed,
                alt_url_unsub_failed                =>     $alt_url_unsub_failed,
                alt_url_unsub_failed_w_qs           =>     $alt_url_unsub_failed_w_qs, 
                
                
                captcha_sub                         => $captcha_sub, 
                
            
        }); 
        
        print $q->redirect(-uri=>$DADA::Config::S_PROGRAM_URL . '?flavor=list_options&done=1'); 
    }
}




sub sending_options { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'sending_options');

    $list = $admin_list;

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    # TO DO: Make a guesstimate on how long a message will take to send. 
    #my $lh                    = DADA::MailingList::Subscribers->new(-List => $list);
    #
    #my $num_subscribers = $lh->num_subscribers(-Type => 'list');
    
    if(!$process){ 
    
        my @message_amount = (1..60); 
        
                           #  , 30, 40, 50, 60, 70, 
                            #  80, 90, 100, 150, 200, 
                            #  250, 300, 350, 400, 450, 
                            #  500, 1000, 1500, 2000, 
                            #  4000, 6000, 8000, 10000); 
                              
        unshift(@message_amount, $li->{bulk_send_amount}) 
            if exists($li->{bulk_send_amount}); 
        
        my @message_wait = (1..60); 
                               
        unshift(@message_wait, $li->{bulk_sleep_amount}) 
            if exists($li->{bulk_sleep_amount}); 


       # my @message_label = (1, 60, 3600); 
       
        my @message_label = (1);
        
        
        my %label_label = (1     => 'second(s)',
                           #60    => 'minute(s)', 
                           #3600  => 'hour(s)', 
                           #86400 => 'day(s)',
                          ); 


        my $bulk_send_amount_menu   = $q->popup_menu(-name  => "bulk_send_amount", 
                                                     -value => [@message_amount],
                                                    );
                                                        
        my $bulk_sleep_amount_menu  =  $q->popup_menu(-name  => "bulk_sleep_amount", 
                                                      -value => [@message_wait],  
                                                     );                                                
                                             
        my $no_smtp_server_set = 0; 
           $no_smtp_server_set = 1 
            if(!$li->{smtp_server}) && $li->{send_via_smtp} && ($li->{send_via_smtp} == 1);
         
        my $perl_needs_updating = 0; 
           $perl_needs_updating = 1
            if $] < 5.006;


        
        print(admin_html_header(      
              -Title      => "Sending Options", 
              -List       => $list, 
              -Root_Login => $root_login));
      
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'sending_options_screen.tmpl', 
                                              -vars   => {
                                                            done                               => $done, 
                                                            send_via_smtp                     => $li->{send_via_smtp}, 
                                                            enable_bulk_batching              => $li->{enable_bulk_batching}, 
                                                            get_finished_notification         => $li->{get_finished_notification}, 
                                                            no_smtp_server_set                => $no_smtp_server_set, 
                                                            perl_version                      =>  $], 
                                                            perl_needs_updating               => $perl_needs_updating, 
                                                            bulk_send_amount_menu             => $bulk_send_amount_menu, 
                                                            bulk_sleep_amount_menu            => $bulk_sleep_amount_menu, 
                                                            
                                                            
                                                            auto_pickup_dropped_mailings      => $li->{auto_pickup_dropped_mailings}, 
                                                            restart_mailings_after_each_batch => $li->{restart_mailings_after_each_batch}, 
                                                            
                                                            

                                                      },
                                             );
    
        print(admin_html_footer(-List => $list));

    }else{ 
        
        my $bulk_send_amount           = $q->param("bulk_send_amount"); 
        my $bulk_sleep_amount          = $q->param("bulk_sleep_amount"); 
        my $precedence                 = $q->param('precedence');
        my $charset                    = $q->param('charset');
        my $content_type               = $q->param('content_type');
        my $enable_bulk_batching       = $q->param("enable_bulk_batching")       || 0;  
        my $get_finished_notification  = $q->param("get_finished_notification")  || 0;  
        my $send_via_smtp              = $q->param("send_via_smtp")              || 0;
   
        my $auto_pickup_dropped_mailings      = $q->param('auto_pickup_dropped_mailings')      || 0; 
        my $restart_mailings_after_each_batch = $q->param('restart_mailings_after_each_batch') || 0; 
        
 


        $ls->save({ 
                    bulk_send_amount           =>   $bulk_send_amount,  
                    bulk_sleep_amount          =>   $bulk_sleep_amount, 
                    
                    enable_bulk_batching       =>   $enable_bulk_batching,  
                    bulk_sleep_amount          =>   $bulk_sleep_amount,
                    get_finished_notification  =>   $get_finished_notification,
                    send_via_smtp              =>   $send_via_smtp,
                    
                    auto_pickup_dropped_mailings      => $auto_pickup_dropped_mailings, 
                    restart_mailings_after_each_batch => $restart_mailings_after_each_batch, 
                    
                    
                    
                    
                  }); 
                
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_options&done=1'); 
    }
}




sub adv_sending_options { 


    my ($admin_list, $root_login) =  check_list_security(-cgi_obj    => $q,
                                                         -Function   => 'sending_options');
    $list = $admin_list;
  
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list) ; 
    my $li = $ls->get; 
    
    if(!$process){ 
                             

        unshift(@DADA::Config::CHARSETS, $li->{charset});
        my $precedence_popup_menu = $q->popup_menu(-name    =>  "precedence", 
                                                    -value   => [@DADA::Config::PRECEDENCES],
                                                    -default =>  $li->{precedence}, 
                                                    );
        
        my $priority_popup_menu = $q->popup_menu(-name    =>  "priority", 
                                                 -value   => [keys %DADA::Config::PRIORITIES],
                                                 -labels  => \%DADA::Config::PRIORITIES,
                                                 -default =>  $li->{priority}, 
                                                );
        
        my $charset_popup_menu = $q->popup_menu(-name   => 'charset', 
                                                -value  => [@DADA::Config::CHARSETS], 
                                               );                                                                              
                                                              
        my $plaintext_encoding_popup_menu =  $q->popup_menu( -name    => 'plaintext_encoding', 
                                                             -value   => [@DADA::Config::CONTENT_TRANSFER_ENCODINGS], 
                                                             -default =>  $li->{plaintext_encoding}, 
                                                             );
        
        my $html_encoding_popup_menu = $q->popup_menu(-name    => 'html_encoding', 
                                                      -value   => [@DADA::Config::CONTENT_TRANSFER_ENCODINGS], 
                                                      -default =>  $li->{html_encoding},
                                                     );
                                     
#        my $content_type_popup_menu =  $q->popup_menu(-name    => 'content_type', 
#                                                      -value   => [@CONTENT_TYPES], 
#                                                      -default =>  $li->{content_type},
#                                                      );

        my $wrong_uid = 0; 
           $wrong_uid = 1 
            if $< != $>;
                                              
                                                     
    print(admin_html_header(-Title      => "Advanced Sending Options", 
                            -List       => $list, 
                            -Root_Login => $root_login));
    
    require DADA::Template::Widgets;
    print   DADA::Template::Widgets::screen(-screen => 'adv_sending_options_screen.tmpl', 
                                                -list   => $list,
                                                -vars   => { 
                                                            done                          => $done, 
                                                            precedence_popup_menu         => $precedence_popup_menu, 
                                                            priority_popup_menu           => $priority_popup_menu, 
                                                            charset_popup_menu            => $charset_popup_menu, 
                                                            plaintext_encoding_popup_menu => $plaintext_encoding_popup_menu, 
                                                            html_encoding_popup_menu      => $html_encoding_popup_menu, 
                                                            #content_type_popup_menu       => $content_type_popup_menu, 
                                                            
                                                            strip_message_headers         => $li->{strip_message_headers}, 
                                                            print_list_headers            => $li->{print_list_headers}, 
                                                            add_sendmail_f_flag           => $li->{add_sendmail_f_flag}, 
                                                            f_flag_settings               => $DADA::Config::MAIL_SETTINGS . ' -f' . $li->{admin_email},
                                                            wrong_uid                     => $wrong_uid, 
                                                            print_errors_to_header        => $li->{print_errors_to_header}, 
                                                            print_return_path_header      => $li->{print_return_path_header}, 
                                                            use_habeas_headers            => $li->{use_habeas_headers}, 
                                                            verp_return_path              => $li->{verp_return_path},
                                                            use_domain_sending_tunings    => ($li->{use_domain_sending_tunings} ? 1 : 0), 
                                                            
                                            });
                                           
        print(admin_html_footer(-List => $list));

    }else{ 


        my $precedence                = $q->param('precedence');
        my $priority                  = $q->param('priority');
        my $charset                   = $q->param('charset');
        my $plaintext_encoding        = $q->param('plaintext_encoding'); 
        my $html_encoding             = $q->param('html_encoding');
        #my $content_type              = $q->param('content_type');
        my $strip_message_headers     = $q->param('strip_message_headers')    || 0;
        my $add_sendmail_f_flag          = $q->param('add_sendmail_f_flag')      || 0;
        my $print_return_path_header  = $q->param('print_return_path_header') || 0;
        my $print_errors_to_header    = $q->param('print_errors_to_header')   || 0;
        my $print_list_headers          = $q->param('print_list_headers')       || 0;
        my $verp_return_path          = $q->param('verp_return_path')         || 0; 
        my $use_habeas_headers        = $q->param('use_habeas_headers')       || 0; 

        my $use_domain_sending_tunings = $q->param('use_domain_sending_tunings') || 0; 

        $ls->save({
                   precedence               => $precedence,
                   priority                 => $priority,
                   charset                  => $charset, 
                   #content_type             => $content_type,
                   strip_message_headers    => $strip_message_headers,
                   add_sendmail_f_flag      => $add_sendmail_f_flag,
                   print_list_headers       => $print_list_headers,
                   print_return_path_header => $print_return_path_header,
                   print_errors_to_header   => $print_errors_to_header, 
                   plaintext_encoding       => $plaintext_encoding, 
                   html_encoding            => $html_encoding,
                   verp_return_path         => $verp_return_path, 
                   use_habeas_headers       => $use_habeas_headers, 
                   
                   use_domain_sending_tunings => $use_domain_sending_tunings, 
                   });

        print $q->redirect(-uri=>$DADA::Config::S_PROGRAM_URL . '?flavor=adv_sending_options&done=1'); 
    }
}



sub sending_tuning_options { 

    my ($admin_list, $root_login) =  check_list_security(-cgi_obj    => $q,
                                                         -Function   => 'sending_tuning_options');
                                                         
                                                         
    my @allowed_tunings = qw(
        domain
        send_via_smtp
        add_sendmail_f_flag
        print_return_path_header
        verp_return_path
    ); 
    
    $list = $admin_list;
   
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 
    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
   if($process eq 'remove_all'){ 
   
        $ls->save({domain_sending_tunings => ''});
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1&remove=1'); 

   }elsif($process == 1){ 
   
        my $tunings = eval($li->{domain_sending_tunings});
        #my $errors  = {}; 
        
        
        if($q->param('new_tuning') == 1){ 
        
            my $new_tuning = {};
            my $p_list = $q->Vars;
            
            foreach(keys %$p_list){ 
                if($_ =~ m/^new_tuning_/){ 
                    my $name = $_;
                       $name =~ s/^new_tuning_//;
                    $new_tuning->{$name} = $q->param($_); 
                    
                   # if($p_list->{new_tuning_domain}){
                   #    # TO DO domain regex needs some work...
                   #     if(DADA::App::Guts($p_list->{new_tuning_domain}) == 0 && $p_list->{new_tuning_domain} !~ m/^([a-z]+[-]*(?=[a-z]|\d)\d*[a-z]*)\.(.*?)/){ 
                   #         $errors{not_a_domain} = 1; 
                   #     }
                   # }
                }
            }
            
            if($new_tuning->{domain}){ # really, the only required field.
            #if(! keys %$errors){ 
              push(@$tunings, $new_tuning);
           # }
             }
        }
        
       # if(! keys %$errors){ 
        
            require Data::Dumper; 
            my $tunes = Data::Dumper->new([$tunings]); 
               $tunes->Purity(1)->Terse(1)->Deepcopy(1);
            $ls->save({domain_sending_tunings => $tunes->Dump}); 
       #}
        
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1'); 
        
   }elsif($q->param('process_edit') =~ m/Edit/i) {
        
        if($q->param('domain')){
        
            my $saved_tunings = eval($li->{domain_sending_tunings});
            my $new_tunings = []; 
            
            foreach my $st(@$saved_tunings){
            
                if($st->{domain} eq $q->param('domain')) { 
                    
                    foreach my $a_tuning(@allowed_tunings){ 
            
                        my $new_tune = $q->param($a_tuning) || 0;
                        #  if($q->param($a_tuning)){ 
                            $st->{$a_tuning} = $new_tune; 
                        # }
                    }
                }
            }
            
            
            require Data::Dumper; 
            my $tunes = Data::Dumper->new([$saved_tunings]); 
               $tunes->Purity(1)->Terse(1)->Deepcopy(1);
            $ls->save({domain_sending_tunings => $tunes->Dump}); 
            
        }
        
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1&edit=1'); 


   }elsif($q->param('process_edit') =~ m/Remove/i) {
   
        if($q->param('domain')){
        
            my $saved_tunings = eval($li->{domain_sending_tunings});
            my $new_tunings = []; 

            foreach(@$saved_tunings){
            
                if($_->{domain} ne $q->param('domain')) { 
                    push(@$new_tunings, $_); 
                }
            
            }
            
            require Data::Dumper; 
            my $tunes = Data::Dumper->new([$new_tunings]); 
               $tunes->Purity(1)->Terse(1)->Deepcopy(1);
            $ls->save({domain_sending_tunings => $tunes->Dump}); 

        }
        
       print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1&remove=1'); 
 
   
   } else { 
   
   
       my $li = $ls->get; 
       
       my $saved_tunings = eval($li->{domain_sending_tunings}); 
       
       # This is done because variables inside loops are local, not global, and global vars don't work in loops. 
       my $c = 0; 
       foreach(@$saved_tunings){ 
        $saved_tunings->[$c]->{S_PROGRAM_URL} = $DADA::Config::S_PROGRAM_URL;
        $c++; 
       }
       
        print(admin_html_header(      
              -Title      => "Domain-Specific Sending Tuning", 
              -List       => $list, 
              -Root_Login => $root_login,
              -Form       => 0, 
              
              ));
              
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'sending_tuning_options.tmpl', 
                                              -vars   => {
                                                                    
                                                            tunings => $saved_tunings, 
                                                            done    => ($q->param('done')   ? 1 : 0), 
                                                            edit    => ($q->param('edit')   ? 1 : 0), 
                                                            remove  => ($q->param('remove') ? 1 : 0), 
                                                            
                                                            use_domain_sending_tunings => ($li->{use_domain_sending_tunings} ? 1 : 0), 
                                                            
                                                            # For pre-filling in the "new" forms
                                                            list_send_via_smtp               => $li->{send_via_smtp}, 
                                                            list_add_sendmail_f_flag         => $li->{add_sendmail_f_flag}, 
                                                            list_print_return_path_header    => $li->{print_return_path_header}, 
                                                            list_verp_return_path            => $li->{verp_return_path}, 
    
                                                      },
                                             );
        
        print(admin_html_footer(-List => $list, -Form => 0, ));

    }

}




sub smtp_options { 
    
    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                        -Function => 'smtp_options');
                                                        
    
    
    
    $list = $admin_list;

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 

    require DADA::Security::Password;
    
        

    require CGI::Ajax;
    my $pjx = new CGI::Ajax( 
                             'smtp_test_results'       => \&smtp_test_results,
                             'ajax_save_smtp_options'  => \&ajax_save_smtp_options, 
                             
                             );
        
    my $decrypted_sasl_pass = q{};
    if($li->{sasl_smtp_password}){
        $decrypted_sasl_pass = DADA::Security::Password::cipher_decrypt($li->{cipher_key}, $li->{sasl_smtp_password});      
    }
   
    my $decrypted_pop3_pass = q{};
    if($li->{pop3_password}){ 
        $decrypted_pop3_pass = DADA::Security::Password::cipher_decrypt($li->{cipher_key}, $li->{pop3_password}); 
    }
    
    my $can_use_net_smtp = 0;
     eval { require Net::SMTP };
    if(!$@){ 
        $can_use_net_smtp = 1;
    }


    my $can_use_smtp_ssl = 0;
     eval { require Net::SMTP::SSL };
    if(!$@){ 
        $can_use_smtp_ssl = 1;
    }
    
    if(!$process){
    

        
        my $scr;     
        $scr .= admin_html_header( 
              -HTML_Header => 0, 
              -Title       => "SMTP Sending Options", 
              -List        => $li->{list}, 
              -Root_Login  => $root_login);
              
        require  DADA::Template::Widgets;
        $scr .=  DADA::Template::Widgets::screen(-list   => $list, 
                                                -screen => 'smtp_options_screen.tmpl', 
                                                          -expr   => 1, # because I'm LAZY.
                                              
                                                          -vars  => 
                                                          {     done                => $done, 
                                                                smtp_server         => $li->{smtp_server}, 
                                                                smtp_port           => $li->{smtp_port},
                                                                
                                                                use_smtp_ssl        =>  $li->{use_smtp_ssl},
                                                                can_use_smtp_ssl    =>  $can_use_smtp_ssl, 
                                                                use_pop_before_smtp => $li->{use_pop_before_smtp},
                                                                pop3_server         => $li->{pop3_server}, 
                                                                pop3_username       => $li->{pop3_username}, 
                                                                decrypted_pop3_pass => $decrypted_pop3_pass, 
                                                                set_smtp_sender     => $li->{set_smtp_sender},
                                                                
                                                                admin_email         => $li->{admin_email}, 
                                                                
                                                                use_sasl_smtp_auth  => $q->param('use_sasl_smtp_auth') ? $q->param('use_sasl_smtp_auth') : $li->{use_sasl_smtp_auth},
                                                                sasl_smtp_username  => $q->param('sasl_smtp_username') ? $q->param('sasl_smtp_username') : $li->{sasl_smtp_username}, 
                                                                decrypted_sasl_pass => $q->param('pop3_password')      ? $q->param('pop3_password')      : $decrypted_sasl_pass,
                                                                
                                                          },
                                                          );
                                                          
                                                                # is that last line right?!

        $scr .=  admin_html_footer(-List => $list);
               
        
        # This is really strange - if it's the ajax test, this'll return the test, not the screen up there. REALLY WEIRD. 
        $scr = $pjx->build_html( $q, $scr, {admin_header_params()});

        print $scr; 
        

        
    }else{ 
    
        my $use_pop_before_smtp = $q->param('use_pop_before_smtp')       || 0;
        my $set_smtp_sender     = $q->param('set_smtp_sender')           || 0;
        
        my $smtp_server         = strip($q->param('smtp_server'));
        
        my $pop3_server         = strip($q->param('pop3_server'))        || '';
        my $pop3_username       = strip($q->param('pop3_username'))      || '';
        my $pop3_password       = strip($q->param('pop3_password'))      || '';
        
        
        my $use_smtp_ssl        = $q->param('use_smtp_ssl')              || 0; 
        
        my $use_sasl_smtp_auth  = $q->param('use_sasl_smtp_auth')        || 0; 
        my $sasl_smtp_username  = strip($q->param('sasl_smtp_username')) || ''; 
        my $sasl_smtp_password  = strip($q->param('sasl_smtp_password')) || '';
    
    
        
        $ls->save({
        
            smtp_port           => $q->param('smtp_port'),
            #smtp_connect_tries  => $smtp_connect_tries, 
            use_pop_before_smtp => $use_pop_before_smtp,
            
            use_smtp_ssl        => $use_smtp_ssl, 
            smtp_server         => $smtp_server,
            
            pop3_server         => $pop3_server,    
            pop3_username       => $pop3_username, 
            
            pop3_password       => DADA::Security::Password::cipher_encrypt($li->{cipher_key}, $pop3_password),    
            
            use_sasl_smtp_auth  => $use_sasl_smtp_auth, 
            
            sasl_smtp_username  => $sasl_smtp_username, 
            sasl_smtp_password  => DADA::Security::Password::cipher_encrypt($li->{cipher_key}, $sasl_smtp_password),
            set_smtp_sender     => $set_smtp_sender, 
            
            
                }); 
                
        if($q->param('no_redirect') == 1){ 
        
             print "Status: 204 No Response";
         } else { 
            print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=smtp_options&done=1'); 
        }
    }
}

sub smtp_test_results { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                        -Function => 'smtp_options');
                                                        
    require DADA::Mail::Send; 
    require DADA::MailingList::Settings; 
    
    my $ls = DADA::MailingList::Settings->new(-List => $admin_list); 
    my $li = $ls->get; 
    
    my $mh = DADA::Mail::Send->new($li); 
    
    my ($results, $lines, $report) = $mh->smtp_test; 
       $results =~ s/\</&lt;/g; 
       $results =~ s/\>/&gt;/g; 


my $scr;  
   
  
  
 $scr .= '<div style="width:96%; height:300px; margin: 5px; padding: 5px; border:1px solid black; overflow:auto;">'; 
 $scr .= '<h2>Results:</h2>'; 
 
 foreach my $f(@$report){ 

    my $s_f = $f->{line}; 
       
    $s_f =~ s{Net\:\:SMTP(.*?)\)}{}; 
    
    $scr .= '<p><strong>' . $s_f . '</strong> - ' . $f->{message} . '</p>'; 
    
}
 
 
 $scr .= <<EOF
<h2>Raw Log:</h2> 
<pre>
$results
</pre>
EOF
; 




$scr .= '</div>'; 

#print $scr; 

return $scr; 

}

sub ajax_save_smtp_options { 

die "I am being called!"; 

}




sub checkpop { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                        -Function => 'smtp_options');
    
    $list = $admin_list;
    
    require DADA::Security::Password;
    
    my $user   = $q->param('user'); 
    my $pass   = $q->param('pass'); 
    my $server = $q->param('server'); 
    
    
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    require DADA::Mail::Send; 
    my $mh         = DADA::Mail::Send->new($li);
    my $pop_status;
    
    if(!$user || !$pass || !$server){ 
        $pop_status = undef; 
    }else{
        $pop_status = $mh->_pop_before_smtp(-pop3_server    => $server, 
                                            -pop3_username  => $user, 
                                            -pop3_password  => $pass);
    }

    print $q->header();
    if(defined($pop_status)){ 
        print $q->h2("Success!"); 
        print $q->p($q->b("POP-before-SMTP authentication was successful")); 
        print $q->p($q->b("Make sure to 'Save Changes' to have your edits take affect.")); 
    }else{ 
        print $q->h2("Warning!"); 
        print $q->p($q->b('POP-before-SMTP authentication was ',$q->i('unsuccessful'),));    
    }
}




sub view_list { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'view_list');
                                                        
    $list  = $admin_list; 

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
         
    my $lh                    = DADA::MailingList::Subscribers->new(-List => $list);
    
    my $start                 = int($q->param('start')) || 0; 
    my $length                = $li->{view_list_subscriber_number}; 
    my $num_subscribers       = $lh->num_subscribers(-Type => $type);
    my $screen_finish         = $length+$start;
       $screen_finish         =  $num_subscribers if $num_subscribers < $length+$start;
    my $screen_start          = $start; 
       $screen_start          = 1 if (($start == 0) && ($num_subscribers != 0)); 
    my $previous_screen       = $start-$length; 
    my $next_screen           = $start+$length; 
    my $subscribers           = $lh->subscription_list( -start => $start, '-length' => $length, -Type => $type); 
    my $delete_email_count    = $q->param('delete_email_count'); 
    my $email_count           = $q->param('email_count'); 
                                                     

    if($process eq 'set_black_list_prefs'){ 
                
        my $black_list                           = $q->param('black_list')                           || 0; 
        my $add_unsubs_to_black_list             = $q->param('add_unsubs_to_black_list')             || 0;
        my $allow_blacklisted_to_subscribe       = $q->param('allow_blacklisted_to_subscribe')       || 0;
        my $allow_admin_to_subscribe_blacklisted = $q->param('allow_admin_to_subscribe_blacklisted') || 0;
        
        
        $ls->save({    
                    black_list                           => $black_list, 
                    add_unsubs_to_black_list             => $add_unsubs_to_black_list,
                    allow_blacklisted_to_subscribe       => $allow_blacklisted_to_subscribe,
                    allow_admin_to_subscribe_blacklisted => $allow_admin_to_subscribe_blacklisted
                  
                  }); 
        
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=view_list&type=black_list&black_list_changes_done=1'); 
        return; 

    }elsif($process eq 'set_white_list_prefs'){ 
                
        my $enable_white_list = $q->param('enable_white_list') || 0;         

        $ls->save({
                    enable_white_list => $enable_white_list, 
                 }); 
        
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=view_list&type=white_list&white_list_changes_done=1'); 
        return; 

        
    }else{ 
        
            print(admin_html_header(-Title      => $type_title, 
                                -List       => $list,
                                -Root_Login => $root_login,
                                -Form       => 0
                               ));
        
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-list  => $list,
                                                -screen => 'view_list_screen.tmpl', 
                                                  -vars  => 
                                                  {  view_list_subscriber_number => $li->{view_list_subscriber_number},
                                                     next_screen                 => $next_screen,  
                                                     previous_screen             => $previous_screen, 
                                                     use_previous_screen         => ($start-$length >= 0 && $start > 0) ? 1 : 0, 
                                                     num_subscribers             => $num_subscribers, 
                                                     show_next_screen_link       => ($num_subscribers > ($start + $length)) ? 1 : 0, 
                                                     screen_start                => $screen_start, 
                                                     screen_finish               => $screen_finish, 
                                                     delete_email_count          => $delete_email_count,
                                                     email_count                 => $email_count, 
                                                     subscribers                 => $subscribers,
                                                     
                                                     type                        => $type, 
                                                     type_title                  => $type_title,

                                                     
                                                     
                                                     list_type_isa_list          => ($type eq 'list')       ? 1 : 0, 
                                                     list_type_isa_black_list    => ($type eq 'black_list') ? 1 : 0, 
                                                     list_type_isa_moderators    => ($type eq 'moderators') ? 1 : 0, 
                                                     list_type_isa_testers       => ($type eq 'testers')    ? 1 : 0, 
                                                     list_type_isa_white_list    => ($type eq 'white_list') ? 1 : 0, 
                                                     

                                                     GLOBAL_BLACK_LIST           => $DADA::Config::GLOBAL_BLACK_LIST, 
                                                     GLOBAL_UNSUBSCRIBE          => $DADA::Config::GLOBAL_UNSUBSCRIBE, 
                                                     
                                                     can_use_global_black_list   => $lh->can_use_global_black_list, 
                                                     can_use_global_unsubscribe  => $lh->can_use_global_unsubscribe, 
                                                     
                                                     can_filter_subscribers_through_blacklist => $lh->can_filter_subscribers_through_blacklist, 
                                                     
                                                     black_list_changes_done     => ($q->param('black_list_changes_done')) ? 1 : 0, 
                                                     
                                                     black_list                           => $li->{black_list},
                                                     add_unsubs_to_black_list             => $li->{add_unsubs_to_black_list},
                                                     allow_blacklisted_to_subscribe       => $li->{allow_blacklisted_to_subscribe},
                                                     allow_admin_to_subscribe_blacklisted => $li->{allow_admin_to_subscribe_blacklisted}, 
                                                     
                                                     flavor                      => 'view_list', 
                                                     enable_moderation           => $li->{enable_moderation}, 
                                                     
                                                     enable_white_list           => $li->{enable_white_list}, 
                                                     
                                                  },
                                                  ); 
                                                          
        print(admin_html_footer(-List => $list, -Form => 0));
        
    }
}




sub filter_using_black_list { 

    
    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'filter_using_black_list');
    $list = $admin_list;
    
    if(!$process){ 
        
        my $lh = DADA::MailingList::Subscribers->new(-List => $list); 
        my $ls = DADA::MailingList::Settings->new(-List => $list); 
        my $li = $ls->get; 
        
        my $filtered = $lh->filter_list_through_blacklist; 
        
        print(admin_html_header(-Title      => "Filtering Subscription List...", 
                            -List       => $list,
                            -Root_Login => $root_login,
                            -Form       => 0
                           ));
                               
        
        
        my $should_add_to_black_list = 0; 
        
         $should_add_to_black_list = 1
            if ($li->{black_list} eq "1") && 
               ($li->{add_unsubs_to_black_list} eq "1");
               
               
               
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-list  => $list,
                                                -screen => 'filter_using_black_list.tmpl', 
                                                  -vars  => {
                                                  filtered          => $filtered, 
                                                  add_to_black_list => $should_add_to_black_list, 
                                                  
                                                  },
                                                ); 
        
        print(admin_html_footer(-List => $list, -Form => 0));




    }
}




sub view_list_options { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'view_list_options');
    $list = $admin_list;

    my @list_amount = (10,25,50,100,150,200,
                       250,300,350, 400,450,
                       500,550,600,650,700,
                       750,800,850,900,950,1000
                      );
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get;
    
    if(!$process){ 
    
        
        my $vlsn_menu = $q->popup_menu(-name     => 'view_list_subscriber_number',
                                       -values   => [ @list_amount],
                                       -default  => $li->{view_list_subscriber_number});
                                                                               
        print(admin_html_header(-Title      => "View List Options", 
                                -List       => $list,
                                -Root_Login => $root_login,
                               ));
        
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'view_list_options_screen.tmpl', 
                                                -vars  => { 
                                                            done      => $done, 
                                                            vlsn_menu => $vlsn_menu 
                                                          },
                                               ); 
                                               
        print(admin_html_footer(-List => $list)); 
    
    }else{ 
    
        $ls->save({view_list_subscriber_number => $q->param('view_list_subscriber_number')});
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?f=view_list_options&done=1'); 
        return;
    }

}




sub edit_subscriber { 


    view_list()  
        if ! $email;
    
    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,    
                                                        -Function => 'edit_subscriber');
                                                        
    $list = $admin_list;
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);
    
    print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?f=view_list&error=no_such_address&type=' . $type)
        if $lh->check_for_double_email(-Email => $email, -Type => $type) == 0;
    
    my $errors     = {invalid_email => 0, subscribed => 0}; 
    my $status     = undef; 
    my $subscribed = 0; 
    
    my $edit_email = undef; 
    my $no_changes_made = 0; 
    
    if($process){ 
        $edit_email = $q->param('edit_email');
        
        if($edit_email eq $email){ 
            $no_changes_made = 1; 
        }else{ 
            ($status, $errors) = $lh->subscription_check(-Email => $edit_email, -Type => $type, -Skip => ['already_sent_sub_confirmation']); 
    
            unless(($errors->{invalid_email} == 1) ||
                   (($errors->{subscribed}   == 1) && ($email ne $edit_email))){ 

                $lh->remove_from_list(-Email_List => [$email], -Type => $type);
                $lh->add_to_email_list(-Email_Ref => [$edit_email], -Type => $type);
                $done = 1;
                $email = $edit_email; 
                
            }
        
        }
            
            
    }

    print(admin_html_header(-Title      => "Edit Subscriber", 
                            -List       => $list,
                            -Root_Login => $root_login,
                            -Form       => 0));
      
    require DADA::Template::Widgets;
    print DADA::Template::Widgets::screen(-screen => 'edit_subscribed_screen.tmpl', 
                                          -vars   => {
                                                    done                 => $done, 
                                                        email                => $email, 
                                                        edit_email           => $edit_email, 
                                                        errors_invalid_email => $errors->{invalid_email}, 
                                                        errors_subscribed    => $errors->{subscribed},
                                                        no_changes_made      => $no_changes_made,
                                                        
                                                        type                 => $type, 
                                                        type_title                  => $type_title,

                                                  },
                                         );
                                         
    print(admin_html_footer(-List => $list, -Form => 0)); 

}




sub list_stats { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'list_stats');



# view whos on the list, add delete addresses
$list = $admin_list; 


require  DADA::MailingList::Settings; 
my $ls = DADA::MailingList::Settings->new(-List => $list); 
my $li = $ls->get; 



my $lh = DADA::MailingList::Subscribers->new(-List => $list);

print(admin_html_header(      
      -Title      => "Subscriber Statistics", 
      -List       => $li->{list},
      -Root_Login => $root_login));
      
print "<p>\n";


my $email_count = $q -> param("email_count");
 
if(defined($email_count)){ 
    my $add_message = "$email_count people have been added successfully"; 
    print $q->p("$add_message"); 
}

my $delete_email_count = $q -> param("delete_email_count");
 
if(defined($delete_email_count)){ 
     print "<p>",$delete_email_count; 
     print " emails have been deleted</p>"; 
}



#my $any_subscribers = -s "$DADA::Config::FILES/$list.list";
# debug

my $any_subscribers = 1;

if($any_subscribers != 0){





print"</p>";
 

$DADA::Config::SHOW_EMAIL_LIST = 0; 
my ($everyone, $domains_ref, $count_services_ref) = $lh->list_option_form(-List => $list, -In_Order => $DADA::Config::LIST_IN_ORDER);

if($DADA::Config::SHOW_DOMAIN_TABLE  == 1) { 


#initialize some variables
my $key; 
my $value; 
my $everyone_else = $domains_ref -> {Other};


print <<EOF   

<p>Email addresses sorted by <strong>Top Level Domains</strong>: 
click on the particular domain to view the list of 
emails from that top level domain.</p>


<center> 
 <table cellpadding="1" cellspacing="0" bgcolor="#000000" width="300">
  <tr>
   <td>
    <table cellspacing="1" width="100%"> 
     <tr bgcolor="#cc6666">
      <td><strong>Domain</strong></td>
      <td><strong>Number</strong></td>
      <td><strong>Percent</strong></td>
     </tr> 
EOF
; 


my @keys = sort(keys %$domains_ref); 


foreach $key (@keys){ 

    if($key !~ m/Other/i){ 
        $value = $domains_ref -> {$key}; 

        
        my $percentage;
           if($everyone > 0){ 
             $percentage = ($value * 100)/$everyone;
            }else{ 
               $percentage = 0;
            }
        $percentage= sprintf("%.2f", $percentage);
                         
           
        print $q->Tr($q->td({-bgcolor=>'#FFFFFF'},[
                     
                      $q->a({href=>"$DADA::Config::S_PROGRAM_URL?flavor=search_email&method=domain&keyword=.$key"},$key), 
                      $value, 
                     "$percentage\%"
               
               ])); 

        # now, find what "other" is 


}
}

$value = $domains_ref->{Other}; 


my $percentage;
   if($everyone > 0){
      $percentage = ($value * 100)/$everyone;
    }else{ 
        $percentage = 0;
    }
   $percentage= sprintf("%.2f", $percentage);
   
   
print $q->Tr($q->td({-bgcolor=>'#FFFFFF'},[

             'Other', 
              $value, 
             "$percentage\%"
       
       ])); 

print <<EOF; 

   </table> 
  </td>
 </tr>
</table> 

<p>&nbsp;</p>
<hr />  
 
EOF
; 

}

if($DADA::Config::SHOW_SERVICES_TABLE==1){  

my $skey; 
my $svalue;
my $using; 
my @skeys = sort(values %DADA::Config::SERVICES); 


print $q->p("Email address sorted by popular Email or ISP <strong>Services</strong>: click on a service to see the list of emails from that particular service.");
print <<EOF   

<center>
<table cellpadding="1" cellspacing="0" bgcolor="#000000" width="300">
 <tr>
  <td>
   <table cellspacing="1" width="100%"> 
    <tr bgcolor="#cc6666">
     <td><strong>Service</strong></td>
     <td><strong>Number</strong></td>
     <td><strong>Percent</strong></td>
   </tr> 
EOF
; 


%DADA::Config::SERVICES = reverse(%DADA::Config::SERVICES); 


foreach $skey (@skeys){ 

    $svalue = $count_services_ref->{$skey} || 0; 
    my $spercentage;
    if($everyone > 0){
        $spercentage = ($svalue * 100)/$everyone;
    }else{ 
        $spercentage = 0;
    }
    $spercentage= sprintf("%.2f", $spercentage);


    if($DADA::Config::SERVICES{$skey} !~ m/Other/i){


        print $q->Tr($q->td({-bgcolor=>'#FFFFFF'},[
                     
                      $q->a({href=>"$DADA::Config::S_PROGRAM_URL?flavor=search_email&method=service&keyword=$skey"},$DADA::Config::SERVICES{$skey}), 
                      $svalue, 
                     "$spercentage\%"
               
               ])); 
        }

}

$svalue = $count_services_ref -> {Other}; 
my $spercentage;

if($everyone > 0){ 
    $spercentage = ($svalue * 100)/$everyone;
}else{ 
    $spercentage = 0;
}
$spercentage= sprintf("%.2f", $spercentage);


print $q->Tr($q->td({-bgcolor=>'#FFFFFF'},[
             
              'Other', 
              $svalue, 
             "$spercentage\%"
       
       ])); 
       
       
       

print <<EOF 
      </table> 
     </td>
    </tr>
   </table>  
  </center> 
 <p>&nbsp;</p> 

EOF
;

 print qq{
    <div id="help_link"> 
     <a href="$DADA::Config::HELP_LINKS_URL/view_archive.html" target="_blank">
      [?] Manage List Archive: View
     </a>
    </div> 
        
    } if $DADA::Config::SHOW_HELP_LINKS == 1;
         
}


}else{ 

print $DADA::Config::NO_ONE_SUBSCRIBED;  

}
print(admin_html_footer(-List => $list));
}





sub add  { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'add');

    $list = $admin_list; 
    
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
                                 
    my $lh              = DADA::MailingList::Subscribers->new(-List => $list);
    my $num_subscribers = $lh->num_subscribers;
  
    print(admin_html_header(      
          -Title      => "Manage Additions", 
          -List       => $list,
          -Root_Login => $root_login, 
          -Form       => 0));
    
    
    my $subscription_quota_reached = 0; 
       $subscription_quota_reached = 1
        if ($li->{use_subscription_quota} == 1) && 
           ($num_subscribers              >= $li->{subscription_quota}) && 
           ($num_subscribers               + $li->{subscription_quota} > 1); 
        


    my $list_type_switch_widget = $q->popup_menu(-name     => 'type', 
                                                 '-values' => [keys %list_types], 
                                                 -labels   => \%list_types, 
                                                 -default  => $type, 
                                                 ); 

    require DADA::Template::Widgets;
    print DADA::Template::Widgets::screen(-screen => 'add_screen.tmpl', 
                                          -vars   => {
                                                        subscription_quota         => $li->{subscription_quota}, 
                                                        use_subscription_quota     => $li->{use_subscription_quota}, 
                                                        subscription_quota_reached => $subscription_quota_reached,
                                                        num_subscribers            => $num_subscribers, 
                                                        
                                                        list_type_isa_list          => ($type eq 'list')       ? 1 : 0, 
                                                        list_type_isa_black_list    => ($type eq 'black_list') ? 1 : 0, 
                                                        list_type_isa_moderators    => ($type eq 'moderators') ? 1 : 0, 
                                                        list_type_isa_testers       => ($type eq 'testers')    ? 1 : 0, 
                                                        list_type_isa_white_list    => ($type eq 'white_list') ? 1 : 0, 

                                                        type                        => $type, 
                                                        type_title                  => $type_title,
                                                        flavor                      => 'add', 
                                                        enable_moderation           => $li->{enable_moderation},
                                                
                                                  },
                                         );
                                         
        print(admin_html_footer(-List => $list));
    
}




sub add_email { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                        -Function => 'add_email');
                                                        
    my %seen;
    $list         = $admin_list; 
    
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);

    if(!$process){ 
        my $new_emails;
        my $email_file = $q->param('new_email_file');
    
        if(DADA::App::Guts::strip($q->param("new_emails")) ne ""){ 
            $new_emails = $q->param("new_emails"); 
        }else{ 
            if($email_file){ 
                my $new_file = file_upload('new_email_file');    
               
                open(UPLOADED, "$new_file") or die $!;
               
                $new_emails = do{ local $/; <UPLOADED> }; 
                
                close(UPLOADED);
                unlink($new_file) or warn "could not remove uploaded subscriber list, '$new_file': $!";
            }
        }
        
        my @new_addresses = split(/\s+|,|;|\n+/, $new_emails);
        
        # xss filter... 
        foreach(@new_addresses){ 
            $_ = xss_filter($_); 
        }
        
        my ($subscribed, $not_subscribed, $black_listed, $not_white_listed, $invalid) = $lh->filter_subscribers(-Email_Ref => [@new_addresses], -Type => $type);

        my $num_subscribers = $lh->num_subscribers;
        
        if(
           (($num_subscribers + $#$not_subscribed,) >= $li->{subscription_quota}) && 
            ($li->{use_subscription_quota} == 1)
                                                      ){ 
            $quick = 'no';
        }
        
        
        my $going_over_quota = undef; 
    
        if($quick eq "yes"){ 
        
            # this has to be changed, to deal with whitelisting. 
            my $new_email_count=$lh->add_to_email_list(-Email_Ref => $not_subscribed,
                                                       -Type      => $type, 
                                             );
            
            print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=view_list&email_count=' . $new_email_count . '&type=' . $type); 
            
        }else{ 
    
               $going_over_quota = 1
                if (($num_subscribers + $#$not_subscribed) >= $li->{subscription_quota}) && 
                    ($li->{use_subscription_quota} == 1);
                
            my $addresses_to_add = 0; 
               $addresses_to_add = 1
                 if(defined(@$not_subscribed[0]));
                
            my $black_listed_addresses = [];
               push(@$black_listed_addresses, {email => $_}) 
                foreach @$black_listed; 

            my $not_white_listed_addresses = []; 
                push(@$not_white_listed_addresses, {email => $_}) 
                foreach @$not_white_listed; 
                
            my $not_subscribed_addresses = [];
               push(@$not_subscribed_addresses, {email => $_}) 
                foreach @$not_subscribed; 
            
            my $already_subscribed_addresses = [];
               push(@$already_subscribed_addresses, {email => $_ }) 
                foreach @$subscribed;
    
            my $invalid_addresses = [];
               push(@$invalid_addresses, {email => $_ }) 
                foreach @$invalid;
                
            print(admin_html_header(      
                  -Title      => "Verify Additions", 
                  -List       => $list, 
                  -Root_Login => $root_login,
                  -Form       => 0, 
                  ));
                  
            require DADA::Template::Widgets;
            print DADA::Template::Widgets::screen(-screen => 'add_email_screen.tmpl', 
                                                  -vars   => {
                                                                going_over_quota                     => $going_over_quota, 
                                                                addresses_to_add                     => $addresses_to_add, 
                                                                not_subscribed_addresses             => $not_subscribed_addresses, 
                                                                black_listed_addresses               => $black_listed_addresses, 
                                                                not_white_listed_addresses           => $not_white_listed_addresses, 
                                                                subscription_quota                   => $li->{subscription_quota}, 
                                                                black_list                           => $li->{black_list}, 
                                                                invalid_addresses                    => $invalid_addresses,                                                                
                                                                already_subscribed_addresses         => $already_subscribed_addresses, 
                                                                allow_admin_to_subscribe_blacklisted => $li->{allow_admin_to_subscribe_blacklisted},
                                                             
                                                                type                        => $type, 
                                                                type_title                  => $type_title,
                                                             
                                                             
                                                             },
                                                 );
            print(admin_html_footer(-List => $list, -Form => 0));

        }
        
    } else { 
    
        my @address         = $q->param("address"); 
        my $new_email_count = $lh->add_to_email_list(-Email_Ref => [@address], -Type => $type, ); 
                                            
        print $q->redirect(-uri=> $DADA::Config::S_PROGRAM_URL . '?flavor=view_list&email_count=' . $new_email_count . '&type=' . $type); 

    }
}




sub delete_email{ 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'delete_email',
                                                       );
    $list = $admin_list; 
    
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);
     
    if(!$process){ 
    
        my $list_type_switch_widget = $q->popup_menu(-name     => 'type', 
                                                     '-values' => [keys %list_types], 
                                                     -labels   => \%list_types, 
                                                     -default  => $type, 
                                                     ); 
                                             
                                             
        print(admin_html_header(      
              -Title      => "Manage Deletions", 
              -List       => $list, 
              -Root_Login => $root_login,
              -Form       => 0
             ));
        
        require DADA::Template::Widgets; 
        print DADA::Template::Widgets::screen(-screen => 'delete_email_screen.tmpl',
        
                                              -vars => { 
                                              
                                                         can_use_global_black_list   => $lh->can_use_global_black_list, 
                                                         can_use_global_unsubscribe  => $lh->can_use_global_unsubscribe, 
                                                    
                                                        list_type_isa_list          => ($type eq 'list')       ? 1 : 0, 
                                                        list_type_isa_black_list    => ($type eq 'black_list') ? 1 : 0, 
                                                        list_type_isa_moderators    => ($type eq 'moderators') ? 1 : 0, 
                                                        list_type_isa_testers       => ($type eq 'testers')    ? 1 : 0, 
                                                        list_type_isa_white_list    => ($type eq 'white_list') ? 1 : 0, 

                                                        type                        => $type, 
                                                        type_title                  => $type_title,
                                                        flavor                      => 'delete_email', 
                                                        enable_moderation           => $li->{enable_moderation},
                                              
                                              
                                              }); 
                 
        print(admin_html_footer(-List => $list, -Form => 0));
    
    
    }else{ 

        my $delete_list = undef; 
        my $delete_email_file = $q->param('delete_email_file');    
        if($delete_email_file){    
            my $new_file = file_upload('delete_email_file');    
            
            open(UPLOADED, "$new_file") or die $!;
            
            $delete_list = do{ local $/; <UPLOADED> }; 
           
            close(UPLOADED);
        }else{ 
            $delete_list = $q->param('delete_list'); 
        }
    
    
        my @delete_addresses = split(/\s+|,|;|\n+/, $delete_list);
        
        # xss filter... 
        foreach(@delete_addresses){ 
            $_ = xss_filter($_); 
        }
        
        if(!$delete_addresses[0]){ 
            print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=delete_email'); 
        }
        
        # subscribed should give a darn if your blacklisted, or white listed, white list and blacklist only looks at unsubs. Right. Right?
        my ($subscribed, $not_subscribed, $black_listed, $not_white_listed, $invalid) = $lh->filter_subscribers(-Email_Ref => [@delete_addresses], -Type => $type);
    
        my $should_add_to_black_list = 0; 
           $should_add_to_black_list = 1
            if ($li->{black_list} eq "1") && 
               ($li->{add_unsubs_to_black_list} eq "1");
        
        my $have_subscribed_addresses = 0; 
           $have_subscribed_addresses = 1
            if $subscribed->[0];
            
        my $addresses_to_remove = []; 
        push(@$addresses_to_remove, {email => $_})
            foreach @$subscribed; 
            
        my $not_subscribed_addresses = []; 
        push(@$not_subscribed_addresses, {email => $_}) 
            foreach @$not_subscribed; 
        
        my $have_invalid_addresses = 0; 
           $have_invalid_addresses = 1
            if $invalid->[0];
    
        my $invalid_addresses = [];
           push(@$invalid_addresses, {email => $_ }) 
            foreach @$invalid;
    
        print(admin_html_header(      
              -Title      => "Verify Deletions", 
              -List       => $list, 
              -Root_Login => $root_login,
              -Form       => 0, 
              
        ));
    

        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'delete_email_screen_filtered.tmpl', 
                                              -vars   => {                                                                
                                                            should_add_to_black_list  => $should_add_to_black_list, 
                                                            have_subscribed_addresses => $have_subscribed_addresses, 
                                                            addresses_to_remove       => $addresses_to_remove, 
                                                            not_subscribed_addresses  => $not_subscribed_addresses, 
                                                            have_invalid_addresses    => $have_invalid_addresses, 
                                                            invalid_addresses         => $invalid_addresses, 
                                                            
                                                            type                        => $type, 
                                                            type_title                  => $type_title,
                                                        
                                                        },
                                             );

        print(admin_html_footer(-List => $list));
            
    }
}




sub subscription_options { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'subscription_options');
    $list = $admin_list;
    
    require  DADA::MailingList::Settings;
    my $ls = DADA::MailingList::Settings->new(-List => $list);
    my $li = $ls->get; 
    
    my @quota_values = qw(1 10 25 50 100 150 200 250 300 350 400 450 500 600 
                          700 800 900 1000 1500 2000 2500 3000 3500 4000 4500 
                          5000 5500 6000 6500 7000 7500 8000 8500 9000 9500 
                          10000 11000 12000 13000 14000 15000 16000 17000 
                          18000 19000 20000 30000 40000 50000 60000 70000 
                          80000 90000 100000 200000 300000 400000 500000 
                          600000 700000 800000 900000 1000000
                         );
    unshift(@quota_values, $li->{subscription_quota}); 
    
    
    if(!$process){ 
        
        my $subscription_quota_menu = $q->popup_menu(-name    => 'subscription_quota', 
                                                    '-values' => [@quota_values], 
                                                     -default => $li->{subscription_quota},
                                                    ); 
                                     
        print admin_html_header(-Title      => "Subscriber Options", 
                                -List       => $list,
                                -Root_Login => $root_login
                                 );    
    
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'subscription_options_screen.tmpl', 
                                                -vars   => {
                                                            done                    => $done, 
                                                            use_subscription_quota  => $li->{use_subscription_quota}, 
                                                            subscription_quota_menu => $subscription_quota_menu, 
                                                           },
                                             );
    
        print admin_html_footer(-List => $list);
        
    }else{ 
    
        my $use_subscription_quota = $q->param('use_subscription_quota') || 0; 
        my $subscription_quota     = $q->param('subscription_quota'); 
        
        $ls->save({
                    use_subscription_quota => $use_subscription_quota, 
                     subscription_quota => $subscription_quota,
                });
                
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?f=subscription_options&done=1');        
    } 

}




sub view_archive { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'view_archive');
                                                        
    $list = $admin_list;
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 


    my $ls = DADA::MailingList::Settings->new(-List => $admin_list); 
    my $li = $ls->get; 
    
    
    # let's get some info on this archive, shall we? 
    require DADA::MailingList::Archives; 
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
           
    my $archive = DADA::MailingList::Archives -> new(-List => $li); 
    my $entries = $archive->get_archive_entries(); 
    
    #if we don't have nothin, print the index, 
    unless(defined($id)){ 
    
        my $start = int($q->param('start')) || 0;


        if($c->cached($list . '.admin.view_archive.index.' . $start)){ $c->show($list . '.admin.view_archive.index.' . $start); return;}

            
        
        my $ht_entries = []; 
        
        #reverse if need be
        #@$entries = reverse(@$entries) if($li->{sort_archives_in_reverse} eq "1"); 
        
            
        my $th_entries = []; 
        
        my ($begin, $stop) = $archive->create_index($start);
        my $i;
        my $stopped_at = $begin;

        my @archive_nums; 
        my @archive_links; 
        
        for($i = $begin; $i <=$stop; $i++){ 
        
        next if !defined($entries->[$i]);


        my $entry = $entries->[$i];
        #foreach $entry (@$entries){ 
            my ($subject, $message, $format, $raw_msg) = $archive->get_archive_info($entry); 
    
            my $pretty_subject = pretty($subject);


                my $header_from    = undef; 
                if($raw_msg){ 
                    $header_from    = $archive->get_header(-header => 'From', -key => $entry); 
                    $header_from    = entity_protected_str($header_from);
                }else{ 
                    $header_from    = '-';
                }
                
             my $date = date_this(
                -Packed_Date  => $entry,
                -Write_Month => $li->{archive_show_month},
                -Write_Day => $li->{archive_show_day},
                -Write_Year => $li->{archive_show_year},
                -Write_H_And_M => $li->{archive_show_hour_and_minute},
                -Write_Second => $li->{archive_show_second},
                );
                                           
             my $message_blurb = $archive->message_blurb(-key => $entry); 
                $message_blurb =~ s/\n|\r/ /g; 
                
             push(@$ht_entries, 
             
             { 
               id            => $entry, 
               date          => $date, 
               S_PROGRAM_URL => $DADA::Config::S_PROGRAM_URL, 
               subject       => $pretty_subject, 
               from          => $header_from,
               message_blurb => $message_blurb, 
             });
             
             $stopped_at++;
             
        }               
        
    my $index_nav = $archive->create_index_nav($stopped_at, 1);

    my $scrn; 
    
    $scrn .= (admin_html_header(      
              -Title      => "Manage Archives", 
              -List       => $li->{list},
              -Root_Login => $root_login,
              -Form       => 0, 
            ));
    
    
        require DADA::Template::Widgets;
        $scrn .=  DADA::Template::Widgets::screen(-screen => 'view_archive_index_screen.tmpl',
                                                 -list       => $list, 
                                                 -vars       =>  {
                                                 index_list => $ht_entries, 
                                                 list_name  => $li->{list_name}, 
                                                 index_nav  => $index_nav, 
                                                 
                                                 
                                                                 }, 
                                                 );                

    
    
         
        $scrn .= (admin_html_footer(-List => $list, , -Form => 0));
        print $scrn; 
        
        $c->cache($list . '.admin.view_archive.index.' . $start, \$scrn);

        return; 

    }else{ 


    #check to see if $id is a real id key 
    my $entry_exists = $archive->check_if_entry_exists($id); 

    user_error(-List => $list, -Error => "no_archive_entry")if($entry_exists <= 0); 
     

    # if we got something, print that entry. 
    print(admin_html_header(      
          -Title      => "Manage Archives", 
          -List       => $li->{list},
          -Root_Login => $root_login));


    
    if($c->cached('view_archive.' . $list . '.' . $id)){ $c->show('view_archive.' . $list . '.' . $id); return;}

    
    my $scrn = ''; 
    
    #get the archive info 

    my ($subject, $message, $format) = $archive->get_archive_info($id); 



    my $pretty_subject = pretty($subject);  
    
    $scrn .= "<h2>$pretty_subject</h2>";
    my $cal_date = date_this(-Packed_Date => $archive->_massaged_key($id), -All => 1); 

    $scrn .=  "<p><em>Sent $cal_date</em></p> "; 

    if($archive->can_display_message_source){ 
    
        $scrn .=  qq{<p style="text-align:right">
                <a href="$DADA::Config::PROGRAM_URL?f=display_message_source&amp;id=$id" target="_blank"> 
                 Display Original Message Source
                </a>
               </p>}; 
    
    }

    
        $scrn .=  qq{<p style="text-align:right">
                <a href="$DADA::Config::PROGRAM_URL/archive/$list/$id/" target="_blank"> 
                 Display publically viewable version of this message
                </a>
               </p>}; 
        
    

    $scrn .=  qq{<iframe src="$DADA::Config::S_PROGRAM_URL?f=archive_bare;l=$list;id=$id;admin=1" id="archived_message_body_container">};
    $scrn .=  $archive->massaged_msg_for_display(-key => $id, -body_only => 1); 
    $scrn .=  '</iframe>'; 



$scrn .=  <<EOF 

    <hr /> 


<p class="error">Note: some archiving formatting options only take affect when viewing messages publically.</p>



EOF
; 


$scrn .=  qq{ 

<div class="buttonfloat">

}; 

    $scrn .=  qq{ 
     <input type="button" class="cautionary"  value="Edit Message..." onClick="window.location='$DADA::Config::PROGRAM_URL?f=edit_archived_msg&id=$id'" />    
    }; 

$scrn .=  qq{ 
 <input type="button" class="alertive" " name="process" value="Delete Message" onClick="window.location='$DADA::Config::PROGRAM_URL?flavor=delete_archive&address=$id'" />

}; 

$scrn .=  qq{ 

</div>
<br />
<div class="floatclear"></div>
}; 







my $nav_table = $archive -> make_nav_table(-Id => $id, -List => $li->{list}, -Function => "admin"); 
$scrn .=  "<center>$nav_table</center>";




    $scrn .= (admin_html_footer(-List => $list));
    
    print $scrn; 
    $c->cache('view_archive.' . $list . '.' . $id, \$scrn); 
    
    
    return; 
    
    
    
    }
}




sub display_message_source { 


    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'display_message_source');
                                                        
    $list = $admin_list; 
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $admin_list); 
    my $li = $ls->get; 
    
    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
           
    my $la = DADA::MailingList::Archives -> new(-List => $li); 
    
    
    if($la->check_if_entry_exists($q->param('id'))){
    
        if($la->can_display_message_source){ 
        
            print $q->header('text/plain'); 
            $la->print_message_source(\*STDOUT, $q->param('id')); 

        }else{

            user_error(-List => $list, -Error => "no_support_for_displaying_message_source");

        }
    
    
    } else { 
    
        user_error(-List => $list, -Error => "no_archive_entry");
    
    }    

}


sub delete_archive { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                       -Function => 'delete_archive');
                                                       
    $list = $admin_list;
    my @address = $q->param("address"); 

    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $admin_list); 
    my $li = $ls->get; 
    
    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
    
    my $archive = DADA::MailingList::Archives->new(-List => $li); 
       $archive->delete_archive(@address);
    
    print $q->redirect(-uri=>"$DADA::Config::S_PROGRAM_URL?flavor=view_archive"); 

}




sub purge_all_archives { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'purge_all_archives');

    $list = $admin_list;

    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $admin_list); 

    require  DADA::MailingList::Archives; 
    my $ah = DADA::MailingList::Archives -> new(-List => $ls->get); 

    $ah->delete_all_archive_entries(); 
    
    print $q->redirect(-uri=>$DADA::Config::S_PROGRAM_URL . '?flavor=view_archive');

}






sub archive_options { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'archive_options'); 


    $list = $admin_list; 
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $show_archives          = $q->param('show_archives')          || 0;
    my $archive_messages       = $q->param('archive_messages')       || 0; 
    my $archive_subscribe_form = $q->param('archive_subscribe_form') || 0; 
    my $archive_search_form    = $q->param('archive_search_form')    || 0; 
    my $archive_send_form      = $q->param('archive_send_form')      || 0; 
    my $send_newest_archive    = $q->param('send_newest_archive')    || 0; 
    
    
    if(!$process){ 
        
        print(admin_html_header(      
              -Title      => "Archive Options", 
              -List       => $list,
              -Root_Login => $root_login 
        ));
         
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'archive_options_screen.tmpl',
                                              -expr   => 1, 
                                              -vars   => {
                                                    list                   => $list, 
                                                    done                   => $done, 
                                                        archive_messages       => $li->{archive_messages}, 
                                                        show_archives          => $li->{show_archives}, 
                                                        archive_search_form    => $li->{archive_search_form},
                                                        archive_subscribe_form => $li->{archive_subscribe_form}, 
                                                        archive_send_form      => $li->{archive_send_form},
                                                        send_newest_archive    => $li->{send_newest_archive}, 
                                                        
                                                      },
                                             );
                                             
        print(admin_html_footer(-List => $list));

    }else{ 

        $ls->save({show_archives          => $show_archives,
                   archive_messages       => $archive_messages,
                   archive_subscribe_form => $archive_subscribe_form,
                   archive_search_form    => $archive_search_form,
                   archive_send_form      => $archive_send_form,
                   send_newest_archive    => $send_newest_archive, 
                   
                  }); 

        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=archive_options&done=1');  
    }
}




sub adv_archive_options { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'adv_archive_options');
    
    $list = $admin_list; 


    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 


    my $ls = DADA::MailingList::Settings->new(-List => $list);
    my $li = $ls->get; 
    
    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
           
    my $la = DADA::MailingList::Archives->new(-List => $li); 
    
    if(!$process) { 
    
        my @index_this = ($li->{archive_index_count},1..10,15,20,25,30,40,50,75,100);

        my $archive_index_count_menu = $q->popup_menu(-name  => 'archive_index_count',
                                                      -id    => 'archive_index_count',
                                                      -value => [@index_this]
                                                     );
                                              
        
        my $ping_sites = []; 
        push(@$ping_sites, { ping_url => $_ }) 
         foreach @$DADA::Config::PING_URLS; 
        
        my $can_use_xml_rpc = 1; 
        
        eval { require XMLRPC::Lite }; 
        if($@){ 
         $can_use_xml_rpc = 0;
        }

    my $can_use_html_scrubber = 1; 
        
        eval { require HTML::Scrubber; }; 
        if($@){ 
         $can_use_html_scrubber = 0;
        }
        
        print(admin_html_header(-Title      => "Advanced Archive Options", 
                                -List       => $list,
                                -Root_Login => $root_login));

        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'adv_archive_options_screen.tmpl', 
                                              -vars   => {
                                                     done                         => $done, 
                                                            stop_message_at_sig          => $li->{stop_message_at_sig}, 
                                                            sort_archives_in_reverse     => $li->{sort_archives_in_reverse}, 
                                                            archive_show_day             => $li->{archive_show_day}, 
                                                            archive_show_month           => $li->{archive_show_month}, 
                                                            archive_show_year            => $li->{archive_show_year}, 
                                                            archive_show_hour_and_minute => $li->{archive_show_hour_and_minute},
                                                            archive_show_second          => $li->{archive_show_second}, 
                                                            archive_index_count_menu     => $archive_index_count_menu, 
                                                            publish_archives_rss         => $li->{publish_archives_rss}, 
                                                            list                         => $list,
                                                            ping_archives_rss            => $li->{ping_archives_rss}, 
                                                            ping_sites                   => $ping_sites, 
                                                            can_use_xml_rpc              => $can_use_xml_rpc, 
                                                            html_archives_in_iframe      => $li->{html_archives_in_iframe}, 
                                                            disable_archive_js           => $li->{disable_archive_js},
                                                            can_use_html_scrubber        => $can_use_html_scrubber, 
                                                            
                                                            style_quoted_archive_text    => $li->{style_quoted_archive_text}, 
                                                            
                                                            display_attachments          => $li->{display_attachments},
                                                            
                                                            can_display_attachments      => $la->can_display_attachments,
                                                            add_subscribe_form_to_feeds  => $li->{add_subscribe_form_to_feeds}, 
                                                            
                                                            add_social_bookmarking_badges => $li->{add_social_bookmarking_badges}, 
                                                            
                                                            },
                                             );
                                  
        print(admin_html_footer(-List => $list));

    }else{ 

        my $sort_archives_in_reverse     = $q->param('sort_archives_in_reverse')     || 0;
        my $archive_show_year            = $q->param('archive_show_year')            || 0; 
        my $archive_show_month           = $q->param('archive_show_month')           || 0; 
        my $archive_show_day             = $q->param('archive_show_day')             || 0;  
        my $archive_show_hour_and_minute  = $q->param('archive_show_hour_and_minute') || 0;  
        my $archive_show_second           = $q->param('archive_show_second')          || 0; 
        my $archive_index_count           = $q->param('archive_index_count')          || 10;
        my $stop_message_at_sig           = $q->param('stop_message_at_sig')          || 0;
        my $publish_archives_rss          = $q->param('publish_archives_rss')         || 0;
        my $ping_archives_rss             = $q->param('ping_archives_rss')            || 0; 
        
        my $html_archives_in_iframe       = $q->param('html_archives_in_iframe')      || 0; 
        my $disable_archive_js            = $q->param('disable_archive_js')           || 0; 
        my $style_quoted_archive_text     = $q->param('style_quoted_archive_text')    || 0; 
        my $display_attachments           = $q->param('display_attachments')          || 0; 
        my $add_subscribe_form_to_feeds   = $q->param('add_subscribe_form_to_feeds')  || 0; 
        my $add_social_bookmarking_badges = $q->param('add_social_bookmarking_badges') || 0; 
                
        
        $ls->save({  stop_message_at_sig          => $stop_message_at_sig,
                     sort_archives_in_reverse     => $sort_archives_in_reverse,
                     archive_show_year            => $archive_show_year,
                     archive_show_month           => $archive_show_month,
                     archive_show_day             => $archive_show_day,
                     archive_show_hour_and_minute => $archive_show_hour_and_minute,
                     archive_show_second          => $archive_show_second,
                     archive_index_count          => $archive_index_count,
                     publish_archives_rss         => $publish_archives_rss, 
                     ping_archives_rss            => $ping_archives_rss, 
                     html_archives_in_iframe      => $html_archives_in_iframe, 
                     disable_archive_js           => $disable_archive_js, 
                     style_quoted_archive_text    => $style_quoted_archive_text, 
                     display_attachments          => $display_attachments, 
                     add_subscribe_form_to_feeds  => $add_subscribe_form_to_feeds, 
                     add_social_bookmarking_badges => $add_social_bookmarking_badges, 
                  });

        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=adv_archive_options&done=1'); 
        
    }
}




sub edit_archived_msg {
    
    require DADA::Template::HTML; 
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle;

    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;

    require DADA::Mail::Send; 
    
    require MIME::Parser;
    
    my $parser = new MIME::Parser; 
       $parser = optimize_mime_parser($parser); 
        
    my $skel = []; 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                        -Function => 'edit_archived_msg');
    my $list = $admin_list; 
    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
             
    my $li = $ls->get; 
    
    my $mh = DADA::Mail::Send->new($li);
    my $ah = DADA::MailingList::Archives->new(-List => $li); 
    
    edit_archived_msg_main();
    #---------------------------------------------------------------------#
    
    sub edit_archived_msg_main { 
        
        if($q->param('process') eq 'prefs'){ 
            &prefs; 
        }else{ 
        
            if($q->param('process')){    
                &edit_archive; 
            }else{ 
                &view;    
            }
        }
    }
    
    
    sub view { 
    
    
        my $D_Content_Types = [
        'text/plain', 
        'text/html'
        ];
        
        my %Headers_To_Edit;
    
       my $parser = new MIME::Parser; 
       $parser = optimize_mime_parser($parser); 
       
        my $id = $q->param('id');
        
        if(!$id){ 
            print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=view_archive'); 
            exit; 
        }
            
        if($ah->check_if_entry_exists($id) <= 0){
            print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=view_archive'); 
            exit; 
        }
                
                
        my ($subject, $message, $format, $raw_msg) = $ah->get_archive_info($id); 
        
        # do I need this?
        $raw_msg ||= $ah->_bs_raw_msg($subject, $message, $format); 
        $raw_msg =~ s/Content\-Type/Content-type/; 
        
        
        
        print(admin_html_header(-Title      => "Edit Archived Message",
                                -List       => $li->{list},
                                -Form       => 0,
                                -Root_Login => $root_login));
        
        if($q->param('done')){
            print $DADA::Config::GOOD_JOB_MESSAGE;
        }
        
        if($ah->can_display_message_source){ 
        
            print qq{<p style="text-align:right">
                    <a href="$DADA::Config::S_PROGRAM_URL?f=display_message_source&amp;id=$id" target="_blank"> 
                     Display Original Message Source
                    </a>
                   </p>}; 
        
        }
        
        
        
        print qq{<form action="$DADA::Config::S_PROGRAM_URL" enctype="multipart/form-data" method="post">
                 <input type="hidden" name="f" value="edit_archived_msg" /> 
                 
        }; 
        
        my $entity; 
        
        eval { $entity = $parser->parse_data($raw_msg) };
        
        make_skeleton($entity);
            
            
        foreach(split(',', $li->{editable_headers})){ 
            $Headers_To_Edit{$_} = 1; 
        }
        
        foreach my $tb(@$skel){
        
            my @c = split('-', $tb->{address}); 
            my $bqc = $#c -1; 
            
            for(0..$bqc){ print '<div style="padding-left: 30px; border-left:1px solid #ccc">'; }
        
    
            if($tb->{address} eq '0'){ 
                print '<table width="100%">'; 
    
                # head of the message!  
                my %headers = $mh->return_headers($tb->{entity}->head->original_text); 
                foreach my $h(@DADA::Config::EMAIL_HEADERS_ORDER){ 
                    if($headers{$h}){ 
                        if($Headers_To_Edit{$h} == 1){ 
                            print '<tr><td>'; 
                            print $q->p($q->label({'-for' => $h}, $h . ': '));
                            print '</td><td width="99%">'; 
                            
                            if($DADA::Config::ARCHIVE_DB_TYPE eq 'Db' && $h eq 'Content-type'){ 
                                push(@{$D_Content_Types}, $headers{$h});   
                                print $q->p($q->popup_menu('-values' => $D_Content_Types, -id => $h, -name => $h, -default => $headers{$h})); 
                            }else{ 
                                print $q->p($q->textfield(-value => $headers{$h}, -id => $h, -name => $h, -class => 'full')); 
                            }
                            
                            print '</td></tr>'; 
                        }
        
        
                    }
        
                }
                print '</table>'; 
            }
            my ($type, $subtype) = split('/', $tb->{entity}->head->mime_type);
            
    
            print $q->p($q->strong('Content Type: '), $tb->{entity}->head->mime_type); 
    
            if($tb->{body}){ 
    
                if ($type =~ /^(text|message)$/ && $tb->{entity}->head->get('content-disposition') !~ m/attach/i) {     # text: display it...
                    
                    #$q->checkbox(-name => 'delete_' . $tb->{address}, -value => 1, -label => '' ), 'Delete?', $q->br(),
                
                if ($subtype =~ /html/ && $DADA::Config::FCKEDITOR_URL){ 
                    
                        require DADA::Template::Widgets;
                        print DADA::Template::Widgets::screen(-screen => 'edit_archived_msg_textarea.widget', 
                                                              -vars   => {
                                                                            name  => $tb->{address},
                                                                            value => js_enc($tb->{entity}->bodyhandle->as_string()),
                                                              }
                                                             );                
                    }else{ 
                    
                        print $q->p($q->textarea(-value => $tb->{entity}->bodyhandle->as_string, -rows => 15, -name => $tb->{address}));
                    
                    }
            
                }else{ 
                
                    
                    print '<div style="border: 1px solid #000;padding: 5px">';
                                    
                    my $name = $tb->{entity}->head->mime_attr("content-type.name") || 
                               $tb->{entity}->head->mime_attr("content-disposition.filename"); 
    
                    my $attachment_url;
                    
                    if($name){ 
                        $attachment_url = $DADA::Config::S_PROGRAM_URL . '?f=file_attachment&l=' . $list . '&id=' . $id . '&filename=' . $name . '&mode=inline';
                    }else{ 
    
                        $name ='Untitled.'; 
                        
                        my $m_cid = $tb->{entity}->head->get('content-id'); 
                           $m_cid =~ s/^\<|\>$//g;
               
                        $attachment_url = $DADA::Config::S_PROGRAM_URL . '?f=show_img&l=' . $list . '&id=' . $id . '&cid=' . $m_cid;
    
                    }
                    
                    print $q->p($q->strong('Attachment: ' ), $q->a({-href => $attachment_url, -target => '_blank'}, $name)); 
                    
                    print '<table style="padding:5px">'; 
                    
                    print '<tr><td>'; 
                    
                    if($type =~ /^image/ && $subtype =~ m/gif|jpg|jpeg|png/){ 
                        print $q->p($q->a({-href => $attachment_url, -target => '_blank'}, $q->img({-src => $attachment_url, -width => '100'}))); 
                    }else{ 
                        #print $q->p($q->a({-href => $attachment_url, -target => '_blank'}, $q->strong('Attachment: ' ), $q->a({-href => $attachment_url, -target => '_blank'}, $name)));
                    }
                    print '</td><td>'; 
                    
                    print $q->p($q->checkbox(-name => 'delete_' . $tb->{address}, -id => 'delete_' . $tb->{address}, -value => 1, -label => '' ), $q->label({'-for' => 'delete_' . $tb->{address}}, 'Remove From Message')); 
                    print $q->p($q->strong('Update:'), $q->filefield(-name => 'upload_' . $tb->{address})); 
                    
                    print '</td></tr></table>';
                    
                    print '</div>';
                    
                    
                }
            }
            
            for(0..$bqc){ print '</div>'; }
        }
        
        #footer
        
        print $q->hidden('process' , 1); 
        print $q->hidden('id', $id); 
    
        print qq{
        
        <hr /> 
        
        <p><a href="$DADA::Config::S_PROGRAM_URL?flavor=view_archive&id=$id">&lt;-- View Saved Message</a></p>
        
        <div class="buttonfloat">
         <input type="reset" class="cautionary"  value="Clear Changes" />
         <input type="submit" class="processing" value="Save Changes" />
        </div>
        <br />
        <div class="floatclear"></div>
        
        }; 
    
        print '</form>'; 
        
        print qq{<p style="text-align:right"><a href="$DADA::Config::S_PROGRAM_URL?flavor=edit_archived_msg&process=prefs&id=$id">Archive Editor Preferences...</a></p>};
        print admin_html_footer(-List => $list, -Form => 0); 
    
    }
    
    
    
    
    sub prefs { 
    
        if($q->param('process_prefs')){ 
        
            my $the_id = $q->param('id'); 
    
            my $editable_headers = join(',', $q->param('editable_header')); 
            $ls->save({editable_headers => $editable_headers}); 
            
            print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?f=edit_archived_msg&process=prefs&done=1&id=' . $the_id); 
            exit; 
            
            
        }else{ 
        
        my %editable_headers; 
           $editable_headers{$_} = 1 foreach(split(',', $li->{editable_headers}));
           
        my $edit_headers_menu = [];  
        foreach(@DADA::Config::EMAIL_HEADERS_ORDER){ 
            
            push(@$edit_headers_menu, {name => $_, editable => $editable_headers{$_}});
        }
        
        
        
    
        print(admin_html_header(-Title      => "Edit Archived Message Preferences",
                                -List       => $li->{list},
                                -Form       => 0,
                                -Root_Login => $root_login));
        
    my $the_id = $q->param('id'); 
    my $done   = $q->param('done'); 
    
    
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen   => 'edit_archived_msg_prefs_screen.tmpl', 
                                              -vars     => {
                                                            edit_headers_menu => $edit_headers_menu,
                                                            done              => $done, 
                                                            id                => $the_id, 
                                                      },
                                             );
    
        print admin_html_footer(-List => $list, -Form => 0); 
    
        }
    
        
    }
    
    sub edit_archive { 
    
        
        my $id = $q->param('id'); 
        
        my $parser = new MIME::Parser; 
        $parser = optimize_mime_parser($parser); 
       
        my ($subject, $message, $format, $raw_msg) = $ah->get_archive_info($id); 
        
        $raw_msg ||= $ah->_bs_raw_msg($subject, $message, $format); 
        $raw_msg =~ s/Content\-Type/Content-type/; 
    
        my $entity; 
        
        eval { $entity = $parser->parse_data($raw_msg) };
    
        my $throwaway = undef; 
        
        ($entity, $throwaway) = edit($entity);
        
        
        # not sure if this, "if" is needed.
        if($DADA::Config::ARCHIVE_DB_TYPE eq 'Db'){ 
            $ah->set_archive_info($id, $entity->head->get('Subject', 0), undef, $entity->head->get('Content-type', 0), $entity->as_string); 
        }else{ 
        
            $ah->set_archive_info($id, $entity->head->get('Subject', 0), undef, undef, $entity->as_string); 
        }
        
        
        print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?f=edit_archived_msg;id=' . $id . '&done=1'); 
        
    
    }
    
    sub make_skeleton {
        my ($entity, $name) = @_;
        defined($name) or $name = "0";
        
        my $IO;
        # Output the body:
        my @parts = $entity->parts;
        if (@parts) {             
        
            push(@$skel, {address => $name, entity => $entity}); 
    
            # multipart... 
            my $i;
            foreach $i (0 .. $#parts) {       # dump each part...
                make_skeleton($parts[$i], ("$name\-".($i)));
            }
            
    
        }else {                            # single part...    
            push(@$skel, {address => $name, entity => $entity, body => 1}); 
    
        }
    }
    
    
    
    
    sub edit { 
    
        my ($entity, $name) = @_;
        defined($name) or $name = "0";
        my $IO;
        
        my %Headers_To_Edit;
    
        if($name eq '0'){ 
        
            foreach(split(',', $li->{editable_headers})){ 
                $Headers_To_Edit{$_} = 1; 
            }
        
            foreach my $h(@DADA::Config::EMAIL_HEADERS_ORDER){ 
                if($Headers_To_Edit{$h} == 1){                
                    $entity->head->replace($h, $q->param($h)); 
                }
            }
        }
        
        
        
        my @parts = $entity->parts;
        if (@parts) {             
        
            # multipart... 
            my $i;
            foreach $i (0 .. $#parts) {       
                
                my $name_is; 
                
                # I don't understand this part...
                ($parts[$i], $name_is) = edit($parts[$i], ("$name\-".($i)));
                
                if($q->param('delete_' . $name_is) == 1){ 
                     splice(@parts, $i, 0);

                    #delete($parts[$i]);
                }
            }
            #love it. #love it love it. 
            $entity->parts(\@parts);                           
            $entity->sync_headers('Length'      =>  'COMPUTE',
                                  'Nonstandard' =>  'ERASE');
            
        }else {                             
            
            return (undef, $name) if($q->param('delete_' . $name) == 1);
        
            my $content = $q->param($name); 
            if($content){            
                   my $body    = $entity->bodyhandle;
                   my $io = $body->open('w');
                      $io->print( $content );
                      $io->close;
            
            }
                
            my $cid = $entity->head->get('content-id') || undef; 
            
            if($q->param('upload_' . $name)){ 
                $entity = get_from_upload($name,  $cid); 
            }
            
            $entity->sync_headers('Length'      =>  'COMPUTE',
                                  'Nonstandard' =>  'ERASE');
    
            return ($entity, $name); 
            
        }
        
        return ($entity, $name); 
    
     }
     
     
     
     
     sub get_from_upload {  
    
        my $name = shift;
        my $cid  = shift; 
        
        my $filename = file_upload('upload_' . $name); 
        my $data; 
        
        my $nice_filename = $q->param('upload_' . $name);
    
        require MIME::Entity; 
        my $ent = MIME::Entity->build(
                                      Path        => $filename,
                                      Filename    => $nice_filename, 
                                      Encoding    => "base64",
                                      Disposition => "attachment",
                                      Type        => find_attachment_type($filename), 
                                      Id          => $cid, 
                                     );
        return $ent; 
        
     }
 
}




sub html_code { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'html_code');

    $list = $admin_list; 
    
    print(admin_html_header(-Title      => "Cut-and-Paste Code", 
                            -List       => $list,
                            -Root_Login => $root_login,
                            -Form       => 0, 
                            
                           ));
    
    require DADA::Template::Widgets;
    print DADA::Template::Widgets::screen(-screen => 'html_code_screen.tmpl',
                                          -vars   => { 
                                            list => $list,   
                                          }
                                        );
    
    print(admin_html_footer(-List => $list, -Form => 0));
    
}




sub edit_template {

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,                                     
                                                        -Function => 'edit_template');

    $list = $admin_list; 

    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $default_template = default_template($DADA::Config::PROGRAM_URL); 
    
    
    if(!$process) { 
            
        my $edit_this_template = $default_template . "\n";
           $edit_this_template = open_template(-List => $list) . "\n"
            if check_if_template_exists( -List => $list ) >= 1; 

        my $get_template_data_from_default_template = 0; 
           $get_template_data_from_default_template = 1
            if $li->{get_template_data} eq 'from_default_template';
            

        my $get_template_data_from_template_file = 0; 
           $get_template_data_from_template_file = 1
            if $li->{get_template_data} eq 'from_template_file';

        my $get_template_data_from_url = 0; 
           $get_template_data_from_url = 1
            if $li->{get_template_data} eq 'from_url';

        my $can_use_lwp_simple; 
        eval { require LWP::Simple; };
        $can_use_lwp_simple = 1    
            if !$@; 
            
        
        my $template_url_check = 1;
        
        if($get_template_data_from_url == 1){ 
        
            if($can_use_lwp_simple == 1){ 
            
                if(LWP::Simple::get($li->{url_template})){ 
                    # ...
                } else { 
                
                $template_url_check = 0; 
                
                }
            }   
        }        
        
        print(admin_html_header(-Title      => "Edit the List Template", 
                                -List       => $li->{list},
                                -Root_Login => $root_login,
                                -Form       => 0, 
                                ));

        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'edit_template_screen.tmpl', 
                                              -vars   => {
                                                            done                                    => $done,
                                                            edit_this_template                      => $edit_this_template, 
                                                            get_template_data                       => $li->{get_template_data}, 
                                                            get_template_data_from_url              => $get_template_data_from_url, 
                                                            get_template_data_from_template_file    => $get_template_data_from_template_file, 
                                                            get_template_data_from_default_template => $get_template_data_from_default_template, 
                                                            can_use_lwp_simple                      => $can_use_lwp_simple, 
                                                            url_template                            => $li->{url_template}, 
                                                            default_template                        => $default_template, 
                                                            apply_list_template_to_html_msgs        => $li->{apply_list_template_to_html_msgs}, 
                                                            
                                                            template_url_check                      => $template_url_check, 
                                                            
                                                          },
                                            );

        print(admin_html_footer(-List => $list, -Form => 0));
 
    }else{ 
        
        if($process eq "preview template")  {
            
                my $template_info;
                my $test_header;
           my $test_footer;
        
            if($q->param('get_template_data') eq 'from_url'){ 
                eval {require LWP::Simple;};
                if(!$@){ 
                    $template_info = LWP::Simple::get($q->param('url_template'));
                    ($test_header, $test_footer) = split(/\[dada\]/,$template_info);
                }    
            }else{  
                $template_info = $q->param("template_info"); 
                ($test_header, $test_footer) = split(/\[dada\]/,$template_info);
            }
            print $q->header();
            
            for($test_header, $test_footer) { 
                s/\[program_name\]/$DADA::Config::PROGRAM_NAME/g; 
                s/\[program_url\]/$DADA::Config::PROGRAM_URL/g;
            }
            
            
            my $default_css = default_css();
            
            $test_header =~ s/<\!--\[default_css\]-->/$default_css/g;
            $test_header =~ s/\[default_css\]/$default_css/g;

            $test_header =~ s/\[message\]/preview of template/g; 
            $test_header =~ s/\[version\]/$DADA::Config::VER/g; 
            print $test_header; 
            print "<p>This is a <strong>preview</strong> (read: not saved!!!!) of your template.</p><p>To save or edit, close this window and hit the <strong>Change Template</strong> button.</p><p>&nbsp;</p>"; 
            
            $test_footer =~ s/\[message\]/preview of template/g; 
            $test_footer =~ s/\[version\]/$DADA::Config::VER/g; 
            
            
            print $test_footer; 

        }else{
        


            my $template_info     = $q->param("template_info"); 
                        
            my $get_template_data = $q->param("get_template_data") || '';
            my $url_template      = $q->param('url_template')      || ''; 
            my $apply_list_template_to_html_msgs = $q->param('apply_list_template_to_html_msgs') || 0;    
            
            require DADA::MailingList::Settings;
                   $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    
            $ls->save({
                       apply_list_template_to_html_msgs => $apply_list_template_to_html_msgs, 
                       url_template                     => $url_template,
                       get_template_data                => $get_template_data,
                       });
                       
            make_template({-List => $list, -Template  => $template_info});
            
            $c->flush;
            
            print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=edit_template&done=1');
            return;
        }
    }
}




sub back_link { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'back_link');

    $list = $admin_list;

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
        
    if(!$process){ 
    
        print(admin_html_header(-Title      => "Create a Back Link", 
                                -List       => $list,
                                -Root_Login => $root_login));
    
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'back_link_screen.tmpl',
                                                -list   => $list,
                                                -vars   => { 
                                                                website_name => $li->{website_name}, 
                                                                website_url  => $li->{website_url}, 
                                                                done         => (($q->param('done')) ? ($q->param('done')) : (0)), 
                                                           },
                                                ); 
        print(admin_html_footer(-List => $list));

    }else{ 

        my $website_name = $q->param("website_name") || ''; 
        my $website_url  = $q->param("website_url")  || ''; 
         
        $ls->save({website_name  =>   $website_name,
                   website_url   =>   $website_url,
                 });
                 
        print $q->redirect(-uri=>$DADA::Config::S_PROGRAM_URL . '?flavor=back_link&done=1'); 
    }
}




sub edit_type {

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'edit_type');
    $list = $admin_list; 
    
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    if(!$process){ 

        print(admin_html_header(-Title      => "Customize Email Messages", 
                                -List       => $list,
                                -Root_Login => $root_login));
        
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'edit_type_screen.tmpl',
                                            -list   => $list,
                                            -vars   => { 
                                                        wrap                        => $wrap,
                                                        text_area_style             => $text_area_style, 
                                                        done                        => $done, 
                                                        confirmation_message        => $li->{confirmation_message}, 
                                                        unsub_confirmation_message  => $li->{unsub_confirmation_message}, 
                                                        subscribed_message          => $li->{subscribed_message}, 
                                                        unsubscribed_message        => $li->{unsubscribed_message}, 
                                                        mailing_list_message        => $li->{mailing_list_message}, 
                                                        mailing_list_message_html   => $li->{mailing_list_message_html}, 
                                                        not_allowed_to_post_message => $li->{not_allowed_to_post_message}, 
                                                        send_archive_message        => $li->{send_archive_message},
                                                        send_archive_message_html   => $li->{send_archive_message_html}, 
                                                        
                                                        you_are_already_subscribed_message => $li->{you_are_already_subscribed_message}, 
                                                        
                                                        email_your_subscribed_msg           => $li->{email_your_subscribed_msg}, 
                                                        
                                                        },
                                                ); 
        print(admin_html_footer(-List => $list));

    }else{ 
    
    
        my $confirmation_message        = $q->param('confirmation_message')           || ''; 
        my $unsub_confirmation_message  = $q->param('unsub_confirmation_message')  || '';  
        my $subscribed_message          = $q->param('subscribed_message')          || '';   
        my $unsubscribed_message        = $q->param('unsubscribed_message')           || ''; 
        my $mailing_list_message        = $q->param('mailing_list_message')        || ''; 
        my $mailing_list_message_html   = $q->param('mailing_list_message_html')   || ''; 
        my $send_archive_message        = $q->param('send_archive_message')        || ''; 
        my $send_archive_message_html   = $q->param('send_archive_message_html')   || ''; 
        my $not_allowed_to_post_message = $q->param('not_allowed_to_post_message') || ''; 
        
        my $you_are_already_subscribed_message = $q->param('you_are_already_subscribed_message') || '';
        
        for(
            $subscribed_message,
            $unsubscribed_message,
            $unsubscribed_message,
            $confirmation_message,
            $unsub_confirmation_message, 
            $mailing_list_message,
            $mailing_list_message_html,
            $not_allowed_to_post_message,
            $send_archive_message,
            $send_archive_message_html,
            $you_are_already_subscribed_message, 
            
          ){
            s/\r\n/\n/g;
          
            # a very odd place to put this, but, hey,  easy enough. 
            if($q->param('revert')){ 
               $_ = undef; 
            }
          }
                    
        $ls->save({ 
                subscribed_message           =>   $subscribed_message,
                unsubscribed_message         =>   $unsubscribed_message,
                confirmation_message         =>   $confirmation_message,
                unsub_confirmation_message   =>   $unsub_confirmation_message,
                mailing_list_message         =>   $mailing_list_message,
                mailing_list_message_html    =>   $mailing_list_message_html,
                not_allowed_to_post_message  =>   $not_allowed_to_post_message,
                send_archive_message         =>   $send_archive_message,
                send_archive_message_html    =>   $send_archive_message_html,
                
                you_are_already_subscribed_message => $you_are_already_subscribed_message, 
                
                  });
                  
        print $q->redirect(-uri=>$DADA::Config::S_PROGRAM_URL . '?flavor=edit_type&done=1'); 
    
    }
}




sub edit_html_type { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                        -Function => 'edit_html_type');
    $list = $admin_list; 

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 


    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 


    if(!$process){ 
    
        print(admin_html_header(-Title      => "Customize HTML Messages", 
                                -List       => $list,
                                -Root_Login => $root_login));

        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'edit_html_type_screen.tmpl',
                                                -list   => $list,
                                                -vars   => { 
                                                            done                            => $done,  
                                                            html_confirmation_message       => $li->{html_confirmation_message},
                                                            html_unsub_confirmation_message => $li->{html_unsub_confirmation_message}, 
                                                            html_subscribed_message         => $li->{html_subscribed_message}, 
                                                            html_unsubscribed_message       => $li->{html_unsubscribed_message}, 
                                                        },
                                                ); 
        print(admin_html_footer(-List => $list));

    }else{ 


        my $html_confirmation_message       = $q->param('html_confirmation_message')       || ''; 
        my $html_unsub_confirmation_message = $q->param('html_unsub_confirmation_message') || '';
        my $html_subscribed_message         = $q->param('html_subscribed_message')         || '';
        my $html_unsubscribed_message       = $q->param('html_unsubscribed_message')       || '';


        for($html_confirmation_message,
            $html_unsub_confirmation_message,
            $html_subscribed_message,
            $html_unsubscribed_message){
                s/\r\n/\n/g;
            } 

        $ls->save({ 
                    html_confirmation_message         =>   $html_confirmation_message,
                    html_unsub_confirmation_message   =>   $html_unsub_confirmation_message, 
                    html_subscribed_message           =>   $html_subscribed_message,
                    html_unsubscribed_message         =>   $html_unsubscribed_message
                  });

        print $q->redirect(-uri=>"$DADA::Config::S_PROGRAM_URL?flavor=edit_html_type&done=1"); 
    }
}




sub manage_script { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'manage_script');
    
       $list                = $admin_list; 
    my $more_info           = $q->param('more_info') || 0;
    my $sendmail_locations    =`whereis sendmail`;
    my $at_incs             = []; 
    push(@$at_incs, {name => $_}) 
        foreach(@INC); 
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    
    
    print(admin_html_header(-Title      => "About $DADA::Config::PROGRAM_NAME", 
                            -List       => $li->{list},
                            -Root_Login => $root_login));
    
        require DADA::Template::Widgets;
        print   DADA::Template::Widgets::screen(-screen => 'manage_script_screen.tmpl', 
                                                -list   => $list, 
                                                -vars   => 
                                                { 
                                                    more_info          => $more_info, 
                                                    smtp_server        => $li->{smtp_server}, 
                                                    server_software    => $q->server_software(), 
                                                    operating_system   => $^O,
                                                    perl_version       => $], 
                                                    sendmail_locations => $sendmail_locations, 
                                                    at_incs            => $at_incs, 
                                                    list_owner_email   => $li->{list_owner_email},
    
                                                },
                                                ); 
                                                
    print(admin_html_footer(-List => $list));
     
}




sub feature_set { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'feature_set');
    $list = $admin_list; 
    
    require  DADA::MailingList::Settings; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 

    require DADA::Template::Widgets::Admin_Menu; 
    
    if(!$process){ 

    my $feature_set_menu = DADA::Template::Widgets::Admin_Menu::make_feature_menu($li); 
    
        print(admin_html_header(-Title      => "Customize Feature Set", 
                                -List       => $li->{list},
                                -Root_Login => $root_login,
                                -Start_Form => 0, ));
        
        

        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'feature_set_screen.tmpl', 
                                              
                                              -vars   => {
                                                       done             => (defined($done)) ? 1 : 0,
                                                       feature_set_menu => $feature_set_menu,
                                                       disabled_screen_view_hide     => ($li->{disabled_screen_view} eq 'hide')     ? 1 : 0, 
                                                       disabled_screen_view_grey_out => ($li->{disabled_screen_view} eq 'grey_out') ? 1 : 0, 
                                                       
                                                       
                                                       
                                                      },
                                             );        
        print(admin_html_footer(-List => $list, -End_Form   => 0));
    
    }else{ 
        
        my @params = $q->param; 
        my %param_hash; 
        foreach(@params){
            next if $_ eq 'disabled_screen_view'; # special case.
            $param_hash{$_} = $q->param($_);
        }    
        
            my $save_set = DADA::Template::Widgets::Admin_Menu::create_save_set(\%param_hash);        
            
            my $disabled_screen_view = $q->param('disabled_screen_view'); 
            
            $ls->save({ 
                        admin_menu           => $save_set,
                        disabled_screen_view => $disabled_screen_view, 
                      });

            print $q->redirect(-uri=>"$DADA::Config::S_PROGRAM_URL?flavor=feature_set&done=1"); 
        }
}




sub subscribe { 
    
    my %args = (-html_output => 1, @_);
        
    my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);
    
    if($args{-html_output} != 0){         
    
        if($list_exists == 0){ 
            $q->param('error_invalid_list', 1); 
            &default;
            return; 
        }
        if (!$email){ 
            $set_flavor = 's'; 
            $q->param('error_no_email', 1); 
            list_page(); 
            return; 
        }
    }

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $lh = DADA::MailingList::Subscribers->new(-List => $list); 
    
    my $li = $ls->get(-Format => "replaced");
    
    $email = lc_email($email);


    if($li->{no_confirm_email}  == "0"){    
        $pin = make_pin(-Email => $email);  
        confirm(-html_output => $args{-html_output}); 
        return; 
        
        # Note! return - no do anything more!!!
    }
    
    
    
    my ($status, $errors) = $lh->subscription_check(-Email => $email, 
                                                    ($li->{allow_blacklisted_to_subscribe} == 1) ? 
                                                    (
                                                    -Skip  => ['blacklisted'], 
                                                    ) : (), 
                                                    ); 

     my $mail_your_subscribed_msg = 0; 
     if($li->{email_your_subscribed_msg} == 1){ 
        if($errors->{subscribed} == 1){ 
            my @num = keys %$errors; 
            if($#num == 0){ # meaning, "subscribed" is the only error...
                # Don't Treat as an Error
                $status = 1; 
                # But send a private error message out...
                $mail_your_subscribed_msg = 1; 
            }
        }
    }    
    

    if($status == 0){ 
    
        if($args{-html_output} != 0){ 
        
            if(($li->{use_alt_url_sub_confirm_failed} == 1) && ($li->{alt_url_sub_confirm_failed} ne "")){ 
            
                my $qs = ''; 
                if($li->{alt_url_sub_confirm_failed_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=sub_confirm&status=0&email=' . DADA::App::Guts::uriescape($email);
                    $qs .= '&errors=' . $_ foreach keys %$errors; 
                }
                
                print $q->redirect(-uri => $li->{alt_url_sub_confirm_failed} . $qs); 
                return;
                
            }else{                
               
                user_error(-List => $list, -Error => "invalid_email",                 -Email => $email) if $errors->{invalid_email}                 == 1;
                user_error(-List => $list, -Error => "mx_lookup_failed",              -Email => $email) if $errors->{mx_lookup_failed}              == 1;
                user_error(-List => $list, -Error => "email_in_list",                 -Email => $email) if $errors->{subscribed}                    == 1;  
                user_error(-List => $list, -Error => "closed_list",                   -Email => $email) if $errors->{closed_list}                   == 1;  
                user_error(-List => $list, -Error => "over_subscription_quota",       -Email => $email) if $errors->{over_subscription_quota}       == 1;  
                user_error(-List => $list, -Error => "black_listed",                  -Email => $email) if $errors->{blacklisted}                   == 1;  
                user_error(-List => $list, -Error => "not_white_listed",              -Email => $email) if $errors->{not_white_listed}              == 1;  
                user_error(-List => $list, -Error => "settings_possibly_corrupted",   -Email => $email) if $errors->{settings_possibly_corrupted}   == 1;  
                user_error(-List => $list, -Error => "already_sent_sub_confirmation", -Email => $email) if $errors->{already_sent_sub_confirmation} == 1;  
                
                # If all else fails.
                user_error(-List => $list, -Email => $email);
                return;
            }            
        }
        
    }else{ 
        
        if($mail_your_subscribed_msg == 0){ 
        
            require DADA::App::Messages;
            DADA::App::Messages::send_confirmation_message(-List         => $list, 
                                                           -Email        => $email, 
                                                           -Settings_obj => $ls, 
                                                          ); 
        }else{ 
            require DADA::App::Messages;
            DADA::App::Messages::send_generic_email(
                                                    -List         => $list, 
                                                    -Email        => $email, 
                                                    -Settings_obj => $ls, 
                                                    -Subject      => $li->{list_name} . ' Mailing List Confirmation - Already Subscribed', 
                                                    -Message      => $li->{you_are_already_subscribed_message}, 
                                                    
                                                   );
        
        
        }
        
        
        if($li->{limit_sub_confirm } == 1){ 
                             
             # Doesn't seem possible, can you actually get here if you're on this list?!
             my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'sub_confirm_list');
    
              $lh->add_to_email_list(-Email_Ref => [$email],
                                     -Type      => 'sub_confirm_list',);           
        }
        
        
        if($args{-html_output} != 0){         
            if(($li->{use_alt_url_sub_confirm_success} == 1) && ($li->{alt_url_sub_confirm_success} ne "")){ 
                my $qs = ''; 
                if($li->{alt_url_sub_confirm_success_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=sub_confirm&status=1&email=' . DADA::App::Guts::uriescape($email); 
                }
                print $q->redirect(-uri => $li->{alt_url_sub_confirm_success} . $qs); 
                return;        
            }else{ 
    
                print(the_html(-Part  => "header",
                               -Title => "Please Confirm",
                               -List  => $li->{list}));
                               
                $li->{html_confirmation_message} =~ s/\[subscriber_email\]/$email/g; 
                
                print $li->{html_confirmation_message}; 
                
                print(the_html(-Part      => "footer", 
                               -List      => $li->{list},
                               -Site_Name => $li->{website_name}, 
                               -Site_URL  => $li->{website_url}));
            
                return; 
            }
        }
    }
}




sub subscribe_flash_xml { 
        
    if($q->param('test') == 1){ 
        print $q->header('text/plain'); 
    }else{ 
        print $q->header('application/x-www-form-urlencoded'); 
    }
    
    if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 0){ 
        #note! This should be handled in the subscription_check_xml() method, 
        # but this object *also* checks to see if a list is real. Chick/Egg
        print '<subscription><email>' . $email . '</email><status>0</status><errors><error>no_list</error></errors></subscription>';
    }else{ 
        my $lh = DADA::MailingList::Subscribers->new(-List => $list); 
        my ($xml, $status, $errors) =  $lh->subscription_check_xml(-Email => $email); 
        print $xml;
    
        if($status == 1){ 
            subscribe(-html_output => 0); 
        }
    }
}




sub unsubscribe_flash_xml { 
        
    if($q->param('test') == 1){ 
        print $q->header('text/plain'); 
    }else{ 
        print $q->header('application/x-www-form-urlencoded'); 
    }
    
    if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 0){ 
        print '<unsubscription><email>' . $email . '</email><status>0</status><errors><error>no_list</error></errors></unsubscription>';
    }else{ 
        my $lh = DADA::MailingList::Subscribers->new(-List => $list); 
        my ($xml, $status, $errors) =  $lh->unsubscription_check_xml(-Email => $email); 
        print $xml;
        
        if($status == 1){ 
            unsubscribe(-html_output => 0); 
        }    
    }
}




sub unsubscribe { 

    my %args = (-html_output => 1, @_); 
    
    # If the list doesn't exist, don't go through the process, 
    # Just go to the default page, 
    # Set the flavor to, "unsubscribe"
    # And give a word out that the list ain't there: 
    
    if($args{-html_output} != 0){ 
    
        if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 0){    
            
            $set_flavor = 'u'; 
            $q->param('error_invalid_list', 1); 
            &default; 
            return;        
        }
    
        # If the list is there, 
        # but there's no email already filled out, 
        # state that an email needs to be filled out
        # and show the list page. 
        
        if (!$email){                                    
            $set_flavor = 'u'; 
            $q->param('error_no_email', 1); 
            list_page();
            return;
        }

    }
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get(-Format => "replaced"); 

    # Basically, if double opt out is turn off, 
    # make up a pin
    # and confirm the unsub from there
    # This *still* does error check the unsub request
    # just in a different place. 
  
    if($li->{unsub_confirm_email} != 1){  
            $pin = make_pin(-Email => $email);
            &unsub_confirm(-html_output => $args{-html_output}); #we'll change this one later...
            return;
     }       
 
    # If there's already a pin, 
    # (that we didn't just make) 
    # Confirm the unsubscription
    if($pin){
        unsub_confirm(-html_output => $args{-html_output}); #we'll change this one later...
        return;
    }
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);

    my ($status, $errors) = $lh->unsubscription_check(-Email => $email, -Skip => ['no_list']);
        
    # If there's any problems, handle them. 
    if($status == 0){ 
    
        if($args{-html_output} != 0){ 
        
            # URL redirect?
            if(($li->{use_alt_url_unsub_confirm_failed} == 1) && ($li->{alt_url_unsub_confirm_failed} ne "")){ 
                
                my $qs = ''; 
                # With a query string?
                if($li->{alt_url_unsub_confirm_failed_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=unsub_confirm&status=0&email=' . DADA::App::Guts::uriescape($email); 
                    $qs .= '&errors=' . $_ foreach keys %$errors; 
                }
                print $q->redirect(-uri => $li->{alt_url_unsub_confirm_failed} . $qs);
                return; 
                
            }else{        
                # If not, show the correct error screen. 
                user_error(-List => $list, -Error => "unsub_invalid_email",             -Email => $email)  if $errors->{invalid_email}    == 1;
                user_error(-List => $list, -Error => "email_not_in_list",               -Email => $email)  if $errors->{not_subscribed}   == 1;    
                user_error(-List => $list, -Error => "settings_possibly_corrupted",     -Email => $email)  if $errors->{settings_possibly_corrupted} == 1;
                user_error(-List => $list, -Error => "already_sent_unsub_confirmation", -Email => $email)  if $errors->{already_sent_unsub_confirmation}   == 1;  
                
                # If all else fails.
                user_error(-List => $list, -Email => $email);
                
            }
        }
    }else{    # Else, the unsubscribe request was OK, 
     
        # Send the URL with the unsub confirmation URL:
        require DADA::App::Messages;    
        DADA::App::Messages::send_unsub_confirm_email(
                                                      -List         => $list, 
                                                      -Email        => $email, 
                                                      -Settings_obj => $ls,
                                                     );
        
        # Limit unsubscriptions, means that we don't keep sending unsub requests. 
        if($li->{limit_unsub_confirm } == 1){ 
                         
             # Doesn't seem possible, can you actually get here if you're on this list?!
             my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'unsub_confirm_list');
             
              $lh->add_to_email_list(
                  -Email_Ref => [$email],
                  -Type      => 'unsub_confirm_list',
              );
        } 
    
        if($args{-html_output} != 0){ 
        
            # Redirect?
            if(($li->{use_alt_url_unsub_confirm_success} == 1) && ($li->{alt_url_unsub_confirm_success} ne "")){ 
            
                # With... Query String?
                my $qs = ''; 
                if($li->{use_alt_url_unsub_confirm_success_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=unsub_confirm&status=1&email=' . DADA::App::Guts::uriescape($email); 
                }
                print $q->redirect(-uri => $li->{alt_url_unsub_confirm_success} . $qs);
                return; 
                
            }else{ 
            
            
                # Then say Hello! in the ol' web browser.
                print(the_html(-Part  => "header",
                               -Title => "Please Confirm Your Unsubscription",
                               -List  => $li->{list}));
                $li->{html_unsub_confirmation_message} =~ s/\[subscriber_email\]/$email/g; 
                print $li->{html_unsub_confirmation_message}; 
                print(the_html(-Part      => "footer", 
                               -List      => $li->{list},
                               -Site_Name => $li->{website_name},
                               -Site_URL  => $li->{website_url}
                              )
                     );     
            }                 
        }
    }
}




sub unsub_confirm { 

    my %args = (-html_output => 1, @_); 
    
    if($args{-html_output} != 0){ 
    
        if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 0){
            $q->param('error_invalid_list', 1); 
            &default; 
            return;        
        }
    }
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings   ->new(-List => $list); 
    my $li = $ls->get(-Format => "replaced"); 
    
    if($li->{limit_unsub_confirm } == 1){ 
        my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'unsub_confirm_list');    
    }
    
    my($status, $errors) = $lh->unsubscription_check(-Email => $email);
     
    if($args{-html_output} != 0){ 
        user_error(-List => $list, -Error => "no_list", -Email => $email)  
            if $errors->{no_list} == 1;
    }
    
    if(check_email_pin(-Email => $email, -Pin => $pin) == 1){ 
         $status = 0; 
         $errors->{invalid_pin} = 1; 
    }
    
    if($status == 0){ 
        if($args{-html_output} != 0){ 
    
            if(($li->{use_alt_url_unsub_failed} == 1) && ($li->{alt_url_unsub_failed} ne "")){ 
    
                my $qs = ''; 
                if($li->{alt_url_unsub_failed_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=unsub&status=0&email=' . DADA::App::Guts::uriescape($email); 
                    $qs .= '&errors=' . $_ foreach keys %$errors; 
                }
                print $q->redirect(-uri => $li->{alt_url_unsub_failed} . $qs);
                return; 
                    
            }else{ 
            
                user_error(-List => $list, -Error => 'invalid_pin',                 -Email => $email) if $errors->{invalid_pin}                 == 1;
                user_error(-List => $list, -Error => "invalid_email",               -Email => $email) if $errors->{invalid_email}               == 1;
                user_error(-List => $list, -Error => "email_not_in_list",           -Email => $email) if $errors->{not_subscribed}              == 1;    
                user_error(-List => $list, -Error => "no_list",                     -Email => $email) if $errors->{no_list}                     == 1;
                user_error(-List => $list, -Error => "settings_possibly_corrupted", -Email => $email) if $errors->{settings_possibly_corrupted} == 1;  
                # If all else fails.
                user_error(-List => $list, -Email => $email);
            }
            
        }
    }else{ 
    
        my $rm_status = $lh->remove_from_list(-Email_List =>[$email]);
        
        if($args{-html_output} != 0){ 
            # I doubt these are even in affect anymore...
            user_error(-List => $list, -Error => 'no_list',  -Email => $email)  if $rm_status eq 'no list'; 
            user_error(-List => $list, -Error => 'too_busy', -Email => $email)  if $rm_status eq 'too busy';     
        }
        
        if(($li->{black_list} eq "1")  and ($li->{add_unsubs_to_black_list} eq "1")){
            $lh->add_to_email_list(-Email_Ref => [$email],  -Type      => 'black_list');
        }
    
        require DADA::App::Messages; 
        DADA::App::Messages::send_owner_happenings($list, $email, "unsubscribed");
        
        if($li->{send_unsub_success_email} == 1){ 

            require DADA::App::Messages; 
            DADA::App::Messages::send_unsubscription_email(-List      => $list,
                                                           -Email     => $email,
                                                           -List_Info => $li); 
        }

        if($args{-html_output} != 0){ 
         if(($li->{use_alt_url_unsub_success} == 1) && ($li->{alt_url_unsub_success} ne "")){ 
         
                my $qs = ''; 
                if($li->{alt_url_unsub_success_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=unsub&status=1&email=' . DADA::App::Guts::uriescape($email);  
                }
                print $q->redirect(-uri => $li->{alt_url_unsub_success} . $qs);
                return; 
            
            }else{                
                print(the_html(-Part  => "header",
                               -Title => "Unsubscription Successful",
                               -List  => $list)); 
                
                $li->{html_unsubscribed_message} =~ s/\[subscriber_email\]/$email/g; 
                    
                print $li->{html_unsubscribed_message};
                print(the_html(-Part      => "footer",
                               -List      => $list,
                               -Site_Name => $li->{website_name},
                                   -Site_URL  => $li->{website_url})); 
                return; 
            }
        }
    } 
}





sub confirm { 

    my %args = (-html_output => 1, @_) ;

    my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);

    if($args{-html_output} != 0){ 
    
        if($list_exists == 0){ 
            $q->param('error_invalid_list', 1); 
            &default;
            return; 
        }
        if (!$email){ 
            $set_flavor = 's'; 
            $q->param('error_no_email', 1); 
            list_page(); 
            return; 
        }
    }
    
    
    $email = lc_email($email); 
            
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 


    my $lh = DADA::MailingList::Subscribers->new(-List => $list);
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get(-Format => 'replaced');    
    
    
    
    
    
    if($li->{captcha_sub} == 1){    
        # CAPTCHA STUFF
        
        warn "captcha on..."; 
        
        
        my $captcha_worked = 0; 
        my $captcha_auth   = 1; 
        
        if($q->param('captcha_try')){                
        
            #warn "loading " . DADA::Security::AuthenCAPTCHA; 
                                                 
            require DADA::Security::AuthenCAPTCHA;         
    
            warn "loaded!"; 
            
            my $cap = DADA::Security::AuthenCAPTCHA->new; 
    
            my $try = $cap->check_CAPTCHA($q->param('captcha_try')); 
    
            if($try == 1){ 
                $captcha_auth = 1;
                $captcha_worked = 1; 
            } else { 
            
                 $captcha_worked = 0; 
                 $captcha_auth   = 0; 
            }
        }else{
        
            $captcha_worked = 0; 
        
        }
       
        if($captcha_worked == 0){ 
            
              
            require DADA::Security::AuthenCAPTCHA; 
            
            my $cap = DADA::Security::AuthenCAPTCHA->new; 
            my $img_string = $cap->create_CAPTCHA; 
      
      
          print(the_html(-Part  => "header",
                                   -Title => "Subscription Almost Complete",
                                   -List => $li->{list}));
                                   
                                   
            require DADA::Template::Widgets;
            print DADA::Template::Widgets::screen(-screen => 'confirm_captcha_step_screen.tmpl', 
                                                      -vars   => {
                                                                    img_string => $img_string,
    
                                                                    flavor     => $q->param('flavor'), 
                                                                    list       => $q->param('list'), 
                                                                    email      => $q->param('email'), 
                                                                    pin        => $q->param('pin'), 
                                                                    
                                                                    captcha_auth => $captcha_auth, 
                                                                    
                                                              },
                                                     );
           print(the_html(-Part => "footer", 
                   -List => $li->{list},
                   -Site_Name => $li->{website_name},
                   -Site_URL  => $li->{website_url}));                                          
    
               return; 
        }                                             
    
        #/ CAPTCHA STUFF
    }                                
                                             
 
    
    
    
    
    

    if($li->{limit_sub_confirm } == 1){ 
        my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'sub_confirm_list');    
    }

    my ($status, $errors) = $lh->subscription_check(-Email => $email, 
                                                ($li->{allow_blacklisted_to_subscribe} == 1) ? 
                                                (
                                                -Skip  => ['blacklisted'], 
                                                ) : (), 
                                                );
                                                
                                                
     my $mail_your_subscribed_msg = 0; 
     if($li->{email_your_subscribed_msg} == 1){ 
        if($errors->{subscribed} == 1){ 
            my @num = keys %$errors; 
            if($#num == 0){ # meaning, "subscribed" is the only error...
                # Don't Treat as an Error
                $status = 1; 
                # But send a private error message out...
                $mail_your_subscribed_msg = 1; 
            }
        }
    }    
                                                
    
    my ($invalid_pin) = check_email_pin(-Email => $email, -Pin => $pin);
    if ($invalid_pin >= 1) {
        $status = 0; 
        $errors->{invalid_pin} = 1;
    }

    if($args{-html_output} != 0){                                                       
        user_error(-List => $list, -Error => "no_list",       -Email => $email)  
            if $errors->{no_list}  == 1;        
    }
    
    if($status == 0){ 
        if($args{-html_output} != 0){ 

            if(($li->{use_alt_url_sub_failed} == 1) && ($li->{alt_url_sub_failed} ne "")){ 
                        
                my $qs = ''; 
                if($li->{alt_url_sub_failed_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=sub&status=0&email=' . DADA::App::Guts::uriescape($email);
                    $qs .= '&errors=' . $_ foreach keys %$errors; 
                }
                print $q->redirect(-uri => $li->{alt_url_sub_failed} . $qs); 
                return;
                
            }else{            
            
                user_error(-List => $list, -Error => "invalid_email",               -Email => $email)  if $errors->{invalid_email}               == 1;
                user_error(-List => $list, -Error => "invalid_pin",                 -Email => $email)  if $errors->{invalid_pin}                 == 1;
                user_error(-List => $list, -Error => "mx_lookup_failed",            -Email => $email)  if $errors->{mx_lookup_failed}            == 1;
                user_error(-List => $list, -Error => "email_in_list",               -Email => $email)  if $errors->{subscribed}                  == 1;  
                user_error(-List => $list, -Error => "closed_list",                 -Email => $email)  if $errors->{closed_list}                 == 1;  
                user_error(-List => $list, -Error => "over_subscription_quota",     -Email => $email)  if $errors->{over_subscription_quota}     == 1;  
                user_error(-List => $list, -Error => "black_listed",                -Email => $email)  if $errors->{blacklisted}                 == 1;  
                user_error(-List => $list, -Error => "not_white_listed",            -Email => $email)  if $errors->{not_white_listed}            == 1; 
                user_error(-List => $list, -Error => "settings_possibly_corrupted", -Email => $email)  if $errors->{settings_possibly_corrupted} == 1;  
                # If all else fails.
                user_error(-List => $list, -Email => $email);
               
                return;
                
            }            
        }        
    }else{ 
    
        if($mail_your_subscribed_msg == 0){ 
        
            $lh->add_to_email_list(-Email_Ref => [$email]); 
        
            if($li->{send_sub_success_email} == 1){                                             
    
                require DADA::App::Messages; 
                DADA::App::Messages::send_subscribed_message(-List         => $list, 
                                                            -Email        => $email, 
                                                             -Settings_obj => $ls,
                                                            ); 
            
            }
            
            require DADA::App::Messages; 
            DADA::App::Messages::send_owner_happenings($list, $email, "subscribed"); 
    
            if($li->{send_newest_archive} == 1){ 
                
                #require DADA::App::Messages;
                DADA::App::Messages::send_newest_archive(-List         => $list, 
                                                         -Email        => $email, 
                                                         -Settings_obj => $ls, 
                                                        );                                   
            }
        }else{ 
            require DADA::App::Messages;
            DADA::App::Messages::send_generic_email(
                                                    -List         => $list, 
                                                    -Email        => $email, 
                                                    -Settings_obj => $ls, 
                                                    -Subject      => $li->{list_name} . ' Mailing List Confirmation - Already Subscribed', 
                                                    -Message      => $li->{you_are_already_subscribed_message}, 
                                                    
                                                   );
        }

                
        if($args{-html_output} != 0){    
        
            if(($li->{use_alt_url_sub_success} == 1) && ($li->{alt_url_sub_success} ne "")){

                my $qs = ''; 
                if($li->{alt_url_sub_success_w_qs} == 1){ 
                    $qs = '?list=' . $list . '&rm=sub&status=1&email=' . DADA::App::Guts::uriescape($email); 
                }
                print $q->redirect(-uri => $li->{alt_url_sub_success} . $qs); 
                return; 
                
                

            }else{        
                
                print(the_html(-Part  => "header",
                               -Title => "Subscription Successful",
                               -List => $li->{list}));
                
                $li->{html_subscribed_message} =~ s/\[subscriber_email\]/$email/g; 
                
                print $li->{html_subscribed_message}; 
                
                print(the_html(-Part => "footer", 
                               -List => $li->{list},
                               -Site_Name => $li->{website_name},
                               -Site_URL  => $li->{website_url}));
                return; 
            }
        }            
    }
}




sub resend_conf {


    my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);
    
    if($list_exists == 0){ 
        &default;
        return; 
    }
    if (!$email){ 
        $q->param('error_no_email', 1); 
        list_page(); 
        return; 
    }
    
    if($q->param('rm') ne 's' && $q->param('rm') ne 'u'){ 
        &default;
        return; 
    }
    
    if($q->request_method() !~ m/POST/i){ 
        &default;
        return; 
    }

    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $lh = DADA::MailingList::Subscribers->new(-List => $list); 
    
       
        my ($sec, $min, $hour, $day, $month, $year) = (localtime)[0,1,2,3,4,5];

       if(DADA::App::Guts::check_email_pin(-Email => $month . '.' . $day . '.' . $email, -Pin => $q->param('auth_code')) == 1){ 
        
        
        my ($e_day, $e_month, $e_stuff) = split('.', $email); 
        
        if($e_day != $day || $e_month != $month){ 
            # a stale blocking thingy.
            if($q->param('rm') eq 's'){
                my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'sub_confirm_list');    
            }elsif($q->param('rm') eq 'u'){
                my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'unsub_confirm_list');    
            }
        }
        
        # Like, you clicked the submit button wrong, what?!
        list_page(); 
        return; 
    }
    

    if($q->param('rm') eq 's'){
        my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'sub_confirm_list');
        print $q->redirect(-uri => $DADA::Config::PROGRAM_URL . '?f=s&email=' . $email . '&list=' . $list); 
        return; 
    
    }elsif($q->param('rm') eq 'u'){
        my $rm_status = $lh->remove_from_list(-Email_List =>[$email], -Type => 'unsub_confirm_list');
        print $q->redirect(-uri => $DADA::Config::PROGRAM_URL . '?f=u&email=' . $email . '&list=' . $list); 
        return; 
            
    }
    
}




sub search_email { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'search_email');
    $list = $admin_list; 

    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);

    my $method  = $q->param("method"); # should put a default to this...
            
    if(defined($keyword)){ 

        print(admin_html_header(-Title      => "Search Email Subscribers: Search Results", 
                             -List       => $li->{list},
                             -Root_Login => $root_login,
                             -Form       => 0, 
                            ));
                         
        my ($found, $html) =  $lh->search_email_list(
                                    -Method  => $method, 
                                    -Keyword => $keyword,
                                    -Type    => $type, 
                                    -as_string => 1, 
                                    
                                    ); 
                      
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'search_email_results_screen.tmpl', 
                                              -expr   => 1, 
                                              -vars   => {
                                                           keyword             => $keyword, 
                                                           adding_to_blacklist => (($li->{black_list} eq "1")  && ($li->{add_unsubs_to_black_list} eq "1")) ? 1 : 0, 
                                                           type                => $type,
                                                           found               => $found, 
                                                           method              => $method, 
                                                         results              => $html, 
                                                      },
                                             );
                                            

        print(admin_html_footer(-List => $list, -Form => 0));

    }else{ 

    print(admin_html_header(-Title      => "Search Email Subscribers", 
                         -List       => $li->{list},
                         -Root_Login => $root_login,
                         -Form       => 0, 
                         ));
                         
        require DADA::Template::Widgets;
        print DADA::Template::Widgets::screen(-screen => 'search_email_screen.tmpl', 
                                              -expr   => 1, 
                                              -vars   => {
                                                           type => $type,
                                                         },
                                             );
                       
        print(admin_html_footer(-List => $list));
    } 
}




sub text_list { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'text_list');
                                                        
    $list = $admin_list; 

    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);

    my $email; 
    print $q->header('text/plain');
    print "Email Addresses for List: " .  $li->{list_name} . "\n"; 
    print "=" x 72, "\n"; 
    my $email_count =  $lh->print_out_list(-List=>$list, -Type => $type); 
    print "=" x 72, "\n"; 
    print "Total: $email_count \n\n"; 
}





sub send_list_to_admin { 
 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'send_list_to_admin');

    $list = $admin_list; 

    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
 my $email; 
 
 my ($sec, $min, $hour, $day, $month, $year) = (localtime)[0,1,2,3,4,5];
 $year = $year + 1900; 
 $month = $month + 1;  

my $lh = DADA::MailingList::Subscribers->new(-List => $list);

my $tmp_file = $lh->write_plaintext_list(-Type => $type); 
  

my $message = <<EOF

Attached to this email is the subscriber list for $li->{list_name} 
as of $month/$day/$year - $hour:$min:$sec. 
 
This was sent to the list owner ($li->{list_owner_email}) from the list control panel.
 
    -$DADA::Config::PROGRAM_NAME
EOF
; 
 
require MIME::Lite;
MIME::Lite->quiet(1) if $DADA::Config::MIME_HUSH == 1;       ### I know what I'm doing 
$MIME::Lite::PARANOID = $DADA::Config::MIME_PARANOID;
 
my $msg = MIME::Lite->new(Type => 'multipart/mixed'); 


$msg -> attach(Type => 'TEXT',  
               Data => $message); 


my $listname  = $li->{list} . '_' . $type . '.list'; 


$msg->attach(Type        => 'TEXT', 
             Path        =>  $tmp_file,
             Filename    =>  $listname, 
             Disposition =>  'inline', 
             Encoding    => $li->{plaintext_encoding}, 
             ); 

$msg->replace('X-Mailer' =>"");
               
my $msg_headers = $msg->header_as_string();
my $msg_body    = $msg->body_as_string();              

require DADA::Mail::Send; 
my $mh = DADA::Mail::Send->new($li); 

my %mail_headers = $mh->return_headers($msg_headers);
my %mailing = ( 
   %mail_headers, 
    To        =>  '"'. escape_for_sending($li->{list_name}) .'" <'. $li->{list_owner_email} .'>', 
    Subject        =>    "$li->{list_name} $type subscriber list $month/$day/$year",        
    Body           =>     $msg_body,
    );
    
$mh->send(%mailing); 

unlink($tmp_file);
    
print $q->redirect(-uri => "$DADA::Config::S_PROGRAM_URL?flavor=view_list&type=" . $type);    

} 

sub preview_form { 

my $code = $q->param("code"); 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'preview_form');

print $q->header(); 
       
print <<EOF

<html> 
 <head> 
  <title>Form Preview</title> 
 </head> 
 <body bgcolor="#ffffff">
  <table width="100%" height="100%" align="center"> 
   <tr>
    <td align="center"> 
     <p>$code</p> 
     <p><a href="#" onclick="self.close();">close the window</a></p> 
    </td> 
   </tr> 
  </table>
 </body> 
</html> 

EOF
;

}

sub new_list {

    require DADA::Security::Password;  
    my $root_password = $q->param('root_password');
    my $agree         = $q->param('agree');
    
    if(!$process) { 
    
        my $errors = shift; 
        my $flags  = shift; 
        my $pw_check;
        	
       if($DADA::Config::DISABLE_OUTSIDE_LOGINS == 1){        	
            require DADA::Security::SimpleAuthStringState; 
            my $sast =  DADA::Security::SimpleAuthStringState->new;  
            my $auth_state = $q->param('auth_state'); 
            
            if($sast->check_state($auth_state) != 1){ 
                user_error(-List => undef, -Error => 'incorrect_login_url');
                return; 
            }

        }
        
        if(!$DADA::Config::PROGRAM_ROOT_PASSWORD){ 
            user_error(-List => $list, -Error => "no_root_password");
        }elsif($DADA::Config::ROOT_PASS_IS_ENCRYPTED == 1){ 
            #encrypted password check
            $pw_check = DADA::Security::Password::check_password($DADA::Config::PROGRAM_ROOT_PASSWORD, $root_password);
        }else{ 
            # unencrypted password check
            if($DADA::Config::PROGRAM_ROOT_PASSWORD eq $root_password){$pw_check = 1}
        }
    
        if ($pw_check == 1){
        
            my @t_lists = available_lists(-dbi_handle => $dbi_handle); 
            
            $agree = 'yes' if $errors;

            if((!$t_lists[0]) && ($agree ne 'yes') && (!$process)){
                    print $q->redirect(-uri => "$DADA::Config::S_PROGRAM_URL?agree=no"); 
            }
    
            if(($DADA::Config::LIST_QUOTA) && (($#t_lists + 1) >= $DADA::Config::LIST_QUOTA)){ 
                user_error(-List => $list, -Error => "over_list_quota");
            }
    
            if(!$t_lists[0]){ 
                $help = 1;
            }
            
            my $ending   = undef; 
            my $err_word = undef;
            
            if($errors){ 
                $ending = '';
                $err_word = 'was';
                $ending = 's'      if $errors > 1; 
                $err_word = 'were' if $errors > 1; 
            }
            
            
            print(the_html(-Part       => "header",
                           -Title      => "Create a New List",
                           -Start_Form => 0,   
                          ));
         
                
            require DADA::Template::Widgets;
            print   DADA::Template::Widgets::screen(-screen => 'new_list_screen.tmpl', 
                                                    -vars   => 
                                                                { 
                                                                errors                            => $errors, 
                                                                ending                            => $ending, 
                                                                err_word                          => $err_word, 
                                                                help                              => $help, 
                                                                root_password                     => $root_password, 
                                                                flags_list_name                   => $flags->{list_name}, 
                                                                list_name                         => $list_name, 
                                                                flags_list_exists                 => $flags->{list_exists}, 
                                                                flags_list                        => $flags->{list}, 
                                                                flags_shortname_too_long          => $flags->{shortname_too_long},
                                                                flags_slashes_in_name             => $flags->{slashes_in_name}, 
                                                                flags_weird_characters            => $flags->{weird_characters}, 
                                                                flags_quotes                      => $flags->{quotes},
                                                                list                              => $list,
                                                                flags_password                    => $flags->{password},
                                                                password                          => $password, 
                                                                
                                                                flags_password_is_root_password   => $flags->{password_is_root_password}, 
                                                                
                                                                flags_retype_password             => $flags->{retype_password}, 
                                                                flags_password_ne_retype_password => $flags->{password_ne_retype_password},            
                                                                retype_password                   => $retype_password, 
                                                                flags_invalid_list_owner_email    => $flags->{invalid_list_owner_email}, 
                                                                list_owner_email                  => $list_owner_email, 
                                                                flags_list_info                   => $flags->{list_info},  
                                                                info                              => $info, 
                                                                flags_privacy_policy              => $flags->{privacy_policy}, 
                                                                privacy_policy                    => $privacy_policy, 
                                                                flags_physical_address            => $flags->{physical_address},
                                                                physical_address                  => $physical_address, 
                                                                flags_list_name_bad_characters    => $flags->{list_name_bad_characters},
                                                                
                                                                }, 
                                                    );
            
            print(the_html(-Part       => "footer", -End_Form   => 0));
    
        }else{
            user_error(-List => $list, -Error => "invalid_root_password");
        }
    }else{

        chomp($list); 
        $list =~ s/^\s+//;
        $list =~ s/\s+$//; 
        $list =~ s/ /_/g;

        my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);
        my ($list_errors,$flags) = check_list_setup(-fields => {list             => $list, 
                                                                list_name        => $list_name, 
                                                                list_owner_email => $list_owner_email, 
                                                                password         => $password, 
                                                                retype_password  => $retype_password, 
                                                                info             => $info,
                                                                privacy_policy   => $privacy_policy,
                                                                physical_address => $physical_address,
                                                                }
                                                    ); 
        
        if($list_errors >= 1){
            undef($process);
            new_list($list_errors, $flags);
        
        }elsif($list_exists >= 1){
            &user_error(-List => $list, -Error => "list_already_exists");
        }else{
        
            $admin_email = $list_owner_email if ! $admin_email; 
            
            
            $admin_email       = lc_email($admin_email);
            $list_owner_email  = lc_email($list_owner_email);
            $password          = DADA::Security::Password::encrypt_passwd($password); 
            
            my %new_info = (list             =>   $list, 
                            list_owner_email =>   $list_owner_email,
                            admin_email      =>   $admin_email,
                            list_name        =>   $list_name,
                            password         =>   $password,
                            info             =>   $info, 
                            privacy_policy   =>   $privacy_policy,
                            physical_address =>   $physical_address, 
                           );
            
            %new_info = (%DADA::Config::LIST_SETUP_DEFAULTS, %new_info);
            
            require DADA::MailingList; 
            my $ls = DADA::MailingList::Create({-name => $list}); 
               $ls->save({%new_info});
               
            my $status; 
            
            require DADA::Logging::Usage;
            my $log = new DADA::Logging::Usage;
               $log->mj_log($list, 'List Created', "remote_host:$ENV{REMOTE_HOST}, ip_address:$ENV{REMOTE_ADDR}") if $DADA::Config::LOG{list_lives};     
            
            my $li = $ls->get; 
            
            my $escaped_list = uriescape($li->{list}); 


            my $auth_state; 
            
            if($DADA::Config::DISABLE_OUTSIDE_LOGINS == 1){ 
                require DADA::Security::SimpleAuthStringState;
                my $sast       =  DADA::Security::SimpleAuthStringState->new;  
                   $auth_state = $sast->make_state;
            }
        
            print(the_html(-Part  => "header",
                           -Title => "Your New List Has Been Created",
                           -Start_Form => 0,   
                          ));
            
            require DADA::Template::Widgets;
            print DADA::Template::Widgets::screen(-screen => 'new_list_created_screen.tmpl', 
                                                  -vars   => {
                                                              list_name        => $li->{list_name},
                                                              list             => $li->{list}, 
                                                              escaped_list     => $escaped_list, 
                                                              list_owner_email => $li->{list_owner_email}, 
                                                              info             => $li->{info},
                                                              privacy_policy   => $li->{privacy_policy},
                                                              physical_address => $li->{physical_address},
                                                              
                                                              auth_state       => $auth_state,
                                                              
                
                                                          },
                                                 );
            print(the_html(-Part      => "footer", -End_Form   => 0));
            
        }
    }
}




sub archive { 

    # are we dealing with a real list?
    my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);

    if($list_exists == 0){ 
    
        print $q->redirect(
            -status => '301 Moved Permanently',
            -uri    => $DADA::Config::PROGRAM_URL, 
            );
            return; 
    }
    
    my $start = int($q->param('start')) || 0;
    
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $lh = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $lh->get; 
    
    user_error(-List => $list, -Error => "no_show_archives") 
        if ($li->{show_archives} == 0);
    
    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
    
    my $archive = DADA::MailingList::Archives->new(-List => $li); 
    my $entries = $archive->get_archive_entries(); 
    
###### These are all little thingies. 

    my $archive_send_form = ''; 
       $archive_send_form = archive_send_form($list,$id, $q->param('send_archive_errors'))
            if $li->{archive_send_form} == 1 && defined($id);
            
    my $nav_table = '';
       $nav_table = $archive->make_nav_table(-Id => $id, -List => $li->{list})
            if defined($id);
            
    my $archive_search_form = ''; 
       $archive_search_form = $archive->make_search_form($li->{list})
            if $li->{archive_search_form} == 1;
            
    
    my $archive_subscribe_form = ""; 
       

    if($li->{hide_list} ne "1"){   
        $li->{info}     =~ s/\n\n/<p>/gi; 
        $li->{info}     =~ s/\n/<br \/>/gi; 
        
        
    
        unless ($li->{archive_subscribe_form} eq "0"){ 
            $archive_subscribe_form .= "<p>" . $li->{info} . "</p>\n"; 
            $archive_subscribe_form .= "<p><strong>Subscribe</strong> to " . $li->{list_name} . ":</p>\n";
        
            require DADA::Template::Widgets;
            $archive_subscribe_form .= DADA::Template::Widgets::screen(-screen => 'list_subscribe_form.tmpl',
              -expr   => 1, 
              -list   => $li->{list}, 
              -vars   => {
                           -email      => $email,
                         },
             );    
        }    
    }
    
    my $archive_widgets = { 
                            archive_send_form      => $archive_send_form, 
                            nav_table              => $nav_table, 
                            publish_archives_rss   => $li->{publish_archives_rss} ? 1 : 0, 
                            archive_search_form    => $archive_search_form, 
                            archive_subscribe_form => $archive_subscribe_form,
                            };
                            

#/##### These are all little thingies. 

    
    if(!$id) {
    
        
        if($c->cached('archive/' . $list . '/' . $start)){ $c->show('archive/' . $list . '/' . $start); return;}


        my $th_entries = []; 
    
        my ($begin, $stop) = $archive->create_index($start);
        my $i;
        my $stopped_at = $begin;
        my $num = $begin;
        
        $num++; 
        my @archive_nums; 
        my @archive_links; 
        
        
        # iterate and save
        for($i = $begin; $i <=$stop; $i++){ 
            my $link; 
            
            if(defined($entries->[$i])){
                
                
                
                my ($subject, $message, $format, $raw_msg) = $archive->get_archive_info($entries->[$i]); 
                        
                # this is so atrocious.
                my $date = date_this(-Packed_Date   => $archive->_massaged_key($entries->[$i]),
                -Write_Month   => $li->{archive_show_month},
                -Write_Day     => $li->{archive_show_day},
                -Write_Year    => $li->{archive_show_year},
                -Write_H_And_M => $li->{archive_show_hour_and_minute},
                -Write_Second  => $li->{archive_show_second});
                
                my $entry = {                
                        id               => $entries->[$i], 
                        date             => $date, 
                        subject          => $subject,
                       'format'          => $format, 
                        list             => $list, 
                        uri_escaped_list => uriescape($list),
                        PROGRAM_URL      => $DADA::Config::PROGRAM_URL, 
                        message_blurb    => $archive->message_blurb(-key => $entries->[$i]),
                        
                        
                         
                    }; 
                
                $stopped_at++;
                push(@archive_nums, $num); 
                push(@archive_links, $link); 
                $num++;


                push(@$th_entries, $entry); 
                    
            }
        } 
    
        my $ii; 
        
        for($ii=0;$ii<=$#archive_links; $ii++){ 
    
            my $bullet = $archive_nums[$ii];
            
            #fix if we're doing reverse chronologic 
            $bullet = (($#{$entries}+1) - ($archive_nums[$ii]) +1) 
                if($li->{sort_archives_in_reverse} == 1);

            # yeah, whatever. 
            $th_entries->[$ii]->{bullet} = $bullet; 
            
        }
    
        my $index_nav = $archive->create_index_nav($stopped_at);
        
        my $scrn = (the_html(-Part       => "header",
                       -Start_Form => 0, 
                       -Title => $li->{list_name}  . " Archives",
                       -List  => $li->{list}));


        require DADA::Template::Widgets; 
        $scrn .=  DADA::Template::Widgets::screen(-screen => 'archive_index_screen.tmpl', 
                                              -vars   => { 
                                                list                     => $list, 
                                                list_name                => $li->{list_name},
                                                entries                  => $th_entries, 
                                                index_nav                => $index_nav,
                                                flavor_archive           => 1, 
                                                %$archive_widgets, 
                                                },
                                             ); 
        $scrn .= (the_html(-Part      => "footer",
                       -End_Form  => 0, 
                       -List      => $li->{list},
                       -Site_Name => $li->{website_name},
                       -Site_URL  => $li->{website_url}));
               

        print $scrn; 
        
        $c->cache('archive/' . $list . '/' . $start, \$scrn); 
        return; 
        
    }else{ 
    
        $id = $archive->newest_entry if $id =~ /newest/i; 
        $id = $archive->oldest_entry if $id =~ /oldest/i; 
        
        if($q->param('extran')){ 
            
            print $q->redirect(
            -status => '301 Moved Permanently',
            -uri    => $DADA::Config::PROGRAM_URL . '/archive/' . $li->{list} . '/' . $id . '/', 
            );
            return; 
        }
        
        if($id !~ m/(\d+)/g){ 
        
            print $q->redirect(-uri => $DADA::Config::PROGRAM_URL . '/archive/' . $li->{list} . '/');
            return;
        }
        
        $id = $archive->_massaged_key($id); 
        
        if($c->cached('archive/' . $list  .'/' . $id)){ $c->show('archive/' . $list  .'/' . $id); return;}

        
        
        my $entry_exists = $archive->check_if_entry_exists($id); 
        user_error(-List => $list, -Error => "no_archive_entry")
            if($entry_exists <= 0); 
        
            
        my ($subject, $message, $format, $raw_msg) = $archive->get_archive_info($id); 
    
        my $scrn =    (the_html(-Part       => "header",
                       -Title      => $subject,
                       -List       => $li->{list}, 
                       -Start_Form => 0,
                       ));
        
        
        my ($massaged_message_for_display, $content_type) = $archive->massaged_msg_for_display(-key => $id, -body_only => 1);
        
        my $show_iframe = $li->{html_archives_in_iframe} || 0; 
        if($content_type eq 'text/plain'){ 
            $show_iframe = 0; 
        }        
        
        my $header_from    = undef; 
        #my $header_date    = undef; 
        my $header_subject = undef; 
        
        my $in_reply_to_id; 
        my $in_reply_to_subject; 
        
                if($raw_msg){ 
                    $header_from    = $archive->get_header(-header => 'From', -key => $id); 
                    $header_from    = entity_protected_str($header_from);
                    $header_subject = $archive->get_header(-header => 'Subject', -key => $id); 
                    
                    $header_subject =~ s/\r|\n/ /g; 
                    $header_subject = strip(xss_filter($header_subject)); 
                    if(! $header_subject){ 
                        $header_subject = $DADA::Config::EMAIL_HEADERS{Subject};
                    }
                    
                    
                    ($in_reply_to_id, $in_reply_to_subject) = $archive->in_reply_to_info(-key => $id); 
                    
                    $in_reply_to_subject = xss_filter($in_reply_to_subject);
                    
                }
                
        my $attachments = ($li->{display_attachments} == 1) ? $archive->attachment_list($id) : []; 
        
        
        # this is so atrocious.
                my $date = date_this(-Packed_Date   => $id,
                -Write_Month   => $li->{archive_show_month},
                -Write_Day     => $li->{archive_show_day},
                -Write_Year    => $li->{archive_show_year},
                -Write_H_And_M => $li->{archive_show_hour_and_minute},
                -Write_Second  => $li->{archive_show_second});
                
                
        require DADA::Template::Widgets; 
        $scrn .=  DADA::Template::Widgets::screen(-screen => 'archive_screen.tmpl', 
                                                  -vars   => { 
                                                    list                          => $list, 
                                                    list_name                     => $li->{list_name}, 
                                                    id                            => $id, 
                                                    subject                       => $subject, 
                                                    js_enc_subject                => js_enc($subject), 
                                                    uri_encoded_subject           => DADA::App::Guts::uriescape($subject), 
                                                    uri_encoded_url               => DADA::App::Guts::uriescape($DADA::Config::PROGRAM_URL . '/archive/' . $list . '/' . $id .'/'), 
                                                    archived_msg_url              => $DADA::Config::PROGRAM_NAME . '/archive/' . $list . '/' . $id .'/', 
                                                    massaged_msg_for_display      => $massaged_message_for_display, 
                                                    send_archive_success          => $q->param('send_archive_success') ? $q->param('send_archive_success') : undef, 
                                                    send_archive_errors           => $q->param('send_archive_errors')  ? $q->param('send_archive_errors')  : undef, 
                                                    show_iframe                   => $show_iframe, 
                                                    discussion_list               => ($li->{group_list} == 1) ? 1 : 0,
                                                    header_from                   => $header_from, 
                                                    header_subject                => $header_subject,
                                                    in_reply_to_id                => $in_reply_to_id, 
                                                    in_reply_to_subject           => xss_filter($in_reply_to_subject),  
                                                    attachments                   => $attachments, 
                                                    date                          => $date,
                                                    add_social_bookmarking_badges => $li->{add_social_bookmarking_badges}, 
                                                    
                                                    %$archive_widgets, 
                                                     
                                                },
                                             ); 
        $scrn .= (the_html(-Part      => "footer",
                       -End_Form  => 0, 
                       -List      => $li->{list},
                       -Site_Name => $li->{website_name},
                       -Site_URL  => $li->{website_url},
                       
                       ));    
                    
        print $scrn; 
        
        $c->cache('archive/' . $list . '/' . $id, \$scrn); 
        return; 
        
    
    }

}


sub archive_bare { 

    
    if($q->param('admin')){ 
            my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                                -Function => 'view_archive');
            $list = $admin_list;
    }
    
    
    if($c->cached('archive_bare.' . $list . '.' . $id . '.' . $q->param('admin'))){ $c->show('archive_bare.' . $list . '.' . $id . '.' . $q->param('admin')); return;}

    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
           
    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $la = DADA::MailingList::Archives->new(-List => $li); 
    
    if(!$q->param('admin')){ 
        user_error(-List => $list, -Error => "no_show_archives") 
            if ($li->{show_archives} == 0);
    }    
    user_error(-List => $list, -Error => "no_archive_entry")
        if($la->check_if_entry_exists($id) <= 0); 
            
    my $scrn = $q->header(); 
       $scrn .= $la->massaged_msg_for_display(-key => $id); 
    print $scrn; 
    
    $c->cache('archive_bare.' . $list . '.' . $id . '.' . $q->param('admin'), \$scrn); 
    
    return; 
}




sub search_archive { 

    user_error(-List => $list, -Error => "no_list") 
        if (check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) <= 0); 
        
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 

    user_error(-List => $list, -Error => "no_show_archives") 
        if ($li->{show_archives} == 0);

    $keyword = xss_filter($keyword); 
    
    if($keyword =~ m/^[A-Za-z]+$/){ # just words, basically.
        if($c->cached($list.'.search_archive.' . $keyword)){ $c->show($list.'.search_archive.' . $keyword); return;}
    }


    require DADA::MailingList::Archives;
           $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
    
    my $archive      = DADA::MailingList::Archives -> new(-List => $li); 
    my $entries      = $archive->get_archive_entries(); 
    my $ending       = "";
    my $count        = 0; 
    my $ht_summaries = []; 

    
    my $search_results = $archive->search_entries($keyword); 

    if(defined(@$search_results[0]) && (@$search_results[0] ne "")){

       $count = $#{$search_results}+1; 
       $ending = 's' 
        if defined(@$search_results[1]);
      
        my $summaries = $archive->make_search_summary($keyword, $search_results); 

        foreach(@$search_results){ 
        
            my ($subject, $message, $format) = $archive->get_archive_info($_);    
            my $date = date_this(-Packed_Date   => $_,
                                 -Write_Month   => $li->{archive_show_month},
                                 -Write_Day     => $li->{archive_show_day},
                                 -Write_Year    => $li->{archive_show_year},
                                 -Write_H_And_M => $li->{archive_show_hour_and_minute},
                                 -Write_Second  => $li->{archive_show_second});
                                            
            push(@$ht_summaries, {
                summary     => $summaries->{$_},
                subject     => $subject, 
                date        => $date, 
                id          => $_, 
                PROGRAM_URL => $DADA::Config::PROGRAM_URL, 
                list        => uriescape($list),
            }); 
                 
        }
    }

    my $search_form = ''; 
    if($li->{archive_search_form} == 1){
        $search_form = $archive->make_search_form($li->{list}); 
    }

    my $archive_subscribe_form = ''; 
    if($li->{hide_list} ne "1"){   
       $li->{info} =~ s/\n\n/<p>/gi; 
       $li->{info} =~ s/\n/<br \/>/gi; 
    
        unless ($li->{archive_subscribe_form} eq "0"){ 
            $archive_subscribe_form .= '<p>' . $li->{info} . '</p>' . "\n"; 
            $archive_subscribe_form .=  '<p><strong>Subscribe</strong> to ' . $li->{list_name} . ':</p>' . "\n";
            require DADA::Template::Widgets;
            $archive_subscribe_form .=  DADA::Template::Widgets::screen(-screen => 'list_subscribe_form.tmpl', 
                                                  -expr      => 1, 
                                            
                                                  -vars   => { 
                                                              email     => $email,
                                                              list      => $li->{list},
                                                              list_name => $li->{list_name},
                                                             }, 
                                                  );
        }
    
    }

    my $scrn; 
    
    $scrn = (the_html(-Part       => "header",
                       -Title      => "Archive Search Results", 
                       -List       => $li->{list},
                       -Start_Form => 0, 
                       ));
                   
                
    require DADA::Template::Widgets;
    $scrn .= DADA::Template::Widgets::screen(-screen => 'search_archive_screen.tmpl', 
                                          -vars => { 
                                                   list_name              => $li->{list_name},
                                                    uriescape_list         => uriescape($list),    
                                                    list                   => $list, 
                                                    count                  => $count, 
                                                    ending                 => $ending, 
                                                    keyword                => $keyword, 
                                                    
                                                    summaries              => $ht_summaries, 
                                                    
                                                    search_results         => $ht_summaries->[0] ? 1 : 0, 
                                                    search_form            => $search_form, 
                                                    archive_subscribe_form => $archive_subscribe_form,                          
                                                    },
                                        ); 
                
    $scrn .= (the_html(-Part      => "footer",
                   -List      => $li->{list},
                   -Site_Name => $li->{website_name},
                   -Site_URL  => $li->{website_url},
                   -End_Form  => 0,
                   ));
    
    print $scrn; 
    
    if($keyword =~ m/^[A-Za-z]+$/){ # just words, basically.
        $c->cache($list.'.search_archive.' . $keyword, \$scrn);
    }
    
    return; 
    
     
}




sub send_archive { 

    my $entry        = $q->param('entry');
    my $sender_email = $q->param('sender_email');
    my $note         = $q->param('note');
    
    my $errors       = 0;
    
    my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);
    
    user_error(-List => $list, -Error => "no_list") if ($list_exists <=0); 
    
    $errors++ if(check_for_valid_email($email)        == 1);
    $errors++ if(check_for_valid_email($sender_email) == 1);    
    
    $errors++ if(check_referer($q->referer()))        != 1; 
    
    
    require  DADA::MailingList::Settings; 
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    
    $errors++ if $li->{archive_send_form}        != 1; 
    
    if($errors > 0){ 
        print $q->redirect(-uri => $DADA::Config::PROGRAM_URL . '?f=archive&l=' . $list . '&id=' . $entry . '&send_archive_errors=' . $errors);
    }else{
    
    
        require DADA::MailingList::Archives;
               $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
               
        my $archive = DADA::MailingList::Archives->new(-List => $li); 
        
        
        my $archive_message_url = $DADA::Config::PROGRAM_URL . '/archive/' . $list . '/' . $entry . '/';
        
        my ($subject, $message, $format, $raw_msg) = $archive->get_archive_info($entry); 
            
            
        require MIME::Lite; 
        
        my $msg = MIME::Lite->new(From    => $sender_email, 
                                  To      => $email, 
                                  Subject => $subject . ' (Archive)', , 
                                  Type    => 'multipart/mixed'
                                  ); 
        
        my $pt_msg = $li->{send_archive_message};
           $pt_msg =~ s/\[sender_email\]/$sender_email/g;
           $pt_msg =~ s/\[note\]/$note/g;
           $pt_msg =~ s/\[archive_message_url\]/$archive_message_url/g; 
           
        my $pt = MIME::Lite->new(Type     => 'text/plain', 
                                 Data     => $pt_msg, 
                                 Encoding => $li->{plaintext_encoding});
                               
        my $html_msg = $li->{send_archive_message_html};
           $html_msg =~ s/\[sender_email\]/$sender_email/g;
           $html_msg =~ s/\[note\]/$note/g;
           $html_msg =~ s/\[archive_message_url\]/$archive_message_url/g; 
           
           
        my $html = MIME::Lite->new(Type      => 'text/html', 
                                   Data      => $html_msg, 
                                   Encoding  => $li->{html_encoding}
                                  ); 
                               
        my $ma = MIME::Lite->new(Type => 'multipart/alternative');
           $ma->attach($pt); 
           $ma->attach($html); 
           
           $msg->attach($ma); 
    
        my $a_msg;
        
        if($raw_msg){ 
        
            $a_msg = MIME::Lite->new(Type        => 'message/rfc822', 
                                       Disposition => "inline", 
                                       Data        => $archive->massage_msg_for_resending(-key => $entry),
                                      ); 
        
        }else{ 
    
            $a_msg = MIME::Lite->new(Type        => 'message/rfc822', 
                                       Disposition => "inline",
                                       Type        => $format, 
                                       Data        => $message
                                      ); 
        }
        
        $msg->attach($a_msg); 
        
        
        require DADA::App::FormatMessages; 
        my $fm = DADA::App::FormatMessages->new(-List => $list); 
           $fm->use_list_template(0); 
           $fm->use_email_templates(0); 
           $fm->use_header_info(1); 
           
        my ($final_header, $final_body) = $fm->format_headers_and_body(-msg => $msg->as_string );
       
        require DADA::Mail::Send;    
        my $mh = DADA::Mail::Send->new($li);
        
        
        $mh->send(
            $mh->return_headers($final_header),
            Body => $final_body, 
        ); 
            print $q->redirect(-uri => $DADA::Config::PROGRAM_URL . '?f=archive&l=' . $list . '&id=' . $entry . '&send_archive_success=1');
    }
}




sub archive_rss { 

    my %args = (-type => 'rss', 
                @_
               ); 
               

    my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle);
    
    if ($list_exists == 0){
    
    }else{ 
    
        require DADA::MailingList::Settings;
               $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

        my $ls = DADA::MailingList::Settings->new(-List => $list); 
        my $li = $ls->get; 
        
        if ($li->{show_archives} == 0){
    
        }else{ 
    
            if($li->{publish_archives_rss} == 0){ 
    
            }else{ 
                    
                if($args{-type} eq 'rss'){ 
                    
                    if($c->cached('archive_rss/' . $list)){ $c->show('archive_rss/' . $list); return;}
                    
                    require DADA::MailingList::Archives;
                    $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
                
                    my    $archive = DADA::MailingList::Archives->new(-List => $li);
                    
                    my $scrn = $q->header('application/xml') .  $archive->rss_index();

                    print $scrn; 
                    
                    $c->cache('archive_rss/' . $list, \$scrn); 
                    return; 
                    
                    
                }elsif($args{-type} eq 'atom'){ 
                
                    if($c->cached('archive_atom/' . $list)){ $c->show('archive_atom/' . $list); return;}

                    require DADA::MailingList::Archives;
                    $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
                    my    $archive = DADA::MailingList::Archives->new(-List => $li);
                    my $scrn = $q->header('application/xml') . $archive->atom_index(); 
                    print $scrn; 
                    
                    $c->cache('archive_atom/' . $list, \$scrn); 
                    return; 
                    
                }else{ 
                    warn "wrong type of feed asked for: " . $args{-type} . ' - '. $!;
                }
            }
     }
    } 
}




sub archive_atom { 

    archive_rss(-type => 'atom'); 

}




sub email_password { 


    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
         
    require DADA::Security::Password;
    
    if(( $li->{pass_auth_id} ne "")    &&  
       ( defined($li->{pass_auth_id})) && 
       ( $q->param('pass_auth_id')  eq $li->{pass_auth_id})){ 
    
        my $new_passwd  = DADA::Security::Password::generate_password(); 
        my $new_encrypt = DADA::Security::Password::encrypt_passwd($new_passwd); 

        $ls->save({
                   password     => $new_encrypt,
                   pass_auth_id => ''
                }); 
        
        
        require DADA::Mail::Send;  
        my $mh = DADA::Mail::Send->new($li); 

my $Body = qq{

Hello, 
Someone asked for the $DADA::Config::PROGRAM_NAME List Password password for:

$li->{list_name}
 
to be emailed to this address. Since you are the list owner, 
the password is: 

$new_passwd

Notice, you probably didn't use this password to begin with, 
$DADA::Config::PROGRAM_NAME stores passwords that are encrypted and no 
password it stores can be "unencrypted" 
So, a new, random password is generated. You may reset the password
to anything you want in the list control panel. 

Please be sure to delete this email for security reasons. 

-$DADA::Config::PROGRAM_NAME

};

    
    $mh->send(From    => '"' . escape_for_sending($li->{list_name}) . '" <' . $li->{list_owner_email} . '>', 
              To      => '"List Owner for: '. escape_for_sending($li->{list_name}) .'" <'. $li->{list_owner_email} .'>', 
              Subject => "List Password", 
              Body    => $Body,
             );

        require DADA::Logging::Usage; 
        my $log = new DADA::Logging::Usage; 
           $log->mj_log($list, 'List Password Reset', "remote_host:$ENV{REMOTE_HOST}, ip_address:$ENV{REMOTE_ADDR}") 
                if $DADA::Config::LOG{list_lives};

    
    print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=' . $DADA::Config::SIGN_IN_FLAVOR_NAME . '&list=' . $list); 


}else{ 

    require DADA::Mail::Send;  
    my $mh = DADA::Mail::Send->new($li); 
    
    my $rand_str = DADA::Security::Password::generate_rand_string();
    
    $ls->save({pass_auth_id => $rand_str});
    

my $Body = qq{ 

Hello, 
Someone asked for the $DADA::Config::PROGRAM_NAME List Password password for:

$li->{list_name}
 
to be emailed to this address. 

Before this can be done, it has to be confirmed that the list
owner (meaning you) actually wants a new password to be set for this list 
and mailed to you. To confirm this, visit this URL: 

$DADA::Config::S_PROGRAM_URL?f=email_password&l=$list&pass_auth_id=$rand_str

By visiting this URL, you will reset the list password. This new 
password will then be emailed to you. You will then be redirected 
to the admin login screen. 

If you do not know why you were sent this email, ignore it and 
your password will not be changed. 

This request for the password change was done from:

    Remote Host:    $ENV{REMOTE_HOST}
    IP Address:    $ENV{REMOTE_ADDR}  

-$DADA::Config::PROGRAM_NAME

}; 

    $mh->send(From     => '"' . escape_for_sending($li->{list_name}) . '" <' . $li->{list_owner_email} . '>', 
              To       =>  '"List Owner for: '. escape_for_sending($li->{list_name}) .'" <'. $li->{list_owner_email} .'>', 
              
              Subject  => "Confirm List Password Change", 
              Body     => $Body
             ); 

        require DADA::Logging::Usage; 
        my $log = new DADA::Logging::Usage; 
           $log->mj_log($list, 'Sent Password Change Confirmation', "remote_host:$ENV{REMOTE_HOST}, ip_address:$ENV{REMOTE_ADDR}") 
                if $DADA::Config::LOG{list_lives};

    
    sleep(10); 
    
    print(the_html(-Part => "header",
                   -Title => "Confirm Password Change", 
                   -List  => $list)); 
    
    print '<p>A confirmation email has been sent to the list owner of ' . $li->{list_name} .
           ' to confirm the password change.</p>
           <ul> 
            <li>
             <p>
              Logged Remote Host: ' . $ENV{REMOTE_HOST} . '</p></li>' .
           '<li><p>Logged Remote IP: ' . $ENV{REMOTE_ADDR} . '</p></li>
           </ul> 
           ';
    
    print(the_html(-Part => "footer",
                   -List  => $list)); 

    }
}




sub login { 

    my $referer        = $q->param('referer')        || $DADA::Config::DEFAULT_ADMIN_SCREEN;
    my $admin_password = $q->param('admin_password') || ""; 
    my $admin_list     = $q->param('admin_list')     || ""; 
    my $auth_state     = $q->param('auth_state')     || undef; 

    my $try_referer = $referer;
    
       $try_referer =~ s/(^http\:\/\/|^https\:\/\/)//; 
       $try_referer =~ s/^www//;       
        
       my $reg_try_referer = quotemeta($try_referer);  
       if($DADA::Config::PROGRAM_URL =~ m/$reg_try_referer$/){ 
            $referer = $DADA::Config::DEFAULT_ADMIN_SCREEN;  
       }
       
    $list = $admin_list;

   if($DADA::Config::DISABLE_OUTSIDE_LOGINS == 1){ 
        require DADA::Security::SimpleAuthStringState; 
        my $sast =  DADA::Security::SimpleAuthStringState->new;  
        if($sast->check_state($auth_state) != 1){ 
            user_error(-List => $list, -Error => 'incorrect_login_url');
            return; 
        }
    }
    
    my $cookie;
    
    if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) >= 1){
               
       require DADA::Security::Password; 
       
        my $dumb_cookie = $q->cookie(-name    => 'blankpadding', 
                                     -value   => 'blank',
                                     %DADA::Config::COOKIE_PARAMS,
                                    ); 
        
        require DADA::App::Session; 
        my $dada_session = DADA::App::Session->new(); 
        
        
        if($dada_session->logged_into_diff_list(-cgi_obj => $q) != 1){ 
        
            my $login_cookie = $dada_session->login_cookie(-cgi_obj => $q, 
                                                           -list    => $list,
                                                           -password => $admin_password); 
            
            require DADA::App::ScreenCache; 
            my $c = DADA::App::ScreenCache->new; 
            $c->remove('login_switch_widget');
       
            if($DADA::Config::LOG{logins}){
                require DADA::Logging::Usage;
                my $log = new DADA::Logging::Usage;
                my $rh = $ENV{REMOTE_HOST} || '';
                my $ra = $ENV{REMOTE_ADDR} || ''; 
                
                $log->mj_log($admin_list, 'login', 'remote_host:' . $rh . ', ip_address:' . $ra);     
            }
                
            print $q->header(-cookie  => [$dumb_cookie, $login_cookie], 
                              -nph     => $DADA::Config::NPH,
                              -Refresh =>'0; URL=' . $referer); 
                    
            print $q->start_html(-title=>'Logging On...',
                                 -BGCOLOR=>'#FFFFFF'
                                ); 
            print $q->p($q->a({-href => $referer}, 'Logging On...')); 
            print $q->end_html();
            
            $dada_session->remove_old_session_files(); 
                    
        }else{ 
        
            user_error(-List  => $list, 
                       -Error => "logged_into_different_list",
                      );        
        
        }
      
    }else{
        user_error(-List  => $list, 
                   -Error => "no_list",
                  );
    }
}




sub logout { 

    my %args = (-redirect               => 1, 
                -redirect_url           => $DADA::Config::DEFAULT_LOGOUT_SCREEN, 
                -no_list_security_check => 0,  
                
                @_); 
                
     my $admin_list;     
     my $root_login;
    
     my $list_exists = check_if_list_exists(-List => $admin_list, -dbi_handle => $dbi_handle); 
     
    # I don't quite even understand why there's this check...
    
    if($args{-no_list_security_check} == 0){     
        if($list_exists == 1){ 
    
            ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                             -Function => 'logout');    
        }
    }


    require DADA::App::ScreenCache; 
    my $c = DADA::App::ScreenCache->new; 
       $c->remove('login_switch_widget');
    
    my $l_list   = $admin_list; 

    my $location = $args{-redirect_url}; 
    
    if($q->param('login_url')){ 
        $location = $q->param('login_url'); 
    }
    
    if ($DADA::Config::LOG{logins} != 0){
    
        require DADA::Logging::Usage;
        my $log = new DADA::Logging::Usage;
           $log->mj_log($l_list, 'logout', "remote_host:$ENV{REMOTE_HOST}, ip_address:$ENV{REMOTE_ADDR}");     
    
    }

    my $logout_cookie; 
   
        require DADA::App::Session; 
        my $dada_session  = DADA::App::Session->new(-List => $l_list); 
           $logout_cookie = $dada_session->logout_cookie(-cgi_obj => $q);
                      
    if($args{-redirect} == 1){ 
    
        print $q->header(-COOKIE       => $logout_cookie, 
                              -nph     => $DADA::Config::NPH,
                              -Refresh =>'0; URL=' . $location,
                            );
        
        print $q->start_html(-title   =>'Logging Out...',
                             -BGCOLOR =>'#FFFFFF'
                            ),
              $q->p($q->a( {-href => $location}, 'Logging Out...')),                  
              $q->end_html(); 
     } else { 
        return $logout_cookie;
     }
   
}



sub log_into_another_list { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'log_into_another_list');
                                                        
    logout(-redirect_url => $DADA::Config::PROGRAM_URL . '?f=' . $DADA::Config::SIGN_IN_FLAVOR_NAME, ); 
    
    return; 

}





sub change_login { 


    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'change_login');

    die "only for root logins!" 
        if ! $root_login;
    
    require DADA::App::Session; 
    my $dada_session = DADA::App::Session->new(); 
    
    my $change_to_list = $q->param('change_to_list'); 
    my $location       = $q->param('location'); 
    
    $q->delete_all();
    $location =~ s/(\;|\&)done\=1$//;

    my $new_cookie = $dada_session->change_login(-cgi_obj => $q, -list => $change_to_list);
    
    require DADA::App::ScreenCache; 
    my $c = DADA::App::ScreenCache->new; 
       $c->remove('login_switch_widget'); 
    
    print $q->header(-cookie  => [$new_cookie], 
                      -nph     => $DADA::Config::NPH,
                      -Refresh =>'0; URL=' . $location); 
    print $q->start_html(-title=>'Switching...',
                         -BGCOLOR=>'#FFFFFF'
                        ); 
    print $q->p($q->a({-href => $location}, 'Switching...')); 
    print $q->end_html();
    
}




sub checker { 
    
    # I really don't understand how this subroutine got.. invented. 
    
    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,
                                                        -Function => 'checker');
        
    $list = $admin_list; 
    
    # TODO - why isn't his here? Why aren't we reading it from the pref?!
    
    my $add_to_black_list = $q->param('add_to_black_list') || 0;
    
    my $lh = DADA::MailingList::Subscribers->new(-List => $list);
    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get; 
    
    my $email_count = $lh->remove_from_list(-Email_List => \@address,
                                            -Type       => $type, 
                                           );
    
    my $should_add_to_black_list = 0; 
        

               
    if($type eq 'list'){ 
        
        if($li->{black_list}               == 1 && 
           $li->{add_unsubs_to_black_list} == 1
           ){ 
               
            $lh->add_to_email_list(-Email_Ref => \@address, 
                                   -Type => 'black_list');
        }
    }
    
    print $q->redirect(-uri=>"$DADA::Config::S_PROGRAM_URL?flavor=view_list&delete_email_count=$email_count&type=" . $type); 

}




sub file_upload {

    my $upload_file = shift; 
    
    my $fu   = CGI->new(); 
    my $file = $fu->param($upload_file);  
    if ($file ne "") {
        my $fileName = $file; 
           $fileName =~ s!^.*(\\|\/)!!;   
         eval {require URI::Escape}; 
         if(!$@){
            $fileName =  URI::Escape::uri_escape($fileName, "\200-\377");
         }else{ 
            warn('no URI::Escape is installed!'); 
         }
        $fileName =~ s/\s/%20/g;
          
        my $outfile = make_safer($DADA::Config::TMP . '/' . time . '_' . $fileName);
         
        open (OUTFILE, '>' . $outfile) or warn("can't write to " . $outfile . ": $!");        
        while (my $bytesread = read($file, my $buffer, 1024)) { 
            print OUTFILE $buffer;
        } 
        close (OUTFILE);
        chmod($DADA::Config::FILE_CHMOD, $outfile);  
        return $outfile;
    }
    
}




sub pass_gen { 

    my $pw = $q->param('pw'); 
    require DADA::Template::Widgets;

    print(the_html(-Part => "header", -Title => "Password Encryption", -Start_Form => 0,));
    
    if(!$pw){ 
     
        print DADA::Template::Widgets::screen(-screen => 'pass_gen_screen.tmpl', 
                                              -expr   => 1, 
                                              -vars   => {},
                                             );
                     
    }else{

        require DADA::Security::Password; 
        print DADA::Template::Widgets::screen(-screen => 'pass_gen_process_screen.tmpl', 
                                              -expr   => 1, 
                                              -vars   => {
                                                            encrypted_password => DADA::Security::Password::encrypt_passwd($pw), 
                                                          },
                                             );
    }

    print(the_html(-Part => "footer", -End_Form   => 0));

}




sub setup_info { 

    my $root_password = $q->param('root_password') || '';
    
    if(root_password_verification($root_password) == 1){ 

        my $home_dir_guess   = $ENV{DOCUMENT_ROOT};
        my $pub_html_dir      = $home_dir_guess; 
           $pub_html_dir      =~ s(^.*/)();
           $home_dir_guess   =~ s/\/$pub_html_dir$//g;
        
        my $sendmails = []; 
        if ($DADA::Config::OS !~ /^Win|^MSWin/i){
            push(@$sendmails, {location => $_})
                foreach(split(" ", `whereis sendmail`));
        }

        print(the_html(-Part  => "header", 
                       -Title => "Setup Information"
                      ));
        
        require DADA::Template::Widgets;                
        print DADA::Template::Widgets::screen(-screen => 'setup_info_screen.tmpl', 
                                              -vars   => { 
                                                          FILES        => $DADA::Config::FILES, 
                                                          exists_FILES => (-e $DADA::Config::FILES) ? 1 : 0,
                                                          FILES_starts_with_a_slash => ($DADA::Config::FILES =~ m/^\//) ? 1 : 0,
                                                          FILES_ends_in_a_slash     => ($DADA::Config::FILES =~ m/\/$/) ? 1 : 0,
                                                          DOCUMENT_ROOT             => $ENV{DOCUMENT_ROOT}, 
                                                          home_dir_guess            => $home_dir_guess, 
                                                          MAILPROG                  => $DADA::Config::MAILPROG, 
                                                          sendmails                 => $sendmails, 
                                                         },
                                             );

        print(the_html(-Part => "footer"));
            
    }else{ 

        my $guess = $DADA::Config::PROGRAM_URL; 
           $guess = $q->script_name()
                if $DADA::Config::PROGRAM_URL eq "" || 
                   $DADA::Config::PROGRAM_URL eq 'http://www.changetoyoursite.com/cgi-bin/dada/mail.cgi'; # default.
    
        my $incorrect_root_password = $root_password ? 1 : 0; 
      
        print(the_html(-Part           => 'header', 
                           -Title      => 'Setup Information',
                           -Start_Form => 0
                          ));


        require DADA::Template::Widgets;                
        print DADA::Template::Widgets::screen(-screen => 'setup_info_login_screen.tmpl', 
                                              -vars   => { 
                                                          program_url_guess       => $guess,
                                                          incorrect_root_password => $incorrect_root_password, 
                                                          
                                                         },
                                             );
                                             
        print(the_html(-Part       => 'footer', 
                       -End_Form   => 0
                    ));
    }

}




sub reset_cipher_keys { 

    my $root_password   = $q->param('root_password');    
    my $root_pass_check = root_password_verification($root_password);
    
    if($root_pass_check == 1){ 
        require DADA::Security::Password; 
        my @lists = available_lists(-dbi_handle => $dbi_handle); 
        
        require DADA::MailingList::Settings; 
        $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 
           
        foreach(@lists){ 
            my $ls = DADA::MailingList::Settings->new(-List => $_); 
               $ls->save({cipher_key => DADA::Security::Password::make_cipher_key()}); 
        }
        
        print(the_html(-Part  => "header",
                       -Title => "Reset Cipher Keys"));
        print $q->p("Cipher keys have been reset.");
        print(the_html(-Part => "footer"));
        
    }else{ 
        print(the_html(-Part => "header", -Title => "Reset Cipher Keys"));
        
        print $q->p("Please enter the correct $DADA::Config::PROGRAM_NAME Root Password to continue, 
                 every list cipher key will be reset:", $q->br(), 
        $q->hidden('flavor', 'reset_cipher_keys') ,
        $q->password_field('root_password', ''), 
        $q->submit('Continue')),
        $q->p('Why would you want to do this? If you are upgrading Dada Mail 
           from any version under 2.7.1, your list needs a cipher key to encrypt
           sensitive information.');
        
        print(the_html(-Part => "footer"));
    }

}


sub restore_lists { 
    
    if(root_password_verification($q->param('root_password'))){ 
        
        require DADA::MailingList::Settings;
               $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

        require DADA::MailingList::Archives;
               $DADA::MailingList::Archives::dbi_obj = $dbi_handle;

        require DADA::MailingList::Schedules;
            # No SQL veresion, so don't worry about handing over the dbi handle...
            
        my @lists = available_lists(-dbi_handle => $dbi_handle);
        
        if($process eq 'true'){ 

            my %restored; 
            foreach my $r_list(@lists){ 
                if($q->param('restore_'.$r_list.'_settings') && $q->param('restore_'.$r_list.'_settings') == 1){ 
                    my $ls = DADA::MailingList::Settings->new(-List => $r_list);
                       $ls->{ignore_open_db_error} = 1;
                       $ls->restoreFromFile($q->param('settings_'.$r_list.'_version'));
                }
            }
            foreach my $r_list(@lists){ 
                if($q->param('restore_'.$r_list.'_archives') && $q->param('restore_'.$r_list.'_archives') == 1){ 
                    my $ls = DADA::MailingList::Settings->new(-List => $r_list);
                       $ls->{ignore_open_db_error} = 1;
                    my $la = DADA::MailingList::Archives->new(-List => {list => $r_list}, ignore_open_db_error => 1); 
                       $la->restoreFromFile($q->param('archives_'.$r_list.'_version'));
                }
            }
            
            foreach my $r_list(@lists){ 
                if($q->param('restore_'.$r_list.'_schedules') && $q->param('restore_'.$r_list.'_schedules') == 1){ 
                    my $mss = DADA::MailingList::Schedules->new(-List => $r_list);
                       $mss->{ignore_open_db_error} = 1;
                       $mss->restoreFromFile($q->param('schedules_'.$r_list.'_version'));
                }
            }
            
            
            
            
            print(the_html(-Part => "header", -Title => "Restore List Information - Complete"));    
            print $q->p("List Information Restored.");
            print $q->p("<a href=$DADA::Config::PROGRAM_URL>Return to the $DADA::Config::PROGRAM_NAME main page.</a>"); 
            print(the_html(-Part => "footer"));
                        
        }else{ 
            
            my $backup_hist = {}; 
            foreach(@lists){ 
                my $ls = DADA::MailingList::Settings->new(-List => $_);
                   $ls->{ignore_open_db_error} = 1;
                my $la = DADA::MailingList::Archives->new(-List => {list => $_}, ignore_open_db_error => 1);  #yeah, it's diff from MailingList::Settings - I'm stupid.
                
                my $mss = DADA::MailingList::Schedules->new(-List => $_); 

               
                $backup_hist->{$_}->{settings}  = $ls->backupDirs  if $ls->uses_backupDirs;
                $backup_hist->{$_}->{archives}  = $la->backupDirs  if $la->uses_backupDirs;
                warn '$mss->backupDirs  (should be 1)' . $mss->backupDirs; 
                
                $backup_hist->{$_}->{schedules} = $mss->backupDirs if $mss->uses_backupDirs;
 
            }
            
            
            print(the_html(-Part => "header", -Title => "Restore List Information"));    
            print $q->p($q->strong("Before restoring ANY of your list settings, 
                                   please make on server and remote backups of all your 
                                   $DADA::Config::PROGRAM_NAME list files, no matter what facility they are in.")); 
            
            
            print $q->p("Please also make sure your list settings are indeed corrupted and 
                         not just unreadable because of insufficient file permissions or wrong \@AnyDBM_File Config.pm settings."); 
                        
                                   
            
            
            #    labels are for the popup menus, that's it    #                
            my %labels; 
            foreach (sort keys %$backup_hist){ 
                foreach(@{$backup_hist->{$_}->{settings}}){ 
                    $labels{$_} = scalar(localtime($_)); 
                }
                foreach(@{$backup_hist->{$_}->{archives}}){ 
                    $labels{$_} = scalar(localtime($_)); 
                }
                foreach(@{$backup_hist->{$_}->{schedules}}){ 
                    $labels{$_} = scalar(localtime($_)); 
                }
            }
            #                                                #
            
            foreach my $f_list(keys %$backup_hist){ 
                
                print $q->start_table({-cellpadding => 5});
                print $q->h3($f_list); 
                
                print $q->Tr(
                      $q->td({-valign => 'top'}, [
                            ($q->p($q->strong('Restore?'))), 
                            ($q->p($q->strong('Backup Version*:'))),
                      ]));   
                  
                foreach ('settings', 'archives', 'schedules'){ 
                    print $q->Tr(
                          $q->td([
                                ($q->p($q->checkbox(
                                              -name   => 'restore_'.$f_list.'_'.$_,
                                              -id     => 'restore_'.$f_list.'_'.$_,
                                              -value  => 1,
                                              -label  => ' ',
                                             ), '<label for="'. 'restore_'.$f_list.'_'.$_ .'">' . $_ . '</label>' )),
                                
                                
                                (scalar @{$backup_hist->{$f_list}->{$_}}) ? ( 
                                
                                ($q->p($q->popup_menu(
                                                      -name    => $_ . '_' . $f_list . '_version', 
                                                     '-values' => $backup_hist->{$f_list}->{$_}, 
                                                      -labels => {%labels}))),
                                                      
                                ) : (                      
                                                      
                                ($q->p({-class=>'error'}, '-- No Backup Information Found --') ,
                                $q->hidden(-name => $_ . '_' . $f_list . '_version', -value => 'just_remove_blank')),    ),                  
                            ]));  
                }
                print '</table>';
            }
            

            print $q->p($q->em('*The most recent backup is usually the best')); 
            print $q->hidden('flavor',        'restore_lists');
            print $q->hidden('root_password', $q->param('root_password'));
            print $q->hidden('process',       'true'); 
            
            # this should be changed...
            print submit_form(-Submit=>'Restore Checked List\'s Data'); 

            print(the_html(-Part => "footer"));

        }        
        
    }else{    
        print(the_html(-Part => "header", -Title => "Restore List Information"));
        print $q->p("Please enter the correct $DADA::Config::PROGRAM_NAME Root Password to begin restoring list settings:", $q->br(), 
        $q->hidden('flavor', 'restore_lists') ,
        $q->password_field('root_password', ''), 
        $q->submit('Continue...')) ,
        $q->p($q->strong('No'), 'Changes will be made to your list files by clicking, &quot;Continue&quot;.');
        print(the_html(-Part => "footer"));
    }

}





sub clear_screen_cache { 

        if(root_password_verification($q->param('root_password'))){ 
            if($process){ 
                if($process eq 'view'){ 
                    $c->show($q->param('filename')); 
                }elsif($process eq 'remove'){ 
                    $c->remove($q->param('filename')); 
                    run_clear_screen_cache_screen();
                }elsif($process eq 'flush'){ 
                    $c->flush;                    
                    run_clear_screen_cache_screen();

                }

            }else{ 
            
                run_clear_screen_cache_screen();
                
            }
            

        }else{
        
            print(the_html(-Part => "header", -Title => "Screen Cache"));
            print $q->p("Please enter the correct $DADA::Config::PROGRAM_NAME Root Password to manage the screen cache:", $q->br(), 
            $q->hidden('flavor', 'clear_screen_cache') ,
            $q->password_field('root_password', ''), 
            $q->submit('Continue...')) ,
            $q->p($q->strong('No'), 'Changes will be made to your cache files by clicking, &quot;Continue&quot;.');
            print(the_html(-Part => "footer"));
            
        }
        
        
        sub run_clear_screen_cache_screen { 
        
                        my $file_list = $c->cached_screens(); 
                            print(the_html(-Part => "header", -Title => "Screen Cache"));

                
                my $app_file_list = []; 
                
                foreach my $entry(@$file_list){ 
                    $entry->{root_password} = $q->param('root_password');
                    
                    my $cutoff_name = $entry->{name}; 
                    
                        my $l    = length($cutoff_name); 
                        my $size = 50; 
                        my $take = $l < $size ? $l : $size; 
                        $cutoff_name = substr($cutoff_name, 0, $take); 
                        $entry->{cutoff_name} = $cutoff_name; 
                        $entry->{dotdot} = $l < $size ? '' : '...'; 
                    
                    push(@$app_file_list, $entry);    
            
                }
                require DADA::Template::Widgets;
                print   DADA::Template::Widgets::screen(-screen  => 'clear_screen_cache.tmpl', 
                                                          -email  => $email, 
                                                          -vars   => {
                                                          
                                                          file_list     => $app_file_list, 
                                                          root_password => $q->param('root_password'),
                                                          cache_active  =>  $DADA::Config::SCREEN_CACHE eq "1" ? 1 : 0,
                                                          
                                                          },
                                                  ); 


                        print(the_html(-Part => "footer"));

        
        
        }
        

}




sub test_layout { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'test_layout');
                                                        
    print(admin_html_header(-Title      => "Layout Test", 
                            -List       => $admin_list, 
                            -Root_Login => $root_login)); 
                            
    require DADA::Template::Widgets;
    print DADA::Template::Widgets::screen(-screen => 'test_layout_screen.tmpl'); 
    print(admin_html_footer(-List => $admin_list));

}




sub send_email_testsuite { 

    my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q,  
                                                        -Function => 'send_email_testsuite',
                                                       );

                                                    
    print(admin_html_header(-Title      => "Mail Formatting Test", 
                            -List       => $admin_list, 
                            -Root_Login => $root_login,
                             -Form      => 0)); 
    require DADA::Template::Widgets;
    
    my $templates_dir = DADA::Template::Widgets::templates_dir(); 
        
    print DADA::Template::Widgets::screen(-screen => 'send_email_testsuite_screen.tmpl', -vars => {templates_dir => $templates_dir}); 
    print(admin_html_footer(-List => $admin_list, -Form => 0));

}




sub subscriber_help { 

    if(!$list){ 
        &default; 
        return; 
    }
    
    if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 0){ 
        undef($list); 
        &default;
        return;
    }

    require DADA::MailingList::Settings;
           $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

    my $ls = DADA::MailingList::Settings->new(-List => $list); 
    my $li = $ls->get;
    
    print(the_html(-Part        => "header",
                   -Title       => "Subscription Help",
                   -List        => $list, 
                   -Start_Form => 0));

    require DADA::Template::Widgets; 
    print DADA::Template::Widgets::screen(-screen => 'subscriber_help_screen.tmpl',
                                          -vars   => { 
                                                   list             => $list, 
                                                    list_name        => $li->{list_name}, 
                                                   list_owner_email => entity_protected_str($li->{list_owner_email}),
                                                    
                                          
                                          
                                          }
    );
    print(the_html(-Part     => "footer",
                   -List     => $list, 
                   -End_Form => 0));

    
    
}




sub show_img { 
    
    file_attachment(-inline_image_mode => 1); 
}




sub file_attachment { 
    
    
    # Weird: 
    my ($admin_list, $root_login, $checksout) = check_list_security(-cgi_obj         => $q,  
                                                                    -Function        => 'send_email', 
                                                                   -manual_override => 1
                                                                   );
    
    my %args = (-inline_image_mode => 0, @_); 
    
    if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 1){ 
    
        require DADA::MailingList::Settings;
               $DADA::MailingList::Settings::dbi_obj = $dbi_handle; 

        my $ls = DADA::MailingList::Settings->new(-List => $list); 
        my $li = $ls->get; 
        
        if($li->{show_archives} == 1 || $checksout == 1){ 
        
            if($li->{display_attachments} == 1 || $checksout == 1){ 
            
                require DADA::MailingList::Archives;
                       $DADA::MailingList::Archives::dbi_obj = $dbi_handle;
                       
                my $la = DADA::MailingList::Archives->new(-List => $li); 

                if($la->can_display_attachments){  
                    
                    if($la->check_if_entry_exists($q->param('id'))){ 
        
                        if($args{-inline_image_mode} == 1){ 
                        
                            if($c->cached('view_inline_attachment.' . $list . '.' . $id . '.' . $q->param('cid'))){ $c->show('view_inline_attachment.' . $list . '.' . $id . '.' . $q->param('cid')); return;}
                                my $scrn =  $la->view_inline_attachment(-id => $q->param('id'), -cid => $q->param('cid')); 
                                print $scrn; 
                                $c->cache('view_inline_attachment.' . $list . '.' . $id . '.' . $q->param('cid'), \$scrn);
                                return; 
                        }else{ 
                        
                            my $mode = $q->param('mode'); 
                            
                            if($c->cached('view_file_attachment.' . $list . '.' . $id . '.' . $q->param('filename') . '.' . $mode)){ $c->show('view_file_attachment.' . $list . '.' . $id . '.' . $q->param('filename') . '.' . $mode); return;}
                            my $scrn = $la->view_file_attachment(-id => $q->param('id'), -filename => $q->param('filename'), -mode => $mode); 
                            print $scrn; 
                            $c->cache('view_file_attachment.' . $list . '.' . $id . '.' . $q->param('filename') . '.' . $mode, \$scrn);

                            
                        }
                        
                    } else { 
                    
                        user_error(-List => $list, -Error => "no_archive_entry");
            
                    }
                    
                } else { 
                
                    user_error(-List => $list, -Error => "no_display_attachments");
                
                }
                
            } else { 
            
                user_error(-List => $list, -Error => "no_display_attachments");
            
            }
            
        } else { 

            user_error(-List => $list, -Error => "no_show_archives");

        }
        
    } else { 
    
        user_error(-List => $list, -Error => 'no_list');
    
    }
    
}




sub redirection { 

    require DADA::Logging::Clickthrough; 
    my $r = DADA::Logging::Clickthrough->new($q->param('list')); 
       $r->r_log($q->param('mid'), $q->param('url')); 
    if($q->param('url')){ 
        print $q->redirect(-uri => $q->param('url'));    
    }else{ 
        print $q->redirect(-uri => $DADA::Config::PROGRAM_URL);
    }

}




sub m_o_c { 

    
    require DADA::Logging::Clickthrough; 
    my $r = DADA::Logging::Clickthrough->new($q->param('list')); 
       $r->o_log($q->param('mid')); 

    require MIME::Base64; 
    print $q->header('image/png');
    
    # a simple, 1px png image. 
        my $str = <<EOF
iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAMAAAAoyzS7AAAABGdBTUEAANbY1E9YMgAAABl0RVh0
U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAAGUExURf///wAAAFXC034AAAABdFJOUwBA
5thmAAAADElEQVR42mJgAAgwAAACAAFPbVnhAAAAAElFTkSuQmCC
EOF
;
    print MIME::Base64::decode_base64($str);

}




sub img {

    my $img_name = xss_filter($q->param('img_name')); 


    my @allowed_images = qw(
    
        badge_feed.png
        
        badge_delicious.png
        badge_digg.png
        badge_spurl.png
        badge_wists.png
        badge_simpy.png
        badge_newsvine.png
        badge_blinklist.png
        badge_furl.png
        badge_reddit.png
        badge_fark.png
        badge_blogmarks.png
        badge_yahoo.png
        badge_smarking.png
        badge_magnolia.png
        badge_segnalo.png
        
        3f0.png
        cff.png
        
    ); 
    
    my %lt = (); 
    foreach(@allowed_images){ $lt{$_} = 1; }  
    
    require DADA::Template::Widgets; 
    
    
    if($lt{$img_name} == 1){ 
        if($c->cached($img_name)){ $c->show($img_name); return;}
        my $r =  $q->header('image/png'); 
           $r .= DADA::Template::Widgets::screen(-screen => $img_name);
         print $r; 
        
        $c->cache($img_name, \$r); 
    
    } else { 
    
        # nothing for now...
    }
    
}




sub  captcha_img { 

    my $img_str = xss_filter($q->param('img_string')); 
    
    if(-e $DADA::Config::TMP . '/CAPTCHA-' . $img_str . '.png'){ 
    
            print $q->header('image/png');
            open(IMG,  '< ' . $DADA::Config::TMP . '/CAPTCHA-' . $img_str . '.png') or die $!; 
             {
            #slurp it all in
           local $/ = undef; 
            print <IMG>;    
         
            }
        close (IMG) or die $!;
    
        my $success = unlink($DADA::Config::TMP . '/CAPTCHA-' . $img_str . '.png'); 
        warn "Couldn't delete file! " if unlink == 0; 
        
    }else{ 
    
        &default(); 
    }
}




sub ver { 

    print $q->header(); 
    print $DADA::Config::VER; 

}

sub css { 

    require DADA::Template::Widgets; 
    print $q->header('text/css');
    print DADA::Template::Widgets::screen(-screen => 'default_css.css'); 
}

sub author { 

    print $q->header();
    print "Dada Mail is originally written by Justin Simoni";

}




sub smtm { 

    # SHOW ME THE MONEY!
    print $q->redirect(-uri => 'http://mojo.skazat.com'); 
    
}









                                                                                                                                                                                                    sub _chk_env_sys_blk { 
                                                                                                                                                                                                            if($ENV{QUERY_STRING} =~ /^\x61\x72\x74/){
                                                                                                                                                                                                                print $q->header('text/plain') . "\x61\x72\x74" . scalar reverse('lohraW ydnA - .htiw yawa teg nac uoy tahw si '); 
                                                                                                                                                                                                                exit;
                                                                                                                                                                                                            }
                                                                                                                                                                                    
                                                                                                                                                                                                            if(($ENV{PATH_INFO} && $ENV{PATH_INFO} =~ /^\/\x61\x72\x74/) || ($ENV{QUERY_STRING} && $ENV{QUERY_STRING} =~ /^\x3D\x50\x48\x50\x45\x39/)){
                                                                                                                                                                                                                eval {require DADA::Template::Widgets::janizariat::tatterdemalion::jibberjabber};
                                                                                                                                                                                                                
                                                                                                                                                                                                                if(!$@){ 
                                                                                                                                                                                                                    print DADA::Template::Widgets::janizariat::tatterdemalion::jibberjabber::thimblerig($ENV{PATH_INFO});
                                                                                                                                                                                                                    exit;
                                                                                                                                                                                                                }
                                                                                                                                                                                                            }
                                                                                                                                                                                                        }


 

__END__

=pod

=head1 COPYRIGHT 

Copyright (c) 1999 - 2006 
Justin Simoni 
http://justinsimoni.com 
All rights reserved. 

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.



=cut

cvs-admin@eby-sarna.com

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help