#!/usr/local/bin/perl

# Author: Kevin P. Inscoe <kevin@inscoe.org>.
# File: mozmailarchive.pl
# Date of creation: April 17, 2004.
# Warranty: None expressed or implied.
# License: The Open Software License. V1.1 http://www.opensource.org/licenses/osl.php
#
# OSI Certified Open Source Software. http://www.opensource.org/licenses/
#
# Prerequisites: Perl 5.004 (minimum).

#
# Supports Mozilla 1.x and Netscape 7.x.
#
# The purpose of this program is to: 
#
#	A) Copy the mbox contents of all folders to the archive directory specified by
#		$MozBase verifying via MD5 and
#	B) Empty the folder mbox content of all but selected folders ($NoEmptyMozFolders) 
#		via erasing the original file as well as the index file (.msf) and 
#               touching a new empty one.
#

# Requirements
require 5.004;
use strict;
use File::Find;
use Digest::MD5;
use File::Copy;

#Turn off Perl buffering 
$| = 1; 

# Globals
$main::dbg = 0;
$main::MozBase = "/Documents and Settings/InscoeK/Application Data/Mozilla/Profiles/default/7svf9f1t.slt/Mail";
$main::ArchBase = "/burn/mail200402";
$main::errs = 0;
$main::count = 0;
$main::mbxfile = "/temp/mbox.txt";
@main::NoEmptyMozFolders = ("/Local Folders/Drafts",
"/Local Folders/Inbox",
"/Local Folders/Unsent Messages",
"/Local Folders/Archive Mail.sbd/Inscoe Web.sbd/Web Examples",
"/Local Folders/Archive Mail.sbd/Weather.sbd/Web Links",
"/Local Folders/Archive Mail.sbd/_To Do_.sbd/bookmarks",
"/Local Folders/Archive Mail.sbd/_To Do_.sbd/Download to Palm",
"/Local Folders/Archive Mail.sbd/_To Do_.sbd/Inbox",
"/Local Folders/Archive Mail.sbd/_To Do_.sbd/sell",
"/Local Folders/Archive Mail.sbd/_To Do_.sbd/summarise",
"/Local Folders/Archive Mail.sbd/_To Do_.sbd/wget",
"/pop.earthlink.net/Drafts",
"/pop.earthlink.net/Inbox");

# Locals
my $revision="1.0";
my $prog = "mozmailarchive.pl";
my $time=scalar localtime();

sub create_folders ();
sub create_rules;
sub make_folder ();
sub copy_file;
sub comp_file;
sub empty_folder;
sub mygrep;
sub touch;

# Main

# First create the mail folders under Mozilla and migrate the mail...

print "$prog $revision: Archiving mail at $time...\n";

my $start = time();

# If debug mode create list of mailboxes
if ( $main::dbg ) { open(MBX, ">$main::mbxfile") or die "Can't open '$main::mbxfile' for output: $!"; }

create_folders;

if ( $main::dbg ) { close(MBX); }

$time=scalar localtime();

my $end = time();

my $difference = $end - $start;

my $seconds    =  $difference % 60;
$difference = ($difference - $seconds) / 60;
my $minutes    =  $difference % 60;
my $elapsed = "\($minutes mins. and $seconds secs.\)";

print "\n$prog $revision: completed at $time.\n       $main::errs error(s). $main::count folders archived. Elapsed: $elapsed\n\n";

# Create Mozilla folders
sub create_folders () 	{

if ( $main::dbg ) { print "+++ create_folders() \n"; }

print "Processing $main::MozBase...\n";
find(\&make_folder, $main::MozBase);

if ( $main::dbg ) { print "--- create_folders() \n"; }

}

# Make a folder in Mozilla
sub make_folder () 	{

my $source = $File::Find::name;

if ( $main::dbg ) { print "+++ make_folder() \n   dbg: source=$source\n"; }

# Match the hierarchy
my $file = $_;
my $dest = $source;
my $pos = 0;

substr($dest, $pos, length($main::MozBase), $main::ArchBase);

# If a directory make it over on the Mozilla side

my $isdir = 0;

-d and $isdir = 1;

if ( $isdir == 1) {
	print "Creating directory $dest...\n" and
	mkdir $dest;
	return;
} 

# return if not a mbox file

-f and /.msf$/ and return;
-f and /.snm$/ and return;
-f and /^Template/ and return;
-f and /^Trash/ and return;
-f and /.dat$/ and return;
-f and /.tmp$/ and return;
-f and /.LOG$/ and return;
-f and /.log$/ and return;

# If this is directory "." (the source directory) don't copy either

if ( $main::dbg ) { print "   dbg: MozBase=$main::MozBase\n"; }

if ( $source eq $main::MozBase ) { return; }

# Ok if we got this far it's a mbox file so archive it

# copy the file
print "Copying $source\n\t to $dest...\n";

# Get mbox name
my $mbox = substr($source, length($main::MozBase));
if ( $main::dbg ) { 
	print "   dbg: mbox=$mbox\n";
	print MBX "$mbox\n";
	}

copy_file ($source, $dest, $mbox);

if ( $main::dbg ) { print "--- make_folder() \n"; }

return;

}

# Copy the mbox file
sub copy_file	{

if ( $main::dbg ) { print "+++ copy_file() \n";}

my ($src, $dst, $mbox) = @_;

# Copy source to destination...

copy($src,$dst);

# Now compare the copied file to make sure it copied ok
my $result = comp_file ($src, $dst);

# Now empty the original file if not on the exclusion list

if ( $result )	{ $main::count++; empty_folder($mbox, $src); }

if ( $main::dbg ) { print "--- copy_file() \n"; }

return;
		
}

# Verify the copied file
sub comp_file	{

if ( $main::dbg ) { print "+++ comp_file() \n"; }

my ($src, $dst) = @_;

my $status = 0;

open(SRC, "<$src") or die "Can't open '$src' for comparison: $!";
binmode(SRC);

my $md5 = Digest::MD5->new;
while (<SRC>) {
	$md5->add($_);
}
close(SRC);

my $srcmd5 = $md5->b64digest;

open(DST, "<$dst") or die "Can't open '$dst' for comparison: $!";
binmode(DST);

$md5 = Digest::MD5->new;

while (<DST>) {
	$md5->add($_);
}
close(DST);

my $dstmd5 = $md5->b64digest;

if ( $main::dbg ) { print "   MD5: $dst==> SRC=$srcmd5 DST=$dstmd5\n"; }

if ($dstmd5 ne $srcmd5) { 
	print "ERROR!: CHECKSUMS DO NOT MATCH - $dst\n"; 
	$status = -1;
	$main::errs++;
} else { $status = 1; }

if ( $main::dbg ) { print "--- comp_file() \n"; }
	
return $status;
	
}

# Verify the copied file
sub empty_folder	{

if ( $main::dbg ) { print "+++ empty_folder() \n"; }

my ($mbox, $src) = @_;
my $idxfil = $src . ".msf";

# If this folder appears on exclusion list don't empty
my $hits = mygrep($mbox);

if ( $hits > 0 ) { print "   ***SKIPPING EMPTY***\n"; }
else	{
	unlink $src;
	unlink $idxfil;
	touch $src;
	touch $idxfil;
}

if ( $main::dbg ) { print "   hits=$hits\n   mbox=$mbox\n   NoEmptyMozFolders=@main::NoEmptyMozFolders\n"; }

if ( $main::dbg ) { print "--- empty_folder() \n"; }

}
sub mygrep 	{

if ( $main::dbg ) { print "+++ mygrep() \n"; }

my ($term) = @_;

my $hits = 0;
my $line;

foreach $line (@main::NoEmptyMozFolders)	{
	if ($line eq $term) { 
	$hits++; 
	if ( $main::dbg ) { print "   MATCHED TERM: $line\n   term=$term\n"; }
	}
}

if ( $main::dbg ) { print "--- mygrep() \n"; }

return $hits;

}

sub touch 	{

if ( $main::dbg ) { print "+++ touch() \n"; }

my ($file) = @_;

open(FIL, ">$file") or die "Can't open '$file' for empty: $!";
close(FIL);

if ( $main::dbg ) { print "--- mygrep() \n"; }

return;

}