home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _76d2c82d0acffc445a378cc682d16275 < prev    next >
Encoding:
Text File  |  2004-04-13  |  2.0 KB  |  86 lines
  1. package PPM::Installer::Local;
  2. @PPM::Installer::Local::ISA = qw(PPM::Installer);
  3.  
  4. use strict;
  5. use Data::Dumper;
  6. use PPM::PPD;
  7. use PPM::Result qw(Ok Warning Error List);
  8.  
  9. sub new {
  10.     my $class = shift;
  11.     my $targ = shift;
  12.     my $name = shift;
  13.     my $inst = bless {
  14.     name => $name,
  15.     path => $targ->{path},
  16.     type => $targ->{type},
  17.     port => $targ->{port},
  18.     }, $class;
  19.     return $inst;
  20. }
  21.  
  22. sub init {
  23.     my $inst = shift;
  24.  
  25.     # First, check if the process is already running. If so, use that.
  26.     my $ok = $inst->connect_to('localhost', $inst->{port});
  27.  
  28.     # If it isn't, try to launch it ourselves, _then_ connect. Because
  29.     # spawning a process is fairly slow, we have to try to connect for a
  30.     # little while, to give the child time to set up the server.
  31.     do {
  32.     $inst->spawn;
  33.     for (1 .. 10) {
  34.         $ok = $inst->connect_to('localhost', $inst->{port});
  35.         last if $ok->ok;
  36.         # let the CPU swap out to the child process.
  37.         defined &Win32::Sleep ? Win32::Sleep(250) : sleep 1;
  38.     }
  39.     die $ok->msg unless $ok->ok;
  40.     } unless $ok->ok;
  41.     $ok;
  42. }
  43.  
  44. sub fini {
  45.     my $o = shift;
  46.     $o->sendmsg('STOP');
  47. }
  48.  
  49. sub spawn {
  50.     my $inst = shift;
  51.  
  52.     $ENV{PPM_PORT} = $inst->port;
  53.  
  54.     # Note: $inst->{path} must be an executable, but Windows
  55.     # does not support an executable permission bit, checking
  56.     # for .bat or .exe files instead. This isn't suitable
  57.     # for scripts, so we only make this check on non-Windows boxes
  58.     die "$0: error: '$inst->{path}' is not executable"
  59.       unless ((-x $inst->{path}) or ($^O eq 'MSWin32'));
  60.     if ($^O eq 'MSWin32') {
  61.     $inst->{path} =~ s,/,\\,g;
  62.     $inst->{pid} = system(1, $inst->{path});
  63.     }
  64.     else {
  65.     $inst->{pid} = fork();
  66.     if (defined $inst->{pid} and $inst->{pid} == 0) {
  67.         exec $inst->{path};
  68.         exit 1;
  69.     }
  70.     }
  71. }
  72.  
  73. sub ckeys {
  74.     my $o = shift;
  75.     ($o->SUPER::ckeys,
  76.      qw(path),
  77.     );
  78. }
  79.  
  80. sub path {
  81.     my $o = shift;
  82.     $o->{path};
  83. }
  84.  
  85. 1;
  86.