diff options
Diffstat (limited to 'bin/PerlACE/ProcessVX_Win32.pm')
-rw-r--r-- | bin/PerlACE/ProcessVX_Win32.pm | 421 |
1 files changed, 0 insertions, 421 deletions
diff --git a/bin/PerlACE/ProcessVX_Win32.pm b/bin/PerlACE/ProcessVX_Win32.pm deleted file mode 100644 index dcf1cbc06fb..00000000000 --- a/bin/PerlACE/ProcessVX_Win32.pm +++ /dev/null @@ -1,421 +0,0 @@ -# $Id$ - -package PerlACE::ProcessVX; - -use strict; -use Win32::Process; -use File::Basename; -use File::Spec; -use FileHandle; -use Cwd; - -############################################################################### - -# This is what GetExitCode will return if the process is still running. -my $STILL_ACTIVE = 259; - -my $set_vx_defgw = 1; -my $do_vx_init = (defined $ENV{"ACE_RUN_VX_NO_INITIAL_REBOOT"}) ? 0 : 1; - -############################################################################### - -### Constructor and Destructor - -sub new -{ - my $proto = shift; - my $class = ref ($proto) || $proto; - my $self = {}; - - $self->{RUNNING} = 0; - $self->{IGNOREEXESUBDIR} = 1; - $self->{PROCESS} = undef; - $self->{EXECUTABLE} = shift; - $self->{ARGUMENTS} = shift; - if (!defined $PerlACE::ProcessVX::WAIT_DELAY_FACTOR) { - $PerlACE::ProcessVX::WAIT_DELAY_FACTOR = 2; - } - $self->{WINDSH} = $ENV{"ACE_RUN_WINDSH"}; - if (!defined $self->{WINDSH}) { - $self->{WINDSH} = $ENV{"WIND_BASE"} . "\\host\\" . $ENV{"WIND_HOST_TYPE"} . "\\bin\\windsh.exe"; - } - $self->{REBOOT_CMD} = $ENV{"ACE_RUN_VX_REBOOT_CMD"}; - if (!defined $self->{REBOOT_CMD}) { - $self->{REBOOT_CMD} = "reboot"; - } - $self->{REBOOT_TIME} = $ENV{"ACE_RUN_VX_REBOOT_TIME"}; - if (!defined $self->{REBOOT_TIME}) { - $self->{REBOOT_TIME} = 90; - } - - bless ($self, $class); - return $self; -} - -sub DESTROY -{ - my $self = shift; - - if ($self->{RUNNING} == 1) { - print STDERR "ERROR: <", $self->{EXECUTABLE}, - "> still running upon object destruction\n"; - $self->Kill (); - } - - if (!defined $ENV{'ACE_TEST_VERBOSE'}) { - unlink "run_test.vxs"; - } -} - -############################################################################### - -### Some Accessors - -sub Normalize_Executable_Name -{ - my $executable = shift; - - my $basename = basename ($executable); - my $dirname = dirname ($executable). '/'; - - $executable = $dirname.$PerlACE::ProcessVX::ExeSubDir.$basename.".out"; - - ## Installed executables do not conform to the ExeSubDir - if (! -e $executable && -e $dirname.$basename.'.out') { - $executable = $dirname.$basename.'.out'; - } - - $executable =~ s/\//\\/g; # / <- # color coding issue in devenv - - return $executable; -} - - -sub Executable -{ - my $self = shift; - - if (@_ != 0) { - $self->{EXECUTABLE} = shift; - } - - my $executable = $self->{EXECUTABLE}; - - if ($self->{IGNOREEXESUBDIR} == 0) { - $executable = PerlACE::ProcessVX::Normalize_Executable_Name ($executable); - } - else { - $executable = $executable.".out"; - $executable =~ s/\//\\/g; # / <- # color coding issue in devenv - } - - return $executable; -} - -sub Arguments -{ - my $self = shift; - - if (@_ != 0) { - $self->{ARGUMENTS} = shift; - } - - return $self->{ARGUMENTS}; -} - -sub CommandLine () -{ - my $self = shift; - - my $commandline = $self->Executable (); - - if (defined $self->{ARGUMENTS}) { - $commandline .= ' '.$self->{ARGUMENTS}; - } - - return $commandline; -} - -sub IgnoreExeSubDir -{ - my $self = shift; - - if (@_ != 0) { - $self->{IGNOREEXESUBDIR} = shift; - } - - return $self->{IGNOREEXESUBDIR}; -} - -############################################################################### - -### Spawning processes - - -# Spawn the process and continue. - -sub Spawn () -{ - my $self = shift; - - if ($self->{RUNNING} == 1) { - print STDERR "ERROR: Cannot Spawn: <", $self->Executable (), - "> already running\n"; - return -1; - } - - if (!defined $self->{EXECUTABLE}) { - print STDERR "ERROR: Cannot Spawn: No executable specified\n"; - return -1; - } - - if (!-x $self->{WINDSH}) { - print STDERR "ERROR: Cannot Spawn: <", $self->{WINDSH}, - "> not executable\n"; - return -1; - } - - if ($self->{IGNOREEXESUBDIR} == 0) { - if (!-f $self->Executable ()) { - print STDERR "ERROR: Cannot Spawn: <", $self->Executable (), - "> not found\n"; - return -1; - } - } - - my $status = 0; - - my $cmdline; - ## - ## initialize VxWorks kernel (reboot!) if needed - if ($do_vx_init || $ENV{'ACE_RUN_VX_TGT_REBOOT'}) { - if (defined $ENV{'ACE_RUN_VX_REBOOT_TOOL'}) { - if (defined $ENV{'ACE_TEST_VERBOSE'}) { - print "Calling: $ENV{'ACE_RUN_VX_REBOOT_TOOL'}\n"; - } - system ($ENV{'ACE_RUN_VX_REBOOT_TOOL'}); - } - else { - $cmdline = $self->{WINDSH} . " -e \"shParse {" . $self->{REBOOT_CMD} . "}\" " . $ENV{'ACE_RUN_VX_TGTSVR'}; - if (defined $ENV{'ACE_TEST_VERBOSE'}) { - print $cmdline . "\n"; - } - ## reboot VxWorks kernel to cleanup - Win32::Process::Create ($self->{PROCESS}, - $self->{WINDSH}, - $cmdline, - 0, - 0, - '.'); - if (defined $ENV{'ACE_TEST_VERBOSE'}) { - print "Spawned: " . $cmdline . "\n"; - } - Win32::Process::GetExitCode ($self->{PROCESS}, $status); - if ($status != $STILL_ACTIVE) { - print STDERR "ERROR: Spawn failed for <", $self->{WINDSH}, ">\n"; - exit $status; - } - if (defined $ENV{'ACE_TEST_VERBOSE'}) { - print "Status: $status\n"; - } - $self->{RUNNING} = 1; - $status = $self->TimedWait (3); - if (defined $ENV{'ACE_TEST_VERBOSE'}) { - print "TimedWait Status: $status\n"; - } - if ($status == -1) { - $self->Kill (); - # Don't need to Wait since we are on Win32 - } - $self->{RUNNING} = 0; - $self->{PROCESS} = undef; - } - $set_vx_defgw = 1; - $do_vx_init = 0; - - sleep($self->{REBOOT_TIME}); - } - - my $program = $self->Executable (); - my $cwdrel = dirname ($program); - if (length ($cwdrel) > 0) { - $cwdrel = File::Spec->abs2rel( cwd(), $ENV{"ACE_ROOT"} ); - } - else { - $cwdrel = File::Spec->abs2rel( $cwdrel, $ENV{"ACE_ROOT"} ); - } - $cwdrel =~ s/\\/\//g; - $program = basename($program, ".out"); - - unlink "run_test.vxs"; - my $oh = new FileHandle(); - if (!open($oh, ">run_test.vxs")) { - print STDERR "ERROR: Unable to write to run_test.vxs\n"; - exit -1; - } - - if ( defined $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} && $set_vx_defgw ) { - print $oh "\n" . - "mRouteAdd(\"0.0.0.0\", \"" . $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} . "\", 0,0,0)\n"; - $set_vx_defgw = 0; - } - - print $oh "\n" . - "cd \"" . $ENV{"ACE_ROOT"} . "/" . $cwdrel . "\"\n" . - "\@cd \"" . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . "\"\n" . - "putenv(\"TMPDIR=" . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . "\")\n"; - - if (defined $ENV{'ACE_RUN_VX_CHECK_RESOURCES'}) { - print $oh "memShow();\n"; - } - - my $length = length ($program) + 2; - my $arguments = ""; - if (defined $self->{ARGUMENTS}) { - ($arguments = $self->{ARGUMENTS})=~ s/\"/\\\"/g; - $arguments = ",\"" . $arguments . "\""; - } - print $oh "write(2, \"\\n$program\\n\", $length);\n" . - "ld 1,0,\"" . $program . ".out\"\n" . - "ace_vx_rc = vx_execae(ace_main" . $arguments . ")\n" . - "unld \"" . $program . ".out\"\n" . - "exit(ace_vx_rc)\n"; - - close($oh); - - my $executable = $self->{WINDSH}; - if (defined $ENV{'ACE_TEST_VERBOSE'}) { - $cmdline = $self->{WINDSH} . " -s run_test.vxs " . $ENV{"ACE_RUN_VX_TGTSVR"}; - print "$executable $cmdline\n"; - } - else { - $cmdline = $self->{WINDSH} . " -q -s run_test.vxs " . $ENV{"ACE_RUN_VX_TGTSVR"}; - - } - Win32::Process::Create ($self->{PROCESS}, - $executable, - $cmdline, - 0, - 0, - '.'); - - Win32::Process::GetExitCode ($self->{PROCESS}, $status); - - if ($status != $STILL_ACTIVE) { - print STDERR "ERROR: Spawn failed for <", $cmdline, ">\n"; - exit $status; - } - - $self->{RUNNING} = 1; - return 0; -} - - -# Wait for the process to exit or kill after a time period - -sub WaitKill ($) -{ - my $self = shift; - my $timeout = shift; - - my $status = $self->TimedWait ($timeout); - - if ($status == -1) { - print STDERR "ERROR: $self->{EXECUTABLE} timedout\n"; - $self->Kill (); - # Don't need to Wait since we are on Win32 - - $do_vx_init = 1; # force reboot on next run - } - - $self->{RUNNING} = 0; - - return $status; -} - - -# Do a Spawn and immediately WaitKill - -sub SpawnWaitKill ($) -{ - my $self = shift; - my $timeout = shift; - - if ($self->Spawn () == -1) { - return -1; - } - - return $self->WaitKill ($timeout); -} - - -# Kill the process - -sub Kill () -{ - my $self = shift; - - if ($self->{RUNNING}) { - Win32::Process::Kill ($self->{PROCESS}, -1); - } - - $self->{RUNNING} = 0; -} - - -# Terminate the process and wait for it to finish - -sub TerminateWaitKill ($) -{ - my $self = shift; - my $timeout = shift; - - if ($self->{RUNNING}) { - print STDERR "INFO: $self->{EXECUTABLE} being killed.\n"; - Win32::Process::Kill ($self->{PROCESS}, 0); - $do_vx_init = 1; # force reboot on next run - } - - return $self->WaitKill ($timeout); -} - - -# Wait until a process exits. -# return -1 if the process is still alive. - -sub Wait ($) -{ - my $self = shift; - my $timeout = shift; - if (!defined $timeout || $timeout < 0) { - $timeout = INFINITE; - } else { - $timeout = $timeout * 1000 * $PerlACE::ProcessVX::WAIT_DELAY_FACTOR; - } - - my $result = 0; - - if ($self->{RUNNING}) { - $result = Win32::Process::Wait ($self->{PROCESS}, $timeout); - if ($result == 0) { - return -1; - } - } - Win32::Process::GetExitCode ($self->{PROCESS}, $result); - if ($result != 0) { - $do_vx_init = 1; # force reboot on next run - } - return $result; -} - - -# Wait for a process to exit with a timeout - -sub TimedWait ($) -{ - my($self) = shift; - my($timeout) = shift; - return $self->Wait($timeout); -} - -1; |