package DADA::App::FormatMessages;

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

use DADA::Config;

use MIME::Parser;
use MIME::Entity; 

use DADA::Config;
use DADA::App::Guts; 
use DADA::MailingList::Settings; 

use Carp; 

use vars qw($AUTOLOAD); 

=pod

=head1 NAME

DADA::App::FormatMessages

=head1 SYNOPSIS

 my $fm = DADA::App::FormatMessages->new(-List => $list); 
 
 # The subject of the message is...  
   $fm->Subject('This is the subject!'); 
   
 # Use information you find in the headers 
  $fm->use_header_info(1);
 
 # Use the list template   
   $fm->use_list_template(1); 
 
 # Use the email template.
   $fm->use_email_templates(1);  
 
 # Consider this message as if it's from a discussion list
   $fm->treat_as_discussion_msg(1);
 
 my ($header_str, $body_str) = $fm->format_headers_and_body(-msg => $msg);
 
 # (... later on... 
 
 use DADA::MAilingList::Settings; 
 use DADA::Mail::Send; 
 
 my $ls = DADA::MailingList::Settings->new(-List => $list); 
 my $mh = DADA::Mail::Send->new($ls->get); 
 
 $mh->send(
           $mh->return_headers($header_str), 
		   Body => $body_str,
		  ); 

=head1 DESCRIPTION

DADA::App::FormatMessages is used to get a email message ready for sending to your 
mailing list. Most of its magic is behind the scenes, and isn't something you have
to worry about, but we'll go through some detail. 



=head1 METHODS

=cut




my %allowed = (
	Subject                      => undef, 
	use_list_template            => 0, 
	use_html_email_template      => 1,
	use_plaintext_email_template => 1, 
	treat_as_discussion_msg      => 0, 
	use_header_info              => 0, 
	orig_entity                  => undef, 
);



=pod

=head2 new


 my $fm = DADA::App::FormatMessages->new(-List => $list); 


=cut

sub new {

	my $that = shift; 
	my $class = ref($that) || $that; 
	
	my $self = {
		_permitted => \%allowed, 
		%allowed,
	};
	
	bless $self, $class;
	
	my %args = (-List => undef,
					@_); 
		
   die "no list!" if ! $args{-List}; 	
	
   $self->_init(\%args); 
   return $self;
}




sub AUTOLOAD { 
    my $self = shift; 
    my $type = ref($self) 
    	or croak "$self is not an object"; 
    	
    my $name = $AUTOLOAD;
       $name =~ s/.*://; #strip fully qualifies portion 
    
    unless (exists  $self -> {_permitted} -> {$name}) { 
    	croak "Can't access '$name' field in object of class $type"; 
    }    
    if(@_) { 
        return $self->{$name} = shift; 
    } else { 
        return $self->{$name}; 
    }
}




sub _init  {

	my $self    = shift; 
	my $args    = shift;
	
	my $parser = new MIME::Parser; 
	   $parser = optimize_mime_parser($parser); 
	   
 	$self->{parser} = $parser; 
 	
 	my $ls = DADA::MailingList::Settings->new(-List => $args->{-List}); 
 	
 	$self->{li}    = $ls->get; 
 	
 	$self->{-List} = $args->{-List};

	$self->Subject($self->{li}->{list_name}); 
	
	$self->use_email_templates(1); 
		
	$self->use_list_template($self->{li}->{apply_list_template_to_html_msgs}); 

}




sub use_email_templates { 
	
	my $self = shift; 
	my $v    = shift; 
		
	if($v == 1 || $v == 0) { 
	
		$self->use_html_email_template($v); 
		$self->use_plaintext_email_template($v); 
		$self->{use_email_templates} = $v;
		
		return  $self->{use_email_templates}; 
		
	}else{ 
		return $self->{use_email_templates};
	}

}




sub format_message { 

	my $self = shift; 
	
	my %args = (-msg  => undef, 
				@_); 
	
	die "no msg!"  if ! $args{-msg};
	
	
	my $entity     = $self->{parser}->parse_data($args{-msg});
	
	$self->Subject($entity->head->get('Subject', 0))
		if $entity->head->get('Subject', 0); 

	$entity     = $self->_format_headers($entity)
		if $self->treat_as_discussion_msg; 
		
	$entity     = $self->_fix_for_only_html_part($entity); 
	$entity     = $self->_format_text($entity);		
	
	return $entity->as_string;
}




=pod

=head2 format_headers_and_body

 my ($header_str, $body_str) = $fm->format_headers_and_body(-msg => $msg);

Given a string, $msg, returns two variables; $header_str, which will have all 
the headers and $body_str, that holds the body of your message. 

=head1 ACCESSORS

=head2 Subject

Set the subject of a message

=head2 use_list_template

If set to a true value, will apply the list template to the HTML part of your message 

=head2 use_email_templates

If set to a true value, will apply your email templates to the HTML/PlainText parts 
of your message. 

=head2 treat_as_discussion_msg 

When set to a true value, will try the message as if it was from a discussion list. 

=head2 use_header_info

If set to a true value, will inspect the headers of a message (for example, the From: line) 
to work with

=cut

sub format_headers_and_body { 

	my $self = shift; 
	
	my %args = (-msg                 => undef, 
		  	    @_
		  	   ); 

	die "no msg!"  if ! $args{-msg};
	
	my $entity     = $self->{parser}->parse_data($args{-msg});

	$self->orig_entity($entity); 

	$self->Subject($entity->head->get('Subject', 0))
		if $entity->head->get('Subject', 0);

	$entity     = $self->_format_headers($entity)
		if $self->treat_as_discussion_msg; 
	
	$entity     = $self->_fix_for_only_html_part($entity); 
	$entity     = $self->_format_text($entity);		
	
	# yeah, don't know why you have to do it 
	# RIGHT BEFORE you make it a string...
	$entity->head->delete('X-Mailer')
    	if $entity->head->get('X-Mailer', 0); 


	return ($entity->head->as_string, $entity->body_as_string) ;

}


=pod

=head1 PRIVATE METHODS

=head2 _fix_for_only_html_part

 $entity = $self->_fix_for_only_html_part($entity); 

Changes the single part, HTML entity into a multipart/alternative message, 
with an auto plaintext version. 

=cut


sub _fix_for_only_html_part { 

	my $self   = shift; 
	my $entity = shift; 
	
	$entity = $self->_create_multipart_from_html($entity); 

	return $entity; 

}




=pod

=head2 _format_text

 $entity = $self->_format_text($entity);	

Given an MIME::Entity (may be multipart) will attempt to:

=over

=item * Apply the List Template

=item * Apply the Email Template

=item * interpolate the message to change Dada Mail's pseudo tags to their real value

=back

=cut

sub _format_text { 

	my $self   = shift; 
	my $entity = shift; 
	
	
	
	my @parts  = $entity->parts; 
	
	if(@parts){
		my $i; 
		foreach $i (0 .. $#parts) {
			$parts[$i]= $self->_format_text($parts[$i]);	
		}
		$entity->sync_headers('Length'      =>  'COMPUTE',
							  'Nonstandard' =>  'ERASE');
	}else{ 		
	
		my $is_att = 0; 
		if (defined($entity->head->mime_attr('content-disposition'))) { 
				$is_att = 1
				 if  $entity->head->mime_attr('content-disposition') =~ m/attachment/; 
			}
			
		if(
		    (
		    ($entity->head->mime_type eq 'text/plain') ||
			($entity->head->mime_type eq 'text/html')  
		  	) 
		    && 
		    ($is_att != 1)
		  ) {
			
			
			        
			my $body    = $entity->bodyhandle;
			my $content = $body->as_string;
			
			
			if($content){ # do I need this?
			
				my $switch = 1; 
				   $switch = 0 
						if	$self->treat_as_discussion_msg           &&
							$self->{li}->{group_list} == 1           && 
							$self->{li}->{allow_group_interpolation} != 1;
				
				if($switch){ 	
					   $content = $self->_parse_in_list_info(-data => $content, 
															 -type => $entity->head->mime_type, 
														    );
				
				}
				

					
					
				$content = $self->_apply_template(-data => $content, 
												 -type => $entity->head->mime_type, 
												);
				
				$content = $self->_add_opener_image($content)
					if $self->{li}->{enable_open_msg_logging} == 1 && 
					   $entity->head->mime_type               eq 'text/html';
						   
		       my $io = $body->open('w');
				  $io->print( $content );
				  $io->close;
				$entity->sync_headers('Length'      =>  'COMPUTE',
									  'Nonstandard' =>  'ERASE');
		
			}
		}
		return $entity; 
	}
	
	return $entity; 
}




sub _add_opener_image { 

	my $self    = shift; 
	my $content = shift; 
	
	# body tags will now be on their own line, regardless.
	$content =~ s/(\<body.*?\>|<\/body\>)/\n$1\n/gi; 
	
	my $img_opener_code = '<!--open_img--><img src="' . $PROGRAM_URL . '/spacer_image/[list]/[message_id]/spacer.png" /><!--/open_img-->';

	$content =~ s/(\<body.*?\>)/$1\n$img_opener_code/g;
	
	return $content; 

}




=pod

=head2 _create_multipart_from_html

 $entity = $self->_create_multipart_from_html($entity); 


Recursively goes through a multipart entity, changing any non-attachment
singlepart HTML message into a multipart/alternative message with an 
auto-generated PlainText version. 

=cut


sub _create_multipart_from_html { 

	my $self   = shift; 
	my $entity = shift; 
	
	if(
	  ($entity->head->mime_type                         eq 'text/html' ) && 
	  ($entity->head->mime_attr('content-disposition') !~ m/attachment/)
	  ){ 	  		
			$entity = $self->_make_multipart($entity); 		   
	}
	elsif(
		   ($entity->head->mime_type                         eq 'multipart/mixed') && 
	       ($entity->head->mime_attr('content-disposition') !~ m/attachment/)){ 
      		
      		my @parts = $entity->parts(); 
      		my $i = 0; 
      		if(!@parts){ 
      			warn 'multipart/mixed with no parts?! Something is screwy....'; 
      		}else{ 
      			my $i; 
				foreach $i (0 .. $#parts) {
					if(
					  ($parts[$i]->head->mime_type eq 'text/html') &&
					  ($parts[$i]->head->mime_attr('content-disposition') !~ m/attachment/)) { 
							$parts[$i] = $self->_make_multipart($parts[$i]);
					}
				$entity->sync_headers('Length'      =>  'COMPUTE',
						  			  'Nonstandard' =>  'ERASE');
				}
      		}
	}
	
	$entity->sync_headers('Length'      =>  'COMPUTE',
						  'Nonstandard' =>  'ERASE');

	return $entity; 
}



=pod

=head2 _make_multipart

 $entity = $self->_make_multipart($entity); 	
 
Takes a single part entity and changes it to a multipart/alternative message, 
with an autogenerated PlainText version. 

=cut

sub _make_multipart { 

	my $self   = shift; 
	my $entity = shift; 
	
	require MIME::Entity; 
		
	my $html_body    = $entity->bodyhandle;
	my $html_content = $html_body->as_string;

	$entity->make_multipart('alternative'); 
	
	my $plaintext_entity = MIME::Entity->build(Type => 'text/plain', 
											   Data => $self->_create_plaintext_from_html($html_content)
											  ); 
	
	$entity->add_part($plaintext_entity, 0); 

	return $entity; 
}



=pod

=head2 _create_plaintext_from_html

 my $PlainText_var = $self->_create_plaintext_from_html($HTML_Ver); 

 Given a B<string>, simple converts the HTML to PlainText

=cut

sub _create_plaintext_from_html { 

	my $self   = shift; 
	my $body   = shift; 
	#yay, we'll see...
	return convert_to_ascii($body); 
}




=pod

=head2 _format_headers 

 $entity = $self->_format_headers($entity)

Given an entity, will do some transformations on the headers. It will: 

=over

=item * Tack on the list name/list shortname on the Subject header for discussion lists

=item * Add the correct Reply-To header

=item * Remove any Message-ID headers

=item * Makes sure the To: header has a real name associated with it

=back

=cut

sub _format_headers { 

	my $self   = shift; 	 
	my $entity = shift; 
	
	if($self->{li}->{group_list} == 1){

		if($self->{li}->{append_list_name_to_subject} == 1){  
			if($self->{li}->{append_discussion_lists_with} eq "list_name"){ 
				my $subject = $entity->head->get('Subject', 0);
				$entity->head->replace('Subject', $self->_list_name_subject($self->{li}->{list_name}, $subject));
			}else{ 
				my $subject = $entity->head->get('Subject', 0);
				$entity->head->replace('Subject', $self->_list_name_subject($self->{-List}, $subject));			
			}
		}
				
		if($self->{li}->{add_reply_to} == 1){ 
			my $reply_to = Email::Address->new($self->{li}->{list_name}, $self->{li}->{discussion_pop_email});
			
		   $entity->head->delete('Reply-To');
		   $entity->head->add('Reply-To', $reply_to);
		
		} else {
		
			my $original_sender = $entity->head->get('From', 0);
		   $entity->head->delete('Reply-To');
		   $entity->head->add('Reply-To', $original_sender); 
		}
		
		$entity->head->delete('Return-Path'); 
		
		$entity->head->delete('Cc');
		$entity->head->delete('Bcc');
		



	}else{ 
	
		$entity->head->delete('From'); 
	
	}
	
	
	
	$entity->head->delete('Message-ID'); 
	
	require Email::Address; 
	
	$entity->head->add('To', $self->{li}->{list_owner_email})
	 	if ! $entity->head->get('To', 0); 
	
	my @addrs = Email::Address->parse($entity->head->get('To', 0));
  	if($addrs[1]){ 
  		# more than 1? What's going on?!
  		# who knows. Leave it at that!
  	}else{ 
  		my $to_addy = $addrs[0];
  		if(!$to_addy->phrase){ 
  			$to_addy->phrase($self->{li}->{list_name}); 
  			$entity->head->delete('To');
		    $entity->head->add('To', $to_addy->format); 
  		}
  	}
  
 	return $entity;
}




=pod

=head2 _list_name_subject

 my $subject = $self->_list_name_subject($list_name, $subject));

Appends, B<$list_name> onto subject. 


=cut

sub _list_name_subject { 

	# This is awful code, yuck!
	
	my $self    = shift;
	my $list    = shift; 
	my $subject = shift; 
	
	 $subject   =~ s/\[$list\]//; 
	 $subject   =~ s/^((RE:|AW:)\s+)+//i; # AW (German!) 
	
	my $re      = $1;
	   $re      =~ s/^(\s+)//; 
	   $re      =~ s/(\s+)$//; 
	   $re      = ' ' . $re if $re; 
	   
	$subject    =~ s/^(\s+)//;
	$subject    = '[' . $list . ']' . "$re $subject"; 
	
	return $subject; 

}




=pod

=head2 _parse_in_list_info

 $data = $self->_parse_in_list_info(-data => $data, 
                                    -type => (PlainText/HTML), 
                                   );
								        
Given a string, changes Dada Mail's pseudo tags into what they represent. 

B<-type> can be either PlainText or HTML

=cut

sub _parse_in_list_info { 

	my $self = shift; 
	
	my %args = (-data => undef, 
				-type => undef, 
					@_); 
 
 	die "no data! $!" if ! $args{-data}; 
 	die "no type! $!" if ! $args{-type}; 
 	
 	my $data = $args{-data}; 
 	# These are stupid.   
 	   $args{-type} = 'HTML'      if $args{-type} eq 'text/html';
 	   $args{-type} = 'PlainText' if $args{-type} eq 'text/plain';
 	   	   
#### Not completely happy with the below --v

    my $s_link   = $self->_macro_tags(-type => 'subscribe'  ); 
    my $us_link  = $self->_macro_tags(-type => 'unsubscribe'); 
     
### this is messy. 

	$data =~ s/\[plain_list_subscribe_link\]/$s_link/g;	
	$data =~ s/\[plain_list_unsubscribe_link\]/$us_link/g;

	
	if($args{-type} eq 'HTML'){ 
		 $s_link  =  "<a href=\"$s_link\">$s_link</a>";
		 $us_link =  "<a href=\"$us_link\">$us_link</a>";
	}
	
	$data =~ s/\[list_subscribe_link\]/$s_link/g;	
	$data =~ s/\[list_unsubscribe_link\]/$us_link/g;

	# confirmations.
	
    my $cs_link  = $self->_macro_tags(-type => 'confirm_subscribe',  -make_pin => 1); 
    my $cus_link = $self->_macro_tags(-type => 'confirm_unsubscribe', -make_pin => 1); 

	$data =~ s/\[plain_list_confirm_subscribe_link\]/$cs_link/g;	
	$data =~ s/\[plain_list_confirm_unsubscribe_link\]/$cus_link/g;

	
	if($args{-type} eq 'HTML'){ 
		my $s_link  =  "<a href=\"$cs_link\">$cs_link</a>";
		my $us_link =  "<a href=\"$cus_link\">$cus_link</a>";
	}
	
	$data =~ s/\[list_confirm_subscribe_link\]/$cs_link/g;	
	$data =~ s/\[list_confirm_unsubscribe_link\]/$cus_link/g;
	
	
	my $info; 
	my $privacy_policy; 
	my $physical_address; 
	
	if($args{-type} eq 'HTML'){ 
		
		 $info             = webify_plain_text($self->{li}->{info}); 
		 $privacy_policy   = webify_plain_text($self->{li}->{privacy_policy});
		 $physical_address = webify_plain_text($self->{li}->{physical_address}); 
	
	}else{ 
	
		$info             = $self->{li}->{info}; 
		$privacy_policy   = $self->{li}->{privacy_policy}; 
		$physical_address = $self->{li}->{physical_address}; 
	
	}

	$data =~ s/\[info\]/$info/g;
	$data =~ s/\[privacy_policy\]/$privacy_policy/g;
	$data =~ s/\[physical_address\]/$physical_address/g;

	
###/ this is messy 
	
	 # I loathe this. 
	 $data = DADA::App::Guts::interpolate_string(-String      => $data, 
								                 -List_Db_Ref => $self->{li},
								                 -Skip        => ['list', 'list_name']
								                );
								                
## This isn't even list info, but, eh...

	
	if($self->use_header_info){ 
		require Mail::Address; 
		if(my $to_temp = (Mail::Address->parse($self->orig_entity()->head->get('To', 0)))[0]){ 
	  		my $email = $to_temp->address();
	  		   $data =~ s/\[email\]/$email/g;	
	  	}
	}
	


## Global Stuff, now!

	$data =~ s/\[program_name\]/$PROGRAM_NAME/g;
	$data =~ s/\[program_url\]/$PROGRAM_URL/g; 
	
	
	return $data; 
	
}




=pod

=head2 _macro_tags

 my $s_link   = $self->_macro_tags(-type => 'subscribe'  ); 
 my $us_link  = $self->_macro_tags(-type => 'unsubscribe');

Explode the various B<link> pseudo tags into a form that will later be interpolated. 

B<-type> can be: 

=over

=item * subscribe

=item * unsubscribe

=item * confirm_subscribe

=item * confirm_unsubscribe

=back


=cut

sub _macro_tags { 

	my $self = shift; 
	

	my %args = (-url         => $PROGRAM_URL, # Really.
				-email        => undef, 
				-pin          => undef, 
				-make_pin     => 0,
				-list         => $self->{-List},
				-escape_list  => 1,
				-escape_all   => 0,
				@_
				); 
	
	my $type; 
	
	if($self->use_header_info){ 
		require Mail::Address; 
		if(my $to_temp = (Mail::Address->parse($self->orig_entity()->head->get('To', 0)))[0]){ 
	  		$args{-email} = $to_temp->address();
		}
	
	}
	
	if($args{-email} && $args{-make_pin} == 1){ 
		$args{-pin} = make_pin(-Email => $args{-email}); 
	}

	if($args{-type} eq 'subscribe'){ 
	
		$type = 's'; 
	
	}elsif($args{-type} eq 'unsubscribe'){ 
	
		$type = 'u'; 
	
	}elsif($args{-type} eq 'confirm_subscribe'){ 
	
		$type = 'n';
		$args{-email} ||= '[email_name]@[email_domain]';
		$args{-pin}   ||= '[pin]';
	
	}elsif($args{-type} eq 'confirm_unsubscribe'){ 
		
		$type = 'u'; 
		$args{-email} ||= '[email_name]@[email_domain]';
		$args{-pin}   ||= '[pin]';
	
	}
	
	my $link = $args{-url} . '/';
	
	if($args{-escape_all} == 1){ 
		foreach($args{-email}, $args{-pin}, $type, $args{-list}){ 
			$_ = uriescape($_);
		}
		
	}elsif($args{-escape_list} == 1){ 
		require URI::Escape;
		$args{-list} = URI::Escape::uri_escape($args{-list}, "\200-\377");
	}
	
	if($args{-email}){ 
	my $tmp_email = $args{-email};
	
	    $tmp_email =~ s/\@/\//g;	# snarky. Replace, "@" with, "/"
	    $tmp_email =~ s/\+/_p2Bp_/g;
	    
	    $args{-email} = $tmp_email; 
	}
	
	my @qs; 
	push(@qs,  $type)         if $type;   
	push(@qs,  '[list]')  if $args{-list};	
	push(@qs,  $args{-email}) if $args{-email};
	push(@qs,  $args{-pin})   if $args{-pin};
	
	$link .= join '/', @qs; 
	
	return $link . '/';
	
}




=pod

=head2 _apply_template

$content = $self->_apply_template(-data => $content, 
								  -type => $entity->head->mime_type, 
								 );

Given a string in B<-data>, applies the correct email mailing list template, 
depending on what B<-type> is passed, this will be either the PlainText or
HTML version.							 	

=cut

sub _apply_template {

	my $self = shift; 
	
	my %args = (-data                => undef, 
				-type                => undef, 
				@_,
				); 

	die "no data! $!" if ! $args{-data}; 
	die "no type! $!" if ! $args{-type}; 

 	# These are stupid.   
 	   $args{-type} = 'HTML'      if $args{-type} eq 'text/html';
 	   $args{-type} = 'PlainText' if $args{-type} eq 'text/plain';
 	   
	my $data = $args{-data}; 

	my $new_data; 
	my $template_out = 0; 
	
	  
	if($args{-type} eq 'PlainText'){ 
		$template_out = $self->use_plaintext_email_template;
	}elsif($args{-type} eq 'HTML'){   
		$template_out = $self->use_html_email_template;
	}
	
	if($template_out){ 
	
		if($args{-type} eq 'PlainText'){ 
			$new_data = strip($self->{li}->{mailing_list_message}) || '[message_body]';
		}else{ 
			$new_data = strip($self->{li}->{mailing_list_message_html}) || '[message_body]';
		}
		
		if($args{-type} eq 'HTML'){  
		
			my $bodycontent     = undef; 
			my $new_bodycontent = undef; 
		
			# code below replaces code above - any problems?
			# as long as the message dada is valid HTML...
			$data =~ m/\<body.*?\>([\s\S]*?)\<\/body\>/i;
			$bodycontent = $1; 
   
			if($bodycontent){ 
							
				$new_bodycontent = $bodycontent;
			
				$new_data =~ s/\[message_body\]/$new_bodycontent/;
				
				my $safe_bodycontent = quotemeta($bodycontent);
				
				$data     =~ s/$safe_bodycontent/$new_data/;			
				$new_data = $data; 
				
			}else{ 			
					$new_data =~ s/\[message_body\]/$data/g;
			}
			
		}else{ 
				$new_data =~ s/\[message_body\]/$data/g;	
		}
	}else{ 
	
		$new_data = $data; 
	}
	
	
	if($args{-type} eq 'HTML'){  

		$new_data = $self->_apply_list_template($new_data)
				if $self->use_list_template; 			
	}
	
	$new_data = $self->_parse_in_list_info(-data => $new_data, 
								          -type => $args{-type}, 
								        );
	
	#dude. If there ain't no body...
	if($args{-type} eq 'HTML'){  
		if($new_data !~ /\<body(.*?)\>/i){

			my $title = $self->Subject || 'Mailing List Message'; 

			$new_data = qq{ 
<html> 
<head>
<title>$title</title>
</head> 
<body> 
$new_data
</body> 
</html> 
			};
		}
	}
	# seriously...
	
	return $new_data; 
	
}

=pod

=head2 _apply_list_template

 $new_data = $self->_apply_list_template($new_data);

Given a string, will apply the List Template. The List Template is 
usually used for HTML screens that appear in your web browser. 

=cut

sub _apply_list_template { 

	my $self = shift; 
	
	require DADA::Template::HTML; 
	
	my $html      = shift; 
	my $new_html  = shift; 
	my $body_html = ''; 
	
	$html =~ s/(\<body.*?\>|<\/body\>)/\n$1\n/gi; 

	my @lines = split("\n", $html); 
		foreach (@lines){ 
			if(/\<body(.*?)\>/i .. /\<\/body\>/i)	{
				next if /\<body(.*?)\>/i || /\<\/body\>/i;
				$body_html .= $_ . "\n";
			}
		}

	$body_html ||= $html; 
			 
	$new_html = (DADA::Template::HTML::the_html(-Part  => "header",
						                        -Title  =>  $self->Subject,
						                        -List   => $self->{li}->{list},
					                            -Header => 0
					                            -Start_Form   => 0, 
					                           )) . 
									   
	 $body_html                     	          .       						   
			   
	 DADA::Template::HTML::the_html(-Part     => "footer",
			                       -List   => $self->{li}->{list}, 
			                       -End_Form => 0, 
			 );                   

	my $save_f = quotemeta($HTML_FOOTER); # Thanks but no thanks spam reports. 
	   $new_html =~ s/$save_f//g; 
	
	return $new_html;
	
}

sub DESTROY {

	my $self = shift; 
	$self->{parser}->filer->purge;
}


1;