pilot-manager 1.107.0pre108-5 / usr / share / perl5 / PilotMgr / SendMail.pm

# Copyright (c) 1997 Sun Microsystems, Inc.
# All rights reserved.
# 
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF SUN
# MICROSYSTEMS, INC. HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 
# SUN MICROSYSTEMS, INC. SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS
# FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THE SOFTWARE PROVIDED
# HEREUNDER IS ON AN "AS IS" BASIS, AND SUN MICROSYSTEMS, INC. HAS NO
# OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
#  SendMail conduit for PilotManager
#  Andy Poggio, 2/98
#  Updated to not "wordwrap" the mail headers 
#  by Chris Waters <xtifr@debian.org> 7/01
#
#  Adapted from SyncMemo by Alan Harder,
#  MemoEmailer by Martin von Weissenberg,
#  and pilot-mail.c by Kenneth Albanowski
#
#  ONLY SENDS MAIL FROM PILOT FOR NOW !!!
#
#  Ignores from, priority, and notification.
package SendMail;

use Tk;
use TkUtils;
use strict;
use Data::Dumper;
use Carp;

my ($gHomeDirectory) = ("SendMail");	# base directory for files
my ($gConfigDialog);		# configuration dialog
my ($gDismissBtn);		# dismiss button on config dialog
my ($RCFILE);			# configuration file
my ($PREFS);			# configuration variables
my ($VERSION) = ("0.900ea");	# SendMail version
my ($sendmail) = ("/usr/lib/sendmail -t");
my ($fold) = ("/usr/bin/fold -s -w 72");
my ($SIGPREFID) = 3;
my ($OUTBOXCATEGORY) = 1;

# following string only used for updates from previous versions.
my ($oldsendmail) = ("| /usr/bin/fold -s -w 72 | /usr/lib/sendmail -t");

sub conduitInit
{
    $RCFILE = $gHomeDirectory . "/SendMail.prefs";
    &loadPrefs;

    $PREFS->{"gFoldPipe"} = $fold unless defined $PREFS->{"gFoldPipe"};
    $PREFS->{"gSendPipe"} = $sendmail unless defined $PREFS->{"gSendPipe"};

    # check for old, out-of-date config item.
    if (defined $PREFS->{"gSendMailPipe"})
    {
#	my $oldvalue = $PREFS->{"gSendMailPipe"};
	undef $PREFS->{"gSendMailPipe"};

#	if ($oldvalue ne $oldsendmail)
#	{
	    # this is the tricky bit...user has changed old prefs.
	    # we should do something, like warn, but I'm not sure yet what.
#	}
    }
}

sub conduitQuit
{
    &savePrefs;
}

sub conduitInfo
{
    return { "database" =>
		{
		    "name" => "MailDB",
		    "creator" => "mail",
		    "type" => "DATA",
		    "flags" => 0,
		    "version" => 0,
		},
	     "version" => $VERSION,
	     "author" => "Andy Poggio",
	     "email" => "andy.poggio\@Sun.COM" };
}

sub conduitConfigure
{
    my ($this, $wm) = @_;
    my ($frame, $obj, $subfr, $text);

    unless (defined $gConfigDialog and $gConfigDialog->Exists)
    {
	$gConfigDialog = $wm->Toplevel(-title => "Configuring SendMail");
	$gConfigDialog->withdraw;
	$gConfigDialog->transient($wm);

	$frame = $gConfigDialog->Frame(-relief => "ridge", -bd => 3);

	$frame->Label(-text => "SendMail v$VERSION\n" . &conduitInfo->{"email"}
	    . "\nSends mail from Palm Pilot outbox (doesn't sync other"
	    . " mail messages)")->pack;

	$text =
	"Format: this string is a shell command used as a pipeline for\n" .
	"formatting the body of an email.  It must accept unformatted text\n" .
	"as standard input, and produce formatted text as standard output\n" .
	"The default word-wraps at 72 columns.\n" .
	"Default: " . $fold;

	$obj = $frame->Label(-text => $text);
	$obj->pack(-anchor => "c");
	$obj->configure(-justify => 'left');

	$subfr = $frame->Frame;
	$obj = $subfr->Label(-text => "Format Pipeline: ");
	$obj->pack(-side => "left", -anchor => "nw", -fill => "x");
	$obj = $subfr->Entry(-textvariable => \$PREFS->{"gFoldPipe"},
			     -relief => "sunken");
	$obj->pack(-side => "right", -anchor => "w", -fill => "x");
	$subfr->pack(-anchor => "w");

	$text =
	"Advanced Sendmail Setting: Do not change unless you know what\n" .
	"you are doing.  This is the mail delivery pipeline for SendMail.\n" .
	"Default: " . $sendmail;

	$obj = $frame->Label(-text => $text);
	$obj->pack(-anchor => "c");
	$obj->configure(-justify => 'left');

	$subfr = $frame->Frame;
	$obj = $subfr->Label(-text => "SendMail Pipeline: ");
	$obj->pack(-side => "left", -anchor => "nw", -fill => "x");

	$obj = $subfr->Entry(-textvariable => \$PREFS->{"gSendPipe"},
			     -relief => "sunken");
	$obj->pack(-side => "right", -anchor => "w", -fill => "x");
	$subfr->pack(-anchor => "w");
	$frame->pack(-side => 'top', -fill => 'x');

	$subfr = $frame->Frame;
	$gDismissBtn = TkUtils::Button($gConfigDialog, "Dismiss",
		sub{ &savePrefs; $gConfigDialog->withdraw });
	$gDismissBtn->pack(-side => 'bottom', -anchor => 'c');
	
	PilotMgr::setColors($gConfigDialog);
    }

    $gConfigDialog->Popup(-popanchor => 'c',
			  -popover => $wm,
			  -overanchor => 'c');
}


sub conduitSync
{
    my ($this, $dlp, $info) = @_;
    my ($record, %pilot);
    my ($appinfo, $cnt, $ret, $i, $sigpref, $signature, $line);
    my (@cats, %catcase, %catindx, $cat, @cat_ids, $pilot_dbhandle, $id);
    my ($dbinfo) = (&conduitInfo->{database});
    my ($dbname) = ($dbinfo->{name});

    # Open Pilot DB:
    eval
	{
	    $pilot_dbhandle = $dlp->open($dbname);
	};
    if ($@ =~ /read-only value/)
	{
	    PilotMgr::msg("Pilot database '$dbname' does not exist.\n");
	    croak($@);
	}
    elsif ($@)
	{
	    croak($@);
	}

    if (!defined($pilot_dbhandle))
    {
	PilotMgr::msg("Unable to open '$dbname'.  Aborting!");
	return;
    }

    # Let the user know what we're doing
    #
    $dlp->getStatus();

    $appinfo = $pilot_dbhandle->getAppBlock();

    # Get signature prefs
    $sigpref = $pilot_dbhandle->getPref( $SIGPREFID);
    $signature = $sigpref->{"signature"};

    # Read mail to be sent
    $i = 0;
    while (1)
    {
	$record = $pilot_dbhandle->getNextRecord( $OUTBOXCATEGORY);
	
	last if (!defined($record));
	next if ($record->{"deleted"} || $record->{"archived"});
	PilotMgr::status("Sending Pilot mail", 0);
	$line = $record->{"to"};
	if (!defined($line) || length($line)==0)
	{
	    PilotMgr::msg("Msg must have a To address.");
	    next;
	}
	$line = $record->{"body"};
	if (!defined($line) || length($line)==0)
	{
	    PilotMgr::msg("Msg must have a body.");
	    next;
	}

	# Now, set up our pipelines...
	# The tricky bit is that we set up the sendmail pipeline
	# as stdout for the fold pipeline.  This is a slightly
	# dangerous technique in general, but it works in this
	# case because we do an atomic write on the fold pipeline.
	if (not open SM, "| " . $PREFS->{"gSendPipe"}) 
	{
	    PilotMgr::msg("Unable to open sendmail pipeline");
	    next;
	}

	if ($PREFS->{"gFoldPipe"})
	{
	    open SAV, ">&STDOUT";
	    open STDOUT, ">&SM";
	    $ret = open FL, "| " . $PREFS->{"gFoldPipe"};
	    open STDOUT, ">&SAV";
	    if (not $ret)
	    {
	        PilotMgr::msg("Unable to open text formatting pipeline");
		next;
	    }
	}

	select SM; $| = 1; select STDOUT;	# no buffering on SM

	PilotMgr::status("Sending Pilot mail", 50);

	print SM "To: " . $record->{"to"} . "\n";
	$line = $record->{"cc"};
	print SM "Cc: " . $line . "\n" if (defined($line));
	$line = $record->{"bcc"};
	print SM "Bcc: " . $line . "\n" if (defined($line));
	$line =  $record->{"replyTo"};
	print SM "Reply-To: " . $line . "\n" if (defined($line));
	$line =  $record->{"subject"};
	print SM "Subject: " . $line . "\n" if (defined($line));
	$line = "X-mailer: pilotmgr-mail-" . $VERSION . "\n";
	print SM $line . "\n";

	# Print body to secondary pipeline, and then close pipeline to
	# flush the external program's buffers.
	if ($PREFS->{"gFoldPipe"})
	{
	    print FL $record->{"body"} . "\n";
	    close FL;
	    # this cries out for better error handling, but I'm not
	    # quite sure of the best thing to do at this point....
	}
	else
	{
	    print SM $record->{"body"} . "\n";
	}

	$line =  $record->{"signature"};
	print SM $signature . "\n" if (defined($line) && $line);

	close SM;
	if ($?)
	{
	    PilotMgr::msg("WARNING: failed to send message for " .
		$record->{"to"} . ".");
	} else {
	    $i++;
	    $pilot_dbhandle->deleteRecord($record->{"id"});
	}

	PilotMgr::status("Sending Pilot mail", 100);

    }
    PilotMgr::status("Sending Pilot mail", 100);

    undef $signature; # does this fix bug?

    # don't cleanup since we didn't actually sync any data, just sent outbox
    # &cleanupPilot($dlp, $pilot_dbhandle);

    $pilot_dbhandle->close();

    PilotMgr::msg("Sent " . $i . " msg(s).");

}

##########################################################################

sub loadPrefs
{
    my ($lines);

    open(FD, "<$RCFILE") || return;
    $lines = join('', <FD>);
    close(FD);
    eval $lines;

    # For some reason, we need to reference $PREFS here
    # or the preferences won't get loaded properly.
    #
    $PREFS;
}

sub savePrefs
{
    my ($var);

    $Data::Dumper::Purity = 1;
    $Data::Dumper::Deepcopy = 1;

    if (open(FD, ">$RCFILE"))
    {
	if (defined &Data::Dumper::Dumpxs)
	{
	    print FD Data::Dumper->Dumpxs([$PREFS], ['PREFS']);
	}
	else
	{
	    print FD Data::Dumper->Dump([$PREFS], ['PREFS']);
	}

	print FD "1;\n";
	close(FD);
    }
    else
    {
	PilotMgr::msg("Unable to save preferences to $RCFILE!");
    }
}

sub cleanupPilot
{
    my ($dlp_db, $pilot_dbhandle) = @_;
    $pilot_dbhandle->purge();
    $pilot_dbhandle->resetFlags();
}

1;