src/Testing/TestSuite.pm

#____________________________________________________________________ 
# File: TestSuite.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2005-08-17 15:49:06+0200
# Revision: $Id: TestSuite.pm,v 1.1 2005/08/17 14:31:41 sashby Exp $ 
#
# Copyright: 2005 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package TestSuite;

=head1 NAME

TestSuite - A package to contain testing routines for each SCRAM command.

=head1 SYNOPSIS

        my $obj = TestSuite->new();
        $obj->run();
        $obj->statusreport();

=head1 DESCRIPTION

A testing utility. This runs the installed scram script B<scram.pl> using
B<system()>, passing whichever arguments are needed. Each command has a
self-contained set of tests in its own subroutine in this package to fully
exercise all supported options.

This package is used only by the test script B<testsuite.pl> found in the
Testing directory.

When a new command or command option is introduced, a subroutine in this package
must be created (or modified, if an option is added) to define a test.

=head1 METHODS

=over

=cut

require 5.004;
use Exporter;
use Installation::SCRAM_SITE;
use SCRAM::SCRAM;
use Cwd;

@ISA=qw(Exporter);
@EXPORT_OK=qw( );


sub new()
   {
   ###############################################################
   # new                                                         #
   ###############################################################
   # modified : Wed Aug 17 15:49:14 2005 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my $self={};
   bless $self,$class;
   $self->{TESTREPORT}={};
   $self->{SCRAM} = SCRAM::SCRAM->new();
   $self->{COMMANDS} = $self->{SCRAM}->commands();
   $self->{SCRAMMAIN} = $ENV{'SCRAM_HOME'}."/src/main/scram.pl";

   # Check to make sure that SCRAM installation has already been done:
   die "SCRAM TestSuite: Unable to find the installed scram script!","\n"
      if (! -f $self->{SCRAMMAIN});
   $self->init_();
   return $self;
   }

sub init_()
   {
   my $self=shift;
   
   # Set up parameters needed for the tests:
   my $SANDBOX=cwd()."/SandBoxForTestSuite";
   # Get rid of existing dir:
   if ( -d $SANDBOX )
      {
      system("rm","-rf",$SANDBOX);      
      }
   
   # Create new sandbox:
   mkdir($SANDBOX);
   $self->{WORKDIR} = $SANDBOX;
   chdir($self->{WORKDIR});
   $self->{PROJECTNAME} = "SCRAMTestSuite";
   $self->{PROJECTVERSION} = "1.0";
   $SELF->{PROJECTINSTALLNAME} = "SCRAMtsdev";
   
   }

sub run()
   {
   my $self=shift;
   map { print "-> Running test for \"".$_."\" command\n\n"; $self->$_(); }
   @{$self->{COMMANDS}};
   }

sub statusreport()
   {
   my $self=shift;
   print "\n";
   foreach my $cmd (keys %{$self->{TESTREPORT}})
      {
      print "Report for ".uc($cmd)." tests:","\n";

      foreach my $detail (@{$self->{TESTREPORT}->{$cmd}})
         {
         print "\t".$detail->[0]." (status = ".$detail->[1].")","\n";
         }
      print "\n";
      }
   
   }

sub log()
   {
   my $self=shift;
   my ($cmd,$message,$status)=@_;

   if (exists($self->{TESTREPORT}->{$cmd}))
      {
      push(@{$self->{TESTREPORT}->{$cmd}},[ $message, $status ]);
      }
   else
      {
      $self->{TESTREPORT}->{$cmd} = [ [ $message, $status ] ];
      }
   }


#### Command Routines ####
sub version()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"version","-h");
   $self->log("version","Test of help functionality", $status);
   my $status = system($self->{SCRAMMAIN},"version","-c");
   $self->log("version","Test of \"-c\" argument", $status);
   my $status = system($self->{SCRAMMAIN},"version","-i");
   $self->log("version","Test of \"-i\" argument", $status);
   }

sub arch()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"arch","-h");
   $self->log("arch","Test of help functionality", $status);
   my $status = system($self->{SCRAMMAIN},"-arch","TEST_ARCHITECTURE","arch");
   $self->log("arch","Test of -arch argument", $status);
   }

sub urlget()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"urlget","-h");
   $self->log("urlget","Test of help functionality", $status);
   }

sub list()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"list","-h");
   $self->log("list","Test of help functionality", $status);

      
   $ENV{SCRAM_USERLOOKUPDB} = "";
   }

sub db()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"db","-h");
   $self->log("db","Test of help functionality", $status);

   
   }


sub project()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"project","-h");
   $self->log("project","Test of help functionality", $status);


   # Create a new project:

   # Install it:

   # Create a developer area, rename it, install it in a different directory:

   # Remove project from database:
   

   }

sub runtime()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"runtime","-h");
   $self->log("runtime","Test of help functionality", $status);


   }

sub config()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"config","-h");
   $self->log("config","Test of help functionality", $status);

   
   }

sub setup()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"setup","-h");
   $self->log("setup","Test of help functionality", $status);   
   }

sub tool()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"tool","-h");
   $self->log("tool","Test of help functionality", $status);   

   }

sub ui()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"ui","-h");
   $self->log("ui","Test of help functionality", $status);   
   }

sub build()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"build","-h");
   $self->log("build","Test of help functionality", $status);   
   }

sub xmlmigrate()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"xmlmigrate","-h");
   $self->log("xmlmigrate","Test of help functionality", $status);   
   }

sub install()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"install","-h");
   $self->log("install","Test of help functionality", $status);
   }

sub remove()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"remove","-h");
   $self->log("remove","Test of help functionality", $status);
   }


1;

__END__


=back

=head1 AUTHOR/MAINTAINER

Shaun Ashby

=cut

Revision:	1.2
Committed:	Wed Aug 17 16:00:43 2005 UTC (19 years, 8 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.1:	+125 -11 lines
Log Message:	Added some files for test suite- dummy config, toolbox
#	User	Rev	Content
1	sashby	1.1	#____________________________________________________________________
2			# File: TestSuite.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2005-08-17 15:49:06+0200
7	sashby	1.2	# Revision: $Id: TestSuite.pm,v 1.1 2005/08/17 14:31:41 sashby Exp $
8	sashby	1.1	#
9			# Copyright: 2005 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package TestSuite;
13
14			=head1 NAME
15
16			TestSuite - A package to contain testing routines for each SCRAM command.
17
18			=head1 SYNOPSIS
19
20			my $obj = TestSuite->new();
21			$obj->run();
22			$obj->statusreport();
23
24			=head1 DESCRIPTION
25
26			A testing utility. This runs the installed scram script B<scram.pl> using
27			B<system()>, passing whichever arguments are needed. Each command has a
28			self-contained set of tests in its own subroutine in this package to fully
29			exercise all supported options.
30
31			This package is used only by the test script B<testsuite.pl> found in the
32			Testing directory.
33
34			When a new command or command option is introduced, a subroutine in this package
35			must be created (or modified, if an option is added) to define a test.
36
37			=head1 METHODS
38
39			=over
40
41			=cut
42
43			require 5.004;
44			use Exporter;
45			use Installation::SCRAM_SITE;
46			use SCRAM::SCRAM;
47	sashby	1.2	use Cwd;
48	sashby	1.1
49			@ISA=qw(Exporter);
50			@EXPORT_OK=qw( );
51
52
53			sub new()
54			{
55			###############################################################
56			# new #
57			###############################################################
58			# modified : Wed Aug 17 15:49:14 2005 / SFA #
59			# params : #
60			# : #
61			# function : #
62			# : #
63			###############################################################
64			my $proto=shift;
65			my $class=ref($proto) \|\| $proto;
66			my $self={};
67			bless $self,$class;
68	sashby	1.2	$self->{TESTREPORT}={};
69	sashby	1.1	$self->{SCRAM} = SCRAM::SCRAM->new();
70			$self->{COMMANDS} = $self->{SCRAM}->commands();
71			$self->{SCRAMMAIN} = $ENV{'SCRAM_HOME'}."/src/main/scram.pl";
72
73			# Check to make sure that SCRAM installation has already been done:
74			die "SCRAM TestSuite: Unable to find the installed scram script!","\n"
75			if (! -f $self->{SCRAMMAIN});
76	sashby	1.2	$self->init_();
77			return $self;
78			}
79
80			sub init_()
81			{
82			my $self=shift;
83
84			# Set up parameters needed for the tests:
85			my $SANDBOX=cwd()."/SandBoxForTestSuite";
86			# Get rid of existing dir:
87			if ( -d $SANDBOX )
88			{
89			system("rm","-rf",$SANDBOX);
90			}
91
92			# Create new sandbox:
93			mkdir($SANDBOX);
94			$self->{WORKDIR} = $SANDBOX;
95			chdir($self->{WORKDIR});
96			$self->{PROJECTNAME} = "SCRAMTestSuite";
97			$self->{PROJECTVERSION} = "1.0";
98			$SELF->{PROJECTINSTALLNAME} = "SCRAMtsdev";
99	sashby	1.1
100			}
101
102			sub run()
103			{
104			my $self=shift;
105	sashby	1.2	map { print "-> Running test for \"".$_."\" command\n\n"; $self->$_(); }
106	sashby	1.1	@{$self->{COMMANDS}};
107			}
108
109			sub statusreport()
110			{
111			my $self=shift;
112	sashby	1.2	print "\n";
113			foreach my $cmd (keys %{$self->{TESTREPORT}})
114			{
115			print "Report for ".uc($cmd)." tests:","\n";
116
117			foreach my $detail (@{$self->{TESTREPORT}->{$cmd}})
118			{
119			print "\t".$detail->[0]." (status = ".$detail->[1].")","\n";
120			}
121			print "\n";
122			}
123
124	sashby	1.1	}
125
126	sashby	1.2	sub log()
127			{
128			my $self=shift;
129			my ($cmd,$message,$status)=@_;
130
131			if (exists($self->{TESTREPORT}->{$cmd}))
132			{
133			push(@{$self->{TESTREPORT}->{$cmd}},[ $message, $status ]);
134			}
135			else
136			{
137			$self->{TESTREPORT}->{$cmd} = [ [ $message, $status ] ];
138			}
139			}
140
141
142			#### Command Routines ####
143	sashby	1.1	sub version()
144			{
145			my $self=shift;
146	sashby	1.2	my $status = system($self->{SCRAMMAIN},"version","-h");
147			$self->log("version","Test of help functionality", $status);
148			my $status = system($self->{SCRAMMAIN},"version","-c");
149			$self->log("version","Test of \"-c\" argument", $status);
150			my $status = system($self->{SCRAMMAIN},"version","-i");
151			$self->log("version","Test of \"-i\" argument", $status);
152	sashby	1.1	}
153
154			sub arch()
155			{
156			my $self=shift;
157	sashby	1.2	my $status = system($self->{SCRAMMAIN},"arch","-h");
158			$self->log("arch","Test of help functionality", $status);
159			my $status = system($self->{SCRAMMAIN},"-arch","TEST_ARCHITECTURE","arch");
160			$self->log("arch","Test of -arch argument", $status);
161	sashby	1.1	}
162
163	sashby	1.2	sub urlget()
164	sashby	1.1	{
165			my $self=shift;
166	sashby	1.2	my $status = system($self->{SCRAMMAIN},"urlget","-h");
167			$self->log("urlget","Test of help functionality", $status);
168	sashby	1.1	}
169
170	sashby	1.2	sub list()
171	sashby	1.1	{
172			my $self=shift;
173	sashby	1.2	my $status = system($self->{SCRAMMAIN},"list","-h");
174			$self->log("list","Test of help functionality", $status);
175
176
177			$ENV{SCRAM_USERLOOKUPDB} = "";
178	sashby	1.1	}
179
180	sashby	1.2	sub db()
181	sashby	1.1	{
182			my $self=shift;
183	sashby	1.2	my $status = system($self->{SCRAMMAIN},"db","-h");
184			$self->log("db","Test of help functionality", $status);
185
186
187
188	sashby	1.1	}
189
190	sashby	1.2
191
192
193
194			sub project()
195	sashby	1.1	{
196			my $self=shift;
197	sashby	1.2	my $status = system($self->{SCRAMMAIN},"project","-h");
198			$self->log("project","Test of help functionality", $status);
199
200
201			# Create a new project:
202
203			# Install it:
204
205			# Create a developer area, rename it, install it in a different directory:
206
207			# Remove project from database:
208
209
210	sashby	1.1	}
211
212	sashby	1.2	sub runtime()
213	sashby	1.1	{
214			my $self=shift;
215	sashby	1.2	my $status = system($self->{SCRAMMAIN},"runtime","-h");
216			$self->log("runtime","Test of help functionality", $status);
217
218
219	sashby	1.1	}
220
221	sashby	1.2	sub config()
222	sashby	1.1	{
223			my $self=shift;
224	sashby	1.2	my $status = system($self->{SCRAMMAIN},"config","-h");
225			$self->log("config","Test of help functionality", $status);
226
227
228	sashby	1.1	}
229
230			sub setup()
231			{
232			my $self=shift;
233	sashby	1.2	my $status = system($self->{SCRAMMAIN},"setup","-h");
234			$self->log("setup","Test of help functionality", $status);
235	sashby	1.1	}
236
237			sub tool()
238			{
239			my $self=shift;
240	sashby	1.2	my $status = system($self->{SCRAMMAIN},"tool","-h");
241			$self->log("tool","Test of help functionality", $status);
242
243	sashby	1.1	}
244
245			sub ui()
246			{
247			my $self=shift;
248	sashby	1.2	my $status = system($self->{SCRAMMAIN},"ui","-h");
249			$self->log("ui","Test of help functionality", $status);
250	sashby	1.1	}
251
252			sub build()
253			{
254			my $self=shift;
255	sashby	1.2	my $status = system($self->{SCRAMMAIN},"build","-h");
256			$self->log("build","Test of help functionality", $status);
257	sashby	1.1	}
258
259			sub xmlmigrate()
260			{
261			my $self=shift;
262	sashby	1.2	my $status = system($self->{SCRAMMAIN},"xmlmigrate","-h");
263			$self->log("xmlmigrate","Test of help functionality", $status);
264	sashby	1.1	}
265
266			sub install()
267			{
268			my $self=shift;
269	sashby	1.2	my $status = system($self->{SCRAMMAIN},"install","-h");
270			$self->log("install","Test of help functionality", $status);
271	sashby	1.1	}
272
273			sub remove()
274			{
275	sashby	1.2	my $self=shift;
276			my $status = system($self->{SCRAMMAIN},"remove","-h");
277			$self->log("remove","Test of help functionality", $status);
278	sashby	1.1	}
279
280
281			1;
282
283			__END__
284
285
286			=back
287
288			=head1 AUTHOR/MAINTAINER
289
290			Shaun Ashby
291
292			=cut
293