#!/usr/bin/perl -T
use strict; 
use lib qw(./ ./DADA ../ ../DADA ../DADA/perllib); 
use CGI::Carp "fatalsToBrowser"; 

#---------------------------------------------------------------------#
# archive_editor.cgi
# For instructions, see the pod of this file. try:
#
#  http://mojo.skazat.com/support/documentation/archive_editor.cgi
#
#---------------------------------------------------------------------#
# There are no serviceable parts                                      #
#---------------------------------------------------------------------#

my $Program_Ver = '.01 - 11/15/05'; 

use CGI; 
my $q = new CGI; 
my $URL = $q->url; 


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


use DADA::Config;
use DADA::Template::HTML; 
use DADA::App::Guts;
use DADA::MailingList::Settings; 
use DADA::MailingList::Archives;
use DADA::Mail::Send; 

use MIME::Parser; 


$|++; 

my %Headers_To_Edit;

my $parser = new MIME::Parser; 
   $parser = optimize_mime_parser($parser); 


my $skel = []; 


my ($admin_list, $root_login) = check_list_security(-cgi_obj  => $q, 
                                                    -Function => 'archive_editor');
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); 

main();
#---------------------------------------------------------------------#

sub main { 
	
	if($q->param('flavor') eq 'prefs'){ 
		&prefs; 
	}else{ 
	
		if($q->param('process')){ 	
			&edit_archive; 
		}else{ 
			&view; 	
		}
	}
}


sub view { 


	my $id = $q->param('id');
	
	if(!$id){ 
		print $q->redirect(-uri => $PROGRAM_URL . '?flavor=view_archive'); 
		exit; 
	}
		
	if($ah->check_if_entry_exists($id) <= 0){
		print $q->redirect(-uri => $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); 
	
	
	print(admin_html_header(-Title      => "Edit Archived Message (BETA) - $Program_Ver",
							-List       => $li->{list},
							-Form       => 0,
							-Root_Login => $root_login));
	
	if($q->param('done')){
		print $GOOD_JOB_MESSAGE;
	}
	
	if($ah->can_display_message_source){ 
	
		print qq{<p style="text-align:right">
		        <a href="$PROGRAM_URL?f=display_message_source&amp;id=$id" target="_blank"> 
		         Display Original Message Source
		        </a>
		       </p>}; 
	
	}
	
	
	
	print qq{<form action="$URL" enctype="multipart/form-data" method="post">}; 
	
	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(@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%">'; 
						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(),
				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 = $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 = $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="$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="$URL?flavor=prefs&id=$id">Archive Editor Preferences...</a></p>};
	print admin_html_footer(-List => $list, -Form => 0); 

}




sub prefs { 

	if($q->param('process')){ 
	
		my $the_id = $q->param('id'); 

		my $editable_headers = join(',', $q->param('editable_header')); 
		$ls->save({editable_headers => $editable_headers}); 
		
		print $q->redirect(-uri => $URL . '?flavor=prefs&done=1&id=' . $the_id); 
		exit; 
		
		
	}else{ 
	
	my %editable_headers; 
	   $editable_headers{$_} = 1 foreach(split(',', $li->{editable_headers}));
	   
	my $edit_headers_menu = [];  
	foreach(@EMAIL_HEADERS_ORDER){ 
		
		push(@$edit_headers_menu, {name => $_, editable => $editable_headers{$_}});
	}
	
	
	

	print(admin_html_header(-Title      => "Edit Archived Message (BETA) - $Program_Ver Preferences",
							-List       => $li->{list},
							-Form       => 0,
							-Root_Login => $root_login));

#die $q->param('id'); 

my $the_id = $q->param('id'); 
my $done   = $q->param('done'); 


	require DADA::Template::Widgets;
	print DADA::Template::Widgets::screen(-data   => prefs_template(), 
										  -vars   => {
										  				edit_headers_menu => $edit_headers_menu,
										  				done              => $done, 
										  				URL               => $URL, 
										  				id                => $the_id, 
												  },
										 );


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

	}

	
}

sub prefs_template { 

	my $template =  <<EOF
	
	<form action="<!-- tmpl_var URL -->" method="post"> 
	
	<!-- tmpl_if done --> 
	
	  <!-- tmpl_var GOOD_JOB_MESSAGE --> 
	  
	<!--/tmpl_if--> 
	
	<p><strong>Editable Headers:</strong></p>
	
	<div style="height: 200px; width:250px; overflow: auto; border:1px solid black">
	 <table cellpadding="2" cellspacing="0" border="0" width="100%">
     
	<!-- tmpl_loop edit_headers_menu --> 
	  <tr<!-- tmpl_if name="__odd__" --> style="background-color:#ccf;"<!--/tmpl_if-->>

		    <td width="25">

	 <input type="checkbox" name="editable_header" id="<!-- tmpl_var name ESCAPE="HTML"-->" value="<!-- tmpl_var name ESCAPE="HTML"-->" <!--tmpl_if editable -->checked="checked"<!--/tmpl_if--> />
	 </td> 
	 <td> 
	  
	 
	 <label for="<!-- tmpl_var name ESCAPE="HTML"-->"><!-- tmpl_var name --></label>
	</td> 
	</tr> 
	
	<!--/tmpl_loop--> 
	
	
	</table> 
	</div>
	
	<hr /> 
	
	<input type="hidden" name="process" value="1" /> 
	<input type="hidden" name="flavor" value="prefs" /> 
	
	<input type="hidden" name="id" value="<!-- tmpl_var id -->" />

	<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>
	
	</form> 
	
	<p><a href="<!-- tmpl_var URL -->?id=<!-- tmpl_var id -->">&lt;-- Back to the Archived Message</a></p>
	
EOF
; 

	return \$template; 
}



sub edit_archive { 


	my $id = $q->param('id'); 
	
	my ($subject, $message, $format, $raw_msg) = $ah->get_archive_info($id); 
	
	my $entity; 
	
	eval { $entity = $parser->parse_data($raw_msg) };

	my $throwaway = undef; 
	
	($entity, $throwaway) = edit($entity);
	
	$ah->set_archive_info($id, $q->param('Subject'), undef, undef, $entity->as_string); 
	
	print $q->redirect(-uri => $URL . '?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;

    if($name eq '0'){ 
		foreach my $h(@EMAIL_HEADERS_ORDER){ 
			if($q->param($h)){ 
				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; 
			
			($parts[$i], $name_is) = edit($parts[$i], ("$name\-".($i)));
			
			if($q->param('delete_' . $name_is) == 1){ 
				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 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($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($FILE_CHMOD, $outfile);  
		return $outfile;
	}
	
}





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($MIME_TYPES{'.'.lc($file_ending)})) {  
			$a_type = $MIME_TYPES{'.'.lc($file_ending)};
		}else{ 
			$a_type = $DEFAULT_MIME_TYPE; 
		}
	}
	#if(!$a_type){ 
		#warn "attachment MIME Type never figured out, letting MIME::Lite handle this..."; 
		#$a_type = 'AUTO';
	#} 
	
	return $a_type; 
}


=cut

=pod

=head1 NAME archive_editor.cgi (BETA RELEASE)

=head1 Obtaining The Program

archive_editor.cgi is located in the, I<dada/plugins> directory of the Dada Mail distribution.

=head1 DESCRIPTION 

B<archive_editor.cgi> is a plugin for Dada Mail that allows you to edit the complex email messages that Dada Mail supports in creating and sending. 

This program is currently in beta and is neither complete nor absolutely stable. 

Saying that, it is released in this form to test the current implementation and to give a platform to test on, so that feedback can be used to make the plugin better. 

Once the plugin is feature complete and stable, the entire plugin will be folded into the main Dada Mail program. 

The philosophy behind this program is: to be simple to use and relatively lightweight code-size-wise. 


=head1 REQUIREMENTS

This plugin was released with version 2.10.2 of Dada Mail. You'll need at least that version of Dada Mail to have this plugin work. It's suggested that when using the most recent version of this plugin, that you use the most recent version of Dada Mail as well. 

=head1 INSTALLATION 

=head2 Upload, "archive_editor.cgi" into the plugins directory

We're assuming your cgi-bin looks like this: 

 /home/account/cgi-bin/dada

and inside the I<dada> directory is the I<mail.cgi> file and the I<DADA> (uppercase) directory. Good! Make a B<new> directory in the I<dada> directory called, B<plugins>. 

Upload your  copy of I<archive_editor.cgi> into that B<plugins> directory. chmod 755 archive_editor.cgi

=head2 Set the, "$ARCHIVE_EDITOR_URL" Config.pm Variable

In the Config.pm file, you'll have the find the variable, "$ARCHIVE_EDITOR_URL" - set this to the URL you would use to access the archive_editor.cgi plugin. 

If you're Dada Mail install is at: 

 http://example.com/cgi-bin/dada/mail.cgi

a good guess at where this plugin would be is: 

 http://example.com/cgi-bin/dada/plugins/archive_editor.cgi

=head2 Configure the Config.pm file (Optional) 

This plugin will give you a new menu item in your list control panel. Tell Dada Mail to make this menu item by tweaking the Config.pm file. Find this line in Config.pm file: 

 #		 {-Title           => 'Archive Editor', 
 #		   -Title_URL      => $PLUGIN_URL."/archive_editor.cgi",
 #		   -Function       => 'archive_editor',
 #		   -Activated      => 1, 
 #		  },

Uncomment it (take off the "#"'s) 

Save the Config.pm file. 

=head1 Using archive_editor.cgi

Login into your list control panel. Click B<Manage Archives - View Archive>. 

In the table that holds  your list archives, you should see a new button on the right hand side labeled, "edit". Clicking that button will bring you into the editor.

Viewing individual messages will also show a, "Edit Message" button at the button of the screen. 

=head1 The one minute crash course in complex email messages: 

When using the editor, you'll see labels entitled, "B<Content-Type>" and the one of the folloing (there are more)

=over

=item * text/plain

=item * text/html

=item * multipart/alternative

=item * multipart/mixed

=item * multipart/related

=back

Complex email messages are made up of different B<parts>. 

For example, one part could be the message itself, another part may be an attachment. This is an example of a B<multipart/mixed> message. 

Another email message could have two parts, one being a plaintext version of your message, the other an HTML version of your message. This is an example of a B<multipart/alternative> message. When editing these types of messages, you'll most likely see two sets of messages, that have similar content - but one is in plain text, and one is in HTML. Currently, you'll have to edit these messages separately. 

=head1 BETA Software?! Why are you releasing it? 

This plugin was commissioned. It's not complete, but is usable. If there is a feature you'd like to see that's not currently available, please contact the author at: 

http://mojo.skazat.com/contact

To see about hiring me to add functionality to the plugin. 

=head1 COPYRIGHT

Copyright (c) 2005 Justin Simoni http://justinsimoni.com 

All rights reserved.


=head1 LICENSE

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






# TODO - make multiparts, singlepart if something is deleted.