#!/usr/bin/perl -w

use strict;

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

package PDA::PilotInstall;

=head1 NAME

PDA::PilotInstall - portably install files onto a Palm Pilot handheld

=head1 SYNOPSIS

    use PDA::PilotInstall;

    $obj = new PDA::PilotInstall;
    $obj->read_config_file ();
    $obj->install_file ("/Path/to/file.pdb");
    $obj->write_config_file ();

=head1 DESCRIPTION

This class provides a front-end to the HotSync system provided by Palm for
their range of handheld PDAs, and -- in the future -- to the other alternative
HotSync mechanisms provided on other operating systems where the Palm software
is not available (unfortunately the latter part is not quite implemented yet).

This allows Perl script authors to portably install PRC and PDB files without
having to deal with the complexity of the Palm install mechanism.

In addition, PDA::PilotInstall has built-in knowledge of the mechanism used
by the Hotsync system on the Windows platform, and can therefore install files
without requiring any user interaction at all, after an initial "training run"
of the Palm Install Application.

Since the goal of the latter functionality is to avoid running the Palm Install
App, this module uses a configuration file to store the data gleaned from the
"training run", so the Install App does not have to be run again.

=head1 METHODS

=over 4

=cut

###########################################################################
#
# Implementation note:
#
# All registry accesses must be protected by eval's to
# avoid requiring Win32::TieRegistry on non-Win32 platforms!!
# Ditto for similar mechanisms on other platforms as applicable,
# (Mac::Glue etc.)

# ---------------------------------------------------------------------------

use File::Find;
use File::Copy;

$PDA::PilotInstall::VERSION = "0.01";

BEGIN {
  if ($^O =~ /win/i) {
    # Note -- we import the registry into a global var,
    # %PDA::PilotInstall::Registry.  That's because the registry
    # is a global thing, no point making it a member of each instance!
    eval '
      use Win32::TieRegistry ( Delimiter => "/",
      		ArrayValues => 0, TiedHash => \'%RegHash\' );
      use Win32::Process;

      $PDA::PilotInstall::Registry = \%RegHash;
    ';
  }
}

# ---------------------------------------------------------------------------

=item $obj = new PDA::PilotInstall ()

Create an installer object.

=cut

sub new {
  my($class) = @_;
  my $self = ();

  $self->{os} = $^O;
  $self->{install_keys} = ();
  $self->{install_dirs} = ();
  $self->{install_app} = ();	# not written to config, detected each run
  $self->{pilot_dir} = undef;
  $self->{username} = undef;
  $self->{unix_install_app} = undef;
  $self->{verbose} = 1;

  $self = bless $self, $class;

  $self;
}

# ---------------------------------------------------------------------------

=item $obj->read_config_file ( [$filename] )

C<read_config_file> will read the configuration file. If a filename is not
specified, a file called I<PDA_Pilot_Install.cf> will be used in a pre-defined
location.  On Windows, this is the Perl C<site/lib> directory, or C<C:\Windows>
if that is not available or not writable.  On UNIX, the file is created as a
dotfile in the home directory of the current user.

C<read_config_file> will also initialise the installer, and perform any
detection of Palm installation programs, etc., that may be required. 

=cut

sub read_config_file {
  my $self = shift;
  my $file = shift;

  # try to detect some filenames if one has not been passed in.
  #
  my $fn = "PDA_Pilot_Install.cf";
  my $dir;

  if (!defined $file && $self->{os} =~ /win/i) {
    # First, try to find the Win32 ActiveState site/lib directory.

    my $key = 'HKEY_LOCAL_MACHINE/Software/ActiveWare/Perl5//PRIVLIB';
    eval '$dir = $PDA::PilotInstall::Registry->{$key};';
    if (defined $dir) {
      $dir =~ s,\\[^\\]+,,; $dir .= "\\site\\lib";
    }

    (-w $dir) and $file = "$dir/$fn";

    # failover to C:\Windows then
    (!defined $file) and (-w ($dir = "C:/Windows")) and $file = "$dir/$fn";
  }

  # the usual UNIX default
  (!defined $file) and (-w ($dir = $ENV{'HOME'})) and $file = "$dir/.$fn";
  # ...
  # OS/2? Macs? good defaults please! Mail them to <jm /at/ jmason.org>

  $self->{config_file} = $file;

  if (open (IN,"< $file")) {
    $self->{install_keys} = ();
    while (<IN>) {
      /^InstallKey \"(.+)\": (.+)$/ and $self->{install_keys}->{$1} = $2;
      /^InstallDir \"(.+)\": (.+)$/ and $self->{install_dirs}->{$1} = $2;
      /^PilotDir: (.+)$/ and $self->{pilot_dir} = $1;
      /^UnixInstallApp: (.+)$/ and $self->{inst_app} = $1;
    }
    close IN;
  }

  $self->setup();
}

# ---------------------------------------------------------------------------

=item $obj->write_config_file ( [$filename] )

C<write_config_file> will write the configuration file. If a filename is not
specified, the same file that was read previously in the C<read_config_file>
invocation will be used.

=cut

sub write_config_file {
  my $self = shift;
  my $file = shift;

  $file ||= $self->{config_file};
  open (OUT, ">". $file) or die "cannot write to ".$file;

  my $k;
  foreach $k (sort keys %{$self->{install_keys}}) {
    print OUT "InstallKey \"$k\": ".$self->{install_keys}->{$k}."\n";
  }
  foreach $k (sort keys %{$self->{install_dirs}}) {
    print OUT "InstallDir \"$k\": ".$self->{install_dirs}->{$k}."\n";
  }
  if (defined $self->{pilot_dir}) {
    print OUT "PilotDir: ".$self->{pilot_dir}."\n";
  }
  if (defined $self->{inst_app}) {
    print OUT "UnixInstallApp: ".$self->{inst_app}."\n";
  }
  close OUT;
}

sub setup {
  my $self = shift;
  my $file = shift;

  if ($self->{os} =~ /win/i) {
    return $self->setup_win ($file);

  } elsif ($self->{os} =~ /(vms|mac|os2)/i) {
    warn "Palm install: do not know how to install on this platform!\n";
    return undef;

  } else {
    return $self->setup_unix ($file);
  }
}

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

sub setup_unix {
  my $self = shift;
  my $file = shift;

  $self->{username} = "unixuser";

  my $instdir = undef;
  my $instapp = undef;
  my $home = $ENV{'HOME'};

  # Declare paths for common desktop suites.
  #
  my $pilot_mgr_dir = $home."/.pilotmgr/Installer";
  my $jpilot_file = $home."/.jpilot/jpilot_to_install";
  my $kp_pending_install = $home."/.kde/share/apps/kpilot/pending_install";

  # Declare paths for files that *change* when those suites are
  # used; we can use these to determine which one was last used.
  #
  my $gp_stamp = $home."/.gnome/gnome-pilot.d/gpilotd";
  my $jp_stamp = $home."/.jpilot/jpilot.rc";
  my $pm_stamp = $home."/.pilotmgr/hotsync.log";
  my $kp_stamp = $home."/.kde/share/config/kpilotrc";
  my $px_stamp;

  my $gpinstapp;
  my $pminstdir;
  my $jpinstapp;
  my $pxinstdir;
  my $kpinstdir;

  # Try to autodetect if one of the pilot-desktop tools has been used.
  #
  if ($self->check_for_gnome_pilot ()) {
    $gpinstapp = "gpilot-install-file --later";
  }
  if (-d $kp_pending_install && -f $kp_stamp) {
    $kpinstdir = $kp_pending_install;
  }
  if (-d $pilot_mgr_dir && -f $pm_stamp) {
    $pminstdir = $pilot_mgr_dir;
  }
  if (-f $jpilot_file && -f $jp_stamp) {
    $jpinstapp = "***ADD_TO_MANIFEST*** ".$jpilot_file;
  }

  if (-d "$home/Pilot/Install")		# one pilot-xfer convention
    { $pxinstdir = "$home/Pilot/Install"; }
  elsif (-d "$home/pilot/install")	# another
    { $pxinstdir = "$home/pilot/install"; }

  if (defined $pxinstdir) { $px_stamp = $pxinstdir; }
  if (defined $kpinstdir) { $kp_stamp = $kpinstdir; }

  # now we've found the candidates, work out which one was used most
  # recently.
  #
  my $OFF = 999999;
  $gp_stamp = (defined $gp_stamp && -e $gp_stamp ? -M $gp_stamp : $OFF);
  $pm_stamp = (defined $pm_stamp && -e $pm_stamp ? -M $pm_stamp : $OFF);
  $px_stamp = (defined $px_stamp && -e $px_stamp ? -M $px_stamp : $OFF);
  $jp_stamp = (defined $jp_stamp && -e $jp_stamp ? -M $jp_stamp : $OFF);
  $kp_stamp = (defined $kp_stamp && -e $kp_stamp ? -M $kp_stamp : $OFF);
  if (!defined $gpinstapp) { $gp_stamp = $OFF; }
  if (!defined $jpinstapp) { $jp_stamp = $OFF; }
  if (!defined $pminstdir) { $pm_stamp = $OFF; }
  if (!defined $pxinstdir) { $px_stamp = $OFF; }

  # use a hash and sort it to quickly work out the most recently used.
  #
  my %sorthash = (
    'kp' => $kp_stamp,
    'gp' => $gp_stamp,
    'jp' => $jp_stamp,
    'pm' => $pm_stamp,
    'px' => $px_stamp,
    '' => ($OFF - 1)		# if all else is set to $OFF, this will win
  );

  my @sorted = sort { $sorthash{$a} <=> $sorthash{$b} } keys %sorthash;
  my $newest = $sorted[0]; undef @sorted; undef %sorthash;

  if ($newest eq 'gp') {
    $instapp = $gpinstapp;
    $self->verbose ("using gnome-pilot: \"$instapp\".");

  } elsif ($newest eq 'kp') {
    $instdir = $kpinstdir;
    $self->verbose ("using KPilot: \"$kpinstdir\".");

  } elsif ($newest eq 'jp') {
    $instapp = $jpinstapp;
    $self->verbose ("using JPilot: \"$jpilot_file\".");

  } elsif ($newest eq 'pm') {
    $instdir = $pminstdir;
    $self->verbose ("using PilotManager: \"$instdir\".");

  } elsif ($newest eq 'px') {
    $instdir = $pxinstdir;
    $self->verbose ("using pilot-xfer directory: \"$instdir\".");

  } else {
    $instdir = '.';
    $self->verbose ("No PalmPilot software suites are in use. Copying files\n".
    	"to the current directory for later installation by hand.");
  }

  # and note it in the config.
  #
  if (defined $instdir) {
    $self->{install_dirs} = { 'unixuser' => $instdir };
  }
  if (defined $instapp) {
    $self->{install_app} = { 'unixuser' => $instapp };
  }

  1;
}

sub check_for_gnome_pilot {
  my $self = shift;
  if (`gnome-pilot-config --version 2>&1` !~ /^gnome-pilot \d/) {
    return undef;
  }
  if (!open (PID, "<".$ENV{'HOME'}."/.gpilotd.pid")) {
    return undef;
  }
  my $pid = <PID>; close PID; $pid += 0;

  # if the gpilotd process is running, we will be able to use
  # gnome-pilot to install PRCs.  Otherwise we cannot, so this
  # is quite a reasonable test.
  #
  if ($pid > 1 && kill 0, $pid) {
    return 1;
  }
  return undef;
}

# currently unused, the kpilot pilotListener doesn't always run
sub check_for_kpilot {
  my $self = shift;

  # Try to find the pilotListener process, indicative that
  # kpilot is running.
  open (PID, "ps axww 2>&1; ps -elf 2>&1 |");
  while (<PID>) {
    /pilotListener/ || next;
    close PID; return 1;
  }
  close PID; return undef;
}

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

sub setup_win {
  my $self = shift;
  my $file = shift;

  if (!defined $self->{username}) {
    my $key = "HKEY_CURRENT_USER/Software/U.S. Robotics".
	"/Pilot Desktop/Preferences//LastUserName";
    my $user;
    eval '$user = $PDA::PilotInstall::Registry->{$key};';

    if (!defined $user) {
      warn "Palm install: cannot find Pilot Software registry key:\n".
      	"this must to be installed for PDA::PilotInstall to work.\n";
      return undef;
    }
    $self->{username} = $user;
  }

  if (defined $self->{install_dirs}->{$self->{username}}) {
    $self->{install_dir} = $self->{install_dirs}->{$self->{username}};
  }

  if (!defined $self->{install_dir}) {
    sub get_instdir_wanted {
      return unless (/^install$/i && -d $File::Find::name);
      push (@TmpGlobal::possible_inst_dirs, $File::Find::name);
    }

    my $key = "HKEY_CURRENT_USER/Software/U.S. Robotics".
		  "/Pilot Desktop/Core//Path";
    my $dir;

    if (!defined $self->{pilot_dir}) {
      eval '
	$dir = $PDA::PilotInstall::Registry->{$key};
      ';
      if (!defined $dir) {
	warn "Palm install: cannot find Pilot Software registry key:\n".
	  "this must to be installed for PDA::PilotInstall to work.\n";
	return undef;
      }

      $self->{pilot_dir} = $dir;

    } else {
      $dir = $self->{pilot_dir};
    }

    if (defined $dir) {
      # argh! Hopefully File::Find will become thread-aware
      # and I will be able to avoid this.
      #
      @TmpGlobal::possible_inst_dirs = ();
      find(\&get_instdir_wanted, $dir);
      @{$self->{possible_inst_dirs}} = @TmpGlobal::possible_inst_dirs;
      undef @TmpGlobal::possible_inst_dirs;
    }

    $self->{install_dir} = undef;
    if ($#{$self->{possible_inst_dirs}} == 0) {
      $self->{install_dir} = ${$self->{possible_inst_dirs}}[0];

    } elsif ($#{$self->{possible_inst_dirs}} > 0) {
      # convert "Justin Mason" -> "MasonJ" in the Palm style

      my $name = $self->{username};
      $name =~ s/^\s*(\S).*\s+(\S+)\s*$/$1/g;
      my $dir;
      foreach $dir (@{$self->{possible_inst_dirs}}) {
	if ($dir =~ /$name/io) {
	  $self->{install_dir} = $dir; last;
	}
      }

      if (!defined $self->{install_dir}) {
	warn "Palm install: too many potential Install directories.\n";
	return undef;
      }

    } else {
      warn "Palm install: no directories listed in registry!\n";
      return undef;
    }

    $self->{install_dirs}->{$self->{username}}
				      = $self->{install_dir};
  }

  1;
}

# ---------------------------------------------------------------------------

=item $obj->install_file ( $filename )

C<install_file> will register a PRC or PDB file for installation at the next
HotSync.  If the function returns 1, the filename specified in $filename can be
deleted as the file has either been HotSync'ed or a copy made.

Note that some UNIX Pilot interface suites, may require that the HotSync
process happens immediately.  This will be avoided wherever possible.

Returns undef if the install fails and a copy cannot be kept in the working
dir. Returns 1 if the file specified in $filename can be deleted, as the file
has either been HotSync'ed or a copy made. Returns 2 if the file specified in
$filename should be kept until the next HotSync operation (for example if
it has been added to a manifest list for installation).

=cut

sub install_file {
  my $self = shift;
  my $file = shift;

  if ($self->{os} =~ /win/i) {
    return $self->install_win ($file);

  } elsif ($self->{os} =~ /(vms|mac|os2)/i) {
    warn "Palm install: I do not know how to install on this platform -- sorry!\n";
    return $self->keep_cwd_copy ($file);

  } else {
    return $self->install_unix ($file);
  }
}

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

sub install_unix {
  my $self = shift;
  my $file = shift;

  my $cmd = undef;
  my $instapp = $self->{install_app}->{'unixuser'};
  my $instdir = $self->{install_dirs}->{'unixuser'};

  if (defined $instapp) {
    $self->{inst_app} = $instapp;

    if ($instapp =~ /^\*\*\*ADD_TO_MANIFEST\*\*\* (.*)$/) {
      if (!open (OUT, ">> $1")) {
	warn "Palm install: cannot write to $1\n";
	return $self->keep_cwd_copy ($file);
      } else {
	print OUT $file."\n"; close OUT;
	return 2;
      }

    } else {
      $cmd = "$instapp \"$file\"";
      system $cmd;
      if (($? >> 8) != 0) {
	warn "Palm install: install command failed: $cmd\n";
	return $self->keep_cwd_copy ($file);
      }
      return 1;
    }

  } elsif (defined $instdir) {
    my $outfile = $file;
    $outfile =~ s,^.*[\/\\]([^\/\\]+)$,$1,;
    $outfile = $instdir. "/" .$outfile;
    if (!copy ($file, $outfile)) {
      warn "Palm install: cannot copy $file to $outfile, cannot install.\n";
      return $self->keep_cwd_copy ($file);
    }
    return 1;

  }

  warn "Palm install: do not know how to install $file.\n";
  $self->keep_cwd_copy ($file);
}

sub keep_cwd_copy {
  my $self = shift;
  my $file = shift;

  my $outfile = $file;
  $outfile =~ s,^.*[\/\\]([^\/\\]+)$,$1,;
  if ($file eq $outfile || $file eq './'.$outfile) {
    $outfile = "inst_".$outfile;
  }

  if (copy ($file, $outfile)) {
    warn
      "Palm install: could not figure out how to install \"$outfile\".\n".
      "Please copy it to your Palm hotsync directory yourself, by hand.\n";
    return 1;

  } else {
    warn "Palm install: could not copy $outfile to cwd.\n";
    return undef;
  }
}

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

sub install_win {
  my $self = shift;
  my $file = shift;

  my $outfile = $file;
  $outfile =~ s,^.*[\/\\]([^\/\\]+)$,$1,;
  $outfile = $self->{install_dir}. "/" .$outfile;

  my $instkey = "HKEY_CURRENT_USER/Software/U.S. Robotics".
		"/Pilot Desktop/HotSync Manager/";

  if (!defined $self->{install_keys}->{$self->{username}})
  {
    # we need to use the install app -- and record the result.
    my %pre = ();
    my @post = ();
    my ($f, $found);
    eval '
      foreach $f (grep (m#^/#, keys (%{$PDA::PilotInstall::Registry->{$instkey}}))) {
	$pre{$f} = 1;
      }
    ';

    # run the installer app. It's not very well-behaved so we have
    # to use Win32::Process to wait for it correctly. Even doing this,
    # we still cannot tell if the file was "installed" or not.
    #
    my $code;
    my $slashedfile = $file; $slashedfile =~ s,/,\\,g;
    my $cmd = $self->{pilot_dir}."\\InstApp.exe";
    my $cmdline = "InstApp.exe \"".$slashedfile."\"";

    eval '
      my $proc;
      if (!Win32::Process::Create ($proc,
		$cmd, $cmdline, 0, NORMAL_PRIORITY_CLASS, "."))
      {
	$code = 255; warn Win32::FormatMessage (Win32::GetLastError());
      } else {
	$proc->Wait(INFINITE); $proc->GetExitCode($code);
      }
    1;' or die "eval failed: $@";

    if ($code != 0) {
      warn "Palm install: failed to run InstApp.exe, cannot install $file\n";
      return undef;
    }
    if (!-f $outfile) {
      warn "Palm install: InstApp.exe did not make a copy, cannot install $file\n";
      return undef;
    }

    eval '
      @post = grep (m#^/#, keys (%{$PDA::PilotInstall::Registry->{$instkey}}));
    ';

    # first, check to see if a NEW install key was created.
    foreach $f (@post) {
      next if defined $pre{$f};
      next unless ($f =~ /Install\d+/i);
      $found = $f; last;
    }

    # no new keys? Just use the first install key, whether it
    # was there beforehand or not.
    if (!defined $found) {
      foreach $f (@post) {
	next unless ($f =~ /Install\d+/i);
	$found = $f; last;
      }
    }

    $self->{install_keys}->{$self->{username}} = $found;

  } else {
    # we can use the cached key value.

    # copy the file into the Install dir...
    if (!copy ($file, $outfile)) {
      warn "Palm install: cannot copy $file to $outfile, cannot install.\n";
      return undef;
    }

    # set the key in the registry
    my $key = $instkey . 
	      $self->{install_keys}->{$self->{username}};
    eval '
      $PDA::PilotInstall::Registry->{$key} = [ "0x0001", "REG_DWORD" ];
    ';
  }

  1;
}

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

sub verbose {
  my $self = shift;

  if ($self->{verbose}) {
    warn "Palm install: ".join ('', @_)."\n";
  }
}

1;
__END__

=back

=head1 NOTES

Needs a lot more work on the UNIX side of things; some platforms (such as Red
Hat Linux) have the desktop tools pre-installed, even though the user may not
use them, and it's difficult to work out which (if any) of the multitude of
suites are to be used.

=head1 REQUISITES

	C<File::Find>
	C<File::Copy>

=head1 COREQUISITES

	C<Win32::TieRegistry> on Windows platforms.

=head1 AUTHOR

Justin Mason, jm /at/ jmason.org, CPAN id JMASON.

=cut