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

my $VERSION = $PilotMgr::VERSION;  	# 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",
    };
}

##############################################################################
#
# 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("<ButtonPress>", \&selectDB);
	$gInstallList->bind("<ButtonRelease>", \&selectDB);
	$gInstallList->bind("<KeyPress-Down>", \&selectDB);
	$gInstallList->bind("<KeyPress-Up>", \&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;
