selfforum-cgi/shared/Arc/Starter.pm

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