/usr/share/perl5/PilotMgr.pm

#!/usr/bin/perl
# ------------------------------------------------------------
# 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.
# ------------------------------------------------------------
#
# PilotManager is a synchronization suite for the 3Com(USRobotics) Pilot.
# It allows the user to synchronize Pilot databases with applications
# on your Unix desktop.
# 
# PilotManager offers the ability to plug in in custom designed
# conduits that will synchronize data between the Pilot and your
# desktop.  Each conduit will be called in turn for a specific database.
#
# Be sure to check out the PilotManager web page!
#          http://www.moshpit.org/pilotmgr
#
# Bharat Mediratta, 4/97
# Bharat@Menalto.Com
# Alan Harder, 1/98
# Alan.Harder@Sun.Com
#
# To subscribe to the PilotManager aliases, send email to:
#
#     pilotmgr-announce-request@pilotmgr.ebay.sun.com (Announcements)
#     pilotmgr-request@pilotmgr.ebay.sun.com          (Discussion)
#
# with the word 'subscribe' in the body of the email.
# You can subscribe from within PilotManager using the
# Feedback menu.  You should submit bug reports this way
# also.
#
# Patch for -daemon flag in version 1.107 provided (separately) by
# Aaron Kaplan <kaplan@cs.rochester.edu>/Gossamer <gossamer@tertius.net.au>
# and Robert King <rob@fmr.com>.
# Patch for restoring previous username/id to reset pilot in v1.107
# provided by Bodo Bellut <bodo@garfield.ping.de>.
#
package PilotMgr;

my $VERSION = "1.107";		 # PilotManager Version
my ($BASEDIR);			 # Location of PilotManager directory
my ($RCDIR);			 # PilotManager working directory
my ($userInfo);			 # Synchronization info from Pilot
my ($RCFILE);			 # PilotManager RC file
my ($LOGFILE);			 # PilotManager log file
my ($LOGFILE_THRESHOLD) = 100000;# How big the log can get
use vars qw($PREFS);		 # List of variables to be saved to prefs
my ($DEBUG) = 0;		 # Debugging mode on/off
my ($CANCEL);			 # Should we cancel this hotsync?
my ($MODE);			 # Sync Mode (normal,cmdline,specific conduits)

my $AUTHOR = 'pilotmgr-author@pilotmgr.ebay.sun.com';
my $ALIAS = 'pilotmgr@pilotmgr.ebay.sun.com';
my $ALIAS_MAINT = 'owner-pilotmgr@pilotmgr.ebay.sun.com';
my $REQUEST = 'pilotmgr-request@pilotmgr.ebay.sun.com';
my $ANNC_ALIAS = 'pilotmgr-announce@pilotmgr.ebay.sun.com';
my $ANNC_REQUEST = 'pilotmgr-announce-request@pilotmgr.ebay.sun.com';
my $URL = 'http://www.moshpit.org/pilotmgr';

# This begin block tracks down the actual location of the
# PilotManager code and puts it into @INC

# block removed for Debian version:
# we don't need this since we're installing PilotMgr.pm in the normal
# Perl load paths.  We will be putting the various Sync modules in a
# PilotMgr directory though.

use lib '/usr/share/perl5/PilotMgr';
$BASEDIR = '/usr/share/perl5/PilotMgr';

use PDA::Pilot;
use Data::Dumper;

use strict;
use Time::Local;
use TkUtils;
use sigtrap;
use Carp;

###
# Check command line parameters
#  Getopt seems to have a problem with 'use strict' so for
#  now take the easy way out.
###
while ($_ = shift)
{
    if ($_ eq '-d')
    {
	$DEBUG = 1;
    }
    elsif (/^-da?emon$/i)
    {
	# fork and sync forever in background (blocks)
	$MODE = 'DAEMON';
    }
    elsif (/^-sync$/i)
    {
	# do sync now, don't bring up gui
	$MODE = 'CMDLINE';
    }
    elsif (/^-syncwith$/i)
    {
	# sync with specified conduit(s) only
	$MODE = [shift];
	push(@$MODE, shift) while (@ARGV && $ARGV[0] !~ /^-/);
    }
    elsif (/^-install$/i)
    {
	# use Installer conduit to install specified dbs
	$MODE = ['Installer'];
	while (@ARGV && $ARGV[0] !~ /^-/)
	{
	    $_ = shift;
	    if (system "cp $_ $ENV{HOME}/.pilotmgr/Installer")
	    {
		print "Error copying $_ to $ENV{HOME}/.pilotmgr/Installer\n";
	    } else {
		s|^.*/([^/]+)$|$1|;
		print "File $_ ready for install\n";
	    }
	}
    }
    elsif (/^-rcdir$/i)
    {
	$RCDIR = shift;
    }
    else
    {
	print<<"EOH";
Usage: $0 [-rcdir <dir>]
	[-sync | -daemon | -syncwith <conduits..> | -install <dbs..>]
 -sync = Start sync from command line, don't bring up gui.
 -daemon = Daemon mode, sync forever in background (preferences are locked).
 -syncwith <conduit>* = Start sync from command line with specified conduit(s).
			(Ignores currently "active" conduits from preferences)
 -install <prc/pdb>* = Use Installer conduit to install the specified files.
 -rcdir <dir> = Access resource dir <dir> instead of default ~/.pilotmgr
No parameters brings up PilotManager in normal GUI mode.
EOH
	exit;
    }
}

##############################################################################
#
# GUI code
#
##############################################################################

my ($gWm);			# Main window
my ($gColorDialog);		# Color configuration dialog
my ($gPropsDialog);		# Properties Dialog
my ($gAboutDialog);		# About PilotManager Dialog
my ($gDocDialog);		# PilotManager Document Reader Dialog
my ($gDocText);			# Contents of DocDialog text window
my ($gDocTitle);		# Title of DocDialog text window
my ($gMainFrame);		# Regular sync output frame
my ($gSyncOutput);		# Text area for sync output info
my ($gHotSyncButton);		# Button widget that starts ball rolling
my ($gNewConduits);		# Window for choosing new conduits to load
my ($gNewConduitList);		# Listbox widget containing new conduits
my ($gPortMenu);		# Menu to select port from
my ($gRateMenu);		# Menu to select rate from
my ($gFeedbackMenu);		# Feedback menu
my ($gReloadMenu);		# Reload conduit menu (in debug mode)
my ($gConfigButton);		# Config button on Prefs sheet
my ($gMoveAButton);		# "<< Move" button on Prefs sheet
my ($gMoveIButton);		# "Move >>" button on Prefs sheet
my ($gMoveUButton);		# "Move Up" button on Prefs sheet
my ($gMoveDButton);		# "Move Down" button on Prefs sheet
my ($gActiveConduitList);	# Listbox widget containing active conduits
my ($gInactiveConduitList);	# Listbox widget containing inactive conduits
my ($gClearOutput);		# Button to clear output widget
my ($gStatusWindow);		# immediate status window
my ($gStatus);			# immediate status data record
my ($DefaultColors);		# Default colors for widgets
my ($gCancel);			# Cancel sync button
my ($gOtherPortDialog);		# Text entry dialog for other serial ports
my ($gOtherPort);		# Result from above dialog
my ($gOtherPortDone);		# Modal trigger from above dialog

sub createGUI
{
    my (@frame);	# array of frames and subframes
    my ($menu);
    my ($label);
    my ($button);
    my ($text);
    my ($image);

    my (@FILEMENU) =
	(
	 "Properties...", [],
	 "Installer", [
		"Configure...", [],
		"Run...", [] ],
	 "-", [],
	 "Load New Conduits...", [],
	 "-", [],
	 "Quit", [],
	 );

    my (@RELOADMENU) = ();

    my (@HELPMENU) =
	(
	 "About PilotManager...", [],
	 "-", [],
	 "Writing your own Conduit...", [],
	 "Copyright...", [],
	 );

    my (@FEEDBACKMENU) =
	("File a bug", [],
	 "Send email to PilotManager alias...", [],
	 "Send email to PilotManager author...", [],
	 "-", [],
	 "PilotManager Announcements alias", [
		"About alias", [],
		"Subscribe to alias...", [],
		"Unsubscribe from alias...", []],
	 "PilotManager Discussion alias", [
		"About alias", [],
		"Subscribe to alias...", [],
		"Unsubscribe from alias...", []],
	 "Send email to alias maintainer...", []);

    my ($key);
    foreach $key (sort (keys %{$PREFS->{"InactiveConduits"}},
			keys %{$PREFS->{"ActiveConduits"}}))
    {
	push(@{$FEEDBACKMENU[1]}, "File bug against $key...", []);
	push(@RELOADMENU, $key, []);
    }
    push(@{$FEEDBACKMENU[1]}, "-", [], "File bug against PilotManager...", []);
    push(@RELOADMENU, "PilotSync", []);

    #########################################
    # Main Window
    #########################################


    $gWm = MainWindow->new;
    $gWm->title("PilotManager, v$VERSION");
    $gWm->bind("<Destroy>", sub { if ($_[0] eq $gWm) { &quit; } });
    $image = $gWm->Photo('pilotmgr', 
			 -file => "$BASEDIR/lib/images/pilotmgr.gif");

    $frame[0] = $gWm->Frame(-relief => "raised",
			    -borderwidth => 2);


    $menu = &Menu($frame[0], "File", \&menuChoice, @FILEMENU);
    $menu->configure(-relief => "flat");
    $menu->pack(-side => "left");

    $gFeedbackMenu = &Menu($frame[0], "Feedback", \&menuChoice, @FEEDBACKMENU);
    $gFeedbackMenu->configure(-relief => "flat");
    $gFeedbackMenu->pack(-side => "left");

    if ($DEBUG)
    {
	$gReloadMenu = &Menu($frame[0], "Reload", \&menuChoice, @RELOADMENU);
	$gReloadMenu->configure(-relief => "flat");
	$gReloadMenu->pack(-side => "left");
    }

    $menu = &Menu($frame[0], "Help", \&menuChoice, @HELPMENU);
    $menu->configure(-relief => "flat");
    $menu->pack(-side => "right");

    $frame[0]->pack(-side => "top",
		    -fill => "x");

    $gMainFrame = $gWm->Frame;

    $image = $gWm->Photo('hotsync', 
			 -file => "$BASEDIR/lib/images/hotsync.gif");

    if (!exists($PREFS->{"seenWelcome"}) || $PREFS->{"seenWelcome"} == 0)
    {
	$label = TkUtils::Label($gMainFrame, "^^^ Choose File / Properties");
	$label->pack(-anchor => "w");
    }

    $gHotSyncButton = TkUtils::Button($gMainFrame, "HotSync", 
				      sub{ &buttonChoice("HotSync") });
    $gHotSyncButton->configure(-image => 'hotsync');
    $gHotSyncButton->configure(-relief => 'flat');

    $gHotSyncButton->configure(-foreground => 'red4');
    $gHotSyncButton->pack(-anchor => "c");

    if (!exists($PREFS->{"seenWelcome"}) || $PREFS->{"seenWelcome"} == 0)
    {
	$label = TkUtils::Label($gMainFrame, "Then click ^^^ this button");
	$label->pack(-anchor => "c");
    }

    ($gSyncOutput, $label) = TkUtils::Text($gMainFrame, 
					   "Synchronization Status");
			    
    $gSyncOutput->configure(-wrap => "word");
    $gSyncOutput->parent->pack(-fill => "both",
			       -expand => "true");
    $gSyncOutput->pack(-fill => "both",
		       -expand => "true");

    $frame[0] = $gMainFrame->Frame;
    $gClearOutput = TkUtils::Button($frame[0], "Clear Status Window",
				    sub{ &buttonChoice("Clear Status Window")
					 });
    $gClearOutput->pack(-side => 'left');

    $gCancel = TkUtils::Button($frame[0], "Cancel Sync",
			       sub{ &buttonChoice("Cancel Sync")
					 });
    $gCancel->configure(-state => "disabled");

    $gCancel->pack(-side => 'left');
    
    $frame[0]->pack(-side => 'bottom');

    $gMainFrame->pack(-expand => "true",
		      -fill => "both");

    if ($PREFS->{"mainGeometry"})
    {
	$gWm->geometry($PREFS->{"mainGeometry"});
    }

    &setColors($gWm);

    # Set the icon at the end.  If we set it sooner, the pilotmanager
    # window tends to appear before we're ready (don't know why!)
    #
    $gWm->Icon(-image => 'pilotmgr');
    $gWm->iconname($VERSION);
}

sub updateMenus
{
    my ($conduit, $fmenu, $rmenu);

    # Get menu handles
    return unless (defined $gFeedbackMenu);
    $fmenu = $gFeedbackMenu->cget("-menu")->entrycget(1, "-menu");
    $rmenu = $gReloadMenu->cget("-menu") if ($DEBUG);

    # Delete old items
    #  Index 0 is tearoff, last 2 are separator and PilotMgr choice
    $fmenu->delete(1, $fmenu->index("last") - 2);
    $rmenu->delete(1, "end") if ($DEBUG);

    # Repopulate menus
    foreach $conduit (sort(keys %{$PREFS->{"InactiveConduits"}},
			   keys %{$PREFS->{"ActiveConduits"}}))
    {
	$fmenu->insert($fmenu->index("last") - 1, "command",
	    -label => "File bug against $conduit...",
	    -command =>
		eval qq{sub{&menuChoice(
		    "Feedback / File a bug / File bug against $conduit...")}});

	if ($DEBUG)
	{
	    $rmenu->add("command", -label => $conduit,
		-command => eval qq{sub{&menuChoice("Reload / $conduit")}});
	}
    }
    $rmenu->add("command", -label => "PilotSync",
	-command => sub{&menuChoice("Reload / PilotSync")}) if ($DEBUG);
}

sub createColorDialog
{
    my (@frames);
    my (%menu, %entry);
    my (@opts);
    my ($key);
    my ($obj);

    $gColorDialog = $gWm->Toplevel(-title => "Configure Colors");
    $gColorDialog->withdraw;
    $gColorDialog->transient($gWm);

    $obj = TkUtils::Label($gColorDialog, 
			  "Select a color for each object\n" .
			  "If the field is blank, the default will be used.\n".
			  "Your changes will be saved when you dismiss " .
			  "the dialog.\nHit apply to have your changes " .
			  "reflected immediately.");
    $obj->pack(-side => 'top',
	       -anchor => 'center');

    # Determine list of settable attributes
    #
    foreach $key (sort keys %{$PREFS->{"colors"}->{"Default"}})
    {
	push(@opts, $key, []);
    }

    # Create a choice for each object.
    #
    $frames[0] = $gColorDialog->Frame(-relief => 'ridge', -bd => '2');
    $frames[1] = $frames[0]->Frame;
    $frames[2] = $frames[0]->Frame;
    $frames[3] = $frames[0]->Frame;
    my (%seen);
    foreach $key ("Default", sort keys %{$PREFS->{"colors"}})
    {
	next if $seen{$key}++;

	$obj = TkUtils::Label($frames[1], $key);
	$obj->pack(-side => 'top',
		   -anchor => 'e',
		   -expand => 'true',
		   -fill => 'both');

	$obj->configure(-foreground => 'blue')
	    if ($key eq "Default");

	$entry{$key} = TkUtils::Entry($frames[3],
				      \$PREFS->{"colors"}->{$key}->{$opts[0]});
	$entry{$key}->pack(-side => 'top',
			   -expand => 'true',
			   -fill => 'both');

	$menu{$key} = TkUtils::Menu($frames[2], 
				    $opts[0],
				    sub{ my ($val) = $_[0]; $val =~ s|.*/ ||;
					 $menu{$key}->configure(-text => $val);
					 $entry{$key}->configure(-textvariable => \$PREFS->{"colors"}->{$key}->{$val});
				     },
				    @opts);

	$menu{$key}->pack(-side => 'top',
			  -expand => 'true',
			  -fill => 'both');
    }
    $frames[3]->pack(-side => 'right',
		     -fill => 'both',
		     -expand => 'true');
    $frames[2]->pack(-side => 'right',
		     -fill => 'both',
		     -expand => 'true');
    $frames[1]->pack(-side => 'right',
		     -fill => 'both',
		     -expand => 'true');

    $frames[0]->pack(-side => 'top');

    $frames[0] = $gColorDialog->Frame;

    $obj = TkUtils::Button($frames[0], "Apply", sub{ &setColors($gWm) });
    $obj->pack(-side => 'left',
	       -anchor => 'center');

    $obj = TkUtils::Button($frames[0], "Dismiss", 
			   sub{ &setColors($gWm); $gColorDialog->withdraw });
    $obj->pack(-side => 'left',
	       -anchor => 'center');

    $frames[0]->pack(-side => 'bottom');
    
    &setColors($gColorDialog);
}

sub createAboutDialog
{
    my (@frame);
    my ($label);
    my ($button);
    my (@saveLabels);

    $gAboutDialog = $gWm->Toplevel(-title => "About PilotManager");
    $gAboutDialog->withdraw;
    $gAboutDialog->transient($gWm);
    $frame[0] = $gAboutDialog->Frame;

    $label = TkUtils::Label($frame[0], "PilotManager $VERSION");
    $label->pack(-side => 'top',
		 -anchor => 'center');
    push(@saveLabels, $label);

    $label = TkUtils::Label($frame[0], 
			    "PilotManager is a Unix synchronization " .
			    "suite for the 3Com PalmPilot.\n For more " .
			    "details, please refer to:");
    $label->pack(-side => 'top',
		 -anchor => 'center');

    $label = TkUtils::Label($frame[0], $URL);
    $label->pack(-side => 'top',
		 -anchor => 'center');
    push(@saveLabels, $label);

    $label = TkUtils::Label($frame[0], 
			    "Please file any bugs that you find via\nthe " .
			    "Feedback menu.  Thank-you.");
    $label->pack(-side => 'top',
		 -anchor => 'center');

    $label = TkUtils::Label($frame[0], 
			    "Copyright (C) 1997 Bharat " .
			    "Mediratta\nSubject to the terms of the Sun " .
			    "Microsystems License\nDevelopment taken over " .
			    "11/97 by Alan Harder");
    $label->pack(-side => 'top',
		 -anchor => 'center');


    $button = TkUtils::Button($frame[0], "Dismiss",
			      sub{ $gAboutDialog->withdraw});
    $button->pack;

    $frame[0]->pack;

    &setColors($gAboutDialog);

    foreach $label (@saveLabels)
    {
	$label->configure('foreground' => 'red4');
    }

    $gAboutDialog->withdraw;
}

sub createPropsDialog
{
    my (@frame);
    my ($label);
    my ($button);
    my ($image);

    my (@TTYMENU) =
	("/dev/ttya", [],
	 "/dev/ttyb", [],
	 "/dev/cua/a", [],
	 "/dev/cua/b", [],
	 "/dev/cua0", [],
	 "/dev/cua1", [],
	 "/dev/cua2", [],
	 "/dev/cua3", [],
	 "/dev/pilot", [],
	 "Other...", []);

    my (@RATEMENU) =
	("9600", [],
	 "19200", [],
	 "38400", [],
	 "57600", [],
	 "76800", [],
	 "115200", []);

    $gPropsDialog = $gWm->Toplevel(-title => "PilotManager Properties");
    $gPropsDialog->withdraw;
    $gPropsDialog->transient($gWm);

    $frame[0] = $gPropsDialog->Frame;
    $frame[1] = $frame[0]->Frame;

    $frame[2] = $frame[1]->Frame(-relief => 'ridge', -bd => 2);
    $label = TkUtils::Label($frame[2], "Communication Settings");
    $label->pack(-side => 'top',
		 -anchor => 'center');
    $label->configure(-foreground => "blue");

    $frame[3] = $frame[2]->Frame;
    $frame[4] = $frame[3]->Frame;
    $label = TkUtils::Label($frame[4], "Pilot Port");
    $label->pack(-side => "top");
    $label = TkUtils::Label($frame[4], "Comm speed ");
    $label->pack(-side => "top");
    $frame[4]->pack(-side => "left");

    $frame[4] = $frame[3]->Frame;
    $PREFS->{"gPort"} ||= $TTYMENU[0];
    $gPortMenu = &Menu($frame[4], 
		       $PREFS->{"gPort"} || $TTYMENU[0],
		       sub{
			   if ($_[0] =~ /Other/) { &getOtherPort; } else {
			   ($PREFS->{"gPort"} = $_[0]) =~ s|.*/ ||;
			   $gPortMenu->configure(-text => $PREFS->{"gPort"})
			   }},
		       @TTYMENU);
    $gPortMenu->pack(-side => "top");
    $PREFS->{"gRate"} ||= "9600";
    $gRateMenu = &Menu($frame[4], 
		       $PREFS->{"gRate"} || $RATEMENU[0], 
		       sub{
			   ($PREFS->{"gRate"} = $_[0]) =~ s|.*/ ||;
			   $gRateMenu->configure(-text => $PREFS->{"gRate"})
			   },
		       @RATEMENU);
    $gRateMenu->pack(-side => "top",
		     -expand => "true",
		     -fill => "x");
    $frame[4]->pack(-side => "left");
    $frame[3]->pack;
    $frame[2]->pack(-side => "left",
		    -expand => 'true',
		    -fill => 'both');

    $frame[2] = $frame[1]->Frame(-relief => 'ridge', -bd => 2);
    $label = TkUtils::Label($frame[2], "Miscellaneous");
    $label->configure(-foreground => "blue");
    $label->pack(-anchor => 'c');

    $frame[3] = $frame[2]->Frame;

    $PREFS->{"gDateStamp"} = 1
	unless (exists($PREFS->{"gDateStamp"}) && 
		defined($PREFS->{"gDateStamp"}));

    $button = TkUtils::Checkbutton($frame[3], 
				   "Datestamp hotsync log",
				   \$PREFS->{"gDateStamp"});

    $button->pack(-side => 'top',
		  -expand => 'false');

    $PREFS->{"gShowConduitStatus"} = 1
	unless (exists($PREFS->{"gShowConduitStatus"}) &&
		defined($PREFS->{"gShowConduitStatus"}) );

    $button = TkUtils::Checkbutton($frame[3], 
				   "Show conduit status window",
				   \$PREFS->{"gShowConduitStatus"});

    $button->pack(-side => 'top',
		  -expand => 'false');


    $frame[4] = $frame[3]->Frame;
    $button = TkUtils::Checkbutton($frame[4], 
				   "Use color scheme",
				   \$PREFS->{"gUseColors"});
    $button->bind("<ButtonPress>", 
		  sub{ 
		      if ($PREFS->{"gUseColors"})
		      {
			  &setColors($gWm);
		      }
		      else
		      {
			  &unsetColors($gWm);
		      }
		  });

    $button->pack(-side => 'left',
		  -expand => 'false');
    
    $button = TkUtils::Button($frame[4],
			      "Customize Colors",
			      sub{ &showColorDialog });
    $button->pack(-side => 'left',
		  -expand => 'false');

    $frame[4]->pack(-side => 'top',
		    -expand => 'false');

    $frame[3]->pack;

    $frame[2]->pack(-side => 'left',
		    -expand => 'true',
		    -fill => 'both');
    $frame[1]->pack(-side => 'top',
		    -expand => 'false',
		    -fill => 'x');

    $frame[1] = $frame[0]->Frame(-relief => 'ridge',
				 -bd => '2');
	$frame[1]->pack( -expand => 'true',
				 -fill => 'x');
    $frame[2] = $frame[1]->Frame;
    ($gActiveConduitList, $label) = 
	TkUtils::List($frame[2], "Active Conduits (in order)", "vertical");
    $gActiveConduitList->configure(-height => 5);
    $label->configure(-foreground => "darkgreen");
    $gActiveConduitList->pack(-fill => "both",
			      -expand => "true");
    $gActiveConduitList->bind("<Double-Button-1>", 
			      sub{&buttonChoice("Configure")});
    $gActiveConduitList->bind("<ButtonPress>", \&selectConduit);
    $gActiveConduitList->bind("<ButtonRelease>", \&selectConduit);
    $gActiveConduitList->bind("<KeyPress-Down>", \&selectConduit);
    $gActiveConduitList->bind("<KeyPress-Up>", \&selectConduit);

    $gMoveUButton= TkUtils::Button($frame[2], "Up", 
				   sub{&buttonChoice("Up")});
    $gMoveUButton->configure(-state => "disabled");
    $gMoveUButton->pack(-padx => 0,
			-side => "left",
			-anchor => "c",
			-expand => "true");

    $gMoveDButton= TkUtils::Button($frame[2], "Down", 
				   sub{&buttonChoice("Down")});
    $gMoveDButton->configure(-state => "disabled");
    $gMoveDButton->pack(-side => "left",
			-anchor => "c",
			-expand => "true");
    $gConfigButton= TkUtils::Button($frame[2], "Configure", 
				     sub{&buttonChoice("Configure")});
    $gConfigButton->configure(-state => "disabled");
    $gConfigButton->pack(-side => "left", 
			 -anchor => "c",
			 -expand => "true");


    $gMoveIButton = TkUtils::Button($frame[2], "Move >>", 
				    sub{&buttonChoice("Move >>") });
    $gMoveIButton->configure(-state => "disabled");
    $gMoveIButton->pack(-side => "left",
			-anchor => "c",
			-expand => "true");

    $frame[2]->pack(-side => 'left',
		    -expand => 'true',
		    -fill => 'both');

    $frame[2] = $frame[1]->Frame;
    ($gInactiveConduitList, $label) = 
	TkUtils::List($frame[2], "Inactive Conduits", "vertical");
    $gInactiveConduitList->configure(-height => 5);
    $gInactiveConduitList->bind("<Double-Button-1>", 
				sub{&buttonChoice("<< Move")});
    $gInactiveConduitList->bind("<ButtonPress>", \&selectConduit);
    $gInactiveConduitList->bind("<ButtonRelease>", \&selectConduit);
    $gInactiveConduitList->bind("<KeyPress-Down>", \&selectConduit);
    $gInactiveConduitList->bind("<KeyPress-Up>", \&selectConduit);
    $label->configure(-foreground => "red");
    $gInactiveConduitList->pack(-fill => "both",
				-expand => "true");


    $gMoveAButton = TkUtils::Button($frame[2], "<< Move", 
				    sub{ &buttonChoice("<< Move") });
    $gMoveAButton->configure(-state => "disabled");
    $gMoveAButton->pack(-side => "left", 
			-anchor => "c",
			-expand => "true");
    $frame[2]->pack(-side => 'left',
		    -expand => 'true',
		    -fill => 'both');
    $frame[1]->pack(-side => 'top',
		    -expand => 'true',
		    -fill => 'both');

    $frame[0]->configure(-relief => "raised");
    $frame[0]->pack(-fill => "both",
		 -expand => "true");

    $button = TkUtils::Button($frame[0], "Dismiss", 
			     sub{ &savePrefs; $gPropsDialog->withdraw});
    $button->pack;

    if ($PREFS->{"propsGeometry"})
    {
	$gPropsDialog->geometry($PREFS->{"propsGeometry"});
    }

    $gPropsDialog->bind("<Destroy>",
			sub{ if ($_[0] eq $gPropsDialog) { &savePrefs; } } );


    &setColors($gPropsDialog);

    &updateConduitLists;
}

sub createOtherPortDialog
{
    my ($frame, $obj);

    $gOtherPortDialog = $gWm->Toplevel(-title => 'Serial Port Device');
    $gOtherPortDialog->withdraw;
    $gOtherPortDialog->transient($gWm);

    $frame = $gOtherPortDialog->Frame(-relief => 'ridge', -bd => 2);

    $obj = $frame->Entry(-textvariable => \$gOtherPort, -width => 15);
    $obj->pack(-side => 'top');

    $obj = $frame->Button(-text => 'Ok',
			  -command => sub { $gOtherPortDone = 1; });
    $obj->pack(-side => 'left');

    $obj = $frame->Button(-text => 'Cancel',
			  -command => sub { $gOtherPortDone = 2; });
    $obj->pack;

    $frame->pack;

    &setColors($gOtherPortDialog);
}

sub showAbout
{
    &createAboutDialog
	unless (defined($gAboutDialog) && $gAboutDialog->Exists);

    $gAboutDialog->Popup(-popanchor => 'c',
			 -popover => $gWm,
			 -overanchor => 'c');
}

sub showColorDialog
{
    &createColorDialog
	unless (defined($gColorDialog) && $gColorDialog->Exists);

    $gColorDialog->Popup(-popanchor => 'c',
			 -popover => $gWm,
			 -overanchor => 'c');
}

sub showDoc
{
    my ($doc, $title) = @_;
    my ($ret);

    unless (defined($gDocDialog) && $gDocDialog->Exists)
    {
	my (@frame);
	my ($button);
	$gDocDialog = $gWm->Toplevel(-title => "PilotManager Documentation");
	$gDocDialog->withdraw;
	$gDocDialog->transient($gWm);
	$frame[0] = $gDocDialog->Frame;

	($gDocText, $gDocTitle) = TkUtils::Text($frame[0], $title);
	$gDocText->configure(-height => 20,
			     -state => "disabled");
	$gDocText->pack(-expand => "true",
			-fill => "both");
			     

	$button = TkUtils::Button($frame[0], "Dismiss",
				  sub{ $gDocDialog->withdraw});
	$button->pack;

	$frame[0]->pack(-expand => 'true',
			-fill => 'both');

	&setColors($gDocDialog);
    }

    $gDocText->configure(-state => "normal");
    $gDocText->delete("0.0", "end");

    if(open(FD, "<$BASEDIR/$doc"))
    {
	$gDocTitle->configure(-text => $title);
	while (<FD>)
	{
	    $gDocText->insert("end", $_);
	}
	close(FD);
	$ret = 1;
    }
    else
    {
	$gDocTitle->configure(-text => "Error!");
	$gDocText->insert("end", "Error loading $BASEDIR/$doc!\n"); 
	# $gDocText->insert("end", "Please file a bug using the Feedback menu");
	$ret = 0;
    }

    $gDocText->configure(-state => "disabled");
    $gDocDialog->Popup(-popanchor => 'c',
		       -popover => $gWm,
		       -overanchor => 'c');

    return $ret;
}

sub showProperties
{
    &createPropsDialog
	unless (defined($gPropsDialog) && $gPropsDialog->Exists);

    $gPropsDialog->Popup(-popanchor => 'c',
			 -popover => $gWm,
			 -overanchor => 'c');
}

sub configureInstaller
{
    if (defined &Installer::conduitConfigure)
    {
	Installer::conduitConfigure("Installer", $gWm);
    }
    else
    {
	&tellUser("Installer conduit not found!");
    }
}

sub runInstaller
{
    unless (defined &Installer::conduitSync)
    {
	&tellUser("Installer conduit not found!");
	return;
    }

    my ($saveOrder) = ($PREFS->{"ActiveOrder"});

    $PREFS->{"ActiveOrder"} = ["Installer"];

    $gHotSyncButton->configure(-state => "disabled");
    $gCancel->configure(-state => 'normal');

    eval
    {
	&hotSync;
    };
    msg("Error: $@") if ($@);

    $gHotSyncButton->configure(-state => "normal");
    $gCancel->configure(-state => 'disabled');
    $gStatusWindow->withdraw
	if (defined $gStatusWindow and $gStatusWindow->Exists);

    $PREFS->{"ActiveOrder"} = $saveOrder;
}

sub getOtherPort
{
    &createOtherPortDialog
	unless(defined($gOtherPortDialog) && $gOtherPortDialog->Exists);

    $gOtherPort = '';
    $gOtherPortDone = 0;
    $gOtherPortDialog->Popup(-popanchor => 'c', -overanchor => 'c',
			     -popover => $gPropsDialog);

    $gOtherPortDialog->grab;
    $gOtherPortDialog->waitVariable(\$gOtherPortDone);
    $gOtherPortDialog->grabRelease;
    $gOtherPortDialog->withdraw;

    if ($gOtherPortDone == 1)
    {
	$PREFS->{'gPort'} = $gOtherPort;
	$gPortMenu->configure(-text => $PREFS->{'gPort'});
    }
}

sub menuChoice
{
    my ($choice) = @_;

    ($choice eq "File / Quit") and $gWm->destroy;
    ($choice eq "File / Properties...") and &showProperties;
    ($choice eq "File / Installer / Configure...") and &configureInstaller;
    ($choice eq "File / Installer / Run...") and &runInstaller;
    ($choice eq "File / Load New Conduits...") and &loadNewConduits;
    ($choice eq "Help / About PilotManager...") and &showAbout;
    ($choice eq "Help / Copyright...") and 
	&showDoc("COPYRIGHT", "Copyright");
    ($choice eq "Help / Writing your own Conduit...") 
	and &showDoc("docs/Conduit.api", "Writing your own Conduit");
    ($choice eq "Help / About PilotManager...") and &showAbout;
    ($choice =~ m|.*File a bug / .*\s(.*?)\.\.|) and &feedback("bug $1");
    ($choice =~ m|Feedback / Send .* alias maint|) and &feedback("aliasmaint");
    ($choice =~ m|Feedback / Send .*ilotManager alias|) and &feedback("alias");
    ($choice =~ m|Feedback / Send .* author|) and &feedback("author");
    ($choice =~ m|Feedback / .* Announcements alias / About alias|)
	and &showDoc("docs/AnncAlias.txt", "PilotManager Announcements Alias");
    ($choice =~ m|Feedback / .* Discussion alias / About alias|)
	and &showDoc("docs/DiscAlias.txt", "PilotManager Discussion Alias");
    ($choice =~ m|Feedback / PilotManager (.*) alias / Subscribe|)
	and &feedback("subscribe-$1");
    ($choice =~ m|Feedback / PilotManager (.*) alias / Unsubscribe|)
	and &feedback("unsubscribe-$1");

    if ($DEBUG)
    {
	if ($choice =~ m|Reload / (.*)|)
	{
	    my ($status, %sym) = ({});

	    # Unload
	    delete $INC{"$1.pm"};
	    *sym = "$1::";
	    undef %sym;

	    # Special for PilotSync (not a conduit)
	    if ($1 eq 'PilotSync')
	    {
		eval "use $1";
		msg($@ ? "Error reloading PilotSync: $@"
		       : "PilotSync module reloaded.");
		return;
	    }

	    # Reload
	    &loadConduits( [ $1 ], $status );

	    # Tell user what happened
	    if ($status->{$1})
	    {
		# Remove conduit from GUI things if reload failed
		&updateConduitLists;
		&updateMenus;

		msg("Conduit '$1' not reloaded due to errors.");
	    } else {
		msg("Conduit '$1' has been reloaded.");
	    }
	}
    }
}

sub feedback
{
    my ($type) = @_;

    ($type eq "alias") && 
	&showMail('to' => $ALIAS,
		 'editable' => 'true');

    ($type eq "author") && 
	&showMail('to' => $AUTHOR,
		 'subject' => "PilotManager v$VERSION Feedback",
		 'editable' => 'true');

    ($type eq "aliasmaint") &&
	&showMail('to' => $ALIAS_MAINT,
		  'editable' => 'true');

    ($type =~ /^(subscribe)-(.*)$/ ||
     $type =~ /^(unsubscribe)-(.*)$/) && 
	 &showMail('to' => ($2 eq "Announcements" ? $ANNC_REQUEST : $REQUEST),
		  'subject' => "Administrative request",
		  'body' => "$1\n",
		  'editable' => 'false');

    if ($type eq "bug PilotManager")
    {
	&showMail('to' => $AUTHOR,
		  'subject' => "PilotManager v$VERSION bug report",
		  'editable' => 'true');
    }
    elsif ($type =~ /bug (.*)/)
    {
	my ($conduit);
	if (exists($PREFS->{"ActiveConduits"}{$1}))
	{
	    $conduit = $PREFS->{"ActiveConduits"}{$1};
	}
	else
	{
	    $conduit = $PREFS->{"InactiveConduits"}{$1};
	}

	&showMail('to' => $conduit->{"email"},
		  'subject' => "PilotManager: $1 v$conduit->{version} " .
		               "bug report",
		  'cc' => $AUTHOR,
		  'editable' => 'true');
    }
}

sub showMail
{
    my (%data) = @_;
    my (@frame);
    my ($key);
    my ($win);
    my ($to, $subj, $cc, $text);
    my ($label, $entry, $button);

    $win = $gWm->Toplevel(-title => "Send Feedback...");
    $win->withdraw;
    $win->transient($gWm);
    $frame[0] = $win->Frame;
    $frame[1] = $frame[0]->Frame;
    $frame[2] = $frame[1]->Frame;
    TkUtils::Label($frame[2], "To:");
    TkUtils::Label($frame[2], "Subject:");
    TkUtils::Label($frame[2], "Cc:");
    $frame[2]->pack(-side => 'left');

    $frame[2] = $frame[1]->Frame;
    $entry = TkUtils::Entry($frame[2], \$to);
    $entry->configure(-state => 'disabled')
	if (exists($data{"editable"}) && $data{"editable"} eq 'false');

    $entry = TkUtils::Entry($frame[2], \$subj);
    $entry->configure(-state => 'disabled')
	if (exists($data{"editable"}) && $data{"editable"} eq 'false');

    $entry = TkUtils::Entry($frame[2], \$cc);
    $entry->configure(-state => 'disabled')
	if (exists($data{"editable"}) && $data{"editable"} eq 'false');
    $frame[2]->pack(-side => 'left',
		    -expand => 'true',
		    -fill => 'x');
    $frame[1]->pack(-expand => 'false',
		    -fill => 'x');

    ($text) = TkUtils::Text($frame[0], "");
    $data{"body"} and $text->insert("end", $data{"body"});
    $text->configure(-wrap => 'word');
    $text->parent->pack(-expand => 'true',
			-fill => 'both');
    $text->configure(-state => 'disabled')
	if (exists($data{"editable"}) && $data{"editable"} eq 'false');

    $data{"to"} and $to = $data{"to"};
    $data{"subject"} and $subj = $data{"subject"};
    $data{"cc"} and $cc = $data{"cc"};

    $frame[1] = $frame[0]->Frame;
    $button = TkUtils::Button($frame[1], "Send Email", 
			      sub{ $win->withdraw; 
				   &sendEmail($to, 
					      $subj, 
					      $cc,
					      $text->get("1.0", "end"))
				   });
    $button->pack(-side => 'left');
    $button = TkUtils::Button($frame[1], "Cancel", sub{ $win->withdraw });
    $button->pack(-side => 'left');
    $frame[1]->pack;
    $frame[0]->pack(-expand => 'true',
		    -fill => 'both');
    
    &setColors($win);
    $win->Popup;
}

sub sendEmail
{
    my ($to, $subj, $cc, $body) = @_;
    my ($txt);

    if (open(FD, "|/usr/lib/sendmail -t") or
	open(FD, "|/usr/sbin/sendmail -t"))
    {
	print FD "To: $to\n";
	print FD "Subject: $subj\n"
	    if ($subj);
	print FD "Cc: $cc\n"
	    if ($cc);
	print FD "X-Mailer: PilotManager,v$VERSION\n";
	print FD "\n";
	print FD $body;

	if ($subj =~ /(bug|feedback)/i)
	{
	    print FD "-" x 79, "\n";
	    chomp($txt = Config::myconfig());
	    print FD "$txt  More info:\n";
	    chomp($txt = `uname -a`);
	    print FD "    uname='$txt'\n" if ($txt);
	    if (-r '/usr/dt/lib/libcsa.so')
	    {
		($txt = `/usr/ccs/bin/mcs -p /usr/dt/lib/libcsa.so`) =~ s/\n//g;
		$txt =~ s|^/usr/dt/lib/libcsa.so:||;
		print FD "    libcsa='$txt'\n" if ($txt);
	    }
	    print FD "    perllib='$ENV{'PERLLIB'}'\n"
		if (defined $ENV{'PERLLIB'});
	    print FD "    myPMgr='$0', version=$VERSION\n";
	}

	print FD "\n.\n";
	close(FD);
    }
}

sub buttonChoice
{
    my ($choice) = @_;
    my ($id);

    if ($choice eq "Cancel Sync")
    {
	&cancel;
    }
    elsif ($choice eq "HotSync")
    {
	&savePrefs;
	$gHotSyncButton->configure(-state => "disabled");
	$gCancel->configure(-state => 'normal');

	eval
	{
	    &hotSync;
	};
	msg("Error: $@") if ($@);

	$gHotSyncButton->configure(-state => "normal");
	$gCancel->configure(-state => 'disabled');
	$gStatusWindow->withdraw
	    if (defined($gStatusWindow) && $gStatusWindow->Exists);
    }
    elsif ($choice eq "Clear Status Window")
    {
	$gSyncOutput->configure(-state => "normal");
	$gSyncOutput->delete("0.0", "end");
	$gSyncOutput->configure(-state => "disabled");
    }
    elsif ($choice eq "Up")
    {
	my ($sel);
	$sel = $gActiveConduitList->curselection;
	return if ($sel == 0);
	if (defined($sel))
	{
	    my ($line) = splice(@{$PREFS->{"ActiveOrder"}}, $sel, 1);
	    splice(@{$PREFS->{"ActiveOrder"}}, $sel-1, 0, $line);
	    &updateConduitLists;
	    $gActiveConduitList->selectionSet($sel-1);
	    $gActiveConduitList->see($sel-1);
	    &selectConduit;
	}
    }
    elsif ($choice eq "Down")
    {
	my ($sel);
	$sel = $gActiveConduitList->curselection;
	if (defined($sel))
	{
	    my ($line) = splice(@{$PREFS->{"ActiveOrder"}}, $sel, 1);
	    splice(@{$PREFS->{"ActiveOrder"}}, $sel+1, 0, $line);
	    &updateConduitLists;
	    $gActiveConduitList->selectionSet($sel+1);
	    $gActiveConduitList->see($sel+1);
	    &selectConduit;
	}
    }
    elsif ($choice eq "Move >>")
    {
	my ($sel);
	my ($conduit);
	my ($line);

	$sel = $gActiveConduitList->curselection;
	if (defined($sel))
	{
	    $line = $gActiveConduitList->get($sel);
	    ($conduit = $line) =~ s/[,\s].*//;

	    $PREFS->{"InactiveConduits"}{$conduit} = 
		$PREFS->{"ActiveConduits"}{$conduit};
	    delete $PREFS->{"ActiveConduits"}{$conduit};
	    @{$PREFS->{"ActiveOrder"}} = grep(!/$conduit/,
					      @{$PREFS->{"ActiveOrder"}});
	    &updateConduitLists;
	    $gActiveConduitList->selectionSet($sel);
	    $gActiveConduitList->see($sel);
	    &selectConduit;
	}
    }
    elsif ($choice eq "<< Move")
    {
	my ($sel);
	my ($conduit);
	my ($line);

	$sel = $gInactiveConduitList->curselection;
	if (defined($sel))
	{
	    $line = $gInactiveConduitList->get($sel);
	    ($conduit = $line) =~ s/[,\s].*//;

	    $PREFS->{"ActiveConduits"}{$conduit} = 
		$PREFS->{"InactiveConduits"}{$conduit};
	    delete $PREFS->{"InactiveConduits"}{$conduit};
	    push(@{$PREFS->{"ActiveOrder"}}, $conduit);
	    &updateConduitLists;
	    $gInactiveConduitList->selectionSet($sel);
	    $gInactiveConduitList->see($sel);
	    &selectConduit;
	}
    }
    elsif ($choice eq "Configure")
    {
	my ($line);
	my ($conduit);
	my ($sel);

	$sel = $gActiveConduitList->curselection;
	if (defined($sel))
	{
	    $line = $gActiveConduitList->get($sel);
	    ($conduit = $line) =~ s/[,\s].*//;
	    $conduit->conduitConfigure($gPropsDialog);
	}
    }
}

sub guiMessage
{
    my ($buf) = @_;

    $gSyncOutput->configure(-state => "normal");
    $gSyncOutput->insert("end", "$buf\n");
    $gSyncOutput->see("end");
    $gSyncOutput->configure(-state => "disabled");

    &update;
}

sub update
{
    $gWm->update unless (defined $MODE);
}

sub selectConduit
{
    my ($sel);

    $sel = $gActiveConduitList->curselection;
    if (defined($sel))
    {
	$gConfigButton->configure(-state => "normal");
	$gMoveIButton->configure(-state => "normal");
	$gMoveUButton->configure(-state => "normal");
	$gMoveUButton->configure(-state => "disabled")
	    if ($sel == 0);

	$gMoveDButton->configure(-state => "normal");
	$gMoveDButton->configure(-state => "disabled")
	    if ($sel == @{$PREFS->{"ActiveOrder"}} - 1);
    }
    else
    {
	$gConfigButton->configure(-state => "disabled");
	$gMoveIButton->configure(-state => "disabled");
	$gMoveUButton->configure(-state => "disabled");
	$gMoveDButton->configure(-state => "disabled");
    }

    $sel = $gInactiveConduitList->curselection;
    if (defined($sel))
    {
	$gMoveAButton->configure(-state => "normal");
    }
    else
    {
	$gMoveAButton->configure(-state => "disabled");
    }
}

sub updateConduitLists
{
    my ($conduit, $name);

    return unless (defined $gPropsDialog and $gPropsDialog->Exists);

    $gActiveConduitList->delete(0, "end");
    $gInactiveConduitList->delete(0, "end");
    foreach $conduit (@{$PREFS->{"ActiveOrder"}})
    {
	$name = &getFullName($conduit, $PREFS->{"ActiveConduits"});
	$gActiveConduitList->insert("end", $name);
    }

    foreach $conduit (sort keys %{$PREFS->{"InactiveConduits"}})
    {
	$name = &getFullName($conduit, $PREFS->{"InactiveConduits"});
	$gInactiveConduitList->insert("end", $name);
    }
}

sub unsetColors
{
    my ($widget) = @_;
    my ($attr);
    my ($name);

    ($name = $widget) =~ s/.*::(.*)=.*/$1/;

    foreach $attr (keys %{$PREFS->{"colors"}->{"Default"}})
    {
	eval
	{
	    $DefaultColors->{$name}->{$attr} = ($widget->configure($attr))[3]
		unless (exists($DefaultColors->{$name}->{$attr}));

	    if (!$DefaultColors->{$name}->{$attr})
	    {
		$DefaultColors->{$name}->{$attr} = 
		    ($gWm->configure($attr))[4];
	    }

	    $widget->configure($attr => $DefaultColors->{$name}->{$attr});
	};
    }

    my ($child);
    foreach $child ($widget->children)
    {
	&unsetColors($child);
    }
}

sub setColors
{
    my ($widget, $override) = @_;
    my ($name);
    my ($i);
    my ($attr);
    my (%seen) = ();

    return unless ($PREFS->{"gUseColors"});
    return unless (exists $PREFS->{"colors"});

    ($name = $widget) =~ s/.*::(.*)=.*/$1/;

    my ($COLOR) = $PREFS->{"colors"};

    if (exists($COLOR->{$name}))
    {
	foreach $attr (keys %{$COLOR->{"Default"}})
	{
	    # This is too slow.  And, it doesn't work the second
	    # time around...
	    #
	    if (0)
	    {
		unless ($override)
		{
		    my (@cfg);
		    eval
		    {
			@cfg = $widget->configure($attr);
		    };
		    next if ($@);

		    if (defined($cfg[3]) && defined($cfg[4]) &&
			$cfg[3] ne $cfg[4])
		    {
			next;
		    }
		}
	    }

	    # Otherwise, set it.
	    #
	    eval
	    {
		if (exists($COLOR->{$name}) && 
		    exists($COLOR->{$name}->{$attr}) &&
		    defined($COLOR->{$name}->{$attr}) &&
		    $COLOR->{$name}->{$attr} =~ /\S/)
		{
		    $widget->configure($attr => $COLOR->{$name}->{$attr});
		}
		else
		{
		    $widget->configure($attr => $COLOR->{"Default"}->{$attr})
			if exists($COLOR->{"Default"}->{$attr});
		}
	    };
	}

	# For entry widgets, set the blinking cursor to be the same
 	# color as the foreground text - code snippet from Adam Stein
 	$widget->configure(-insertbackground => $widget->cget('-foreground'))
 		if ($widget->class eq 'Entry' || $widget->class eq 'Text');
    }

    my ($child);
    foreach $child ($widget->children)
    {
	&setColors($child, $override);
    }
}

##############################################################################
#
# Glue routines
#
##############################################################################

sub getFullName
{
    my ($name, $conduits) = @_;

    if (exists($conduits->{$name}{"version"}))
    {
	my ($version) = $conduits->{$name}{"version"};
	return "$name, v$version";
    }

    return "";
}

sub quit
{
    my ($conduit);
    foreach $conduit (keys %{$PREFS->{"ActiveConduits"}},
		      keys %{$PREFS->{"InactiveConduits"}})
    {
	$conduit->conduitQuit();
    }

    &savePrefs;
    exit;
}

sub loadPrefs
{
    my ($upgraded);

    if (-f $RCFILE)
    {
	do "$RCFILE";
    }

    $PREFS->{'gPort'} = '/dev/ttya'
	unless (exists $PREFS->{'gPort'});
    $PREFS->{'gRate'} = '9600'
	unless (exists $PREFS->{'gRate'});
    $PREFS->{'gUseColors'} = 1
	unless (exists $PREFS->{'gUseColors'});

    if (!exists $PREFS->{"colors"})
    {
	$PREFS->{"colors"} = 
	{
		'Default' =>
		{ 
		    'foreground' => 'red4',
		    'background' => '#e5d897',
		    'activeforeground' => '#D3D3D3', 
		    'activebackground' => 'wheat2',
		    'disabledforeground' => 'gray',
		    'disabledbackground' => 'darkgray',#'gray',
		    'highlightcolor' => 'black',
		    'highlightbackground' => '#e5d897',
		},
		
		'Scrollbar' => 
		{
		},

		'Frame' =>
		{
		},
		
		'Text' =>
		{
		    'foreground' => '#D3D3D3', # == lightgray (on my machine)
		    'background' => '#00008B', # == darkblue (on my machine) 
		},

		'Label' =>
		{
		    'foreground' => 'darkgreen',
		},

		'Button' =>
		{
		    'activeforeground' => 'red4',
		},

		'Listbox' =>
		{
		    'foreground' => '#D3D3D3', # == lightgray (on my machine)
		    'background' => '#00008B', # == darkblue (on my machine) 
		},

		'Checkbutton' =>
		{
		    'activeforeground' => 'red4',
		},

		'Radiobutton' =>
		{
		    'activeforeground' => 'red4',
		},

		'Menu' =>
		{
		    'activeforeground' => 'red4',
		},

		'Menubutton' =>
		{
		    'activeforeground' => 'red4',
		},

		'Entry' =>
		{
		    'foreground' => '#D3D3D3', # == lightgray (on my machine)
		    'background' => '#00008B',	# == darkblue (on my machine) 
		},
		
		'Scale' =>
		{
		    'activeforeground' => 'red4',
		},

		'Toplevel' =>
		{
		},
	};
    }

    if (!exists $PREFS->{"version"} or !defined $PREFS->{"version"})
    {
	$upgraded = 1;
    }
    elsif ($PREFS->{"version"} ne $VERSION)
    {
	$upgraded = 1;

	# Do a series of filters to bring prefs up to speed.
	#
	#my ($major, $minor) = split(/-/, $PREFS->{"version"}, 2);
    }

    if ($upgraded)
    {
	# Remove the size restraints on our geometry
	# because we've gone to a new version and the size
	# may be different.
	#
	$PREFS->{"propsGeometry"} =~ s/.*?\+/+/;
	$PREFS->{"mainGeometry"} =~ s/.*?\+/+/;
    }

    # Sanity check on our sizes
    #
    &checkMin(\$PREFS->{"mainGeometry"}, 580, 370);
    &checkMin(\$PREFS->{"propsGeometry"}, 430, 320);
}

sub checkMin
{
    my ($var, $x, $y) = @_;
    my (@opts);

    @opts = split(/[\+x]/, $$var);

    return if (@opts != 4);

    $opts[0] = $x if ($opts[0] < $x);
    $opts[1] = $y if ($opts[1] < $y);

    $$var = "$opts[0]x$opts[1]+$opts[2]+$opts[3]";
}

sub init
{
    my ($conduit, $info);

    srand(time() ^ ($$ + ($$ << 15)));

    if ($DEBUG)
    {
	$RCDIR = "$ENV{HOME}/.pilotmgr-debug" unless (defined $RCDIR);
	print "Debug: Using $RCDIR\n";
    }
    else
    {
	$RCDIR = "$ENV{HOME}/.pilotmgr" unless (defined $RCDIR);
    }

    eval 'use lib "$RCDIR"';	# put user modules at top of search list.

    $RCFILE = "$RCDIR/preferences";
    $LOGFILE = "$RCDIR/hotsync.log";

    $PREFS->{"ActiveConduits"} = {};
    $PREFS->{"InactiveConduits"} = {};

    &loadPrefs;

    # Locate all conduits.  Any ones that are not defined in
    # our conduit tables are put into the inactive list.
    #
    # A conduit is defined as a script that has the following
    # two lines in it:
    #   sub conduitInit
    #   sub conduitSync
    my ($file, $conduitName);
    my (@list); 

    foreach $file (<$BASEDIR/*.pm>, <$RCDIR/*.pm>)
    {
	push(@list, $conduitName) if ($conduitName = &isConduit($file));
    }

    # Change dir to our resource dir.  All conduits expect
    # to be in this dir when started.  Also required for loading conduits
    # placed in this dir ($RCDIR is not in @INC, but "." is).
    #
    mkdir($RCDIR, 0755)
	unless (-d $RCDIR);
    chdir($RCDIR);

    &loadConduits(\@list);

    my ($key);
    foreach $key (keys %{$PREFS->{"ActiveConduits"}})
    {
	if (!grep($_ eq $key, @list))
	{
	    print "Conduit '$key' cannot be found...\n";
	    delete $PREFS->{"ActiveConduits"}->{$key};
	    @{$PREFS->{"ActiveOrder"}} = 
		grep($_ ne $key, @{$PREFS->{"ActiveOrder"}});
	}
	elsif (!grep($_ eq $key, @{$PREFS->{"ActiveOrder"}}))
	{
	    # an active conduit got lost somehow from order list
	    push(@{$PREFS->{"ActiveOrder"}}, $key);
	}
    }

    foreach $key (keys %{$PREFS->{"InactiveConduits"}})
    {
	unless (grep($_ eq $key, @list))
	{
	    print "Conduit '$key' cannot be found...\n";
	    delete $PREFS->{"InactiveConduits"}->{$key};
	    @{$PREFS->{"ActiveOrder"}} = 
		grep($_ ne $key, @{$PREFS->{"ActiveOrder"}});
	}
    }

    if (!exists($PREFS->{"pcid"}) || !defined($PREFS->{"pcid"}) ||
	$PREFS->{"pcid"} == 0)
    {
	$PREFS->{"pcid"} = rand(2147483648) + 1;
    }

    if (!exists($PREFS->{"ActiveOrder"}) || !defined($PREFS->{"ActiveOrder"}))
    {
	@{$PREFS->{"ActiveOrder"}} = keys %{$PREFS->{"ActiveConduits"}};
    }
}

sub isConduit
{
    my ($file) = @_;

    if (open(FD, "<$file"))
    {
	my (@lines) = grep(/^(package|sub conduit(Init|Sync))/, <FD>);
	close(FD);
	if (@lines == 3)
	{
	    $lines[0] =~ /^package\s+(\S+);/;
	    return $1;
	}
    }
    return undef;
}

sub loadConduits
{
    my ($list, $status) = @_;
    my ($pkgname);

    foreach $pkgname (@$list)
    {
	eval "use $pkgname";
	if ($@)
	{
	    $status->{$pkgname} = 1 if (defined $status);

	    print "v" x 30, " ERROR ", "v" x 30, "\n";
	    print "Unable to load conduit '$pkgname'\n";
	    print "$pkgname has been removed from the conduit lists\n";
	    print "Details of the error:\n";
	    print "$@\n";
	    print "^" x 30, " ERROR ", "^" x 30,
		  "\nTo skip loading $pkgname in future execute this command:",
		  "\n% mv $pkgname.pm $pkgname.pm-\n";

	    # Remove it from the system
	    my (%sym);
	    delete $INC{"$pkgname.pm"};
	    *sym = "${pkgname}::";
	    undef %sym;

	    # Remove it from the conduit lists
	    #
	    if (exists $PREFS->{"ActiveConduits"}->{$pkgname})
	    {
		delete $PREFS->{"ActiveConduits"}->{$pkgname};
	    }

	    if (exists $PREFS->{"InactiveConduits"}->{$pkgname})
	    {
		delete $PREFS->{"InactiveConduits"}->{$pkgname};
	    }

	    @{$PREFS->{"ActiveOrder"}} = 
		grep($_ ne $pkgname, @{$PREFS->{"ActiveOrder"}});
	}
	else
	{
	    $status->{$pkgname} = 0 if (defined $status);

	    $pkgname->conduitInit();

	    # If the conduit isn't on either Active or Inactive lists,
	    # put it on the inactive list.
	    #
	    if (exists $PREFS->{"ActiveConduits"}->{$pkgname})
	    {
		$PREFS->{"ActiveConduits"}->{$pkgname} =
		    $pkgname->conduitInfo();
	    }
	    else
	    {
		unless (exists $PREFS->{"InactiveConduits"}->{$pkgname})
		{
		    print "New conduit '$pkgname' added to the inactive " .
			"conduit list\n";
		}
		
		$PREFS->{"InactiveConduits"}->{$pkgname} =
		    $pkgname->conduitInfo();
	    }

	    my $wdir = "$RCDIR/$pkgname";
	    unless (-d $wdir)
	    {
		# Can't use msg() here, the window hasn't been created yet!
		#
		mkdir($wdir, 0755) or
		    print STDERR "Unable to create $wdir\n";
	    }
	}
    }
}

sub loadNewConduits
{
    # Create GUI if needed
    &createNewConduitsGui
	unless (defined $gNewConduits and $gNewConduits->Exists);

    # Update conduit list.  Only show the GUI if we have anything on the list.
    if (&updateNewConduitsGui)
    {
	$gNewConduits->Popup(-popanchor => 'c', -popover => $gWm,
			     -overanchor => 'c');
	$gNewConduits->grab;
    } else {
	$gNewConduits->withdraw;
	&tellUser("No new conduits to load");
    }
}

sub _loadNewConduits
{
    my ($load) = @_;

    if ($load)
    {
	my ($list, $status, $conduit) = ([], {});

	# Get selected conduits
	foreach ($gNewConduitList->curselection)
	{
	    $conduit = $gNewConduitList->get($_);
	    push(@$list, $conduit);
	}

	# Load selected conduits
	&loadConduits($list, $status);

	# Update GUI things
	&updateConduitLists;
	&updateMenus;

	# Tell user what happened
	foreach (@$list)
	{
	    msg("Conduit '$_' ",
		$status->{$_} ? 'not loaded due to errors.'
			      : 'has been loaded.');
	}
    }

    # Make conduit list window go away
    $gNewConduits->grabRelease;
    $gNewConduits->withdraw;
}

sub createNewConduitsGui
{
    my ($frame, $obj, $vscroll);

    # Create GUI list
    $gNewConduits = $gWm->Toplevel(-title => 'New Conduits List');
    $gNewConduits->withdraw;
    $gNewConduits->transient($gWm);

    $frame = $gNewConduits->Frame(-relief => 'ridge', -bd => 2);

    $vscroll = $frame->Scrollbar(-orient => 'vert');
    $vscroll->pack(-side => 'right', -fill => 'y');

    $gNewConduitList = $frame->Listbox(-yscrollcommand => [$vscroll => 'set'],
				       -selectmode => 'multiple');
    $vscroll->configure(-command => [$gNewConduitList => 'yview']);
    $gNewConduitList->pack(-side => 'top');

    $frame->pack(-side => 'top');
    $frame = $gNewConduits->Frame(-bd => 2);

    $obj = $frame->Button(-text => 'Load',
			  -command => sub { &_loadNewConduits(1); });
    $obj->pack(-side => 'left');

    $obj = $frame->Button(-text => 'Cancel',
			  -command => sub { &_loadNewConduits(0); });
    $obj->pack;

    $frame->pack;
    &setColors($gNewConduits);
}

sub updateNewConduitsGui
{
    my ($conduitName, $file, @allConduits, @newConduits);

    # Assemble a list of all the known conduits to make it easier
    # to lookup this information
    @allConduits = sort(keys %{$PREFS->{"InactiveConduits"}},
			keys %{$PREFS->{"ActiveConduits"}});

    # Search directory for new conduits
    foreach $file (<$BASEDIR/*.pm>, <$RCDIR/*.pm>)
    {
	push(@newConduits, $conduitName)
	    if ($conduitName = &isConduit($file) and
		!grep(/$conduitName/, @allConduits));
    }

    # Remove old list and create new one
    $gNewConduitList->delete(0, "end");
    $gNewConduitList->insert("end", sort @newConduits);

    return scalar(@newConduits);
}

sub savePrefs
{
    my ($var);

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

    $PREFS->{"mainGeometry"} = $gWm->geometry unless (defined $MODE);
    $PREFS->{"version"} = $VERSION;
    if (defined($gPropsDialog) && $gPropsDialog->Exists)
    {
	$PREFS->{"propsGeometry"} = $gPropsDialog->geometry;
    }

    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
    {
	print "Unable to save preferences to $RCFILE!\n";
    }
    
}

##############################################################################
#
# Sync routines
#
##############################################################################

sub hotSync
{
    my ($conduit, $key, $retries);
    my ($socket, $dlp);

    &cycleLogs;

    if ($PREFS->{'gPort'} =~ m|^/| &&
	!(-r $PREFS->{'gPort'} && -w $PREFS->{'gPort'}))
    {
	msg("Error: Don't have read/write permissions on $PREFS->{gPort}!\n" .
	    "(On Solaris owner/group/perms should be root/sys/666)");
	return;
    }

    msg("Please press the Hotsync button on your Pilot cradle");

    $CANCEL = 0;

    # Start trying to connect.
    #
    eval
    {
	$ENV{"PILOTRATE"} = $PREFS->{"gRate"};
	$socket = PDA::Pilot::openPort($PREFS->{"gPort"});
    };
    if ($@)
    {
	msg("Error: $@\n");
	return;
    }

    # Try to accept 3 times, each time with a timeout of 10 seconds.
    #
    $retries = 3;
    while (1)
    {
	$retries--;

	$gWm->update unless (defined $MODE);

	my ($err);
	
	eval
	{
	    $SIG{'ALRM'} = sub{ croak("alarm") };
	    alarm(10) unless ($MODE eq 'DAEMON');

	    $dlp = PDA::Pilot::accept($socket);
	};

	alarm(0);

	$gWm->update unless (defined $MODE);

	if ($dlp)
	{
	    msg("Connected.");
	    last;
	}
	else
	{
	    if ($CANCEL)
	    {
		msg("Hotsync cancelled");
		$dlp->log("Hotsync cancelled")
		    if ($dlp);
		$CANCEL = 0;
		PDA::Pilot::close($socket);
		return;
	    }

	    if ($retries == 0)
	    {
		msg("Unable to connect to the Pilot.  Sync aborted.");
		PDA::Pilot::close($socket);
		return;
	    }

	    #
	    # Otherwise, keep trying.
	}
    }

    # If this fails, the user most likely cancelled on the 
    # Pilot side.
    #
    &fullStatus("Pilot Manager", "Retrieving User Information", 0);
    eval
    {
	$userInfo = $dlp->getUserInfo();
    };
    if ($@)
    {
	msg("Synchronization cancelled on Pilot\n");
	eval
	{
	    $dlp->close();
	    PDA::Pilot::close($socket);
	};
	return;
    }

    $SIG{'PIPE'} = 'IGNORE';
    $dlp->log("Hotsync with PilotManager\n" .
		     "Details reported in PilotManager log\n\n");

    # Check the user information to see if the Pilot has been
    # reset or if it's the wrong Pilot for our setup.
    #
    if ($userInfo->{"userID"} == 0 && $userInfo->{"lastSyncPC"} == 0)
    {
	# A hard reset has happened.
	#
	&watchdog($dlp, 1);
	&tellUser("This Pilot has been reset or has never been synced.  ".
		  "Most conduits will sync properly, however you will ".
		  "need to restore your databases from your backups using ".
		  "the Installer conduit.");

	if (exists $PREFS->{"userinfo"})
	{
	    # Ask user whether to restore a previous username/id values
	    my $ans = 
		&askUser("PilotManager was previously synced with\n\n\t".
			 "'$PREFS->{userinfo}->{name}'".
			 "\n\tUnique ID: $PREFS->{userinfo}->{userID}\n\n".
			 "Do you wish to restore these settings to this ".
			 "pilot or enter a new name?",
			 "New Name", "Restore");

	    if ($ans eq "Restore")
	    {
		$userInfo->{"name"} = $PREFS->{"userinfo"}->{"name"};
		$userInfo->{"userID"} = $PREFS->{"userinfo"}->{"userID"};
	    }
	}

	&watchdog($dlp, 0);

	# Trigger all conduits to do a full sync.
	#
	$userInfo->{"successfulSyncDate"} = 0;
    }

    # If the username is not defined, request it from 
    # the user.
    if ($userInfo->{"name"} eq "")
    {
	$userInfo->{"name"} = &getUserName;
	$userInfo->{"userID"} = rand(2147483648) + 1;
    }

    if (exists($PREFS->{"userinfo"}))
    {
	# Check to make sure this is the right user
	#
	if ($PREFS->{"userinfo"}->{"userID"} ne $userInfo->{"userID"})
	{
	    &watchdog($dlp, 1);
	    my ($ans) = 
		&askUser("Your Pilot belongs to\n\n\t'$userInfo->{name}'".
			 "\n\tUnique ID: $userInfo->{userID}".
			 "\n\nbut PilotManager is expecting\n\n\t".
			 "'$PREFS->{userinfo}->{name}'".
			 "\n\tUnique ID: $PREFS->{userinfo}->{userID}\n\n".
			 "If this is an ok match, click 'Proceed' and ".
			 "PilotManager will be configured to match the ".
			 "Pilot.  However, be ".
			 "warned that if you sync somebody else\'s Pilot ".
			 "with your PilotManager configuration very bad ".
			 "things will happen!", "Proceed", "Cancel");
	    &watchdog($dlp, 0);

	    if ($ans ne "Proceed")
	    {
		$gStatusWindow->withdraw
		    if (defined($gStatusWindow) && $gStatusWindow->Exists);
		msg("Hotsync cancelled");
		$dlp->log("Hotsync cancelled");
		eval
		{
		    $dlp->close();
		    PDA::Pilot::close($socket);
		};
		return;
	    }
	}
    }

    # Need to do a full sync if they last sync'd on a 
    # different machine.
    #
    if ($userInfo->{"lastSyncPC"} != $PREFS->{"pcid"})
    {
	$userInfo->{"lastSyncPC"} = $PREFS->{"pcid"};

	# Trigger all conduits to do a full sync.
	#
	$userInfo->{"successfulSyncDate"} = 0;
    }

    # Configure PilotManager to use whatever the Pilot provides
    #
    $PREFS->{"userinfo"} = $userInfo;

    # Set the "official" time of this sync.
    #
    $userInfo->{"thisSyncDate"} = time;

    $PREFS->{"databases"} = &loadDBList($dlp);

    # Call each conduit in turn
    #
    foreach $conduit (@{$PREFS->{"ActiveOrder"}})
    {
	last if ($CANCEL);

	fullStatus($conduit, "", 0);

	# Damage control in case a conduit was irresponsible
	#
	chdir($RCDIR);
	$dlp->tickle;

	eval
	{
	    msg("Synchronizing using the $conduit conduit");
	    $conduit->conduitSync($dlp, $userInfo);
	};
	if ($@)
	{
	    last if ($CANCEL);
	    msg("$conduit did not complete cleanly.\nError $@\n".
		"Trying to continue.");
	}

	$dlp->watchdog(0);
    }
    $gStatusWindow->withdraw
	if (defined($gStatusWindow) && $gStatusWindow->Exists);

    if ($CANCEL)
    {
	msg("Synchronization cancelled.\n");
	$CANCEL = 0;
    }
    else
    {
	# Whatever 'lastSyncDate' is set to when you close the 
	# connection is what 'successfulSyncDate' is set to when
	# you reopen.  Provided that the close goes cleanly.
	#
	$userInfo->{"lastSyncDate"} = $userInfo->{"thisSyncDate"};

	msg("Synchronization complete");
    }

    eval
    {
	$dlp->setUserInfo($userInfo);
    };
    if ($@)
    {
	print $@;
	msg("Error writing user info (this is bad, but not fatal)");
    }

    $dlp->close();
    PDA::Pilot::close($socket);
}

sub getDatabaseList
{
    if (exists($PREFS->{"databases"}) &&
	defined($PREFS->{"databases"}))
    {
	return @{$PREFS->{"databases"}};
    }
    else
    {
	return ();
    }
}

sub getUserName
{
    my ($win, @frames, $obj, $name, $done);

    if (defined $MODE)
    {
	# not in gui mode
	for ($name=''; !length $name;)
	{
	    print "Your Pilot is unlabelled.\nPlease enter your name: ";
	    chomp($name = <STDIN>);
	}
	return $name;
    }

    $win = $gWm->Toplevel(-title => "Identify your Pilot");
    $win->withdraw;
    $frames[0] = $win->Frame;

    $obj = TkUtils::Label($frames[0], 
			  "Your Pilot is unlabelled.\n".
			  "Please enter your name");
    $obj->pack;

    $obj = TkUtils::Entry($frames[0], \$name);
    $obj->bind("<Return>", sub{ $win->grabRelease;
				$win->destroy });
    $obj->pack;

    $obj = TkUtils::Button($frames[0], "Ok", sub{ $win->grabRelease;
						  $win->destroy });
    $obj->pack;

    $frames[0]->pack;

    &setColors($win);

    $win->Popup;
    $win->grab;
    $win->update;
    $win->waitWindow;

    return $name;
}

sub status
{
    return unless ($PREFS->{"gShowConduitStatus"});

    if (!defined($gStatusWindow) || !$gStatusWindow->Exists())
    {
	my (@frames, $obj);

	$gStatusWindow = $gWm->Toplevel(-title => "Conduit Status");
	$gStatusWindow->withdraw;
	$gStatusWindow->transient($gWm);

	$frames[0] = $gStatusWindow->Frame(-relief => 'ridge', -bd => '2');

	$gStatus->{"conduit"}->{"widget"} = TkUtils::Label($frames[0], "");
	$gStatus->{"conduit"}->{"widget"}->pack(-side => 'top',
						-anchor => 'center');

	$gStatus->{"message"}->{"widget"} = TkUtils::Label($frames[0], "");
	$gStatus->{"message"}->{"widget"}->pack(-side => 'top',
						-anchor => 'center');
	
	$gStatus->{"percent"}->{"widget"} =
	    $frames[0]->Canvas(-height => 20,
			       -width => 202);

	$gStatus->{"percent"}->{"widget"}->
	    create("rectangle",
		   0, 0, 202, 20,
		   -fill => 'black',
		   -tags => 'border');

	$gStatus->{"percent"}->{"widget"}->
	    create("rectangle",
		   0, 0, 0, 20,
		   -fill => 'gray',
		   -tags => 'rect');

	$gStatus->{"percent"}->{"widget"}->pack(-side => 'top',
						-padx => 4,
						-anchor => 'center');

	$frames[0]->pack(-side => 'top',
			 -expand => 'true',
			 -fill => 'both');
				     
	$obj = TkUtils::Button($gStatusWindow, "Dismiss", 
			       sub{ $gStatusWindow->withdraw; });
	
	&setColors($gStatusWindow);
	$gStatusWindow->geometry("250x100");
    }

    $gStatus->{"message"}->{"value"} = $_[0];
    my ($perc) = $_[1];

    $perc = 100 if ($perc > 100);
    $perc = 0 if ($perc < 0);

    $gStatus->{"percent"}->{"value"} = $perc;

    $gStatus->{"percent"}->{"widget"}->
	coords("rect", 0, 0,
	       int(202 * $gStatus->{"percent"}->{"value"} / 100), 20);

    $gStatus->{"conduit"}->{"widget"}->
	configure(-text => $gStatus->{"conduit"}->{"value"});

    $gStatus->{"message"}->{"widget"}->
	configure(-text => $gStatus->{"message"}->{"value"});

				
    if (!$gStatusWindow->IsMapped)
    {
	$gStatusWindow->Popup;
    }

    $gStatusWindow->update;
}

sub fullStatus
{
    $gStatus->{"conduit"}->{"value"} = shift;
    &status;			# Pass the stack along
}


sub cancel
{
    # We're getting this in the event thread -- that means
    # that a sync is going on in hotsync().  
    #
    # Tell the conduit to cancel and hope for the best.
    # Meanwhile, set the global CANCEL flag so that the
    # hotsync stops.
    #
    $CANCEL = 1;

    eval
    {
	$gStatus->{"conduit"}->{"value"}->conduitCancel();
    };

    $gStatus->{"conduit"}->{"value"} = "Cancelling, please wait";
    $gStatusWindow->update
	if (defined($gStatusWindow) && $gStatusWindow->Exists);
    $gCancel->configure(-state => "disabled");
}

sub msg
{
    my ($buf) = (join('', @_));
    my ($pad);
    my ($time);

    chomp($buf);

    if (defined($PREFS->{"gDateStamp"}) || $PREFS->{"gDateStamp"})
    {
	$time = &prettyTime(time);
	$time .= "   ";
    }
    else
    {
	$time = "";
    }

    $pad = " " x length($time);
    $buf =~ s/\n/\n$pad/g;

    $buf = "$time$buf";

    if (defined $MODE)
    {
	# Command line sync
	#
	print "$buf\n";
    }
    else
    {
	# Normal gui sync
	#
	&guiMessage($buf);
    }

    if (open(FD, ">>$LOGFILE"))
    {
	print FD "$buf\n";
	close(FD);
    }
}

sub askUser
{
    my ($question, @answers) = @_;
    my ($dialog, $chk);

    unless (defined $MODE)
    {
	$dialog = $gWm->Dialog(
			   -title  => "Riddle me this...",
			   -text   => $question,
			   -bitmap => 'question',
			   -default_button => $answers[0],
			   -buttons => [@answers]
			   );
	$dialog->configure(-wraplength => '4i');
	$dialog->transient($gWm);
	&setColors($dialog);
	return $dialog->Show;
    }
    else
    {
	print "----------\n$question\n";
	while (1)
	{
	    print '[', join('/', @answers), ']: ';
	    chomp($dialog = <STDIN>);
	    foreach $chk (@answers)
	    {
		if ($dialog =~ /^$chk$/i)
		{
		    print "----------\n";
		    return $chk;
		}
	    }
	}
    }
}

sub tellUser
{
    my ($msg) = @_;
    my ($dialog);

    unless (defined $MODE)
    {
	$dialog = $gWm->Dialog(
			   -title  => "Pay attention!",
			   -text   => $msg,
			   -bitmap => 'info',
			   -default_button => "Ok",
			   -buttons => ["Ok"]
			   );
	$dialog->configure(-wraplength => '4i');
	$dialog->transient($gWm);
	&setColors($dialog);
	return $dialog->Show;
    }
    else
    {
	print "----------\n$msg\n----------\n";
	return "Ok";
    }
}

# Stolen from ctime.pl by Waldemar Kebsch (kebsch.pad@nixpbe.UUCP)
# and renamed to 'prettyTime'
#
sub prettyTime
{
    my ($time) = @_;
    my(@DoW) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    my(@MoY) = ('Jan','Feb','Mar','Apr','May','Jun',
		'Jul','Aug','Sep','Oct','Nov','Dec');

    my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);

    # Determine what time zone is in effect.
    # Use GMT if TZ is defined as null, local time if TZ undefined.
    # There's no portable way to find the system default timezone.

    my($TZ) = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
        ($TZ eq 'GMT') ? gmtime($time) : localtime($time);

    # Hack to deal with 'PST8PDT' format of TZ
    # Note that this can't deal with all the esoteric forms, but it
    # does recognize the most common: [:]STDoff[DST[off][,rule]]

    if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
        $TZ = $isdst ? $4 : $1;
    }
    $TZ .= ' ' unless $TZ eq '';

    $mon++;
    return sprintf("%02d/%02d/%04d %2d:%02d:%02d",
		   $mon, $mday, $year + 1900, $hour, $min, $sec);
}

sub loadDBList
{
    my ($dlp) = @_;
    my ($result, $i) = ([], 0);
    my ($count, $count_max, $rec);

    fullStatus("Pilot Manager", "Refreshing Database List", 0);
    $count = 0;
    if (exists($PREFS->{"databases"}) && defined($PREFS->{"databases"}))
    {
	$count_max = @{$PREFS->{"databases"}};
    }
    else
    {
	$count_max = 0;
    }

    eval
    {
	do
	{
	    status("Refreshing Database List", 
		   int(100 * $count++ / $count_max)) if ($count_max);
	    $rec = $dlp->getDBInfo($i,1,0);
	    push(@$result, $rec) if (exists $rec->{"name"} and $rec->{"name"});
	    $i = $rec->{"index"}+1;
	}
	while ($rec->{"more"});
    };

    fullStatus("Pilot Manager", "Refreshing Database List", 100);

    return $result;
}

sub watchdog
{
    my ($dlp, $which) = @_;

    if ($which)
    {
	$dlp->watchdog(20);
    }
    else
    {
	$dlp->watchdog(0);
    }

    return;
}

sub cycleLogs
{
    if (-f $LOGFILE && (stat($LOGFILE))[7] > $LOGFILE_THRESHOLD)
    {
	rename($LOGFILE, $LOGFILE . ".old");
    }
}

# Thanks to Charles LaBrec <Charles.Labrec@East.Sun.Com>
# for finding this bug.
#
sub checkTimeBug
{
    my(@tm1) = (0, 0, 0, 1, 0, 97);
    my($time) = timelocal(@tm1);
    my(@tm2) = localtime($time);

    return (@tm1[0..5] != @tm2[0..5]);
}


##############################################################################
#
# Main code
#
##############################################################################

&init;
&createGUI unless (defined $MODE);

if (!exists($PREFS->{"seenWelcome"}) || $PREFS->{"seenWelcome"} == 0)
{
    if (!defined $MODE)
    {
	if (&showDoc("docs/WelcomeMessage", "Welcome New Users!"))
	{
	    $PREFS->{"seenWelcome"} = time;
	}
    }
    else
    {
	if(open(FD, "<$BASEDIR/docs/WelcomeMessage"))
	{
	    print "Welcome New Users!\n\n", <FD>;
	    close(FD);
	    $PREFS->{"seenWelcome"} = time;
	    print "[Press Return to Continue]\n";
	    scalar(<STDIN>);
	}
    }
}

if (&checkTimeBug)
{
    my $noteText =
	"Congratulations!  Your OS has a bug in the time of day ".
	"code.  This bug causes dates to slowly travel backwards in time ".
	"and interferes with PilotManager's performance.  This bug is ".
	"caused by having a bad timezone environment variable setting. ".
	"Your timezone is set to\n\n\t$ENV{TZ}\n\nYou might try setting ".
	"it to a more specific timezone, for example US/Pacific maps ".
	"to:\n\n\tPST8PDT\n\n" .
	"You'll need to set the correct value for your time zone, of ".
	"course.\n\nPilotManager will not function until this is fixed.".
	"\n(This is NOT a bug in PilotManager!)";

    if (!defined $MODE)
    {
	$gHotSyncButton->configure(-state => 'disabled');
	&tellUser($noteText);
    }
    else
    {
	print "$noteText\n";
	exit;
    }
}

if (!defined $MODE)
{
    # Normal GUI mode
    #
    Tk::MainLoop;
}
elsif ($MODE eq 'CMDLINE')
{
    # Start full sync from command line
    #
    my $saveStatus = $PREFS->{"gShowConduitStatus"};

    $PREFS->{"gShowConduitStatus"} = 0;
    &hotSync;
    $PREFS->{"gShowConduitStatus"} = $saveStatus;
    &quit;
}
elsif ($MODE eq 'DAEMON')
{
    # Start full sync from command line and loop forever
    # XXX Should check we aren't already running before we do this
    #
    my ($saveStatus, $pid) = ($PREFS->{"gShowConduitStatus"});
    unless ($pid = fork)
    {
	unless (fork)
	{
	    $PREFS->{"gShowConduitStatus"} = 0;
	    while (1)
	    {
		&hotSync;
	    }
	    $PREFS->{"gShowConduitStatus"} = $saveStatus;
	}
	exit 0;
    }
    waitpid($pid, 0);
}
else
{
    # Start sync with specified conduit(s) from command line
    #
    my ($saveOrder, $saveStatus, $con) = ($PREFS->{"ActiveOrder"},
					  $PREFS->{"gShowConduitStatus"});

    $PREFS->{"gShowConduitStatus"} = 0;
    $PREFS->{"ActiveOrder"} = [];
    foreach $con (@$MODE)
    {
	if (defined $PREFS->{"ActiveConduits"}->{$con} ||
	    defined $PREFS->{"InactiveConduits"}->{$con})
	{
	    push(@{$PREFS->{"ActiveOrder"}}, $con);
	}
	else
	{
	    print "Conduit '$con' not found.\n";
	}
    }
    if (@{$PREFS->{"ActiveOrder"}})
    {
	&hotSync;
	$PREFS->{"ActiveOrder"} = $saveOrder;
	$PREFS->{"gShowConduitStatus"} = $saveStatus;
	&quit;
    }
    else
    {
	print "No valid conduits found.  Sync aborted.\n";
    }
}
pilot-manager 1.107.0pre108-5 / usr / share / perl5 / PilotMgr.pm
