summaryrefslogtreecommitdiff
path: root/bin/PerlACE/ProcessVX_Win32.pm
diff options
context:
space:
mode:
Diffstat (limited to 'bin/PerlACE/ProcessVX_Win32.pm')
-rw-r--r--bin/PerlACE/ProcessVX_Win32.pm421
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;
View Lorry Controller Status