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

# Originally written by Bharat Mediratta.
# See ChangeLog for list of modifications and contributors.


package Backup;

use Data::Dumper;
use Time::Local;
use Tk;
use Tk::FileSelect;
use TkUtils;
use strict;

my ($DEBUG) = 1;			  # Debug mode on/off
my ($RCFILE);				  # Location of resource file
my $VERSION = $PilotMgr::VERSION;	  # 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",
    };
}

##############################################################################
#
# 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;
	$frame[2] = $frame[1]->Frame;

	$obj = TkUtils::Checkbutton($frame[2],
				    "Backup new databases", 
				    \$PREFS->{"backupnew"});
	$obj->pack(-side => 'top',
		   -expand => 'true',
		   -fill => 'y',
		   -anchor => 'w');

	$obj = TkUtils::Checkbutton($frame[2],
				    "Ignore modify date (backup every time)",
				    \$PREFS->{"ignoremoddate"});
	$obj->pack(-side => 'top',
		   -expand => 'true',
		   -fill => 'y',
		   -anchor => 'w');
	$frame[2]->pack(-side => 'left', -expand => 'true', -fill => 'x');

	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 => 'both');

	if (0)
	{
	    $obj = TkUtils::Button($frame[-1],
				   "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("<ButtonPress>", \&selectDB);
	$gActiveList->bind("<ButtonRelease>", \&selectDB);
	$gActiveList->bind("<KeyPress-Down>", \&selectDB);
	$gActiveList->bind("<KeyPress-Up>", \&selectDB);
	$gActiveList->bind("<Double-Button-1>",
			   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("<ButtonPress>", \&selectDB);
	$gInactiveList->bind("<ButtonRelease>", \&selectDB);
	$gInactiveList->bind("<KeyPress-Down>", \&selectDB);
	$gInactiveList->bind("<KeyPress-Up>", \&selectDB);
	$gInactiveList->bind("<Double-Button-1>",
			     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->{"ignoremoddate"} = 0
	unless (defined $PREFS->{"ignoremoddate"});

    $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"} = $STATS{"palm"} = $STATS{"archive"} = 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 ($PREFS->{"ignoremoddate"}  or
	    !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} = $info->{"modifyDate"};
		push(@success, $filename);
		$STATS{"success"}++; $STATS{"palm"}++;
	    }
	    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 <Archive_*@*>;
	    $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"}++; $STATS{"archive"}++;
			#(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} = $info->{"modifyDate"};
		    push(@success, $filename);
		    $STATS{"success"}++; $STATS{"palm"}++;
		}
		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{palm} databases copied from palm.");
	PilotMgr::msg("$STATS{archive} databases copied from previous archive.");
	$dlp->log("Backup: $STATS{palm} databases successfully retrieved.\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 <Archive_*@*>;
    while (@archList > $max)
    {
	PilotMgr::status("Expiring oldest archive..", 100);
	&expireArchive(shift @archList);
    }

    @archList = reverse sort byDate <Archive_*@*>;
    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 (<FD>)
	{
	    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;
