#! E:/perl/perl.exe
#
# Perl-Conduit for syncing Mail with PMMail
# 

use PDA::Pilot;
use Data::Dumper;
use Net::POP3;
use IO::File;
use POSIX qw(tmpnam);

$device   = 'COM1';
$database = 'MailDB';

$mailserver = 'Place_your_mailserver_here';
$username   = 'Place_your_username_here';
$password   = 'Place_your_password_here';

$PMMAILACCOUNT = 'Z:\PMMAIL\ACCOUNTS\A_WAGN0.ACT';
$PMMAILWORKPATH= 'Z:\pmmail\Accounts';
$tempfile='E:\temp\body.tmp';
@SYNCFOLDER=( "Palmtr0.fld",
              "inbox.fld",
              "Mailin0.fld\\palmpi0.fld",
	      "Mailin0.fld\\palmpi1.fld",
	      "Mailin0.fld\\plucke1.fld" );
# NOTE: all mail in the first folder of that list will be transfered
# to the Palm into specified category, regardless what readstatus the
# files have.

@SYNCCATEGORIES= (3, 0, 0, 0, 0 );

$inbox  = 0;   # constants for in and outbox on Palm
$outbox = 1;   # this is necessary cause theire Names depend on the
               # language of PalmOS used!
$saved  = 3;   # "saved messages" category


sub Logo
{
#----------------------------------------
#  Print the logo-plate
#----------------------------------------
   print "\n\n\n\n\n";
   print "   PMMail conduit written in Perl\n";
   print "様様様様様様様様様様様様様様様様様様�\n";
   print "\n";
   print " (c) 1999 by Alexander Wagner\n";
   print "  -=[ Team OS/2 Franken ]=-\n\n";
}
					  
sub Connect
{
#----------------------------------------
# Open port and connect
#----------------------------------------
   $socket = PDA::Pilot::openPort($device);   # Open device, get socket
   print " 陳逓逓陳�\n";
   print " 陳逓陳�陳 敖陳陳陳陳陳陳陳陳陳陳陳陳陳陳朕\n";
   print " 陳逓逓陳� �  Now press HotSync button... 額\n";
   print " 陳逓陳陳� 青陳陳陳陳陳陳陳陳陳陳陳陳陳陳潰�\n";
   print " 陳逓陳陳�  烝烝烝烝烝烝烝烝烝烝烝烝烝烝烝烝\n\n";
   $dlp  = PDA::Pilot::accept($socket);
   $ui = $dlp->getUserInfo;              # get the name of the pilot
   print " 浜様様様様様様様様様�\n";
   print " � \n";
   print " � Connection to $ui->{name} established!\n";
   print " � \n";
   $dlp->getStatus();           # Set pilot-display to notify user
   
}

sub OpenMailDB
{
#----------------------------------------
# Open MailDB and notify user about what we're doing
#----------------------------------------
 
   $db = $dlp->open($database);
   if (!defined($db))
   {
       print " � 陳> Unable to open MailDB. Aborting!";
       return;
   }
   $dlp->getStatus();
   # Get signature prefs
   $sigpref = $db->getPref($SIGPREFID);
   $signature = $sigpref->{"signature"};
   print " � Current signature:\n";
   print " � " . $signature . "\n";
}

sub CloseMailDB
{
#----------------------------------------
# Close MailDB 
#----------------------------------------

   $db->close();
   print " 麺様様様様様様様様様�\n"; 
   print " �\n";
   print " � Mailsync completed, connection closed.\n";
   print " �\n";
   print " 藩様様様様様様様様様�\n";
}

sub GetMailfromPalm()
{
#----------------------------------------
# Get mail from palm and send them 
# through PMMail/2 using PMMSend
#----------------------------------------
   my ($SIGPREFID) = 3; 
   
   print " 麺様様様様様様様様様�\n";
   print " � Sending Mail via PMMail for OS/2\n";
   print " 麺様様様様様様様様様�\n";

   chdir $PMMAILWORKPATH;
   $i=0;
   while(1)
   {
	$record = $db->getNextRecord( $outbox);
	
	last if (!defined($record));
	next if ($record->{"deleted"} || $record->{"archived"});
	$line = $record->{"to"};
	if (!defined($line) || length($line)==0)
	{
	    print " � 陳> Msg must have a To address.";
	    next;
	}
	$line = $record->{"body"};
	if (!defined($line) || length($line)==0)
	{
	    print " � 陳> Msg must have a body.";
	    next;
	}
	print " 債陳陳陳陳\n";
	print " � To: " . $record->{"to"} . "\n";
	print " � Cc: " .  $record->{"cc"} . "\n";
	print " � Bcc: " . $record->{"bcc"} . "\n";
	print " � Subject: " . $record->{"subject"} . "\n";

	# convert umlauts:
	$line =~ s/�/�/g;
	$line =~ s/�/�/g;
	$line =~ s/�/�/g;
	$line =~ s/�/�/g;
	$line =~ s/�/�/g;
	$line =~ s/�/�/g;
	$line =~ s/�/�/g;
	
	# get tempfile for PMMsend
        $name = $tempfile;

	open(BODY, ">$name") or die "Couldn't open $name for writing: $!";
        print BODY $line . "\n\n";	
	print BODY "-- Brought to you via PalmOS and PMMail for OS/2 \n\n";
	if (defined($record->{"cc"}))
	{
	  print BODY "CC-list: \n" . $record->{"cc"} . "\n";
	}  
        close(BODY);

        # Call PMMSend to send mail. Note: You must start this program
	# from within the directory where PMMail is started from!
	# Otherwise communication with PMMail will fail, and Outbox
	# will not be updated/reindexed.
	#
	# For usage with other mailprograms replace the following part
	# as appropriate. 
	#
	# NOTE: PMMSend can't handle CC and BCC!

        $name =~ s#/#\\#g; # Replace Perl-pathseparator / with \
       
	$record->{"to"} =~ s/\n//g;
	@to = split(/,/, $record->{"to"});	
	foreach $recpt (@to)
	{
	  $status = system("PMMSend","/m ",$name, $recpt,
	  $record->{"subject"}, $PMMAILACCOUNT);
	}

	if (defined($record->{"cc"}))
	{
	  $record->{"cc"} =~ s/\n//g;
  	  @to = split(/,/, $record->{"cc"});	
	  foreach $recpt (@to)
	  {
	    $status = system("PMMSend","/m ",$name,$recpt,
	    $record->{"subject"}, $PMMAILACCOUNT);
	  }
	}
	
	if (defined($record->{"bcc"}))
	{
	  $record->{"bcc"} =~ s/\n//g;
  	  @to = split(/,/, $record->{"bcc"});	
	  foreach $recpt (@to)
	  {
            $status = system("PMMSend","/m ",$name,$recpt,
	    $record->{"subject"}, $PMMAILACCOUNT);
	  }
	}  
	   
	if ($status)
	{
	   print "WARNING: failed to send message for " .
		$record->{"to"} . ".";
	} else {
	    $i++;
	    $db->deleteRecord($record->{"id"});
	}
    }
}

sub GetPalmCategories
{
#---------------------------------------
# Get categories in MailDB
#---------------------------------------

  $appinfo = $db->getAppBlock();

  print " � Your Palm provides the following categories:\n";
  @cats = @{$appinfo->{categoryName}};
  @cat_ids = @{$appinfo->{categoryID}};
  foreach $i ($[..$#cats)
  {
    next unless (length($cats[$i])>0);
    $cat = $cats[$i];
    $cat =~ tr/A-Z/a-z/;
    $catcase{$cat} = $cats[$i];     # translate lowercase to anycase
    $catindx{$cat} = $i;            # translate anycase to index
    print " � $i: $cat \n";
  }
}		    

sub dateToPilot
{
#----------------------------------------
# convert date from mail to Pilot-format 
#----------------------------------------

    my ($str) = @_;
    my ($pilot, %months);
    %months = (
	       'Jan', 0,
	       'Feb', 1,
	       'Mar', 2,
	       'Apr', 3,
	       'May', 4,
	       'Jun', 5,
	       'Jul', 6,
	       'Aug', 7,
	       'Sep', 8,
	       'Oct', 9,
	       'Nov', 10,
	       'Dec', 11
	       );
    $str =~ /^((...),\s*)?(\d*)\s*(...)\s*(\d\d)?(\d\d)\s*(..):(..):(..)\s*(.*)/;
    # TTD: What are the last two numbers in the pilot's array?
    $pilot = [$9, $8, $7, $3, $months{$4}, $6, 0, 0];

    return ($pilot);
}

sub addConduitFile
{
#----------------------------------------
# Update MailDB with $message
#----------------------------------------

   my ($message, $category) = @_;

   $rec = $db->newRecord();
   $rec->{id} = 0;
   $rec->{category} = $category;
   $rec->{"index"} = 0;
   $rec->{priority} = 1;
   $rec->{deleted} = 0;
   $rec->{modified} = 0;
   $rec->{busy} = 0;
   $rec->{archived} = 0;
   $rec->{secret} = 0;
   $rec->{confirmRead} = 0;
   $rec->{signature} = 0;
   $rec->{confirmDelivery} = 0;
   $rec->{date} = [1, 2, 3, 4, 5, 6, 7, 8];

   $firstRcv = 1;
   $firstEmpty = 0;
   foreach $line (@$message)
   {
    $line =~ s/=C4/�/g;       # �
    $line =~ s/=D6/�/g;       # �
    $line =~ s/=DC/�/g;       # �
    $line =~ s/=DF/�/g;       # �
    $line =~ s/=E4/�/g;       # �
    $line =~ s/=F6/�/g;       # � 
    $line =~ s/=FC/�/g;       # �
    $line =~ s/=3D/=/g;       # =
    $ch = $line;

    $firstEmpty = 1 if ($line eq "\n");
    
    # parsing the header:
    
    if (($ch eq "") || ($ch =~ /^[^:]*:\s*/)) 
    {
	$ch =~ s/\s+/ /g;	# Strip extra spaces
	if ($ch =~ /^([^:]*):\s*(.*)$/) 
	{
		$hf = $1;	# Header field
		$hd = $2;	# Header data
		$hf =~ tr/A-Z/a-z/;
			
		if ($hf eq "from") {
		    $rec->{from} = $hd;
		  } elsif (($hf eq "received") && ($firstRcv)) {
		  # Only use first received header which is the time
		  # received by users mail host.  This trick, used by
		  # many mail readers, works around any timezone
		  # issues.
		  $firstRcv = 0;
		  $hd =~ s/^[^;]*;\s*(.*)$/$1/;
		  $rec->{date} = &dateToPilot($hd); 
		  } elsif ($hf eq "to") {
		  $rec->{to} = $hd;
		  } elsif ($hf eq "cc") {
		  $rec->{cc} = $hd;
		  } elsif ($hf eq "reply-to") {
		  $rec->{replyTo} = $hd;
		  } elsif ($hf eq "subject") {
		  $rec->{subject} = $hd;
		  }
	}	
    }
    if ($firstEmpty)           # Body starts after first blank line
    {  
      $rec->{body} = $rec->{body} . $line; 
    }
   } 
   print " 債陳陳陳陳\n";
   print " � From   : " . $rec->{from} . "\n";
   print " � To     : " . $rec->{to} . "\n";
   print " � Subject: " . $rec->{subject} . "\n";
   $db->setRecord($rec);
}


sub GetviaPOP
{
#----------------------------------------
# Retrieve mail via POP-protocol  
#----------------------------------------

   print " 麺様様様様様様様様様�\n";
   print " � Get Mail via POP\n";
   print " 麺様様様様様様様様様�\n";


   $pop = Net::POP3->new($mailserver) 
          or die "Can't connect to POP-server $mailserver: $!\n";
   $pop->login($username, $password);
#          or die "Can't authenticate: $!\n";
   $messages = $pop->list
	  or die "Can't get list of undeleted messages: $!\n";
   foreach $msgid (keys %$messages) 
   {
      $message = $pop->get($msgid);
      unless (defined $message) 
      {
        warn "Couldn't fetch $msgid from server: $!\n";
	next;
      }
      addConduitFile($message, $inbox);
   }
}

sub GetviaPMMail
{
#----------------------------------------
# Retrieve mail via PMMail's Inbox 
#----------------------------------------
 
 $i = 0;
 foreach $SYNC (@SYNCFOLDER)
 {
   $currfolder = $PMMAILACCOUNT . "\\" . $SYNC;
   $SYNC =~ tr/A-Z/a-z/;

   chdir $currfolder;
   open (bag, "<folder.bag") 
     or die " � $currfolder is no pmmail-folder!\n";
   print " � syncing: $currfolder\n";
   while ($line = <bag>)
   {
     @fields = split(/�/,$line);
     if (($fields[0] == 0) || ($i == 0))      
        # indicates unread mail or first folder of the list.
     {
       my ($message) = "";
       open (msg, "<$fields[10]");  # open messagefile
       ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
       $mtime, $ctime, $blksize, $blocks) = stat($fields[10]);
       sysread msg, $data, $size;
       @message = split(/\n/, $data);
       foreach $msg (@message)
       {
         $msg = $msg . "\n";
       }
       $msgref = \@message;
       close(msg);
       addConduitFile($msgref, $SYNCCATEGORIES[$i]);
     }
   }
   close(bag);
   $i++;
  } 
}


#========================================
# The main program
#========================================

Logo();                   # Logo
Connect();                # Connect to Palm
OpenMailDB();             # open Database
GetPalmCategories();      # Get categories available
GetMailfromPalm();        # Send mail stored in Palm's outbox
GetviaPOP();              # First check POP in case PMMail has not
                          # allready retrieved mail
GetviaPMMail();           # Check PMMail
CloseMailDB();            # close Database