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