summaryrefslogtreecommitdiff
path: root/bin/PerlACE
diff options
context:
space:
mode:
Diffstat (limited to 'bin/PerlACE')
-rw-r--r--bin/PerlACE/ConfigList.pm155
-rw-r--r--bin/PerlACE/MSProject.pm393
-rw-r--r--bin/PerlACE/MSProject/DSP.pm28
-rw-r--r--bin/PerlACE/MSProject/VCP.pm30
-rw-r--r--bin/PerlACE/Process.pm36
-rw-r--r--bin/PerlACE/Process_Unix.pm338
-rw-r--r--bin/PerlACE/Process_Win32.pm262
-rw-r--r--bin/PerlACE/Run_Test.pm94
8 files changed, 0 insertions, 1336 deletions
diff --git a/bin/PerlACE/ConfigList.pm b/bin/PerlACE/ConfigList.pm
deleted file mode 100644
index f2546d844d9..00000000000
--- a/bin/PerlACE/ConfigList.pm
+++ /dev/null
@@ -1,155 +0,0 @@
-# $Id$
-
-package PerlACE::ConfigList;
-use strict;
-use FileHandle;
-
-@PerlACE::ConfigList::Configs = ();
-
-my @new_argv = ();
-
-for(my $i = 0; $i <= $#ARGV; ++$i) {
- if ($ARGV[$i] eq '-Config') {
- if (defined $ARGV[$i + 1]) {
- push @PerlACE::ConfigList::Configs, $ARGV[++$i];
- }
- else {
- print STDERR "You must pass a configuration with Config\n";
- exit(1);
- }
- }
- else {
- push @new_argv, $ARGV[$i];
- }
-}
-@ARGV = @new_argv;
-
-
-sub new ()
-{
- my $self = {};
- @{$self->{MY_CONFIGS}} = @PerlACE::ConfigList::Configs;
- bless $self;
- return $self;
-}
-
-sub my_config_list
-{
- my $self = shift;
- if (@_) { @{$self->{MY_CONFIGS}} = @_; }
- return @{$self->{MY_CONFIGS}};
-}
-
-sub add_one_config ($)
-{
- my $self = shift;
- my $newconfig = shift;
- push @{$self->{MY_CONFIGS}}, $newconfig;
-}
-
-sub check_config (@)
-{
- my $self = shift;
- my @testconfigs = @_;
- my $included = 0;
- my $excluded = 0;
- my $noincludes = 1;
-
- foreach my $config (@testconfigs) {
- if ($config =~ /^\w/) { $noincludes = 0; }
- foreach my $myconfig (@{$self->{MY_CONFIGS}}) {
- if ($config eq "!$myconfig") { $excluded = 1; }
- if ($config eq $myconfig) { $included = 1; }
- }
- }
- return ($included || $noincludes) && !$excluded;
-}
-
-sub load ($)
-{
- my $self = shift;
- my $filename = shift;
-
- my $fh = new FileHandle;
- if (!$fh->open ("< $filename")) {
- print STDERR "Could not open $filename: $!\n";
- exit (1);
- }
-
- while (<$fh>) {
- chomp;
- if (/^\s*$/ || /^#/) {
- next;
- }
- # compress white space
- s/\s+/ /g;
-
- my $entry = '';
- my $configs = '';
-
- ($entry, $configs) = split /:/;
-
- push @{$self->{ENTRIES}}, $entry;
- if (defined $configs) {
- @{$self->{CONFIGS}->{$entry}} = split (" ", $configs);
- }
- }
-
- $fh->close ();
-}
-
-sub valid_entries ()
-{
- my $self = shift;
- my @entries = ();
-
- foreach my $entry (@{$self->{ENTRIES}}) {
- if ($self->check_config (@{$self->{CONFIGS}->{$entry}})) {
- push @entries, $entry;
- }
- }
- return @entries;
-}
-
-sub list_configs ()
-{
- my $self = shift;
- my %allconfigs = {};
- my $list = '';
-
- foreach my $entry (@{$self->{ENTRIES}}) {
-
- foreach my $config (@{$self->{CONFIGS}->{$entry}}) {
- $config =~ s/!//g;
- if ($allconfigs{$config} != 1) {
- $list .= $config.' ';
- $allconfigs{$config} = 1;
- }
- }
- }
-
- return $list;
-}
-
-sub dump ()
-{
- my $self = shift;
-
- print "============================================================\n";
- print "Config\n";
- foreach my $config (@{$self->{MY_CONFIGS}}) {
- print $config, "\n";
- }
- print "\n";
- print "Entries\n";
- foreach my $entry (@{$self->{ENTRIES}}) {
- print "- ", $entry, ": ";
- foreach my $config (@{$self->{CONFIGS}->{$entry}}) {
- print $config, " ";
- }
- print "\n";
- }
- print "============================================================\n";
-}
-
-1; \ No newline at end of file
diff --git a/bin/PerlACE/MSProject.pm b/bin/PerlACE/MSProject.pm
deleted file mode 100644
index 86e6548456a..00000000000
--- a/bin/PerlACE/MSProject.pm
+++ /dev/null
@@ -1,393 +0,0 @@
-# $Id$
-
-package PerlACE::MSProject;
-
-use strict;
-use FileHandle;
-
-###############################################################################
-
-# Constructor
-
-sub new
-{
- my $proto = shift;
- my $class = ref ($proto) || $proto;
- my $self = {};
-
- $self->{FILENAME} = shift;
- $self->{VERSION} = undef;
- $self->{NAME} = undef;
- %{$self->{CONFIGS}} = ();
-
- bless ($self, $class);
- return $self;
-}
-
-###############################################################################
-
-# Accessors
-
-sub Filename
-{
- my $self = shift;
-
- if (@_ != 0) {
- $self->{FILENAME} = shift;
- }
-
- return $self->{FILENAME};
-}
-
-sub Version ()
-{
- my $self = shift;
- return $self->{VERSION};
-}
-
-sub Name ()
-{
- my $self = shift;
- return $self->{NAME};
-}
-
-sub Configs ()
-{
- my $self = shift;
- return keys %{$self->{CONFIGS}};
-}
-
-sub DepOutputFile ($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- my $name = $self->OutputFile ($config);
-
- if ($name =~ m/\.dll$/) {
- $name = $self->LibraryFile ($config);
- }
-
- $name =~ s/.*\\//; # / <- For devenv
- $name =~ s/.*\///;
-
- return $name;
-}
-
-sub OutputFile ($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- if (%{$self->{CONFIGS}}->{$config}->{LINK} =~ m/out\:\"([^\"]*)\"/) {
- return $1;
- }
- elsif (defined $self->Name ()) {
- my $filename = $self->Filename;
- my $ext = "";
-
- if (%{$self->{CONFIGS}}->{$config}->{LINK} =~ m/\/dll/) {
- $ext = ".dll";
- }
- elsif (%{$self->{CONFIGS}}->{$config}->{LINK} =~ m/\/subsystem\:/) {
- $ext = ".exe";
- }
- else {
- $ext = ".lib";
- }
-
- $filename =~ s/\.[^\.]*$/$ext/;
- return $filename;
- }
-}
-
-
-sub LibraryFile ($)
-{
- my $self = shift;
- my $config = shift;
- my $dll = undef;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- if ($self->OutputFile ($config) =~ m/([^\/\\]*)\.dll$/i) {
- $dll = $1;
- }
-
- if (defined $dll) {
- if (%{$self->{CONFIGS}}->{$config}->{LINK} =~ m/implib\:\"([^\"]*)\"/i) {
- return $1;
- }
- else {
- $dll =~ s/.*\\//ig; # / <- Just here to fix color coding in devenv beta
- return $self->OutputDir ($config). $dll . ".lib";
- }
- }
-}
-
-sub OutputDir ($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- return %{$self->{CONFIGS}}->{$config}->{OUTPUTDIR};
-}
-
-sub IntermidiateDir ($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- return %{$self->{CONFIGS}}->{$config}->{INTERMEDIATEDIR};
-}
-
-sub TargetDir ($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- return %{$self->{CONFIGS}}->{$config}->{TARGETDIR};
-}
-
-sub CPPOptions ($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- return %{$self->{CONFIGS}}->{$config}->{CPP};
-}
-
-sub LINKOptions ($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- return %{$self->{CONFIGS}}->{$config}->{LINK};
-}
-
-sub Libs($)
-{
- my $self = shift;
- my $config = shift;
-
- if (!defined $config) {
- print STDERR "Error: No configuration specified\n";
- return;
- }
-
- return %{$self->{CONFIGS}}->{$config}->{LIBS};
-}
-
-sub UsesTAOIDL ()
-{
- my $self = shift;
-
- return $self->{TAOIDL};
-}
-
-sub Compiler ()
-{
- my $self = shift;
-
- return $self->{COMPILER};
-}
-
-###############################################################################
-
-# Big methods
-
-sub Load ()
-{
- my $self = shift;
- my $config = "Unknown";
-
- $self->{valid} = 0;
-
- my $fh = new FileHandle;
-
- unless ($fh->open ("<" . $self->{FILENAME})) {
- print "Could not open file ", $self->{FILENAME}, ": ", $_;
- return;
- }
-
- while (<$fh>) {
- if (m/^\#.*Project File - Name=\"([^\"]*)\"/) {
- $self->{NAME} = $1;
- }
-
- if (m/^\#.*Format Version (.*)/) {
- $self->{VERSION} = $1;
- }
-
- # Check for configurations
-
- if (m/^\!.*IF \"\$\(CFG\)\" == \".* - (.*)$\"/) {
- $config = $1;
- }
- elsif (m/^\!ENDIF$/) {
- $config = "";
- }
-
- # Check for directories
-
- if (m/\# PROP Output_Dir \"(.*)\"/) {
- %{$self->{CONFIGS}}->{$config}->{OUTPUTDIR} = $1;
- }
- elsif (m/\# PROP Intermediate_Dir \"(.*)\"/) {
- %{$self->{CONFIGS}}->{$config}->{INTERMEDIATEDIR} = $1;
- }
- elsif (m/\# PROP Target_Dir \"(.*)\"/) {
- %{$self->{CONFIGS}}->{$config}->{TARGETDIR} = $1;
- }
-
- # Look at CPP options
-
- if (m/\# ADD BASE CPP(.*)$/ || m/\# ADD CPP(.*)$/) {
- my @flags = split (/ \//, $1);
-
- foreach my $flag (@flags) {
- if ($flag && %{$self->{CONFIGS}}->{$config}->{CPP} !~ m/$flag/) {
- %{$self->{CONFIGS}}->{$config}->{CPP} .= " /$flag";
- }
- }
- }
- elsif (m/\# SUBTRACT CPP(.*)$/ || m/\# SUBTRACT BASE CPP(.*)$/) {
- my @flags = split (/ \//, $1);
-
- foreach my $flag (@flags) {
- if ($flag && %{$self->{CONFIGS}}->{$config}->{CPP} =~ m/$flag/) {
- %{$self->{CONFIGS}}->{$config}->{CPP} =~ s/ \/$flag//g;
- }
- }
- }
-
- # Look at LINK32 options
-
- if (m/\# ADD BASE LINK32(.*)$/ || m/\# ADD LINK32(.*)$/
- || m/\# ADD BASE LIB32(.*)$/ || m/\# ADD LIB32(.*)$/) {
- my @flags = split (/ \//, $1);
-
- foreach my $flag (@flags) {
- my $found = 0;
- my @libs = split (/ /, $flag);
-
- foreach my $lib (@libs) {
- if ($lib =~ m/\.lib$/) {
- if (%{$self->{CONFIGS}}->{$config}->{LIBS} !~ m/\Q$lib\E/) {
- %{$self->{CONFIGS}}->{$config}->{LIBS} .= " $lib";
- }
- $found = 1;
- }
- }
-
- if (!$found && $flag) {
- my $shortflag = $flag;
- if ($flag =~ m/^(.*)\:/) {
- $shortflag = $1;
- }
-
- if (%{$self->{CONFIGS}}->{$config}->{LINK} !~ m/ \/$shortflag/) {
- %{$self->{CONFIGS}}->{$config}->{LINK} .= " /$flag";
- }
- }
- }
- }
- elsif (m/\# SUBTRACT BASE LINK32(.*)$/ || m/\# SUBTRACT LINK32(.*)$/
- || m/\# SUBTRACT BASE LIB32(.*)$/ || m/\# SUBTRACT LIB32(.*)$/) {
- my @flags = split (/ \//, $1);
-
- foreach my $flag (@flags) {
- my $shortflag = $flag;
- if ($flag =~ m/^(.*)\:/) {
- $shortflag = $1;
- }
-
- if ($flag && %{$self->{CONFIGS}}->{$config}->{LINK} =~ m/ (\/$shortflag\:[^ ]*)/) {
- %{$self->{CONFIGS}}->{$config}->{LINK} =~ s/ \Q$1\E//ig;
- }
- }
- }
-
- if (m/^\# Name \".* - (.*)\"/ && defined %{$self->{CONFIGS}}->{"Unknown"}) {
- %{$self->{CONFIGS}}->{$1} = %{$self->{CONFIGS}}->{"Unknown"};
- delete %{$self->{CONFIGS}}->{"Unknown"};
- }
-
- if (m/tao\_idl/ && m/\$\(InputName\)\.idl/ || m/tao\_idl/ && m/\$\(InputPath\)/) {
- $self->{TAOIDL} = 1;
- }
- }
- $fh->close ();
- $self->{valid} = 1;
-}
-
-###############################################################################
-
-# Build functions
-
-sub Build ($)
-{
- my $self = shift;
- my ($config) = @_;
-
- my $command = $self->Compiler () . " " . $self->Filename ()
- . " /USEENV"
- . " /MAKE \"" . $self->Name ()
- . " - " . $config . "\"";
-
- system $command;
-}
-
-sub Clean ($)
-{
- my $self = shift;
- my ($config) = @_;
-
- my $command = $self->Compiler () . " " . $self->Filename ()
- . " /USEENV"
- . " /MAKE \"" . $self->Name ()
- . " - " . $config . "\" /CLEAN";
-
- system $command;
-}
-
-
-1; \ No newline at end of file
diff --git a/bin/PerlACE/MSProject/DSP.pm b/bin/PerlACE/MSProject/DSP.pm
deleted file mode 100644
index b7ca0276a82..00000000000
--- a/bin/PerlACE/MSProject/DSP.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-# $Id$
-
-package PerlACE::MSProject::DSP;
-
-use strict;
-use PerlACE::MSProject;
-
-our @ISA = ("PerlACE::MSProject");
-
-###############################################################################
-
-# Constructor
-
-sub new
-{
- my $proto = shift;
- my $class = ref ($proto) || $proto;
- my $self = $class->SUPER::new (@_);
-
- $self->{COMPILER} = "msdev.com";
-
- bless ($self, $class);
- return $self;
-}
-
-###############################################################################
-
-1; \ No newline at end of file
diff --git a/bin/PerlACE/MSProject/VCP.pm b/bin/PerlACE/MSProject/VCP.pm
deleted file mode 100644
index 8377d22788b..00000000000
--- a/bin/PerlACE/MSProject/VCP.pm
+++ /dev/null
@@ -1,30 +0,0 @@
-# $Id$
-
-package PerlACE::MSProject::VCP;
-
-use strict;
-use PerlACE::MSProject;
-
-our @ISA = ("PerlACE::MSProject");
-
-###############################################################################
-
-# Constructor
-
-sub new
-{
- my $proto = shift;
- my $class = ref ($proto) || $proto;
- my $self = $class->SUPER::new (@_);
-
- $self->{COMPILER} = "evc.com";
-
- bless ($self, $class);
- return $self;
-}
-
-###############################################################################
-
-# Accessors
-
-1; \ No newline at end of file
diff --git a/bin/PerlACE/Process.pm b/bin/PerlACE/Process.pm
deleted file mode 100644
index 52df7aa6c8f..00000000000
--- a/bin/PerlACE/Process.pm
+++ /dev/null
@@ -1,36 +0,0 @@
-# $Id$
-
-package PerlACE::Process;
-
-use strict;
-use English;
-
-$PerlACE::Process::ExeSubDir = './';
-
-### Check for -ExeSubDir commands, store the last one
-my @new_argv = ();
-
-for(my $i = 0; $i <= $#ARGV; ++$i) {
- if ($ARGV[$i] eq '-ExeSubDir') {
- if (defined $ARGV[$i + 1]) {
- $PerlACE::Process::ExeSubDir = $ARGV[++$i].'/';
- }
- else {
- print STDERR "You must pass a directory with ExeSubDir\n";
- exit(1);
- }
- }
- else {
- push @new_argv, $ARGV[$i];
- }
-}
-@ARGV = @new_argv;
-
-if ($OSNAME eq "MSWin32") {
- require PerlACE::Process_Win32;
-}
-else {
- require PerlACE::Process_Unix;
-}
-
-1;
diff --git a/bin/PerlACE/Process_Unix.pm b/bin/PerlACE/Process_Unix.pm
deleted file mode 100644
index a7ca2127a76..00000000000
--- a/bin/PerlACE/Process_Unix.pm
+++ /dev/null
@@ -1,338 +0,0 @@
-# $Id$
-
-package PerlACE::Process;
-
-use strict;
-use POSIX "sys_wait_h";
-use Cwd;
-use File::Basename;
-use Config;
-
-###############################################################################
-
-### Chorus stuff
-
-$PerlACE::Process::chorushostname = "localhost";
-$PerlACE::Process::chorus = 0;
-
-$PerlACE::Process::cwd = getcwd();
-
-for(my $i = 0; $i <= $#ARGV; $i++) {
- if ($ARGV[$i] eq '-chorus') {
- if (defined $ARGV[$i + 1]) {
- $PerlACE::Process::chorus = 1;
- $PerlACE::Process::chorushostname = $ARGV[$1 + 1];
- }
- else {
- print STDERR "The -chorus option requires " .
- "the hostname of the target\n";
- exit(1);
- }
-
- splice(@ARGV, $i, 2);
- # Don't break from the loop just in case there
- # is an accidental duplication of the -chorus option
- }
-}
-
-###############################################################################
-
-### Grab signal names
-
-my @signame;
-
-if (defined $Config{sig_name}) {
- my $i = 0;
- foreach my $name (split (' ', $Config{sig_name})) {
- $signame[$i] = $name;
- $i++;
- }
-}
-else {
- my $i;
- for ($i = 0; $i < 255; ++$i) {
- $signame[$i] = $i;
- }
-}
-
-###############################################################################
-
-### Constructor and Destructor
-
-sub new
-{
- my $proto = shift;
- my $class = ref ($proto) || $proto;
- my $self = {};
-
- $self->{RUNNING} = 0;
- $self->{IGNOREEXESUBDIR} = 0;
- $self->{PROCESS} = undef;
- $self->{EXECUTABLE} = shift;
- $self->{ARGUMENTS} = shift;
-
- 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 ();
- }
-}
-
-###############################################################################
-
-### Some Accessors
-
-sub Executable
-{
- my $self = shift;
-
- if (@_ != 0) {
- $self->{EXECUTABLE} = shift;
- }
-
- my $executable = $self->{EXECUTABLE};
-
- if ($self->{IGNOREEXESUBDIR}) {
- return $executable;
- }
-
- my $basename = basename ($executable);
- my $dirname = dirname ($executable). '/';
-
- $executable = $dirname.$PerlACE::Process::ExeSubDir.$basename;
-
- 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};
- }
-
- if ($PerlACE::Process::chorus == 1) {
- $commandline = "rsh "
- . $PerlACE::Process::chorushostname
- . " arun "
- . $PerlACE::Process::cwd
- . "/"
- . $commandline;
- }
-
- return $commandline;
-}
-
-sub IgnoreExeSubDir
-{
- my $self = shift;
-
- if (@_ != 0) {
- $self->{IGNOREEXESUBDIR} = shift;
- }
-
- return $self->{IGNOREEXESUBDIR};
-}
-
-###############################################################################
-
-# 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 ($self->{IGNOREEXESUBDIR} == 0) {
- if (!-f $self->Executable ()) {
- print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
- "> not found\n";
- return -1;
- }
-
- if (!$PerlACE::Process::chorus && !-x $self->Executable ()) {
- print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
- "> not executable\n";
- return -1;
- }
- }
-
- FORK:
- {
- if ($self->{PROCESS} = fork) {
- #parent here
- bless $self;
- }
- elsif (defined $self->{PROCESS}) {
- #child here
- exec $self->CommandLine ();
- die "ERROR: exec failed for <" . $self->CommandLine () . ">";
- }
- elsif ($! =~ /No more process/) {
- #EAGAIN, supposedly recoverable fork error
- sleep 5;
- redo FORK;
- }
- else {
- # weird fork error
- print STDERR "ERROR: Can't fork <" . $self->CommandLine () . ">: $!\n";
- }
- }
- $self->{RUNNING} = 1;
-}
-
-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 ();
- }
-
- $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);
-}
-
-sub TerminateWaitKill ($)
-{
- my $self = shift;
- my $timeout = shift;
-
- if ($self->{RUNNING}) {
- kill ('TERM', $self->{PROCESS});
- }
-
- return $self->WaitKill ($timeout);
-}
-
-# really only for internal use
-sub check_return_value ($)
-{
- my $self = shift;
- my $rc = shift;
-
- if ($rc == 0) {
- return 0;
- }
- elsif ($rc == 0xff00) {
- print STDERR "ERROR: <", $self->{EXECUTABLE},
- "> failed: $!\n";
- return ($rc >> 8);
- }
- elsif (($rc & 0xff) == 0) {
- $rc >>= 8;
- return $rc;
- }
-
- my $dump = 0;
-
- if ($rc & 0x80) {
- $rc &= ~0x80;
- $dump = 1;
- }
-
- # check for ABRT, KILL or TERM
- if ($rc == 6 || $rc == 9 || $rc == 15) {
- return 0;
- }
-
- print STDERR "ERROR: <", $self->{EXECUTABLE},
- "> exited with ";
-
- print STDERR "coredump from " if ($dump == 1);
-
- print STDERR "signal $rc : ", $signame[$rc], "\n";
-
- return 0;
-}
-
-sub Kill ()
-{
- my $self = shift;
-
- if ($self->{RUNNING}) {
- kill ('KILL', $self->{PROCESS});
- waitpid ($self->{PROCESS}, 0);
- $self->check_return_value ($?);
- }
-
- $self->{RUNNING} = 0;
-}
-
-sub Wait ()
-{
- my $self = shift;
-
- waitpid ($self->{PROCESS}, 0);
-}
-
-sub TimedWait ($)
-{
- my $self = shift;
- my $timeout = shift;
-
- while ($timeout-- != 0) {
- my $pid = waitpid ($self->{PROCESS}, &WNOHANG);
- if ($pid != 0 && $? != -1) {
- return $self->check_return_value ($?);
- }
- sleep 1;
- }
-
- return -1;
-}
-
-1;
-
diff --git a/bin/PerlACE/Process_Win32.pm b/bin/PerlACE/Process_Win32.pm
deleted file mode 100644
index ce9f04762fe..00000000000
--- a/bin/PerlACE/Process_Win32.pm
+++ /dev/null
@@ -1,262 +0,0 @@
-# $Id$
-
-package PerlACE::Process;
-
-use strict;
-use Win32::Process;
-use File::Basename;
-
-###############################################################################
-
-# This is what GetExitCode will return if the process is still running.
-my $STILL_ACTIVE = 259;
-
-###############################################################################
-
-### Constructor and Destructor
-
-sub new
-{
- my $proto = shift;
- my $class = ref ($proto) || $proto;
- my $self = {};
-
- $self->{RUNNING} = 0;
- $self->{IGNOREEXESUBDIR} = 0;
- $self->{PROCESS} = undef;
- $self->{EXECUTABLE} = shift;
- $self->{ARGUMENTS} = shift;
-
- 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 ();
- }
-}
-
-###############################################################################
-
-### Some Accessors
-
-sub Executable
-{
- my $self = shift;
-
- if (@_ != 0) {
- $self->{EXECUTABLE} = shift;
- }
-
- my $executable = $self->{EXECUTABLE};
-
- if ($self->{IGNOREEXESUBDIR}) {
- return $executable;
- }
-
- my $basename = basename ($executable);
- my $dirname = dirname ($executable). '/';
-
- $executable = $dirname.$PerlACE::Process::ExeSubDir.$basename.".EXE";
-
- $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 ($self->{IGNOREEXESUBDIR} == 0) {
- if (!-f $self->Executable ()) {
- print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
- "> not found\n";
- return -1;
- }
-
- if (!-x $self->Executable ()) {
- print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
- "> not executable\n";
- return -1;
- }
- }
-
- Win32::Process::Create ($self->{PROCESS},
- $self->Executable (),
- $self->CommandLine (),
- 0,
- 0,
- '.');
-
- my $status = 0;
-
- Win32::Process::GetExitCode ($self->{PROCESS}, $status);
-
- if ($status != $STILL_ACTIVE) {
- print STDERR "ERROR: Spawn failed for <", $self->CommandLine (), ">\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
- }
-
- $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}) {
- Win32::Process::Kill ($self->{PROCESS}, 0);
- }
-
- return $self->WaitKill ($timeout);
-}
-
-
-# Wait until a process exits.
-
-sub Wait ()
-{
- my $self = shift;
-
- if ($self->{RUNNING}) {
- Win32::Process::Wait ($self->{PROCESS}, INFINITE);
- }
-}
-
-
-# Wait for a process to exit with a timeout
-
-sub TimedWait ($)
-{
- my $self = shift;
- my $timeout = shift;
-
- if (!$self->{RUNNING}) {
- return 0;
- }
-
- if (Win32::Process::Wait ($self->{PROCESS}, $timeout * 1000) == 0) {
- return -1;
- }
-
- my $status = 0;
- Win32::Process::GetExitCode ($self->{PROCESS}, $status);
- return $status;
-}
-
-1;
diff --git a/bin/PerlACE/Run_Test.pm b/bin/PerlACE/Run_Test.pm
deleted file mode 100644
index e31cbdfc86a..00000000000
--- a/bin/PerlACE/Run_Test.pm
+++ /dev/null
@@ -1,94 +0,0 @@
-# $Id$
-
-# This module contains a few miscellanous functions and some
-# startup ARGV processing that is used by all tests.
-
-use PerlACE::Process;
-use PerlACE::ConfigList;
-
-package PerlACE;
-use Cwd;
-
-# Turn on autoflush
-$| = 1;
-
-sub LocalFile ($)
-{
- my $file = shift;
-
- my $newfile = getcwd () . '/' . $file;
-
- if ($^O eq "MSWin32") {
- $newfile =~ s/\//\\/g;
- }
-
- return $newfile;
-}
-
-
-# Returns a unique id, uid for unix, last digit of IP for NT
-sub uniqueid
-{
- if ($^O eq "MSWin32")
- {
- my $uid = 1;
-
- open (IPNUM, "ipconfig|") || die "Can't run ipconfig: $!\n";
-
- while (<IPNUM>)
- {
- if (/Address/)
- {
- $uid = (split (/: (\d+)\.(\d+)\.(\d+)\.(\d+)/))[4];
- }
- }
-
- close IPNUM;
-
- return $uid;
- }
- else
- {
- return getpwnam (getlogin ());
- }
-}
-
-# Waits until a file exists
-sub waitforfile
-{
- local($file) = @_;
- sleep 1 while (!(-e $file && -s $file));
-}
-
-sub waitforfile_timed
-{
- my $file = shift;
- my $maxtime = shift;
- while ($maxtime-- != 0) {
- if (-e $file && -s $file) {
- return 0;
- }
- sleep 1;
- }
- return -1;
-}
-
-sub check_n_cleanup_files
-{
- my $file = shift;
- my @flist = glob ($file);
-
- my $cntr = 0;
- my $nfile = scalar(@flist);
-
- if ($nfile != 0) {
- for (; $cntr < $nfile; $cntr++) {
- print STDERR "ERROR: File <$flist[$cntr]> exists but should be cleaned up\n";
- }
- unlink @flist;
- }
-}
-
-$sleeptime = 5;
-
-1;
View Lorry Controller Status