#!/usr/bin/perl


my $Digests = [ 

{

List_Name         => 'test', 
Digest_List_Name  => 'digest_test',
Message_History   =>  3, # in hours;

},



];

use lib qw(

/home/account/public_html/cgi-bin/mojo/ 

/home/account/public_html/cgi-bin/mojo/MOJO

/usr/libdata/perl/5.00503/mach 

/usr/libdata/perl/5.00503 

/usr/local/lib/perl5/site_perl/5.005/i386-freebsd 

/usr/local/lib/perl5/site_perl/5.005 

);


=pod

=head1 NAME mojo_digest.pl

=head1 DESCRIPTION 

Creates a digest message from one list, to be sent to another list. 

=head1 INSTRUCTIONS

mojo_digest.pl is designed to be called from the command line or a cron
job. It is not a cgi script and shys away from the limelight that is
the Graphical WWW.

=head1 INSTALLTION

You need to change two things on the top of mojo_digest.pl, the first 
is the B<$Digests> variable which we'll get to shortly, the second 
thing you need to do is set the path to both the Mojo libraries and 
your site's Perl library. Since mojo_digest.pl will most likely but 
run from a cron job, it doesn't know off the bat where the Perl or 
the Mojo libraries are. You tell the script where these places are
by tweaking the 'use lib' statement:

use lib qw( 
/home/account/public_html/cgi-bin/mojo/ 
/home/account/public_html/cgi-bin/mojo/MOJO
/usr/libdata/perl/5.00503/mach 
/usr/libdata/perl/5.00503 
/usr/local/lib/perl5/site_perl/5.005/i386-freebsd 
/usr/local/lib/perl5/site_perl/5.005 
);

The first two are where my Mojo libraries are, they're in my cgi-bin 
right along with mojo.cgi. The ones after that are places where 
the site-wide Perl libraries are located. 


Upload mojo_digest.pl to your hosting account. I recommend NOT putting 
this script in your cgi-bin, simply because it isn't a cgi-script.
You may want to make a directory for mojo scripts like this one in your home account: 

 mkdir /home/account/mojo_scripts

B<Putting this script in your cgi-bin would probably constitute a security threat!>  

change the permissions of mojo_digest.pl to 755.  

To use this script, simple run it: 

 >perl mojo_digest.pl

That's the essence of it. 

=head2 OPTIONS

=over

=item --test

running mojo_digest.pl with the test option will only send out the 
digest to the list owner. Very handy for testing purposes. 

 >perl mojo_digest.pl --test

=item --reset listname

This takes a bit of explaination, but it basically resets the time
mojo_digest.pl remembers when it last sent out a digest. If I send out 
a digest ever day, mojo_digest.pl will remember this and won't send out
a message in a digest it has already sent. This will make 
mojo_digest.pl forget this. 

 >perl mojo_digest.pl --reset listname

listname is the shortname of the list you're grabbing the messages to be
digested, not the digest list 

=back

=head2 SETTING UP A DIGEST

To set up a digest, You need to have two lists, a list to grab the
messages to be digested from and a list to send the digest. I made a
list with a shortname of 'test' and another with a shortname of 
'digest_test'

People who want to have every single message sent to them would want to
subscribe to 'test', people who want the digest would want to subscribe
to 'digest_test'

I then have to decide what sort of time span I want to send my digest. 
I'm thinking every day will work for me. 

Now, mojo_digest.pl needs to know all of this. On the top of the script
itself is a variable called '$Digests'. To put the above information
that I just worked out into $Digests, I'd write: 

	my $Digests = [ 
	{
	List_Name         => 'test', 
	Digest_List_Name  => 'digest_test',
	Message_History   =>  24, 
	},
	];

Message_History work in hours, so one day equals 24 hours. 

If I had another list, called "ramblings" and a list for digests called
"digest_ramblings", that I wanted sent every 3 hours, I'd put that
after my first one: 

	my $Digests = [ 
	{
	List_Name         => 'test', 
	Digest_List_Name  => 'digest_test',
	Message_History   =>  24,
	},
	{
	List_Name         => 'ramblings', 
	Digest_List_Name  => 'digest_ramblings',
	Message_History   =>  3,
	},
	];
	

All there is to it. 	

=head2 Setting up a Cron Tab

You're most likely going to run mojo_digest.pl via a crontab. Here's an
example of one: 

 0 0,3,6,9,12,15,18,21 * * * /home/account/mojo_scripts/mojo_digest.pl 

This will run the script every 3 hours to check if any digests need to 
be sent out. 

=cut




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




use strict;

use MOJO::Config; 
use MOJO::Guts;
use MOJO::Archive;
use MOJO::Mail;
use MOJO::Log;

use Time::Local;
use Getopt::Long; 

my $Time = $^T;
my $log  =  new MOJO::Log;

my $reset;
my $test = 0;

GetOptions("reset=s"  => \$reset, 
			"test"    => \$test); 
			
if($reset){ 
	reset_digest_time($reset);
}else{
	main();
}

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





sub main { 
	foreach my $profile (@$Digests){ 
		send_digest($profile) if profile_check($profile) == 1;
	} 
}





sub profile_check { 
	my $profile = shift; 
	my $check   = 1;
	foreach('List_Name', 'Digest_List_Name'){ 
		if(check_if_list_exists(-List => $profile->{$_}) == 0){ 
			warn $profile->{$_} . " does not exist!";
			return 0; 
		}	 
	}	
	return $check;
}





sub send_digest { 
	my $profile = shift; 
	my %list_info        = open_database(-List => $profile->{List_Name}); 
	my %digest_list_info = open_database(-List => $profile->{Digest_List_Name}); 
	my $archive          = MOJO::Archive->new(-List => \%list_info);
	
	my $span = int($list_info{last_digest_sent}) + (int($profile->{Message_History}) * 3600); # 3600 seconds in an hour 
	if($Time > $span){ 
		my $t = relative_keys(\%list_info, $profile, $archive);
		if($t->[0]){ 			
			my $digest_index = digest_index(\%list_info, $profile, $archive); 
			my $digest_body  = digest_body(\%list_info, $profile, $archive); 
			
			my $body = 'In this issue' . "\n\n" . $digest_index . "\n\n" . $digest_body;
		       $body = create_message($body, \%digest_list_info);
		
			my $mh = MOJO::Mail->new(\%digest_list_info);
			   $mh->bulk_test(1) if($test == 1); 
			   $mh->bulk_send( 
					Subject => $list_info{list_name} . ' Digest', 
					Body    => $body
				);		
			$log->mj_log($list_info{list}, 'digest_sent');    
			
			if($test != 1){ 	
				my $status = setup_list({list            => $list_info{list}, 
										last_digest_sent => $Time});		
				warn "last digest time not saved correctly!" if $status == 0; 
			}
			
		}else{
			$log->mj_log($list_info{list}, 'digest_not_sent', "Reason: No messages to send, $#$t");   
		}
	}else{ 
		$log->mj_log($list_info{list}, 'digest_not_sent', "Reason: Didn't need to, $Time < $span");    	
	}
}





sub digest_index { 
	my ($list_info, $profile, $archive) = @_;
	
	my @subjects;
	my $index; 
	my $keys    = relative_keys($list_info, $profile, $archive);
	
	foreach my $k (@$keys){ 
		my $subject = $archive->get_archive_subject($k);
		push(@subjects, $subject); 
	}
	
	my $i = 0; 
	foreach(@subjects){ 
		$i++;
		$index .= '    ' . $i . ': ' . $_ . "\n";
	}
	return $index; 
}




sub digest_body { 
	my ($list_info, $profile, $archive) = @_;
	
	my $body;
	my $index; 
	my $keys = relative_keys($list_info, $profile, $archive);
	
	foreach my $k (@$keys){ 
		my ($subject, $message, $format) = $archive->get_archive_info($k);
		my ($year, $month, $day, $hour, $minute, $sec) = archive_time($k);
		
		$message = $archive->zap_sig($message); 
				
		$body .= '-' x 72 . "\n\n";
		$body .= 'Date: ' . pretty_date($k) . "\n";
		$body .= 'Subject: ' . $subject . "\n\n";
		$body .= $message . "\n\n"
	}
	return $body;
}




sub relative_keys {
	my ($list_info, $profile, $archive) = @_;
	my $keys = $archive->get_archive_entries('normal');
	my @r_keys;
	foreach my $p_num (@$keys) { 
		
		my ($year, $month, $day, $hour, $minute, $sec) = archive_time($p_num);
		my $c_time  = timelocal($sec, $minute, $hour, $day, $month, $year);	
		
		if($c_time > int($list_info->{last_digest_sent})){ 
		#if($c_time > $span && $c_time > $list_info->{last_digest_sent}) { 
			push(@r_keys, $p_num); 	
		}
	}
	return \@r_keys;
}




sub archive_time { 


	my $p_num     = shift;
	my $year      = substr($p_num, 0,  4)   || "";
	my $month     = substr($p_num, 4,  2)   || ""; 
	my $day       = substr($p_num, 6,  2)   || "";
	my $hour      = substr($p_num, 8,  2)   || "";
	my $minute    = substr($p_num, 10, 2)   || ""; 
	my $sec       = substr($p_num, 12, 2)   || "";

	$_      = int $_ for($year, $month, $day, $hour, $minute, $sec); 
	$year  -= 1900;
	$month -= 1; 
	return ($year, $month, $day, $hour, $minute, $sec);
}




sub pretty_date { 
	my $k = shift; 	
	my ($year, $month, $day, $hour, $minute, $sec) = archive_time($k);
	my $ending = 'am';
	 
	if($hour > 12){ 
		$hour = $hour - 12; 
		$ending = "pm";
	}
	
	$year += 1900;
	


	my %months = (
	'0'   =>    "January",
	'1'   => 	"February",
	'2'   => 	"March",
	'3'   => 	"April",
	'4'   =>	"May",
	'5'   =>	"June",
	'6'   =>	"July",
	'7'   =>	"August",
	'8'   =>	"September",
	'9'   => 	"October",
	'10'  => 	"November",
	'11'  => 	"December"
	);
	
	
	my %end = (
	1    => "1st",
	2    => "2nd",
	3    => "3rd",
	4    => "4th",
	5    =>	"5th",
	6    =>	"6th",
	7    =>	"7th",
	8    =>	"8th",
	9    =>	"9th",
	10   => "10th",
	11   => "11th",
	12   => "12th",
	13   => "13th",
	14   => "14th", 
	15   => "15th", 
	16   => "16th", 
	17   => "17th",
	18   => "18th", 
	19   => "19th", 
	20   => "20th", 
	21   => "21st", 
	22   => "22nd", 
	23   => "23rd",
	24   => "24th", 
	25   => "25th", 
	26   => "26th", 
	27   => "27th", 
	28   => "28th", 
	29   => "29th", 
	30   => "30th", 
	31   => "31st", 
	);
	
	my $date = ""; 
	   $date .= "$months{$month} "       ;#if $args{-Write_Month}   == 1; 
	   $date .= "$end{$day}, "           ;#if $args{-Write_Day}     == 1; 		
	   $date .= "$year "                 ;#if $args{-Write_Year}    == 1; 
	   $date .= "$hour:$minute"          ;#if $args{-Write_H_And_M} == 1; 
	 # $date .= ":$sec "                 ;#if $args{-Write_Second}  == 1; 
	   $date .= " $ending  "             ;#if $args{-Write_H_And_M} == 1; 
	return $date;
}




sub create_message { 
	my ($body, $digest_list_info) = @_;
	my $text_template = $digest_list_info->{mailing_list_message};
	   $text_template =~ s/\[message_body\]/$body/g; 
	   $text_template = interpolate_string(-String      => $text_template, 
    							           -List_Db_Ref => $digest_list_info);
	my $s_link = subscribe_link(-list      => $digest_list_info->{list},
		  					    -email     => '[email]', 
							    -pin       => '[pin]');
							    
	my $us_link = unsubscribe_link(-list   => $digest_list_info->{list},
							       -email  => '[email]', 
						 	       -pin    => '[pin]');
						 	       
	$text_template =~ s/\[list_subscribe_link\]/$s_link/g;
	$text_template =~ s/\[list_unsubscribe_link\]/$us_link/g;  
	
	return $text_template;

}




sub reset_digest_time { 
	my $list = shift; 
	if(check_if_list_exists(-List => $list) == 0){ 
		warn "$list does not exist!\n"; 
	}else{ 
		print "reseting digest time for '$list'\n";
		my $status = setup_list({list            => $list, 
							last_digest_sent => 0});	
		warn "last digest time not saved correctly!" if $status == 0; 
		print "done.\n\n";
	}
}


=pod

=head1 COPYRIGHT 

Copyright (c) 1999 - 2003 
Justin Simoni
me@justinsimoni.com 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



