summaryrefslogtreecommitdiff
path: root/CIAO/bin/PerlCIAO
diff options
context:
space:
mode:
Diffstat (limited to 'CIAO/bin/PerlCIAO')
-rw-r--r--CIAO/bin/PerlCIAO/TestUtils.base3
-rw-r--r--CIAO/bin/PerlCIAO/TestUtils.pm323
-rw-r--r--CIAO/bin/PerlCIAO/TestUtils_Base.pm78
-rw-r--r--CIAO/bin/PerlCIAO/generate_container.pl126
-rw-r--r--CIAO/bin/PerlCIAO/perlciao.mpc9
5 files changed, 0 insertions, 539 deletions
diff --git a/CIAO/bin/PerlCIAO/TestUtils.base b/CIAO/bin/PerlCIAO/TestUtils.base
deleted file mode 100644
index 7e68a521d2f..00000000000
--- a/CIAO/bin/PerlCIAO/TestUtils.base
+++ /dev/null
@@ -1,3 +0,0 @@
-processes
-files
-wd
diff --git a/CIAO/bin/PerlCIAO/TestUtils.pm b/CIAO/bin/PerlCIAO/TestUtils.pm
deleted file mode 100644
index 6cb4ca22fe7..00000000000
--- a/CIAO/bin/PerlCIAO/TestUtils.pm
+++ /dev/null
@@ -1,323 +0,0 @@
-
-#------------------------------------------------------------------------
-# class: TestUtils
-# Author: Stoyan Paunov
-#
-# Description: This is a class to help us write better and more manage-
-# able test utilities. Usually when creating a test in
-# CIAO it has to do with deploying a number of managers
-# and failure to deploy any process means failure of the
-# test. This test utility class takes care of the error
-# handling and clean-up and side of testing and allows
-# the test writer to concentrate on the core logic.
-# These are the main advantages of the TestUtils class:
-# --> Semi-Automatic error handling
-# --> Automatic process shutdown and clean-up
-# --> Semi-Automatic file (IOR) deletion
-# --> Location independent tests
-# --> Clean and concise code base
-# --> Manageable test utility suites
-#------------------------------------------------------------------------
-
-# class TestUtils
-sub new;
-sub DESTROY;
-sub cleanup;
-sub goto_dir;
-sub spawn;
-sub terminate;
-sub required_file;
-sub required_files;
-sub mark_file;
-sub mark_files;
-sub remove_file;
-sub remove_files;
-sub cleanup_files;
-sub cleanup_processes;
-
-package TestUtils;
-use PerlCIAO::TestUtils_Base;
-use strict;
-our @ISA = qw(TestUtils_Base); # inherits from TestUtils_Base
-
-use lib "$ENV{'ACE_ROOT'}/bin";
-use PerlACE::Run_Test;
-use Cwd;
-
-#------------------------------------------------------------------------
-# Constructor
-#------------------------------------------------------------------------
-sub new {
- my $class = shift;
-
- #call the constructor of the parent class, TestUtils_Base.
- my $self = $class->SUPER::new();
-
- $self->{_wd} = getcwd;
-
- bless $self, $class;
- return $self;
-}
-
-#------------------------------------------------------------------------
-# Destructor: performs clean-up
-#------------------------------------------------------------------------
-
-sub DESTROY {
- my $self = shift;
-
- #$self->cleanup (); check the CLEAN-UP description for explanation
-}
-
-#------------------------------------------------------------------------
-# Cleanup: This fuction kills the spawned processes and deletes the
-# marked files. Optionally, once the cleanup is done it will
-# cause the program to exit, iff an exit code is specified.
-#
-#
-# NOTE: You need to call the cleanup () although it is called
-# in the destructor because this class is a wrapper around
-# PerlACE::Run_Test which also keep some internal state
-# and tries to do some clean-up. However its destructor
-# is called before this one, and this results in some
-# errors.
-#------------------------------------------------------------------------
-
-sub cleanup {
- my $self = shift;
- my $exit_code = shift;
-
- print "Performing clean-up ...\n";
-
- $self->cleanup_files ();
- $self->cleanup_processes ();
-
- print "Cleanup = DONE\n";
-
- chdir $self->wd ();
-
- if (defined ($exit_code)) {
- exit ($exit_code);
- }
-}
-
-#------------------------------------------------------------------------
-# Goto_dir: This function allows you to change the current working
-# directory. Note that the class returns to the original
-# working directory upon exit.
-#------------------------------------------------------------------------
-
-#TODO: might want to push the dir to some stack
-sub goto_dir {
- my $self = shift;
- my $dir = shift;
-
- if (! (chdir $dir)) {
- print STDERR "Failed to change directory to: $dir";
- $self->cleanup ();
- }
-
-}
-
-#------------------------------------------------------------------------
-# Spawn: This function is used to spawn a process. It takes a descriptive
-# name under which it stores the process, the command line and the
-# arguments needed by the command. Optionally, you could specify
-# a timeout based on which the process would be spawned and if
-# it has not terminated after timeout seconds it will be killed.
-# If a failure occurs the function will perform clean-up and
-# terminate the program.
-#------------------------------------------------------------------------
-
-sub spawn {
- my $self = shift;
- my $name = shift;
- my $cmd = shift;
- my $args = shift;
- my $timeout = shift;
-
- if (!defined ($self->processes ())) {
- $self->{_processes} = {};
- }
-
- my $process = new PerlACE::Process ($cmd, $args);
-
- if (defined ($timeout)) {
- if ((my $ret = $process->SpawnWaitKill ($timeout)) == -1) {
- print STDERR "ERROR: Process $name returned $ret.\n";
- $self->cleanup (1);
- }
- }
- else {
- if ($process->Spawn () == -1) {
- $process->Kill ();
- #just in case, lets add it to the process list
- $self->processes->{$name} = $process;
- print STDERR "ERROR: Failure to spawn $name.\n";
- $self->cleanup (1);
- }
- }
-
- $self->processes->{$name} = $process;
- return $process;
-}
-
-#------------------------------------------------------------------------
-# Terminate: This function takes in the descriptive process name passed
-# to Spawn, looks up the process corresponding to it and
-# kills it.
-#------------------------------------------------------------------------
-
-sub terminate {
- my $self = shift;
- my $pname = shift;
-
- $self->processes ()->{$pname}->Kill ();
- $self->processes ()->{$pname}->TimedWait (1);
-
- print STDERR "$pname teminated!\n";
-}
-
-#------------------------------------------------------------------------
-# Required_file: This function checks if a required file is present in
-# the current working directory. If the file is missing
-# it performs cleanup and causes the program to exit.
-#------------------------------------------------------------------------
-
-sub required_file {
- my $self = shift;
- my $file = shift;
-
- if (PerlACE::waitforfile_timed
- ($file, $PerlACE::wait_interval_for_process_creation) == -1) {
-
- print STDERR
- "ERROR: Required file $file could not be found.\n";
-
- $self->cleanup (1);
- }
- return 1;
-}
-
-#------------------------------------------------------------------------
-# Required_filez: This function does the same as required_file above
-# except that it works on a reference (REF) to a list
-# of required files.
-#------------------------------------------------------------------------
-
-sub required_files {
- my $self = shift;
- my $files = shift;
- my $pname = shift;
-
- foreach my $file (@{$files}) {
-
- if (PerlACE::waitforfile_timed
- ($file, $PerlACE::wait_interval_for_process_creation) == -1) {
-
- print STDERR
- "ERROR: Required file $file could not be found.\n";
-
- $self->cleanup (1);
- }
- }
- return 1;
-}
-
-#------------------------------------------------------------------------
-# Mark_file: This function marks a file from the current working
-# directory for deletion. Once the file is marked it will be
-# deleted upon program termination. If the file cannot be
-# found, it is ignored.
-#------------------------------------------------------------------------
-
-sub mark_file {
- my $self = shift;
- my $file = shift;
-
- if (!defined $self->files ()) {
- $self->{_files} = [];
- }
-
- push @{$self->files ()}, $file;
-}
-
-#------------------------------------------------------------------------
-# Mark_filez: This function does the same as mark_file above except
-# that it works on a reference (REF) to an array/list of
-# required files.
-#------------------------------------------------------------------------
-
-sub mark_files {
- my $self = shift;
- my $files = shift;
-
- if (!defined $self->files ()) {
- $self->{_files} = [];
- }
-
- foreach my $file (@{$files}) {
- push @{$self->files ()}, $file;
- }
-}
-
-#------------------------------------------------------------------------
-# Remove_file: This fuction removes a file from the current working
-# directory. If the file is not there, it is ignored.
-#------------------------------------------------------------------------
-
-sub remove_file {
- my $self = shift;
- my $file = shift;
-
- my $path = PerlACE::LocalFile ($file);
- unlink $path;
-}
-
-#------------------------------------------------------------------------
-# Remove_filez: This fuction removes a list of file from the current
-# working directory. It takes a REF of a list of files
-# and ignores files which are not found.
-#------------------------------------------------------------------------
-
-sub remove_files {
- my $self = shift;
- my $files = shift;
-
- foreach my $file (@{$files}) {
- my $path = PerlACE::LocalFile ($file);
- unlink $path;
- }
-}
-
-#------------------------------------------------------------------------
-# Cleanup_files: clean us the files :)
-#------------------------------------------------------------------------
-
-sub cleanup_files {
- my $self = shift;
-
- if (defined ($self->files ())) {
- foreach my $file (@{$self->files ()}) {
- $self->remove_file ($file);
- }
- }
-}
-
-#------------------------------------------------------------------------
-# Cleanup_processes: clean us the processes :)
-#------------------------------------------------------------------------
-
-sub cleanup_processes {
- my $self = shift;
-
- if (defined ($self->processes ())) {
- foreach my $pname ( keys %{$self->processes ()}) {
- $self->terminate ($pname);
- delete ($self->processes ()->{$pname});
- }
- }
-}
-
-#return value of the class
-1; \ No newline at end of file
diff --git a/CIAO/bin/PerlCIAO/TestUtils_Base.pm b/CIAO/bin/PerlCIAO/TestUtils_Base.pm
deleted file mode 100644
index be0726946c9..00000000000
--- a/CIAO/bin/PerlCIAO/TestUtils_Base.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-#File generated by C:\ACE_wrappers_devel\ACE_wrappers\TAO\CIAO\bin\PerlCIAO\generate_container.pl.
-#Input file: TestUtils.base.
-#Code generator author: Stoyan Paunov
-#
-
-#class TestUtils_Base
-package TestUtils_Base;
-use strict;
-
-#Class constructor :)
-sub new {
- my ($class) = @_;
-
- #Create a reference to an anonymous hash
- my $self = {
- _processes => undef,
- _files => undef,
- _wd => undef
- };
-
- #Bless the hash.
- bless $self, $class;
- return $self;
-}
-
-#accessor/mutator method for processes
-sub processes {
- my ( $self, $processes ) = @_;
-
- $self->{_processes} = $processes
- if defined ($processes);
-
- return $self->{_processes};
-}
-
-#accessor/mutator method for files
-sub files {
- my ( $self, $files ) = @_;
-
- $self->{_files} = $files
- if defined ($files);
-
- return $self->{_files};
-}
-
-#accessor/mutator method for wd
-sub wd {
- my ( $self, $wd ) = @_;
-
- $self->{_wd} = $wd
- if defined ($wd);
-
- return $self->{_wd};
-}
-
-#print method for the class
-sub print {
- my ($self) = @_;
-
- my $f;
-
- $f = defined ($self->{_processes})
- ? $self->{_processes} : "not defined";
- printf ("processes: %s\n", $f);
-
- $f = defined ($self->{_files})
- ? $self->{_files} : "not defined";
- printf ("files: %s\n", $f);
-
- $f = defined ($self->{_wd})
- ? $self->{_wd} : "not defined";
- printf ("wd: %s\n", $f);
-
-}
-
-#class return value
-1;
-
diff --git a/CIAO/bin/PerlCIAO/generate_container.pl b/CIAO/bin/PerlCIAO/generate_container.pl
deleted file mode 100644
index c56c03ea300..00000000000
--- a/CIAO/bin/PerlCIAO/generate_container.pl
+++ /dev/null
@@ -1,126 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id$
-#
-# The above line is for compatibility /w Linux. Windows uses the .pl extension.
-# Author: Stoyan Paunov
-# Purpose: Generate a container class with mutator/accessor methods
-# The idea is to use this class as a base class in the
-# inheritance hierarchy. This way we can evolve the base
-# container independently from the rest of the code!
-#
-
-use strict;
-
-die "Usage: $0 <module name> <field description file>\n"
- if not defined $ARGV[0];
-
-die "Usage: $0 <module name> <field description file>\n"
- if not defined $ARGV[1];
-
-my $module_name = $ARGV[0];
-my $fields = $ARGV[1];
-
-open (FIELDS, $fields) or die "Failed opening $fields\n";
-
-my @fields = <FIELDS>;
-close FIELDS;
-
-my $field;
-
-print "\#File generated by $0.\n";
-print "\#Input file: $fields.\n";
-print "\#Code generator author: Stoyan Paunov\n\#\n\n";
-
-print "\#class $module_name\n";
-print "package $module_name;\n";
-print "use strict;\n\n";
-print "\#Class constructor :)\n";
-print "sub new {\n";
-print " my (\$class) = \@_;\n\n";
-print " \#Create a reference to an anonymous hash\n";
-print " my \$self = {\n";
-
-my $count = 0;
-my $end = $#fields;
-
-#generate initialization code
-foreach $field (@fields)
-{
- if ($field =~ /^$/ ) # empty line
- {
- next;
- }
-
- chomp ($field);
-
- if ($count == $end)
- {
- printf (" _\%-14s => undef\n", $field);
- next;
- }
- printf (" _\%-14s => undef,\n", $field);
-
-
- $count++
-}
-
-print " };\n\n";
-print " \#Bless the hash.\n";
-print " bless \$self, \$class;\n";
-print " return \$self;\n";
-print "}\n\n";
-
-#Code to generate the accessor and mutator
-
-foreach $field (@fields)
-{
- if ($field =~ /^$/ ) # empty line
- {
- next;
- }
-
- chomp ($field);
-
- print "\#accessor/mutator method for $field\n";
- print "sub $field {\n";
- print " my ( \$self, \$$field ) = \@_;\n\n";
- print " \$self->{_$field} = \$$field\n";
- print " if defined (\$$field);\n\n";
- print " return \$self->{_$field};\n";
- print "}\n\n";
-
-}
-
-
-print "\#print method for the class\n";
-print "sub print {\n";
-print " my (\$self) = \@_;\n\n";
-
-print " my \$f;\n\n";
-
-#Code to generate a print method which dumps the object state
-foreach $field (@fields)
-{
- if ($field =~ /^$/ ) # empty line
- {
- next;
- }
-
- chomp ($field);
- print " \$f = defined (\$self->{_$field}) \n";
- print " ? \$self->{_$field} : \"not defined\";\n";
- print " printf (\"$field: %s\\n\", \$f);\n\n";
-
-}
-
-
-
-print "}\n\n";
-
-print "\#class return value \n1;\n\n";
-
-
-
-
-
diff --git a/CIAO/bin/PerlCIAO/perlciao.mpc b/CIAO/bin/PerlCIAO/perlciao.mpc
deleted file mode 100644
index f596034eab3..00000000000
--- a/CIAO/bin/PerlCIAO/perlciao.mpc
+++ /dev/null
@@ -1,9 +0,0 @@
-
-// $Id$
-
-project(PerlCIAO) : script {
- Script_Files {
- TestUtils.pm
- TestUtils_Base.pm
- }
-}
View Lorry Controller Status