From 4dc257b23e4bf070f9f3e2e53f02065437f77a55 Mon Sep 17 00:00:00 2001 From: ndparker <> Date: Thu, 19 Jul 2001 14:59:12 +0000 Subject: [PATCH] added Arc::Starter --- selfforum-cgi/shared/Arc/Starter.pm | 120 ++++++++++++++++++++++++++++ 1 file changed, 120 insertions(+) create mode 100644 selfforum-cgi/shared/Arc/Starter.pm diff --git a/selfforum-cgi/shared/Arc/Starter.pm b/selfforum-cgi/shared/Arc/Starter.pm new file mode 100644 index 0000000..905a33a --- /dev/null +++ b/selfforum-cgi/shared/Arc/Starter.pm @@ -0,0 +1,120 @@ +package Arc::Starter; + +################################################################################ +# # +# File: shared/Arc/Starter.pm # +# # +# Authors: Andre Malo , 2001-07-16 # +# # +# Description: start severancer and archiver # +# # +################################################################################ + +use strict; +use vars qw( + @EXPORT + $VERSION +); + +################################################################################ +# +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +################################################################################ +# +# Export +# +use base qw(Exporter); +@EXPORT = qw(start_severance); + +### win32_start () ############################################################# +# +# win32 starter +# +# Params: ~none~ +# +# Return: ~none~ +# +sub win32_start ($) { + my $sev = shift; + my $p; + my $x = $^X; + + require Win32::Process; Win32::Process -> import ('NORMAL_PRIORITY_CLASS', 'DETACHED_PROCESS'); + require Win32; + + Win32::Process::Create( + $p, + $x, + "perl $sev", + 0, + NORMAL_PRIORITY_CLASS | DETACHED_PROCESS, + "." + ) or warn 'could not execute severancer: '.Win32::FormatMessage(Win32::GetLastError()); +} + +### posix_start () ############################################################# +# +# POSIX starter +# +# Params: ~none~ +# +# Return: ~none~ +# +sub posix_start ($) { + my $sev = shift; + my $x = $^X; + + require POSIX; + + my $pid = fork; + unless ($pid) { + unless (defined $pid) { + warn "Could not fork severance process: $!"; + } + else { + unless (POSIX::setsid()) { + warn "Could not create new severancer session: $!"; + } else { + exec $x, $sev; + } + warn "could not execute severancer: $!" + } + } +} + +### start_severance () ######################################################### +# +# start the severance script as a new process (group) +# +# Params: $app - /path/to/fo_sev.pl +# +# Return: ~none~ +# +sub start_severance ($) { + my $app = shift; + my $OS; + + unless ($OS = $^O) { + require Config; + $OS = $Config::Config{osname}; + } + + if ($OS =~ /win32/i) { + win32_start ($app); + } + else { + posix_start ($app); + } + + return; +} + +# keep 'require' happy +1; + +# +# +### end of Arc::Starter ######################################################## \ No newline at end of file -- 2.34.1