#!/usr/bin/perl

# pm2imap.pl 0.0.2 2000-05-29
# convert Pegasusmail 3.12c Mailboxes to Unix (imap) Mailboxes
# tested with Pmail 3.12c, but possible works with any Pmail 3+ versions

# Author: Michiel Dethmers, michiel@kipu.co.uk
# Copyright (C) 2000 Michiel Dethmers
# License: GPL

# 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.

# This perl script will convert your pegasus mailboxes *and trays*
# to unix mbox format in an Imap tree.
# 
# Situation: Suppose you use Pegasusmail on a work station that has 
# it's mailbox on a Linux server. Run this script in the folder that
# contains your Pegasus folders and it will create a directory
# structure which reflects the folder structure in Pegasusmail. You can 
# then run an Imap server on your Linux server and access your mail
# with IMAP. A possible and good IMAP server is the one from the 
# Washington University, http://www.washington.edu/imap/
#
# Alternatively, if you store your Pegasus mail folders somewhere
# else, either mount it to your linux box with smbmount (on the like)
# or copy it all across.

# In default settings, it will create the first directory to be 
# "My Mailbox" which is the name Pegasusmail gives the top folder
# that name will be different if you have renamed the top folder
# 
# bugs/todo:
# * I have a huge number of folders and trays in Pegasusmail, and it worked
# for me. The one thing it didn't work on was when the size of a mailfolder
# was very large, so I have put a restriction of 15Mb to the size
# This is probably system dependent, my Linux box doesn't have that much
# memory (32Mb) so it choked on Mailfolders larger than that. If you have
# loads of memory, you can increase the size.
# * The script is quite memory and processor demanding, and I may rewrite it 
# a bit to avoid that, if I find some time.
# * It may break on invalid chars that you use for Folder names. Drop me a line
# if it does.

# changes from 0.0.1:
# - it will detect whether all filenames are lower or uppercase and use them accordingly
# - if My Mailbox is empty, it will choose a name (My Mailbox)
# - type in message count

# Drop me a note if you think this was a useful script.

# Credits: a small part of the code was taken from peg2eud.pl by 
# E. Heyns (heyns@Iris-Advies.deMon.nl) (sub write_message)

# configurable variables:

$delete_old = 0;     # set to 1 to remove the converted mailbox (good idea)

# maximum size a mailbox can have you can set this higher if you like, 
# bit dependent on your system set to 0 to make it unlimited
$MAXSIZE = 15000000;
                   
# by default we start working from the current directory. It will 
# always (well, always, see above) create one subdir from here called "My mailbox", 
# but if you want to target it somewhere else, you can do that here.
$TARGETDIR = ".";    

# for example to create "My mailbox" from the home directory do something like
# $TARGETDIR = "/home/<yourname>
# DON'T end it with a /

$spaces_to_underscore = 0; # make 1 to convert folder and mailbox names to use _ instead of spaces

$ext = ".PMM"; # mailbox extension, you can try to make it lowercase if that suits

$hierarch_file = "HIERARCH.PM"; # the file which contains the folder structure. Possibly correct.

$doit = 0;        # set to 1 to actually run
                  # (to make you read this first)

########################## end of configuration ######################

die "Ha, it's not that straightforward. First configure the script\n" if !$doit;

# let's start with reading the hierarchy of the folders
if (!open H, "\U$hierarch_file") {
  open H,"\L$hierarch_file" || die "Cannot open $hierarch_file, read source for instructions";
  # we can try more permutations, but simply edit the above lines to open the file
}

while (<H>) {
  $_ =~ s/\r//g;  # remove dos crs
  chomp;          # remove newline
  ($num1,$num2,$ID,$parent,$name) = split(/,/,$_);
  
  # trays seem to have non-zero in either num1 and num2 or both, no idea what it means
  if ($num1 || $num2) {
    $tray = {};
    $tray->{id} = &clean($ID);
    $tray->{name} = &clean($name) || "My Mailbox";
    $tray->{parent} = &clean($parent);
    push @trays,$tray;
  } else {
    $ID =~ /".*?:.*?:(.*)"/;
    $filename = $1;
    if (-f "\L$filename$ext") {
      $filename = "\L$filename";
    } elsif (-f "\U$filename$ext") {
      $filename = "\U$filename";
    }
    $box = {};
    $box->{id} = &clean($ID);
    $box->{name} = &clean($name);
    $box->{parent} = substr(&clean($parent),0,25);
    $box->{file} = $filename;
    $box->{size} = (stat("$filename$ext"))[7];
    $box->{done} = 0;
    $box->{reason} = "Reason Unknown";
    push @mailbox,$box;
  }
}
close(H);
# keep some statistics
$trays_todo = @trays +1;
$trays_done = 0;
$mb_todo = @mailbox;
$mb_done = 0;
$totalmsg = 0;
$maxmsg = 0;
$maxsize = 0;
# make a root tray to start the recursion
$roottray = {};
$roottray->{id} = "";
$roottray->{name} = "root";
$roottray->{parent} = "";

print "Trays to process: $trays_todo\n";
print "Mailboxes to process: $mb_todo\n";
# and start the process
&ProcessTray(\$roottray,$TARGETDIR);

print "\n\nSummary: \n";
print "Trays needed to process: $trays_todo\n";
print "Trays processed: $trays_done\n";
print "Mailboxes needed to process: $mb_todo\n";
print "Mailboxes processed: $mb_done\n";
print "Messages processed: $totalmsg\n";
print "Largest Mailbox (size): $maxsize\n";
print "Largest Mailbox (msgs): $maxmsg\n";

# check whether all have been done
for $m (@mailbox) {
  print "Not done: $m->{name} ($m->{file}$ext), $m->{reason}\n" if !$m->{done};
}

sub ProcessTray {
  local($tray,$dir) = @_;
  print "Processing $$tray->{id}, $dir\n";
  
  if (!mkdir($dir,0755)) {
    # it's possible that a folder with the same name exists
    if (-f $dir) {
      rename($dir,$dir.".fld");
      mkdir($dir,0755);
    } else {
      print STDERR "Error: $!\n";
    }
  }
  
  # first we process the mailboxes in this tray
  my @leafs = &MailboxesInTray($tray);
  foreach $leaf (@leafs) {
    &ConvertMailbox($leaf,$dir);
  }
  # now we find the trays that are subtrays of this tray
  my @children = &findChildren($tray);
  foreach $child (@children) {
    &ProcessTray($child,"$dir/$$child->{name}");
  }
  print "Finished $$tray->{id}\n";
  $trays_done++;
}

sub MailboxesInTray {
  local($tray) = @_;
  print "Finding Mailboxes in $$tray->{name} ..";
  my @res = ();
  my $m;
  for $m (@mailbox) {
    push @res,\$m if $m->{parent} eq $$tray->{id};
  }
  $num = @res;
  print ".. $num found \n";
  @res;
}
  
sub ConvertMailbox {
  local($mailbox,$dir) = @_;
  # I somehow always have an unnamed mailbox somewhere (bug in Pmail?)
  return if $$mailbox->{name} eq "";
  `touch "$dir/$$mailbox->{name}"`;
  print "Converting $$mailbox->{name} in $dir (size $$mailbox->{size})\n";
  if (&GenerateMailbox($mailbox,$dir)) {
    unlink("$$mailbox->{file}$ext") if $delete_old;
  }
}

sub findChildren {
  local($tray) = @_;
  print "Finding Children in $$tray->{name}, id: >$$tray->{id}< ..";
  my @res = ();
  my $t;
  for $t (@trays) {
    push @res,\$t if $t->{parent} eq $$tray->{id};
  }
  $num = @res;
  print ".. $num found \n";
  @res;
}

sub GenerateMailbox {
	local($mailbox, $destdir) = @_;
	local *GM_FH;
	local $msgcount = 0;
  my $mbox;
  
  if ($MAXSIZE && $$mailbox->{size} > $MAXSIZE) {
    $$mailbox->{reason} = "Mailbox too large";
    print STDERR "Error: $$mailbox->{name}, Mailbox too large\n";
    return 0;
  }
  $maxsize = $$mailbox->{size} if $maxsize < $$mailbox->{size};
	if (open (GM_FH, "<$$mailbox->{file}$ext")) {
  	$mbox = join('', <GM_FH>);
	  close (GM_FH);
  } elsif (open(GM_FH, "<\L$$mailbox->{file}$ext")) {
	$mbox = join('', <GM_FH>);
        close(GM_FH);
  } else {
    $$mailbox->{reason} = "File not found";
    print STDERR "Error $$mailbox->{file} not found, cannot convert $$mailbox->{name}\n";
    return 0;
  }

	if (!open (GM_FH, ">$destdir/$$mailbox->{name}")) {
    $$mailbox->{reason} = "Cannot create $$mailbox->{name} in $destdir, $!";
    print STDERR "Error: Cannot create $destdir/$$mailbox->{name}, $!\n";
    return 0;
  }

	$mbox = substr($mbox, index($mbox,$$mailbox->{id})+length($$mailbox->{id})+20);
  # it seems that's not enough I had some mailboxes which still had \000 chars left
  $mbox =~ s/^\000*//sg;

	print "$$mailbox->{file} => $destdir/$$mailbox->{name} ";
	$msgcount = 0;
	$mbox =~ s/([^\032]+)\032/&write_message($1, \*GM_FH, \$msgcount)/eg;

	print "($msgcount message(s))\n";

	close(GM_FH) || die "Error: $!";
  $$mailbox->{done} = 1;
  $mb_done++;
  $totalmsg += $msgcount;
  $maxmsg = $msgcount if $maxmsg < $msgcount;
	$msgcount;
}

sub write_message {
	local($msg, $fh, $msgcount) = @_;
	local($header);
	local($border);

	$$msgcount++;

	$msg =~ s/\r?\n/\r\n/sg;
	$border = index $msg, "\r\n\r\n" || die "Argh! No body!\n";

	$header = substr($msg, 0, $border);
	$msg = substr($msg, $border + 4);

	if (!($header =~ /^From /)) {
		$header = "From pm2imap.pl " . localtime() . "\r\n$header";
	}

	$msg =~ s/(\r\n)?From /$1>From /sg;

	$msg = $header . "\r\n\r\n" . $msg. "\r\n";

  $msg =~ s/\r//sg;
	print $fh $msg;
}

sub clean {
  local($var) = @_;
  $var =~ s/^"//;
  $var =~ s/"$//;
  # we're making dirs of the names
  $var =~ s/\//_/g;
  $var =~ s/ /_/g if $spaces_to_underscore;
  $var;
}