selfforum-cgi/shared/Arc/Starter.pm

   1 package Arc::Starter;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Arc/Starter.pm                                           #
   6 #                                                                              #
   7 # Authors:     André Malo <nd@o3media.de>                                      #
   8 #                                                                              #
   9 # Description: start severancer and archiver                                   #
  10 #                                                                              #
  11 ################################################################################
  12
  13 use strict;
  14 use vars qw(
  15   @EXPORT
  16 );
  17
  18 ################################################################################
  19 #
  20 # Version check
  21 #
  22 # last modified:
  23 #    $Date$ (GMT)
  24 # by $Author$
  25 #
  26 sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'}
  27
  28 ################################################################################
  29 #
  30 # Export
  31 #
  32 use base qw(Exporter);
  33 @EXPORT = qw(start_severance);
  34
  35 ### win32_start () #############################################################
  36 #
  37 # win32 starter
  38 #
  39 # Params: ~none~
  40 #
  41 # Return: ~none~
  42 #
  43 sub win32_start ($) {
  44   my $sev = shift;
  45   my $p;
  46   my $x = $^X;
  47
  48   require Win32::Process; Win32::Process -> import ('NORMAL_PRIORITY_CLASS', 'DETACHED_PROCESS');
  49   require Win32;
  50
  51   eval q{
  52     Win32::Process::Create(
  53       $p,
  54       $x,
  55       "perl $sev",
  56       0,
  57       NORMAL_PRIORITY_CLASS | DETACHED_PROCESS,
  58       "."
  59     ) or warn 'could not execute severancer: '.Win32::FormatMessage(Win32::GetLastError());
  60   }
  61 }
  62
  63 ### posix_start () #############################################################
  64 #
  65 # POSIX starter
  66 #
  67 # Params: ~none~
  68 #
  69 # Return: ~none~
  70 #
  71 sub posix_start ($) {
  72   my $sev = shift;
  73   my $x   = $^X;
  74
  75   require POSIX;
  76
  77   my $pid = fork;
  78   unless ($pid) {
  79     unless (defined $pid) {
  80       warn "Could not fork severance process: $!";
  81     }
  82     else {
  83       unless (POSIX::setsid()) {
  84         warn "Could not create new severancer session: $!";
  85       } else {
  86         exec $x, $sev;
  87       }
  88       warn "could not execute severancer: $!"
  89     }
  90   }
  91 }
  92
  93 ### start_severance () #########################################################
  94 #
  95 # start the severance script as a new process (group)
  96 #
  97 # Params: $app - /path/to/fo_sev.pl
  98 #
  99 # Return: ~none~
 100 #
 101 sub start_severance ($) {
 102   my $app = shift;
 103   my $OS;
 104
 105   unless ($OS = $^O) {
 106     require Config;
 107     $OS = $Config::Config{osname};
 108   }
 109
 110   if ($OS =~ /win32/i) {
 111     win32_start ($app);
 112   }
 113   else {
 114     posix_start ($app);
 115   }
 116
 117   return;
 118 }
 119
 120 # keep 'require' happy
 121 1;
 122
 123 #
 124 #
 125 ### end of Arc::Starter ########################################################