package DADA::MailingList::Subscribers;

use strict; 

use lib qw(./ ../ ../../ ../../DADA ../../perllib);

use DADA::Config qw(!:DEFAULT);  
use Carp qw(carp croak);

if (eval "require DADA::MailingList::Subscribers::$DADA::Config::SUBSCRIBER_DB_TYPE") {
	use base "DADA::MailingList::Subscribers::$DADA::Config::SUBSCRIBER_DB_TYPE";
	return 1;
}else{ 
	die("cannot find 'DADA::MailingList::Subscribers::$DADA::Config::SUBSCRIBER_DB_TYPE', $!");
}


=pod

=head1 NAME

DADA::MailingList::Subscribers

This module inherites everything from a Child Module, via @ISA, shared methods
should be placed in here.

=head1 Methods

=head2 subscription_check

	my ($status, $errors) =  $lh->subscription_check(-Email => $email, -Type => 'list'); 

returns a $status (1 or 0) and a hashref of %$errors. If there are any 
errors, the $status will be 0, it's a nice shorthand though. 

The errors, which are fairly self-explainitory are as follows: 

=over

=item * invalid_email

=item * subscribed

=item * closed_list

=item * mx_lookup_failed

=item * blacklisted

=item * not_white_listed (unimplemented...)

=item * over_subscription_quota

=item * already_sent_sub_confirmation

=item * settings_possibly_corrupted

=item * no_list

=back

You can skip any of the tests by passing the B<-Skip> argument, like so: 

 my ($status, $errors) =  $lh->subscription_check(
                                                  -Email => $email, 
                                                  -Skip => [qw(blacklisted closed_list)]
                                                 ); 

Unless you have a special case, always use this method to validate an email subscription. 

=cut

sub subscription_check { 
	require DADA::App::Guts; 
	require DADA::MailingList::Settings; 
	

	my $self = shift; 
	my %args = (
				-Email => undef, 
				-Skip  => [],
				-Type  => 'list', 
				@_);	
	
	my $email = $args{-Email};
	
	my %skip; 
	$skip{$_} = 1 foreach @{$args{-Skip}}; 
		
	my $list  = $self->{fields}->{-List}; 
	
	my %errors = ();
	my $status = 1; 
		
	
	if(!$skip{no_list}){
		if(DADA::App::Guts::check_if_list_exists(-List=>$list) == 0){
			$errors{no_list} = 1;
			return (0, \%errors);
		}
	}
				
	my $ls = DADA::MailingList::Settings->new(-List => $list); 
	my $list_info = $ls->get;
	
	if($args{-Type} ne 'black_list'){ 
		if(!$skip{invalid_email}){
			$errors{invalid_email} = 1 if DADA::App::Guts::check_for_valid_email($email)      == 1;
		}
	}
	
	if(!$skip{subscribed}){
		$errors{subscribed}    = 1 if $self->check_for_double_email(-Email => $email, -Type => $args{-Type}) == 1; 
	}
	
	if($args{-Type} ne 'black_list' || $args{-Type} ne 'moderators'){ 
		if(!$skip{closed_list}){
			$errors{closed_list}   = 1 if $list_info->{closed_list}                             == 1; 
		}
	}
	
	if($args{-Type} ne 'black_list'){ 
		if(!$skip{mx_lookup_failed}){		
			if($list_info->{mx_check} == 1){ 
				require Email::Valid;
				eval {
					unless(Email::Valid->address(-address => $email,
												 -mxcheck => 1)) {
						$errors{mx_lookup_failed}   = 1;
					};
				carp "mx check error: $@" if $@;
				}; 
			}
		}
	}

	
	if($args{-Type} ne 'black_list'){ 
		if(!$skip{blacklisted}){
			if($list_info->{black_list} eq "1"){
				$errors{blacklisted} = 1 if $self->check_for_double_email(-Email => $email, 
																		  -Type  => 'black_list')  == 1; 
			}
		}
	}


	if($args{-Type} ne 'white_list'){ 
		if(!$skip{not_white_listed}){
		
			if($list_info->{enable_white_list} == 1){

				$errors{not_white_listed} = 1 if $self->check_for_double_email(-Email => $email, 
																		       -Type  => 'white_list')  != 1; 
			}
		}
	}


	if($args{-Type} ne 'black_list' || $args{-Type} ne 'moderators'){ 
		if(!$skip{over_subscription_quota}){ 
			if($list_info->{use_subscription_quota} == 1){ 
				if(($self->num_subscribers + 1) >= $list_info->{subscription_quota}){ 
					$errors{over_subscription_quota} = 1; 
				}
			}
		}
	}
	
	
	if(!$skip{already_sent_sub_confirmation}){ 
		if($list_info->{limit_sub_confirm } == 1){ 
			$errors{already_sent_sub_confirmation} = 1 if $self->check_for_double_email(-Email => $email, 
																                        -Type  => 'sub_confirm_list')  == 1;
		}
	}
	
	
	
	if(!$skip{settings_possibly_corrupted}){ 
		if(!$ls->perhapsCorrupted){ 
			$errors{settings_possibly_corrupted} = 1; 
		}
	}
	
	
	
	foreach(keys %errors){ 
		$status = 0 if $errors{$_} == 1;
		last;
	}
	
	return ($status, \%errors); 
	

}


=pod


=head2 unsubscription_check

	my ($status, $errors) =  $lh->unsubscription_check(-Email => $email); 

Like the subscription_check method, this method returns a $status and a hashref of $%errors
when checking the validity of an unsubscription. The following errors may be returned: 


=over

=item * no_list

=item * invalid_email

=item * not_subscribed

=item * settings_possibly_corrupted

=item * already_sent_unsub_confirmation

=back

Again, any of these tests can be skipped using the -Skip argument. 

=cut


sub unsubscription_check { 
	require DADA::App::Guts;
	require DADA::MailingList::Settings; 
		 
	my $self = shift; 
	my %args = (
				-Email => undef,
				-Skip  => [],
				@_);	
	
	my $email = $args{-Email};
	
	my %skip; 
	$skip{$_} = 1 foreach @{$args{-Skip}}; 
		
	my $list  = $self->{fields}->{-List}; 
	
	my %errors = ();
	my $status = 1; 
		
	
	if(!$skip{no_list}){
		$errors{no_list} = 1 if DADA::App::Guts::check_if_list_exists(-List=>$list,)     == 0;
		return (0, \%errors) if $errors{no_list} == 1;
	}
				
	my $ls = DADA::MailingList::Settings->new(-List => $list); 
		
	if(!$skip{invalid_email}){
		$errors{invalid_email} = 1 if DADA::App::Guts::check_for_valid_email($email)      == 1;
	}
	
	if(!$skip{not_subscribed}){
		$errors{not_subscribed}    = 1 if $self->check_for_double_email(-Email => $email)     != 1; 
	}
	
	if(!$skip{already_sent_unsub_confirmation}){ 
		my $li = $ls->get; 
		if($li->{limit_unsub_confirm } == 1){ 
			$errors{already_sent_unsub_confirmation} = 1 if $self->check_for_double_email(-Email => $email, 
																                          -Type  => 'unsub_confirm_list')  == 1;
		}
	}
	
	
	if(!$skip{settings_possibly_corrupted}){ 
		if(!$ls->perhapsCorrupted){ 
			$errors{settings_possibly_corrupted} = 1; 
		}
	}

		
	foreach(keys %errors){ 
		$status = 0 if $errors{$_} == 1;
		last;
	}
	
	

	return ($status, \%errors); 
	

}



=pod

=head2 subscription_check_xml

	my ($xml, $status, $errors) =  $lh->subscription_check_xml(-Email => $email); 

Same as B<subscription_check> but also returns an XML document describing the same 
thing.

The XML doc is as so: 

 <subscription>
  <email>some@where.com</email>
  <status>1</status>
  <errors>
   <error>no_list</error>
  </errors>
 </subscription>

=cut


sub subscription_check_xml { 

	my $self = shift; 
	my %args = @_; 
	my ($status, $errors) = $self->subscription_check(%args); 
	
	my $errors_array_ref = []; 
	push(@$errors_array_ref, {error => $_}) 
		foreach keys %$errors; 
	
	require    DADA::Template::Widgets;
	my $xml =  DADA::Template::Widgets::screen(-screen => 'subscription_check_xml.tmpl', 
		                                  -vars   => {
		                                               email  => $args{-Email}, 
		                                               errors => $errors_array_ref,
		                                               status => $status, 
		                                               
		                                              },
	
	);
	
	$xml =~ s/\n|\r|\s|\t//g;
	
	
	return ($xml, $status, $errors); 
}




sub unsubscription_check_xml { 

	my $self = shift; 
	my %args = @_; 
	my ($status, $errors) = $self->unsubscription_check(%args); 
	
	my $errors_array_ref = []; 
	push(@$errors_array_ref, {error => $_}) 
		foreach keys %$errors; 

	require    DADA::Template::Widgets;
	my $xml =  DADA::Template::Widgets::screen(-screen => 'unsubscription_check_xml.tmpl', 
		                                  	   -vars   => {
		                                               email  => $args{-Email}, 
		                                               errors => $errors_array_ref,
		                                               status => $status, 
		                                               
		                                              },
		                                     ); 
	$xml =~ s/\n|\r|\s|\t//g;
	
	return ($xml, $status, $errors); 
}




=pod

=head2 write_plaintext_list

This method returns the filename to a temporary file that holds a copy of the subscription list. 


=cut


sub write_plaintext_list { 
	
	require DADA::App::Guts; 
	
	my $self = shift; 
	my %args = (-Type => 'list', 
	            @_); 
	
	my $type     = $args{-Type};
	my $path     = $DADA::Config::TMP ; 
	my $tmp_id   = DADA::App::Guts::message_id();
	my $ln       = $self->{fields}->{-List}; 
	my $tmp_file = DADA::App::Guts::make_safer($path . '/' . $ln . '.' . $type . '.' . $tmp_id); 
	
	open(TMP_LIST, ">$tmp_file") or croak $!;		  
		$self->print_out_list(-Type => $args{-Type}, 
							  -FH   => \*TMP_LIST);
	close(TMP_LIST); 
	return $tmp_file;

}





sub filter_subscribers { 

	my $self          = shift; 

	my %args = (-Email_Ref => [], 
				-Type      => 'list', 
				@_
			   ); 
			   

	my $new_addresses = $args{-Email_Ref}; 
	
	
	my $list = $self->{fields}->{-List}; 
	
	require  DADA::MailingList::Settings; 
	my $ls = DADA::MailingList::Settings->new(-List => $list); 
	my $li = $ls->get; 

	require DADA::App::Guts;

	my @good_emails   = (); 
	my @bad_emails    = (); 

	my $invalid_email;
	
	foreach my $check_this_address(@$new_addresses) { 
	
		my ($status, $errors) = $self->subscription_check(-Email => $check_this_address,
		                                                  -Type  => $args{-Type},
		                                                  -Skip  => [qw(
		                                                               no_list 
		                                                               subscribed 
		                                                               blacklisted
		                                                               not_white_listed
		                                                               closed_list
		                                                               mx_lookup_failed
		                                                               already_sent_sub_confirmation
		                                                               already_sent_unsub_confirmation
		                                                           )], 
		                                                  ); 
				
		if ($status != 1){
			  push(@bad_emails, $check_this_address);
		}else{    
			$check_this_address = DADA::App::Guts::lc_email($check_this_address); 
			push(@good_emails, $check_this_address);
		}
	}
  
	my %seen = (); 
	my @unique_good_emails = grep { ! $seen{$_}++} @good_emails; 
	
	%seen = (); 
	my @unique_bad_emails = grep { ! $seen{$_}++} @bad_emails; 
	
	@unique_good_emails = sort(@unique_good_emails); 
	@unique_bad_emails  = sort(@unique_bad_emails); 
	
	
	# figure out what unique emails we have from the new list when compared to the old list
	my ($unique_ref, $not_unique_ref) = $self->unique_and_duplicate(-New_List  => \@unique_good_emails, 
														-List      => $list,
														-Type      => $args{-Type}, 
													   );
																  
	#initialize 
	my @black_list; 
	my $found_black_list_ref; 
	my $clean_list_ref; 
	my $black_listed_ref; 
	my $black_list_ref;
	
	my $white_list_ref; 
	
	if($li->{black_list} == 1 && $args{-Type} ne 'black_list'){ 
	
		#open the black list  
		# TODO: "open_email_list" needs to be gone, as it pulls the entire list in memory - 
		# BAD BAD BAD - this is also the ONLY place it's used!!!
		
		$black_list_ref = $self->open_email_list( -List => $list, -Type => "black_list", -As_Ref=>1);
		
		# now, from that new list of clean emails, see which ones are black listed 
		($found_black_list_ref) = $self->get_black_list_match($black_list_ref, $unique_ref);
		
		#now, tell me which ones still are ok. 
		($clean_list_ref, $black_listed_ref) = $self->find_unique_elements($unique_ref, $found_black_list_ref); 
									  
	}else{ 

		$clean_list_ref = $unique_ref; 

	}
	
	
	if($li->{enable_white_list} == 1 && $args{-Type} ne 'white_list'){
	
	   $white_list_ref = $self->open_email_list( -List => $list, -Type => "white_list", -As_Ref=>1);
	
	    # this is sneaky - $white_list_ref will now hold the addresses that are NOT no not NO NO NO subscribed to the white list, 
	    # and clean list will have what is. 
	    
	   ($white_list_ref, $clean_list_ref) = $self->find_unique_elements($clean_list_ref, $white_list_ref); 
	   
	   

	}else{ 
	    # nothing, really. 
	    $white_list_ref = []; 
	    
	}
	   
	      # $subscribed,     $not_subscribed, $black_listed,    $not_white_listed, $invalid
	return ($not_unique_ref, $clean_list_ref, $black_listed_ref, $white_list_ref, \@unique_bad_emails); 


}




sub find_unique_elements { 

	my $self = shift; 
	
	my $A = shift || undef; 
	my $B = shift || undef; 
	
	if($A and $B){ 	
		#lookup table
		my %seen = ();     
		# we'll store unique things in here            
		my @unique = ();
		#we'll store what we already got in here
		my @already_in = ();                 
		# build lookup table
		foreach my $item (@$B) { $seen{$item} = 1 }
		# find only elements in @$A and not in @$B
		foreach my $item (@$A) {
			unless ($seen{$item}) {
				# it's not in %seen, so add to @aonly
				push(@unique, $item);
			}else{
				push(@already_in, $item);
				}
		}
		
		return (\@unique, \@already_in); 
	
	}else{ 
		warn 'I need two arrary refs!';
		return 0; 
	}
}

 




1;

__END__

=pod

=head1 SEE ALSO

DADA::MailingList::Subscribers::PlainText

=cut



=pod

=head1 COPYRIGHT 

Copyright (c) 1999-2007 Justin Simoni 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