#!/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 to the other alternative HotSync mechanisms
which are provided on other operating systems, where the Palm software is not
available.

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;

use vars qw{
  $VERSION $Registry
};

$VERSION = "0.1";

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

=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;
}

sub open_registry {
  if ($^O =~ /win/i && !defined $Registry) {
    # 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;

      $Registry = \%RegHash;
    ';
  }
}

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

=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';
    open_registry();
    eval '$dir = $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.
It will also close the registry, if it was opened.

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

  $Registry = undef;
}

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;

  my $out = `gnome-pilot-config --version 2>&1`;

  return undef unless defined($out);
  if ($out !~ /^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;
    open_registry();
    eval '$user = $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}) {
      open_registry();
      eval '
	$dir = $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) {
      @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 || $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, or install it with\n".
      "the Palm install tool, 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;

  if (!defined $self->{install_dir}) {
    warn "Palm install: could not figure out installation directory.\n";
    return $self->keep_cwd_copy ($file);
  }

  if (!defined $self->{pilot_dir}) {
    warn "Palm install: could not figure out Palm software directory.\n";
    return $self->keep_cwd_copy ($file);
  }

  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);
    open_registry();
    eval '
      foreach $f (grep (m#^/#, keys (%{$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 $self->keep_cwd_copy ($file);
    }
    if (!-f $outfile) {
      warn "Palm install: InstApp.exe did not make a copy, cannot install $file\n";
      return $self->keep_cwd_copy ($file);
    }

    open_registry();
    eval '
      @post = grep (m#^/#, keys (%{$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 $self->keep_cwd_copy ($file);
    }

    # set the key in the registry
    my $key = $instkey . 
	      $self->{install_keys}->{$self->{username}};
    open_registry();
    eval '
      $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 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