#!/usr/pkg/bin/perl 
# gus_xml-rpc_reboot.pl
# Copyright 2005-09-08 by Gan Uesli Starling
# XML-RPC server reboot script written in Perl.
# 42 liines of code & 30 comment lines.
# For use with this XML-RPC Client/Server pair:
# 1. gus_xml-rpc_server.pl
# 2. gus_xml-rpc_client_tk.pl

# HOW IT WORKS:
# On command, the running server reboots itsels as follows:
# 3. Launches this script in manner similar to below.
# 4. Dies when this script kills it.
# 5. Is reborn when new version launched by this script.

# Args sent by the to-be-restarted, still-running server.
my ( $script_path, $script_list, $local_port, 
     $prefork_pid, $plain_pw, $crypt_key ) = @ARGV;

# Lay running server to rest.
kill 15, $prefork_pid; sleep 5; # Gently persuade at first.
kill  2, $prefork_pid; sleep 5; # If ignored, insist harder.
kill  9, $prefork_pid; sleep 5; # If still ignored, use hammer.

# Prepare launch-string for use with 'Process::Create' on Win32.
# Note: Since this is a string, not a list, any scalars which
# are empty may cause problems. Make sure empty any empty 
# scalars are represented by empty double-quotes or else are
# left out entirely, as below.
my $win32_cmd = "wperl $script_path/gus_xml-rpc_server.pl "
    . "--script_list $script_list "
    . "--local_port $local_port "
    . "--password $plain_pw "
    . "--gui 0 ";

# On the off chance that key is empty.
$win32_cmd .= "--crypt_key $crypt_key " if $crypt_key;

# Prepare launch-array for use with 'fork' on Unix.
my @unix_cmd = (
    "perl", "$script_path/gus_xml-rpc_server.pl", 
    "--script_list", "$script_list",
    "--local_port", "$local_port",
    "--crypt_key", "$crypt_key",
    "--password", "$plain_pw",
    "--gui", "0"
);

# Launch new process the UNIX way.
sub unix_fork_process {
    if ( defined( my $kid = fork ) ) {
        unless ($kid) { 
            exec(@_) or die "Oops! Cannot exec.";
        }
    }
}

# Launch new process the Win32 way.
sub win32_create_process {
    my $win32_cmd = shift;
    require Win32::Process;
    require Win32;
    no strict;
    my $obj;

    sub ErrorReport{
        print Win32::FormatMessage( Win32::GetLastError() );
    }

    Win32::Process::Create(
        $obj, "C:\\Perl\\bin\\wperl.exe",
        "$win32_cmd", 0, NORMAL_PRIORITY_CLASS, "."
    ) || die ErrorReport();
}

# Launch new process any way whichever...
if ($^O =~ /Win32/i) { win32_create_process($win32_cmd) }
else { unix_fork_process(@unix_cmd) }
[download]