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   Win32::Process::Create(
  52     $p,
  53     $x,
  54     "perl $sev",
  55     0,
  56     NORMAL_PRIORITY_CLASS | DETACHED_PROCESS,
  57     "."
  58   ) or warn 'could not execute severancer: '.Win32::FormatMessage(Win32::GetLastError());
  59 }
  60
  61 ### posix_start () #############################################################
  62 #
  63 # POSIX starter
  64 #
  65 # Params: ~none~
  66 #
  67 # Return: ~none~
  68 #
  69 sub posix_start ($) {
  70   my $sev = shift;
  71   my $x   = $^X;
  72
  73   require POSIX;
  74
  75   my $pid = fork;
  76   unless ($pid) {
  77     unless (defined $pid) {
  78       warn "Could not fork severance process: $!";
  79     }
  80     else {
  81       unless (POSIX::setsid()) {
  82         warn "Could not create new severancer session: $!";
  83       } else {
  84         exec $x, $sev;
  85       }
  86       warn "could not execute severancer: $!"
  87     }
  88   }
  89 }
  90
  91 ### start_severance () #########################################################
  92 #
  93 # start the severance script as a new process (group)
  94 #
  95 # Params: $app - /path/to/fo_sev.pl
  96 #
  97 # Return: ~none~
  98 #
  99 sub start_severance ($) {
 100   my $app = shift;
 101   my $OS;
 102
 103   unless ($OS = $^O) {
 104     require Config;
 105     $OS = $Config::Config{osname};
 106   }
 107
 108   if ($OS =~ /win32/i) {
 109     win32_start ($app);
 110   }
 111   else {
 112     posix_start ($app);
 113   }
 114
 115   return;
 116 }
 117
 118 # keep 'require' happy
 119 1;
 120
 121 #
 122 #
 123 ### end of Arc::Starter ########################################################