pilotmgr/0042755000175000017500000000000007310537665012007 5ustar xtifrxtifrpilotmgr/PilotManager0120777000175000017500000000000007310537540016371 2PilotMgr.pmustar xtifrxtifrpilotmgr/COPYRIGHT0100444000175000017500000000176006676267160013303 0ustar xtifrxtifrCopyright (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. pilotmgr/README0100444000175000017500000000014406676267160012663 0ustar xtifrxtifr The documentation for this package is available on the web at: http://www.moshpit.org/pilotmgr/ pilotmgr/README.porting0100444000175000017500000000740506676267160014353 0ustar xtifrxtifrPlease follow the download and install instructions at http://www.moshpit.org/pilotmgr/download.html If precompiled binaries are available for your OS/architecture and perl version then the page above should have all the info you need. However, if you need to compile and install any of the perl modules yourself then this file contains the info you need.... ------------------------------------------------------------------------- PilotManager, being that it's written in Perl, is very portable to other platforms. The installation notes below are incomplete, but they should get you to the point where the GUI actually comes up on your system. Good luck. Installation Notes ================== To save space, the packages that PilotManager depends upon have not been included in this package. You will need to download them and install them in order to use this package. This is not a particularly difficult, but it's not trivial either. Someday I'll simplify this process, but considering how many packages this depends on, it's always going to take time to get it all installed. Packages -------- 1.Perl [v5.003 or later] You must have a working version of Perl, preferably v5.003 or later installed on the system. You can obtain the latest copy of Perl from your nearest CPAN site. If you don't know where to find CPAN, try: http://www.perl.com/ 2. pilot-link [v0.8.4 or later] You can obtain the latest copy of pilot-link from: ftp://ryeham.ee.ryerson.ca/pub/PalmOS/ You must configure and install pilot-link, then configure and install PDA::Pilot (the perl5 interface to pilot-link). % cd pilot-link.0.8.9 % configure % make install % cd Perl5 % perl Makefile.PL % make install FYI, for the sun4-solaris distribution of PilotManager pilot-link was built without debugging info (-g flag removed from Makefile and libsock/Makefile after configure step) and libpisock was statically linked to Pilot.so instead of dynamically linked (modified Makefile after perl Makefile.PL step) 3. Perl modules You can obtain the following Perl modules from CPAN (see above). You'll need to configure, build and install these packages on your system. You can check if you already have a package installed like this: % perl -e "use Tk" % perl -e "use Data::Dumper" These modules are *required* for using PilotManager: - Tk module [v400.202 or later] - Data::Dumper module [v2.07 or later] (NOTE: Data::Dumper comes standard with perl 5.004_71 and later) These modules are required only for using the specified conduits: - Calendar::CSA module [v0.07 or later] This module is required ONLY for the SyncCM conduit which synchronizes with Calendar Manager (openwindows or cde) calendars. If your platform does not have CDE, you do not need this package. - MD5 module [v1.6 or later] - IO modules [v1.15 or later] These modules are required only for the SyncPlan conduit which synchronizes with the Plan calendar package. SyncPlan uses IO::Socket and IO::Select from the IO modules package. Making a Release ================ Once you have finished compiling PilotManager for your platform, you should get in touch with me and coordinate releasing your port. I'd like to keep track of the PilotManager porters so that when there's a new source release we can get new versions out for different platforms relatively quickly. Making a binary release is a bit tricky. There's a sparse Perl library installed under the pilotmgr/lib directory. You'll need to populate your arch's section of the libraries. If you're a perl guru, this is easy. If not, check out one of the prepackaged binary releases. More on making releases later. Happy hacking, Alan.Harder@Sun.Com Bharat@Menalto.Com pilotmgr/ChangeLog0100444000175000017500000004231106676267157013565 0ustar xtifrxtifrChanges from v1.106 to v1.107 * Added -daemon flag (patches from Aaron Kaplan/Gossamer, Robert King) and -rcdir flag. * Withdraw popups before moving around to get rid of flicker thing. * Added Gui help labels the first time pilotmgr is run. Too many users don't hit the hotsync button in the pilotmgr window! * Added option to restore previous username/id to reset pilot instead of setting new id (patch from Bodo Bellut). * Don't let conduits disappear: add back to ActiveOrder list if they get removed somehow. * Use "do $RCFILE" instead of "eval `cat $RCFILE`" to read prefs. * Added PilotSync to Reload menu in debug mode. * Bugfix in getDatabaseList when list is empty. * Added code in getUserName for text mode input. * Some watchdog updates for keeping pilot connection alive. * Removed some preferences update code from v1.100 upgrade. * In Setup script, search each path dir for perl5,perl instead of searching all dirs for perl5 then all dirs for perl. * Enhancements to Backup conduit: - Hardlink instead of copying from previous archive, saves time and disk space (patch from Caspar Dik). - Added option for daily/weekly/monthly backup (suggested by Erik van Oosten). - Fix for = or / in db filenames (reported and tested by Bob Clare). - Fix for problem where dbs installed by Installer in same hotsync might never get backed up (only update backuptime value on read from pilot, not copy from archive). * Enhancements to Installer conduit: - Bugfix for filenames with spaces (patch from Jim Nicholson). - Modified to use File::Copy instead of system "cp". - Ignore non-prc/pdb files placed in ~/.pilotmgr/Installer dir. * Update for SyncCM: Minor fixes to make compatible with upcoming new version of calendar server (v6). * Enhancements to SyncMemo conduit: - Added handling for private flag (skip private memos or set permissions on files). - Use Shell.pm module instead of backtick(`) shell calls (patch from Jeff Dairiki). - Minor bugfix for "archived" records (delete them). - Don't allow empty filenames. - Removed some preferences update code from v1.4 upgrade. * Enhancements to SyncTime conduit: - Added helptext to config dialog. - Use "do $RCFILE" instead of "eval $lines" to read prefs. * Bugfixes/enhancements to SyncPlan conduit: - Bugfix in ReadPlanReply (patch from Aaron Kaplan). - Bugfix when netplan is run with -a flag (patch from Chris Keane and Jeff Dairiki). - Bugfix for dates prior to 1970 (not supported by plan; patch from Jeff Dairiki). - Added VERBOSE and DEBUG flags for controlling how much detail goes to pilotmgr log. * Updates to PilotSync (used by SyncAB, SyncFood): - Added cancel flag. - Don't clear modified flag for pilot records with unmergable changes. - Did much more on merging records.. can auto merge as long as the SAME field is not changed on both sides. - Use "do" instead of "eval" to read master db file (works for larger file size). * Added SyncAB conduit (moved from contrib). Updates: - Use PilotSync cancel flag. - Error handling if unable to open data file. - More work on vCards.. single and multiple file vCard syncs now should be functional. Can sync changes from vCards created from pilot, but can't yet read in new vCards to pilot. * Added SendMail conduit (updated contrib/andy-poggio/SyncMail.pm with version 0.802 and moved to top level, renamed as SendMail) Conduit written by Andy Poggio. Updates: - New configurable shell command for sending mail (from Andy Poggio) - Don't delete message if mailer pipe fails (patch from Chris Keane) - Don't clear sync flags, as messages aren't really synced. * Enhancements to SyncFood conduit: - Supports latest version of Food pilot app (also updated Food.pl editor in contrib section). - Made food datafile configurable. - Use PilotSync cancel flag. * EditAB added to contrib section (by Bodo Bellut). Directly edits CSV file generated by SyncAB. * Added sync-pilot.pl, pi-ldif.pl and LupAB.pl to contrib section. Changes from v1.105 to v1.106 * New Installer menu options let you configure and sync with the Installer conduit without having to reconfigure PilotManager. * New "-install" command line option lets you quickly install new apps on your pilot without having to reconfigure PilotManager. * Moved responsibility for keeping the pilot connection open to the conduits. No longer leaves watchdog always running, which has greatly improved the stability of SyncMemo and SyncPlan. (source of problem identified by Robert Terzi) * New "Load New Conduits" menu option to add new conduits without restarting PilotManager (patch from Adam Stein). * New "Reload Conduits" menu when in Debug mode. Useful for conduit developers (patch from Adam Stein). * Search for conduits in the ~/.pilotmgr directory as well as in the pilotmgr directory. This allows individual users to add new conduits when running from a shared pilotmgr installation where they might not have write access. * Made PilotMgr::tellUser and PilotMgr::askUser functions work when syncing in command line(text) mode. * Support for relative dates in SyncCM's sync date range mode. Syncs calendar appointments inside a moving date window relative to current date (patch from Andy Poggio). * Minor bugfixes for SyncCM- Fixed changing/deleting one of a repeating series of "no time" appts. Avoid perl error when alarm count is too high for pilot to handle. * Minor bugfixes to SyncPlan. Added test script in Setup utility to check required perl packages for SyncPlan. * Minor bugfix for weekly updates in SyncTime (sometimes would not set time exactly one week later). * Added SyncAB, ImpactImport, SyncQMate and SyncMail to contrib section. * Updated README.porting file to specify which perl modules are required for which conduits. Changes from v1.104 to v1.105 * New "-sync" and "-syncwith" options to start a sync from the command line. * New "Other" selection for the Pilot Port allows any device name to be entered. * True multiple selection file dialog added for Installer, with "Select All" button too. * SyncMemo can skip files with specified prefix/suffix (such as backup files created by text editors). * Added SyncPlan conduit. * Made cursors visible in text/entry widgets. Replaced non-standard "darkred" color with "red4". Changes from v1.103 to v1.104 * Removed perl version check. Libraries are now available for both 5.003 and 5.004+ * Fixed minor bug in a Tk call when creating email dialog. This makes it work with Tk402.003 (latest version). Changes from v1.102 to v1.103 * Updated Feedback menu to include both the existing Discussion alias and the new Announcements alias. Has "about" text for each alias. Also added new pilotmgr-author alias and an item to email the alias maintainer. Changes from v1.101 to v1.102 * Rebuilt PDA::Pilot library with latest version of pilot-link (0.8.9, for sun4-solaris) * Added SyncTime, SyncFood conduits * Made it possible to select a whole directory in the Installer conduit (for restoring a hard reset pilot from latest backup) * Updated web page url to http://www.moshpit.org/pilotmgr Changes from v1.100 (fcs) to v1.101 * Avoid crash when user doesn't have permissions to open serial port. Now gives message in PilotManager window. * Add information about libcsa.so in bug reports * Included SyncMemo v1.4 Changes from v1.100-BETA-6 to v1.100 (fcs) * Fixed problem which caused PilotManager to fail to connect excessively. * Updated CDE message in SyncCM to explain that it can also be a problem if your CDE libraries are out of date (not just if they are missing). * Made Backup conduit a lot less wordy in the Hotsync log * Fixed small bug in Monthly by day appointments that I introduced in v1.100-BETA-5. This bug would cause monthly by day appts to appear on the wrong day on the desktop. * Added more appt checking on the Pilot side to find invalid appointments (specifically, those where the end or repeat_end date predate the start of the appointment.) * Added Setup utility to try to autoconfigure PilotManager the first time you run it. * Added hard-reset detection * Added rudimentary multi-pilot awareness * Tweaked icon a little bit Changes from v1.100-BETA-5 to v1.100-BETA-6 * Added an icon! Woohoo! * Several minor bugfixes. * Fixed bug in Installer that would force subsequent syncs to be full syncs even if nothing was installed (thanks Dan Mick!) * Fixed minor bug in SyncCM that would cause private appointments to get continuously shuffled back and forth. * Improved SyncMemo's portability. Changes from v1.009-BETA-4 to v1.100-BETA-5 * Greatly sped up the GUI. * Added status monitoring for conduits. * Provided the user with a way to configure the color scheme. * SyncCM: Many, many changes * Uses CSA from the CDE toolkit. No, you don't need to run CDE to use it. * Private appointments fully supported * Defaults are now configurable within SyncCM * Overwrite modes fully functional, ie, - Desktop overwrite Pilot - Pilot overwrites Desktop - Full merge * SyncCM will now create a new calendar for you if you ask it to sync to a nonexistant one. I find that due to a bug in CSA you have to be root for this to work (and for the 'Pilot overwrites Desktop' mode to work). * SyncCM now passes 1200 appt regression test perfectly (no more duplicates or missing appts in a sequence!) * Added ability to cancel a sync cleanly * Backup allows you to specify behaviour for new databases * Totally revised the glue layer to use PDA::Pilot instead of the SWIG'd libraries. This will make porting much easier since PDA::Pilot is a configure and make system. Changes from v1.009-BETA-3 to v1.009-BETA-4 * Fixed bug in SyncMemo that allowed Pilot to timeout while user answered question about syncing. * Fixed some of the annoying bugs leading to SEGV and BUS errors in the SyncCM conduit. Changes from v1.008 to v1.009-BETA-3 * Added more documentation to the Help menu * Added welcome message to help new users along * Copyrighted PilotManager under Sun's copyright * Made SyncCM's date range y2000 compliant. Added better safeguards to keep the user from entering spurious dates or bogus calendar entries. * Changed structure of SyncCM's preferences. This should be fully backwards compatible... * Made MAJOR memory model improvements to prevent rampant memory leaks. PilotManager should now consume much less memory. * Fixed bug in SyncCM where removing multiple back-to-back appointments from a sequence in dt/cm would cause only the first one to disappear from the Pilot * Toggling "Sync All" / "Sync Date Range" now enables and disables the date range entries to avoid user confusion. * Improved Backup's user-friendliness when choosing a directory to make your backups via the browse button. * Fixed bug in check calendar that would incorrectly report some calendar as inaccessible. * SyncCM.pm: Added much more robust error detection so that it will notify you if either the Pilot datebook or the Calendar Manager calendar shrinks between syncs (like if you accidentally delete your datebook or your calendar moves). * Added a "Clear Status" button so that you can erase the contents of the status window between syncs. * SyncCM.pm: Improved logging support to tell you the time and date of the appointment being changed and to log all changes (v1.008 didn't log all deletes). * Added archival support to Backup. Now you can archive up to 7 snapshots of your backups. * Fixed bug in alarm advance code * Made SyncCM default to "Sync Date Range" initially * Added "Move All" buttons to Backup and added ability to move databases by double-clicking them. * Fixed Backup to use an appropriate backup directory by default * Optimized file selector box in Installer so that it does not get destroyed between adding databases (ie, there's no delay anymore). * Fixed problem with Backup where databases with special characters (like 'Timer++') would cause it to fail. * Added better error handling if connection to Pilot fails * Fixed resize problem in feedback window Changes from v1.007_02 to v1.008 * Added user interaction dialog * SyncCM: Fixed a bug that caused the Pilot to time out at the very end of the SyncCM synchronization cycle. * SyncCM: Added reset button * SyncCM: Added logging feature * Made conduit order adjustable. Changes from v1.007 to v1.007_02 * Installer: fixed bug with databases containing embedded spaces. * Convenience feature: Double-clicking inactive conduits in the property sheet makes them active. * SyncCM: fixed bug that caused Pilot to loose connection during syncs under certain conditions. Changes from v1.007 to v1.007_01 * SyncCM: added alarm support. You can specify which calendar manager alarm to attach your pilot alarm to. * Backup: Alas, the old Pilot series doesn't seem to keep the moddate updated properly. So, I added a 'backup daily' flag to allow you to specify that you want your database backed up every day regardless. * Backup: fixed logic so that it backs up your databases whenever they've changed. Unfortunately the Pilot thinks the database has changed even if you've just looked at it... Changes from v1.006_02 to v1.007 * Changed the whole release architecture to allow separate architectural releases and for the conduits to be released separately from PilotManager. * Added source directory with directions for how to build PilotManager on any platform. Now you can port it to the platform of your choice. Not all modules are available on any platform (ie, SyncCM is only available for Sun because it uses a Sun rpc library) * Added contrib directory, moved SyncMemo files into it * Added buffering to ~/.pilotmgr/hotsync.log so that you can check to see what's going on if the GUI is frozen. * Added Installer conduit. This conduit lets you add new databases to your Pilot. * Improved sync state code to keep better track of which machine you synced your pilot on. This improves compatibility with the Mac/PC sync environment. * Added sync log entries that show up on the Pilot after your hotsync completes. * Fixed bug in Backup that prevented database list from being loaded properly Changes from v1.006 to v1.006_02 * Renamed 'API' directory to 'docs' * Improved code that determines the actual location of PilotManager, which should lead to less problems when running PilotManager through a symlink or shell script. * SyncCM updated to v1.005_02, includes: * Timeless CM appts are now removed properly * Duplicate checking ignores spacing and capitalization Changes from v1.006 to v1.006_01 * Fixed bug in Backup that generated useless warning when Backup is first configured * Fixed the dynaloader bug that caused it to be unable to load 'libresolve.so.2'. Changes from v1.005 to v1.006 * SyncMemo v1.02 bundled. Thanks to Alan Harder, the new version of SyncMemo comes with a bonus tool called 'PilotDrop'. This tool allows you to drag and drop documents onto your pilot! The documents will get copied to your pilot on the next sync. * SyncCM updated to v1.005_01, which incorporates a few tiny changes not worth their own rev. * Added the Backup module which attempts to intelligently back up your data. Right now it's not all that intelligent, but I think it errs on the side of caution (it backs up your stuff a little too frequently, I think). * Improved UI with a new color scheme. Don't like it? Tough! Haha, just kidding. If you can come up with a better color scheme I'd be happy to integrate it. * Added feedback support for each of the separate conduits and a general purpose feedback system. * Solaris x86 supported (along with an architecture that will allow support of any platform). * PilotManager should now be free of directory restrictions (ie, you should be able to run it from any directory). * Wrote up a brief API document in the API directory * New Preferences interface, including the ability to activate and inactivate conduits. All new conduits will be added as inactive, and you must activate them by hand. Alas, these changes mean that preferences from v1.005 and earlier are toast. I did not bother to write code to port them along. However, it should be fairly trivial to recreate them (preferences from specific modules are unchanged). * "Modules" are now called "conduits". Since the term "conduit" is a well known name for synchronization modules, I've decided to go with the flow. * Conduit API more firmly established. Now conduits can be created and installed separately from the PilotManager harness. Changes from v1.004 to v1.005 * Improved exception (ie, missing appts in a sequence) code for certain special cases * SyncCM: Fixed bug in MM/DD/YY orderering that led to rpc failure * SyncCM: Better error handling for rpc failure pilotmgr/Setup0100444000175000017500000001044706676267160013035 0ustar xtifrxtifr#!/bin/sh # ident "@(#)Setup 1.9 99/01/12 Bharat Mediratta" # # Configure PilotManager for the user's environment. # # 1. Find a version of Perl 5. Warn the user if it is not # up to date. Update PilotMgr.pm to use this version. # # 2. Run a series of tests on the user's environment to determine # whether or not PilotManager is going to be effective # cat < to continue"; read foo VERS="5.003" PERL= echo "Locating Perl 5..." for dir in `echo $PATH | sed -e 's/:/ /g'` do for cmd in perl5 perl do if [ -n "$dir" -a -x "$dir/$cmd" ] then MAYBE=`$dir/$cmd -e 'print $^X'` if [ "$MAYBE" != "" ] then `$MAYBE -e "eval{require $VERS}; \ exit 0 if \\$@; exit 1"` fi if [ $? -eq 1 ] then PERL=$MAYBE break 2 fi fi done done # Now, either we've found the right version of Perl and we # can continue, or we haven't and we should fail. # if [ -z "$PERL" ] then cat< /tmp/pmgr-setup.pl <PilotMgr.pm")) { # Replace the top line with our new perl exec binary # ; print OFD "#!$PERL\n"; print OFD ; close(OFD); } else { print "\nError: Unable to write to PilotMgr.pm\n"; rename("PilotMgr.pm.$$", "PilotMgr.pm"); exit; } close(IFD); } else { print "\nError: Unable to read from PilotMgr.pm.$$\n"; exit; } chmod(0755, "PilotMgr.pm"); unlink("PilotMgr.pm.$$"); \$SIG{'INT'} = bail; print "done.\n"; print qq| PilotManager will now test your system to make sure that all your conduits will function properly. Press ^C at any time to abort the tests. Press to continue. |; ; foreach \$file () { (\$name = \$file) =~ s|lib/test/(.*)\.t$|\$1|; print ">> \$name <<\n"; do \$file; } sub bail { print "Aborting tests\n"; print "Your installation is complete, but not fully tested.\n"; &done; } &done; sub done { print qq| Your PilotManager installation is complete. You can invoke it by typing 'PilotManager' at your shell prompt. Please file all bugs and feedback via the 'Feedback' menu in PilotManager. |; } EOF $PERL /tmp/pmgr-setup.pl pilotmgr/PilotMgr.pm0100555000175000017500000021075106676267157014116 0ustar xtifrxtifr#!/bin/sh ./Setup # ------------------------------------------------------------ # 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 /Gossamer # and Robert King . # Patch for restoring previous username/id to reset pilot in v1.107 # provided by Bodo Bellut . # 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 # BEGIN { use Config; use File::Basename; use Cwd; my ($full); my ($cwd); $cwd = Cwd::cwd(); $full = $0; while (-l $full) { $BASEDIR = dirname($full); $full = readlink $full; ($full !~ m|^/|) and $full = $BASEDIR . "/" . $full; } $BASEDIR = dirname($full); $BASEDIR = "$cwd" if (!$BASEDIR || $BASEDIR eq "./" || $BASEDIR eq "."); $BASEDIR = "$cwd/$BASEDIR" unless ($BASEDIR =~ m|^/|); # I'd like to do: 'use lib $BASEDIR' but for some reason # 'use lib' doesn't grok variables. # unshift(@INC, $BASEDIR . "/lib/perl5/$Config::Config{archname}/$]"); unshift(@INC, $BASEDIR . "/lib/perl5/$Config::Config{archname}"); unshift(@INC, $BASEDIR . "/lib/perl5"); unshift(@INC, $BASEDIR); } eval "use PDA::Pilot"; if ($@) { print qq| You do not have the PDA::Pilot Perl module installed on your system. This module is included in the full PilotManager binary distribution. If there is not a binary distribution for your architecture, please read 'README.porting' in the PilotManager directory. |; print "\n$@"; exit; } eval "use Data::Dumper"; if ($@) { print qq| You do not have the Data::Dumper Perl module installed on your system. This module is included in the full PilotManager binary distribution. If there is not a binary distribution for your architecture, please read 'README.porting' in the PilotManager directory. |; print "\n$@"; exit; } 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 ] [-sync | -daemon | -syncwith | -install ] -sync = Start sync from command line, don't bring up gui. -daemon = Daemon mode, sync forever in background (preferences are locked). -syncwith * = Start sync from command line with specified conduit(s). (Ignores currently "active" conduits from preferences) -install * = Use Installer conduit to install the specified files. -rcdir = Access resource 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("", 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("", 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("", sub{&buttonChoice("Configure")}); $gActiveConduitList->bind("", \&selectConduit); $gActiveConduitList->bind("", \&selectConduit); $gActiveConduitList->bind("", \&selectConduit); $gActiveConduitList->bind("", \&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("", sub{&buttonChoice("<< Move")}); $gInactiveConduitList->bind("", \&selectConduit); $gInactiveConduitList->bind("", \&selectConduit); $gInactiveConduitList->bind("", \&selectConduit); $gInactiveConduitList->bind("", \&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("", 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 () { $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); } $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))/, ); 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 = ); } 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("", 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 = ); 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/%02d %2d:%02d:%02d", $mon, $mday, $year, $hour, $min, $sec); } sub loadDBList { my ($dlp) = @_; my ($result, $i) = ([], 0); my ($count, $count_max); fullStatus("Pilot Manager", "Refreshing Database List", 0); $count = 0; if (exists($PREFS->{"databases"}) && defined($PREFS->{"databases"})) { $count_max = @{$PREFS->{"databases"}}; } else { $count_max = 0; } do { status("Refreshing Database List", int(100 * $count++ / $count_max)) if ($count_max); push(@$result, $dlp->getDBInfo($i,1,0)); $i = $result->[-1]->{"index"}+1; } while ($result->[-1]->{"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 # 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", ; close(FD); $PREFS->{"seenWelcome"} = time; print "[Press Return to Continue]\n"; scalar(); } } } 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"; } } pilotmgr/Backup.pm0100644000175000017500000004547007013150544013542 0ustar xtifrxtifr# 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. package Backup; use Data::Dumper; use Time::Local; use Tk; use Tk::FileSelect; use TkUtils; use strict; # Hardlink instead of copying from previous archive added by Casper Dik # (casper@holland.sun.com) in version 1.007 # my ($DEBUG) = 1; # Debug mode on/off my ($RCFILE); # Location of resource file my $VERSION = "1.008 (early-access)"; # Version number my ($PREFS); # Preferences my ($MAXARCHIVES) = 7; # Max number of archives my ($MANIFEST) = ".archive_manifest"; # Tag to help protect # against accidental deletes sub conduitInit { $RCFILE = "Backup/Backup.prefs"; &loadPrefs; } sub conduitQuit { &savePrefs; } sub conduitCancel { # Really not a good idea to cancel backups. Ignore it # for now. } sub conduitInfo { my ($dblist); return { "version" => $VERSION, "database" => undef, "author" => "Bharat Mediratta", "email" => 'bharat@menalto.com', }; } ############################################################################## # # GUI code # ############################################################################## my ($gWm); my ($gConfigDialog); my ($gInactiveList); my ($gActiveList); my ($gMoveAButton); my ($gMoveAllAButton); my ($gMoveIButton); my ($gMoveAllIButton); my ($gArchiveMenu); my ($gFileSelector); sub conduitConfigure { my ($this, $wm) = @_; my (@frame); my ($obj); my ($label); $gWm = $wm; unless (defined $gConfigDialog and $gConfigDialog->Exists) { $gConfigDialog = $gWm->Toplevel(-title => "Configuring Backup"); $gConfigDialog->withdraw; $gConfigDialog->transient($gWm); $frame[0] = $gConfigDialog->Frame; $frame[1] = $frame[0]->Frame; ($obj) = TkUtils::LabelEntry($frame[1], "Backup Directory ", \$PREFS->{"gBackupDir"}); $obj->parent->pack(-side => 'left', -expand => 'true', -fill => 'x'); $obj = TkUtils::Button($frame[1], "Browse...", sub{&buttonChoice("Browse...")}); $obj->pack(-side => 'right'); $frame[1]->pack(-expand => 'false', -fill => 'x'); $frame[1] = $frame[0]->Frame; $obj = TkUtils::Checkbutton($frame[1], "Back up new databases", \$PREFS->{"backupnew"}); $obj->pack(-side => 'left', -expand => 'true', -fill => 'y', -anchor => 'w'); my (@ARCHIVEMENU) = ("Archive 1 copy", []); my ($i); for ($i = 2; $i <= $MAXARCHIVES; $i++) { push(@ARCHIVEMENU, "Archive $i copies", []); } $gArchiveMenu = TkUtils::Menu($frame[1], $PREFS->{"archive"}, sub{($PREFS->{"archive"} = $_[0]) =~ s|.*/ ||; $gArchiveMenu-> configure(-text => $PREFS->{"archive"}) }, @ARCHIVEMENU ); $gArchiveMenu->pack(-side => 'right', -expand => 'true', -fill => 'x'); if (0) { $obj = TkUtils::Button($frame[2], "Update Database List", sub{ &refreshDBs }); $obj->pack(-side => 'top', -expand => 'true', -fill => 'x'); } $frame[1]->pack(-side => 'top', -anchor => 'n', -expand => 'false', -fill => 'x'); $frame[1] = $frame[0]->Frame(-relief => "ridge", -bd => 2); $frame[1]->Label(-text => "Run Backup:")->pack(-side => 'left'); TkUtils::Radiobuttons($frame[1], \$PREFS->{"backupwhen"}, "Every Sync", "Daily", "Weekly", "Monthly"); $frame[1]->pack(-side => 'top', -anchor => 'n', -expand => 'false', -fill => 'x'); $frame[1] = $frame[0]->Frame; $frame[2] = $frame[1]->Frame; $frame[3] = $frame[2]->Frame; $gMoveAllIButton = TkUtils::Button($frame[3], "Move All >>", sub{ &buttonChoice("Move All >>") }); $gMoveAllIButton->configure(-state => 'disabled'); $gMoveAllIButton->pack(-side => 'left', -expand => 'true', -fill => 'x'); $gMoveIButton = TkUtils::Button($frame[3], "Move >>", sub{ &buttonChoice("Move >>") }); $gMoveIButton->configure(-state => 'disabled'); $gMoveIButton->pack(-side => 'left', -expand => 'true', -fill => 'x'); $frame[3]->pack(-expand => 'false', -fill => 'x', -side => 'bottom'); ($gActiveList, $label) = TkUtils::List($frame[2], "Databases to Backup", "vertical"); $gActiveList->bind("", \&selectDB); $gActiveList->bind("", \&selectDB); $gActiveList->bind("", \&selectDB); $gActiveList->bind("", \&selectDB); $gActiveList->bind("", sub{&buttonChoice("Move >>")}); $frame[2]->pack(-expand => 'true', -fill => 'both', -side => 'left'); $frame[2] = $frame[1]->Frame; $frame[3] = $frame[2]->Frame; $gMoveAButton = TkUtils::Button($frame[3], "<< Move", sub{ &buttonChoice("<< Move")} ); $gMoveAButton->configure(-state => 'disabled'); $gMoveAButton->pack(-side => 'left', -expand => 'true', -fill => 'x'); $gMoveAllAButton = TkUtils::Button($frame[3], "<< Move All", sub{ &buttonChoice("<< Move All")} ); $gMoveAllAButton->configure(-state => 'disabled'); $gMoveAllAButton->pack(-side => 'left', -expand => 'true', -fill => 'x'); $frame[3]->pack(-expand => 'false', -fill => 'x', -side => 'bottom'); ($gInactiveList, $label) = TkUtils::List($frame[2], "Databases to Ignore", "vertical"); $gInactiveList->bind("", \&selectDB); $gInactiveList->bind("", \&selectDB); $gInactiveList->bind("", \&selectDB); $gInactiveList->bind("", \&selectDB); $gInactiveList->bind("", sub{&buttonChoice("<< Move")}); $frame[2]->pack(-expand => 'true', -fill => 'both', -side => 'left'); $frame[1]->pack(-expand => 'true', -fill => 'both'); TkUtils::Button($frame[0], "Dismiss", sub{ &savePrefs; $gConfigDialog->withdraw}); $frame[0]->pack(-expand => 'true', -fill => 'both'); PilotMgr::setColors($gConfigDialog); } $gConfigDialog->Popup(-popanchor => 'c', -popover => $gWm, -overanchor => 'c'); &updateDBList; &populateLists; &selectDB; } sub buttonChoice { my ($choice) = @_; my ($id); if ($choice eq "Move All >>") { push(@{$PREFS->{"inactive"}}, @{$PREFS->{"active"}}); @{$PREFS->{"active"}} = (); &populateLists; &selectDB; } elsif ($choice eq "Move >>") { my ($sel); my ($line); $sel = $gActiveList->curselection; if (defined($sel)) { $line = $gActiveList->get($sel); @{$PREFS->{"active"}} = grep(!($_ eq $line), @{$PREFS->{"active"}}); push(@{$PREFS->{"inactive"}}, $line); &populateLists; $gActiveList->selectionSet($sel); $gActiveList->see($sel); &selectDB; } } elsif ($choice eq "<< Move All") { push(@{$PREFS->{"active"}}, @{$PREFS->{"inactive"}}); @{$PREFS->{"inactive"}} = (); &populateLists; &selectDB; } elsif ($choice eq "<< Move") { my ($sel); my ($line); $sel = $gInactiveList->curselection; if (defined($sel)) { $line = $gInactiveList->get($sel); @{$PREFS->{"inactive"}} = grep(!($_ eq $line), @{$PREFS->{"inactive"}}); push(@{$PREFS->{"active"}}, $line); &populateLists; $gInactiveList->selectionSet($sel); $gInactiveList->see($sel); &selectDB; } } elsif ($choice eq "Browse...") { my ($dir, $tmp); unless (defined($gFileSelector)) { $gFileSelector = $gWm->FileSelect('accept', sub { return (-d shift) }, -verify => [[\&verifyBackupDir]] ); PilotMgr::setColors($gFileSelector, 1); } $dir = $gFileSelector->Show; if ($dir) { chomp($tmp = Cwd::cwd() || Cwd::fastcwd() || `pwd`); Cwd::chdir($dir); chomp($PREFS->{"gBackupDir"} = Cwd::cwd() || Cwd::fastcwd() || `pwd`); chdir($tmp); } } } sub verifyBackupDir { my ($self, $base, $leaf) = @_; if (-f $leaf) { print "Tell\n"; PilotMgr::tellUser("'$leaf' is not a directory!\n" . "Please choose a directory for your backups."); return 0; } return 1; } sub selectDB { my ($sel); $sel = $gActiveList->curselection; if (defined($sel)) { $gMoveIButton->configure(-state => "normal"); } else { $gMoveIButton->configure(-state => "disabled"); } if ($gActiveList->size > 0) { $gMoveAllIButton->configure(-state => "normal"); } else { $gMoveAllIButton->configure(-state => "disabled"); } $sel = $gInactiveList->curselection; if (defined($sel)) { $gMoveAButton->configure(-state => "normal"); } else { $gMoveAButton->configure(-state => "disabled"); } if ($gInactiveList->size > 0) { $gMoveAllAButton->configure(-state => "normal"); } else { $gMoveAllAButton->configure(-state => "disabled"); } } sub updateDBList { my ($db); $PREFS->{"dbinfo"} = [PilotMgr::getDatabaseList()]; $PREFS->{"dbinfo"} = [] unless defined($PREFS->{"dbinfo"}); # Add any new databases to the appropriate list # foreach $db (@{$PREFS->{"dbinfo"}}) { if (!grep($_ eq $db->{"name"}, @{$PREFS->{"active"}}) && !grep($_ eq $db->{"name"}, @{$PREFS->{"inactive"}})) { if ($PREFS->{"backupnew"}) { push(@{$PREFS->{"active"}}, $db->{"name"}); } else { push(@{$PREFS->{"inactive"}}, $db->{"name"}); } } } # Remove any databases that are not in the all_list # # Reverse the keys so that we remove from the back of the list # forward. Otherwise, we wind up skipping the element immediately # after any deleted element. # foreach $db (reverse @{$PREFS->{"active"}}) { if (!grep($_->{"name"} eq $db, @{$PREFS->{"dbinfo"}})) { PilotMgr::msg("Database '$db' no longer exists on the Pilot\n" . "removing it from the Backup conduit"); @{$PREFS->{"active"}} = grep(!($_ eq $db), @{$PREFS->{"active"}}); } } foreach $db (reverse @{$PREFS->{"inactive"}}) { if (!grep($_->{"name"} eq $db, @{$PREFS->{"dbinfo"}})) { # If it was inactive, remove it silently # @{$PREFS->{"inactive"}} = grep(!($_ eq $db), @{$PREFS->{"inactive"}}); } } # Remove duplicates and sort. Yes, this is inefficient. # &deDupe($PREFS->{"active"}); &deDupe($PREFS->{"inactive"}); @{$PREFS->{"active"}} = sort @{$PREFS->{"active"}}; @{$PREFS->{"inactive"}} = sort @{$PREFS->{"inactive"}}; } sub deDupe { my ($arr) = @_; my (@tmp) = @$arr; my ($elt); my (%seen); @$arr = (); foreach $elt (@tmp) { next if ($seen{$elt}++); push(@$arr, $elt); } } sub populateLists { &setList($gActiveList, $PREFS->{"active"}); &setList($gInactiveList, $PREFS->{"inactive"}); } sub setList { my ($list, $dbs) = @_; my ($line, $db); $list->delete(0, "end"); foreach $db (@$dbs) { $list->insert("end", $db); } } sub loadPrefs { if (-f $RCFILE) { eval `cat $RCFILE`; } $PREFS->{"active"} = [] unless (defined $PREFS->{"active"}); $PREFS->{"inactive"} = [] unless (defined $PREFS->{"inactive"}); $PREFS->{"gBackupDir"} = "./Backup" unless (defined $PREFS->{"gBackupDir"}); $PREFS->{"backupwhen"} = "Every Sync" unless (defined $PREFS->{"backupwhen"}); $PREFS->{"backupnew"} = 1 unless (defined $PREFS->{"backupnew"}); $PREFS->{"lastBackup"} = 0 unless (defined $PREFS->{"lastBackup"}); $PREFS->{"archive"} ||= "Archive 3 copies"; } 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 { print "Unable to save preferences to $RCFILE!\n"; } } sub skipBackup { my (@lst, @now, $dif); @lst = localtime($PREFS->{"lastBackup"}); @now = localtime(time); $dif = time - $PREFS->{"lastBackup"}; if ($PREFS->{"backupwhen"} eq 'Every Sync' or $PREFS->{"backupwhen"} eq 'Daily' && ($lst[3] != $now[3] or $dif >= 86400) or $PREFS->{"backupwhen"} eq 'Weekly' && ($lst[6] > $now[6] or $dif >= 604800 or ($lst[6] == $now[6] and $dif > 86400)) or $PREFS->{"backupwhen"} eq 'Monthly' && ($lst[4] != $now[4] or $dif >= 18748800) ) { return 0; } return 1; } sub conduitSync { my ($this, $dlp, $info) = @_; my ($dbtype, @now, $arch, $filename, $copied); my ($savedir, @archList, @success); my ($dbname); my (%STATS); return if (&skipBackup); PilotMgr::msg("Starting Backup.."); $STATS{"success"} = 0; $STATS{"fail"} = 0; @now = localtime(time); $arch = sprintf("Archive_%4d-%02d-%02d@%02d:%02d:%02d", $now[5] + 1900, $now[4] + 1, $now[3], $now[2], $now[1], $now[0]); unless (mkdir("$PREFS->{gBackupDir}/$arch", 0755)) { PilotMgr::msg("Unable to make directory: $PREFS->{gBackupDir}/" . "$arch\nBackup aborting.\n"); return; } PilotMgr::watchdog($dlp, 1); $PREFS->{"lastBackup"} = time; &updateDBList; my ($count_max, $count); $count_max = scalar(@{$PREFS->{"active"}}); $count = 0; foreach $dbname (@{$PREFS->{"active"}}) { ($info) = grep($_->{"name"} eq $dbname, @{$PREFS->{"dbinfo"}}); $filename = &makeFilename($dbname, $info); if (!exists $PREFS->{"backuprecord"} or !exists $PREFS->{"backuprecord"}->{$dbname} or $PREFS->{"backuprecord"}->{$dbname} < $info->{"modifyDate"}) { PilotMgr::status("$dbname [from Pilot]", int(100 * $count / $count_max)); PilotMgr::watchdog($dlp, 0); if (&fetchDB($dlp, "$PREFS->{gBackupDir}/$arch", $dbname, $info)) { $PREFS->{"backuprecord"}->{$dbname} = time; push(@success, $filename); $STATS{"success"}++; } else { $STATS{"fail"}++; PilotMgr::msg("Error backing up '$dbname'"); } PilotMgr::watchdog($dlp, 1); } else { # Copy it over from the latest archive so that this # snapshot is current. # chomp($savedir = Cwd::cwd() || Cwd::fastcwd() || `pwd`); chdir($PREFS->{"gBackupDir"}); @archList = reverse sort byDate ; $copied = 0; while (!$copied && @archList) { my $dir = shift @archList; next if ($dir eq $arch); if (-f "$dir/$filename") { PilotMgr::status("$dbname [from archive]", int(100 * $count / $count_max)); if (link("$dir/$filename","$arch/$filename")) { $copied = 1; $STATS{"success"}++; #(don't update backuprecord time on copy from archive) } } } chdir($savedir); if (!$copied) { PilotMgr::status("$dbname [from pilot]", int(100 * $count / $count_max)); PilotMgr::watchdog($dlp, 0); # Get it from the Pilot # if (&fetchDB($dlp, "$PREFS->{gBackupDir}/$arch", $dbname, $info)) { $PREFS->{"backuprecord"}->{$dbname} = time; push(@success, $filename); $STATS{"success"}++; } else { $STATS{"fail"}++; PilotMgr::msg("Error backing up '$dbname'"); } PilotMgr::watchdog($dlp, 1); } else { # Update the backup manifest # push(@success, $filename); } } $count++; } # Update the backup manifest # if (open(FD, ">>$PREFS->{gBackupDir}/$arch/$MANIFEST")) { print FD join("\n", @success), "\n"; close(FD); } else { PilotMgr::msg("Unable to create $PREFS->{gBackupDir}/" . "$arch/$MANIFEST\n" . "PilotManager will be unable to expire " . "this archive automatically."); } if ($STATS{"success"} > 0) { PilotMgr::msg("$STATS{success} databases successfully backed up"); $dlp->log("Backup: $STATS{success} databases saved\n\n"); } PilotMgr::msg("$STATS{fail} WERE NOT backed up!") if ($STATS{"fail"} > 0); my ($max); $PREFS->{"archive"} =~ /Archive (\d+) cop/; $max = $1; chomp($savedir = Cwd::cwd() || Cwd::fastcwd() || `pwd`); chdir($PREFS->{"gBackupDir"}); @archList = sort byDate ; while (@archList > $max) { PilotMgr::status("Expiring oldest archive..", 100); &expireArchive(shift @archList); } @archList = reverse sort byDate ; unlink("LatestArchive"); symlink shift @archList, "LatestArchive"; chdir($savedir); PilotMgr::watchdog($dlp, 0); } sub byDate { my ($a1, $a2); my ($b1, $b2); $a =~ /Archive_([\d-]+)@([\d:]+)/; ($a1, $a2) = ($1, $2); $a1 =~ s/-//g; $a2 =~ s/://g; $b =~ /Archive_([\d-]+)@([\d:]+)/; ($b1, $b2) = ($1, $2); $b1 =~ s/-//g; $b2 =~ s/://g; (($a1 <=> $b1) or ($a2 <=> $a2)); } sub expireArchive { my ($dir) = @_; my ($day, $time); return unless ($dir =~ /Archive_([\d-]+)@([\d:]+)/); ($day, $time) = ($1, $2); unless (-f "$dir/$MANIFEST") { PilotMgr::msg("Archive $day $time: Missing manifest file.\nPlease delete by hand."); return; } if (open(FD, "<$dir/$MANIFEST")) { while () { chomp; unlink "$dir/$_" if (-f "$dir/$_"); } close(FD); unlink("$dir/$MANIFEST"); if (rmdir($dir)) { PilotMgr::msg("Expiring archive: $day $time\n"); } else { PilotMgr::msg("Unable to fully expire modified archive: " . "$day $time"); } } } sub makeFilename { my ($filename, $info) = @_; # Protect any special characters $filename =~ s|=|=3D|g; $filename =~ s|/|=2F|g; if ($info->{"flagResource"}) { $filename .= ".prc"; } else { # pqa type files should already have the .pqa extension # (pqa is palm7 web clip things) (tip from Alan Nichols @ Sun.Com) $filename .= ".pdb" unless ($filename =~ /\.pqa$/i); } return $filename; } sub fetchDB { my ($dlp, $dir, $filename, $info) = @_; my ($file); my ($err); $filename = $dir . "/" . &makeFilename($filename, $info); $file = PDA::Pilot::File::create($filename, $info); $dlp->getStatus(); if (!$file) { return 0; } if (($err = $file->retrieve($dlp, 0)) < 0) { return 0; } undef $file; return 1; } 1; pilotmgr/Installer.pm0100644000175000017500000002165107170451774014302 0ustar xtifrxtifr# 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. package Installer; use Data::Dumper; use Cwd; use Tk; if ($Tk::version == 4.0) { require "MultiFileSelect.pm"; } else { use Tk::FileSelect; } use TkUtils; use File::Basename; use File::Copy; use strict; # Multiple file selection ability in version 1.006 added by Adam Stein. # (adam@iset.scan.mc.xerox.com) # Fix for filenames with spaces in version 1.007 added by Jim Nicholson. # (jim@kosmic.org) # my $VERSION = "1.009 (early-access2)"; # Version number my ($DEBUG) = 0; # Debug mode on/off my ($DEBUGFILE); # Location of debug file my ($RCFILE); # Location of resource file my ($RCDIR); # Location of resource dir my ($PREFS); # Preferences file my ($CANCEL); # global cancel flag sub conduitInit { $RCDIR = "Installer"; $RCFILE = "Installer/Installer.prefs"; $DEBUGFILE = "Installer/Installer.log"; print "Installer DEBUG IS ON\n" if ($DEBUG); &loadPrefs; } sub conduitQuit { &savePrefs; } sub conduitInfo { return { "version" => $VERSION, "database" => undef, "author" => "Bharat Mediratta", "email" => 'bharat@menalto.com', }; } ############################################################################## # # GUI code # ############################################################################## my ($gWm); my ($gConfigDialog); my ($gInstallList); my ($gRemoveButton); my ($gFileSelector); sub conduitConfigure { my ($this, $wm) = @_; my (@frame); my ($obj); my ($label); $gWm = $wm; unless (defined($gConfigDialog) && $gConfigDialog->Exists) { $gConfigDialog = $gWm->Toplevel(-title => "Configuring Installer"); $gConfigDialog->withdraw; $gConfigDialog->transient($gWm); $frame[0] = $gConfigDialog->Frame; ($gInstallList, $label) = TkUtils::List($frame[0], "Databases to be Installed", "vertical"); $gInstallList->bind("", \&selectDB); $gInstallList->bind("", \&selectDB); $gInstallList->bind("", \&selectDB); $gInstallList->bind("", \&selectDB); $frame[1] = $frame[0]->Frame; $obj = TkUtils::Button($frame[1], "Add...", sub{&buttonChoice("Add...")}); $obj->pack(-fill => 'x', -expand => 'true', -side => 'left'); $gRemoveButton = TkUtils::Button($frame[1], "Remove", sub{&buttonChoice("Remove")}); $gRemoveButton->pack(-side => 'left', -fill => 'x', -expand => 'true'); $frame[1]->pack(-expand => 'false', -fill => 'x'); TkUtils::Button($frame[0], "Dismiss", sub{ &savePrefs; $gConfigDialog->withdraw}); $frame[0]->pack(-expand => 'true', -fill => 'both'); PilotMgr::setColors($gConfigDialog); } $gConfigDialog->Popup(-popanchor => 'c', -popover => $gWm, -overanchor => 'c'); &populateList; &selectDB; } sub buttonChoice { my ($choice) = @_; my ($id); my ($sel); my ($line); if ($choice eq "Remove") { $sel = $gInstallList->curselection; if (defined($sel)) { $line = $gInstallList->get($sel); &removeDB($line); &populateList; &selectDB; } } elsif ($choice eq "Add...") { my ($file, @files); unless (defined($PREFS->{"lastdir"})) { chomp($PREFS->{"lastdir"} = Cwd::cwd() || Cwd::fastcwd() || `pwd`); } if (!defined($gFileSelector)) { $PREFS->{"lastdir"} = "." unless (-d $PREFS->{"lastdir"}); my @params = ( -directory => $PREFS->{"lastdir"}, -selectmode => 'multiple', '-accept' => sub{ $file = shift; return ($file =~ /\.(pdb|prc|pqa)$/i && -f $file); }); if ($Tk::version == 4.0) { $gFileSelector = $gWm->MultiFileSelect(@params); } else { $gFileSelector = $gWm->FileSelect(@params); } $gFileSelector->configure(-filelabel => "File (enter * to select all files)"); PilotMgr::setColors($gFileSelector, 1); } # We check the first element of @files because the Cancel button # of the FileSelect widget still returns # scalar(@files) == 1 if (scalar(@files = $gFileSelector->Show) && defined($files[0])) { my ($tmp); # Jump through some hoops to compress the directory # path down from "/a/b/D/../../c" to "/a/c" # $PREFS->{"lastdir"} = $gFileSelector->cget(-directory); chomp($tmp = Cwd::cwd() || Cwd::fastcwd() || `pwd`); Cwd::chdir($PREFS->{"lastdir"}); chomp($PREFS->{"lastdir"} = Cwd::cwd() || Cwd::fastcwd() || `pwd`); chdir($tmp); for ($tmp=$[; $tmp < @files; $tmp++) { $file = $files[$tmp]; if ($file =~ m|/\*$|) { # copy all prc/pdb/pqa files from a dir: opendir FOO, dirname($file); push(@files, map($_ = dirname($file) . "/$_", grep(/\.(prc|pdb|pqa)$/i, readdir FOO))); closedir FOO; next; } # copying to a dir not supported by File::Copy in perl 5.003, # so append basename of file: unless (copy($file, "$RCDIR/" . basename($file))) { PilotMgr::msg("Error copying $file to $RCDIR ($!)"); } } &populateList; &selectDB; } } } sub removeDB { my ($file) = @_; unlink("$RCDIR/$file"); &populateList; &selectDB; } sub selectDB { my ($sel); $sel = $gInstallList->curselection; if (defined($sel)) { $gRemoveButton->configure(-state => "normal"); } } sub populateList { my ($file); my ($sel); $sel = $gInstallList->curselection; $gInstallList->delete(0, "end"); foreach $file (FileList($RCDIR)) { $gInstallList->insert("end", $file); } if (defined($sel)) { $gInstallList->selectionSet($sel); $gInstallList->see($sel); } } sub conduitCancel { $CANCEL = 1; } sub conduitSync { my ($this, $dlp, $info) = @_; my ($file); my (@file_list); my ($changed); $CANCEL = 0; my ($count, $count_max); @file_list = FileList($RCDIR); $changed = 0; $count = 0; $count_max = scalar(@file_list); foreach $file (@file_list) { unless (-r "$RCDIR/$file") { PilotMgr::msg("Unable to read '$file' file, check permissions."); next; } PilotMgr::status("Installing '$file'", int(100 * $count / $count_max)); $count++; if (&installDB($dlp, $file)) { unlink("$RCDIR/$file"); $dlp->log("Installer: installed $file\n\n"); PilotMgr::msg("Installer: installed $file"); $changed++; } else { PilotMgr::msg("Error installing $file\n"); } last if ($CANCEL); } if ($CANCEL) { $CANCEL = 0; PilotMgr::msg("Install cancelled.\n" . "Installed $changed out of $count_max databases"); } else { PilotMgr::msg("Installed $changed applications/databases") if ($count); } if ($changed > 0) { # We've changed some databases, so a slow sync is in order # next time around. # # XXX: is this necessary? # $info->{"lastSyncPC"} = 0; if (defined($gConfigDialog) && $gConfigDialog->IsMapped) { &populateList; &selectDB; } } } sub loadPrefs { if (-f $RCFILE) { eval `cat $RCFILE`; } # 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 { print "Unable to save preferences to $RCFILE!\n"; } } sub installDB { my ($dlp, $filename) = @_; my ($file, $err); $file = PDA::Pilot::File::open("$RCDIR/$filename"); return 0 unless $file; $dlp->getStatus(); if (($err = $file->install($dlp, 0)) < 0) { return 0; } if (($err = $file->close()) < 0) { return 0; } return 1; } sub FileList { my ($dir) = @_; opendir FOO, $dir; my @list = readdir FOO; closedir FOO; return grep(/\.(prc|pdb|pqa)$/i && -f "$dir/$_", @list); } 1; pilotmgr/SyncCM.pm0100444000175000017500000015550706707414537013510 0ustar xtifrxtifr# 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. package SyncCM; use Carp; use SyncCM::pilot; use Data::Dumper; use Time::Local; use Tk; use TkUtils; use strict; use sigtrap; use POSIX; # This guy might fail to load if the user doesn't have the # CDE libraries installed. Handle it carefully. # eval "use SyncCM::cm"; if ($@) { $@ = qq| SyncCM Error! SyncCM was unable to load. Perhaps this is because you do not have the appropriate CDE library (libcsa) installed on your system? Note: This can also happen if your CDE libraries are out of date. Please make sure you have the latest release of CDE installed on your system. \n| . $@; croak($@); } my ($DBFILE); my ($DEBUG) = 0; my ($DONT_CHANGE) = 0; my ($DEBUGFILE); my ($ERRORFILE); my ($LOGFILE); my ($LOGFILE_THRESHOLD) = 100000; my (%STATS); my ($RCFILE); my $VERSION = '1.102'; my ($PREFS); my ($gConfigDialog); my ($gRangeBegin); my ($gRangeEnd); my (@PrefsVars); my ($WARNLIMIT) = 50; my ($gBeginDateEntry); my ($gEndDateEntry); my ($gAlarmMenu); my (@gPrivacyMenu); my ($gLastCheckedTime); my ($CANCEL); my ($DBNAME) = "DatebookDB"; sub conduitCancel { # Set the cancel flag. We check it fairly often during a sync # $CANCEL = "cancel"; } sub checkCancel { # Just croak on cancel. The sync operation will catch the # croak and Do The Right Thing with it. # croak("cancel") if ($CANCEL); } sub conduitInit { $DEBUGFILE = "SyncCM/SyncCM.debug"; $ERRORFILE = "SyncCM/SyncCM.error"; $LOGFILE = "SyncCM/SyncCM.log"; $DBFILE = "SyncCM/pilot-cm.db"; $RCFILE = "SyncCM/SyncCM.prefs"; &loadPrefs; print "SyncCM: DEBUG is on!\n" if ($DEBUG); print "SyncCM: DONT_CHANGE is on! Your calendars will not be changed!\n" if ($DONT_CHANGE); unless (defined($PREFS->{"cal"})) { $PREFS->{"cal"} = ""; } unless (defined($PREFS->{"alarm"})) { $PREFS->{"alarm"}->{"on"} = 0; $PREFS->{"alarm"}->{"value"} = "Audio"; } unless (defined($PREFS->{"privacy"})) { $PREFS->{"privacy"}->{"default"} = "Show Time and Text"; $PREFS->{"privacy"}->{"on"} = 0; $PREFS->{"privacy"}->{"mapping"} = "Show Time only"; } foreach ("Audio", "Flashing", "Popup", "Mail") { next if defined($PREFS->{reminders}->{$_}); $PREFS->{"reminders"}->{$_}->{"on"} = 0; $PREFS->{"reminders"}->{$_}->{"value"} = 15; $PREFS->{"reminders"}->{$_}->{"units"} = "minutes"; } $PREFS->{"reminders"}->{"Mail"}->{"data"} = "" unless(defined($PREFS->{"reminders"}->{"Mail"}->{"data"})); $PREFS->{"beginDate"} ||= &getMDY(time - 1 * 365 * 24 * 60 * 60); $PREFS->{"endDate"} ||= &getMDY(time + 3 * 365 * 24 * 60 * 60); $PREFS->{"syncRange"} ||= "Sync Date Range"; $PREFS->{"dupeCheck"} = 1 unless (defined($PREFS->{"dupeCheck"})); $PREFS->{"logChanges"} = 1 unless (defined($PREFS->{"logChanges"})); $PREFS->{"syncMode"} = "Full Merge" unless (defined($PREFS->{"syncMode"})); $PREFS->{"fastDelete"} = 0 unless (defined($PREFS->{"fastDelete"})); } sub getMDY { my ($tick) = @_; my ($mon, $day, $year); ($day, $mon, $year) = (localtime($tick))[3,4,5]; $mon++; $mon = "0$mon" if (length($mon) == 1); # No y2000 problems here! # $year += 1900; $day = "0$day" if (length($day) == 1); return "$mon/$day/$year"; } sub conduitQuit { &savePrefs; } sub conduitInfo { return { "version" => $VERSION, "author" => "Bharat Mediratta", "email" => 'bharat@menalto.com', }; } sub conduitConfigure { my ($this, $wm) = @_; my (@frames); my ($obj, $text); my (@objs); unless (defined($gConfigDialog) && $gConfigDialog->Exists) { $gConfigDialog = $wm->Toplevel(-title => "Configuring SyncCM"); $gConfigDialog->withdraw; $gConfigDialog->transient($wm); $frames[0] = $gConfigDialog->Frame; # # Desktop calendar box # $frames[1] = $frames[0]->Frame(-relief => 'ridge', -bd => 4); $obj = TkUtils::Label($frames[1], "Desktop Settings"); $obj->pack(-anchor => 'center'); $frames[2] = $frames[1]->Frame; $frames[3] = $frames[2]->Frame(-relief => 'ridge', -bd => 2); @objs = TkUtils::AlignedLabelEntries($frames[3], "Calendar:", \$PREFS->{"cal"} ); $objs[0]->[0]->parent->parent->pack(-expand => 'true', -fill => 'both', -anchor => 'n'); $objs[1]->[0]->bind("", sub{&interpretPrefs("cal")}); $frames[4] = $frames[3]->Frame; (@objs) = TkUtils::Radiobuttons($frames[4], \$PREFS->{"syncRange"}, "Sync All", "Sync Date Range"); $objs[0]->parent->pack(-side => 'top'); $objs[0]->bind("