ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/Scram/ScramFunctions.pm

Comparing COMP/SCRAM/src/Scram/ScramFunctions.pm (file contents):
Revision 1.8 by williamc, Thu Sep 21 13:44:26 2000 UTC vs.
Revision 1.21 by sashby, Tue May 21 10:57:34 2002 UTC

#	Line 19 | Line 19
19		# setuptoolsinarea($area[,$toolname[,$toolversion[,toolfile]) : setup
20		# arch()                : get/set the architecture string
21		# scramobjectinterface(Class)  : print out the interface of a scram class
22	<	# webget(area,url)      : get the url into the cache of the specified area
22	>	# webget(area,url)      : get the url into the cache of the specified area
23		# getversion()          : return the current scram version
24		# spawnversion(version,@args) : spawn the scram version with the given args
25	+	# classverbose(classstring,setting) : Set the class verbosity level
26	+	# toolruntime(ConfigArea): Get a runtime object withthe settings from
27	+	#                          the specified toolbox
28
29		package Scram::ScramFunctions;
30		use URL::URLcache;
#	Line 30 | Line 33 | require 5.004;
33
34		@ISA=qw(Utilities::Verbose);
35
36	<	sub new {
36	>	sub new
37	>	{
38	>	my $class=shift;
39	>	$self={};
40	>	bless $self, $class;
41	>	# -- default settings
42	>	$self->{cachedir}=$ENV{HOME}."/.scramrc/globalcache";
43	>	$self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
44	>	($self->{scram_top})=( $ENV{SCRAM_HOME}=~/(.*)\//) ;
45	>
46	>	return $self;
47	>	}
48	>
49	>	sub classverbose {
50	>	my $self=shift;
51		my $class=shift;
52	<	$self={};
36	<	bless $self, $class;
37	<	# -- default settings
38	<	$self->{cachedir}=$ENV{HOME}."/.scramrc/globalcache";
39	<	$self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
40	<	($self->{scram_top})=( $ENV{SCRAM_HOME}=~/(.*)\//) ;
52	>	my $val=shift;
53
54	<	return $self;
54	>	$ENV{"VERBOSE_".$class}=$val;
55		}
56
57		sub project {
#	Line 70 | Line 82 | sub project {
82		return $area;
83		}
84
85	<	sub setuptoolsinarea {
86	<	my $self=shift;
87	<	my $area=shift;
88	<
89	<	# -- initialise
90	<	$self->_allprojectinitsearcher();
91	<
92	<	# -- create a new toolbox object
93	<	my $toolbox=$self->areatoolbox($area);
94	<	$toolbox->searcher($self->_projsearcher());
95	<
96	<	if ( @_ ) {
97	<	# -- specific tool specified
98	<	if ( my $rv=$toolbox->toolsetup(@_) ) {
99	<	if ( $rv eq 1 ) {
100	<	print "Unknown tool $toolname @ARGV\n";
101	<	exit 1;
102	<	}
103	<	}
104	<	}
105	<	else {
106	<	# -- setup all tools specified in the requirements doc
107	<	my $reqs=$self->arearequirements($area);
108	<	$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
109	<	$reqs->setup($toolbox);
110	<	}
111	<	}
85	>	sub setuptoolsinarea
86	>	{
87	>	my $self=shift;
88	>	my $area=shift;
89	>
90	>	# -- initialise
91	>	print "Initialising setup procedure......","\n";
92	>	$self->_allprojectinitsearcher();
93	>
94	>	# -- create a new toolbox object
95	>	my $toolbox=$self->areatoolbox($area);
96	>	$toolbox->searcher($self->_allprojectinitsearcher());
97	>
98	>	if ( @_ )
99	>	{
100	>	# -- specific tool specified
101	>	if ( my $rv=$toolbox->toolsetup(@_) )
102	>	{
103	>	if ( $rv eq 1 )
104	>	{
105	>	print "Unknown tool $toolname @ARGV\n";
106	>	exit 1;
107	>	}
108	>	}
109	>	}
110	>	else
111	>	{
112	>	# -- setup all tools specified in the requirements doc
113	>	print "Going to set up all tools....","\n\n";
114	>	my $reqs=$self->arearequirements($area);
115	>	$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
116	>	# reqs is a BuildSystem::Requirements object:
117	>	$reqs->setup($toolbox);
118	>	}
119	>	}
120
121		sub satellite {
122		my $self=shift;
#	Line 124 | Line 144 | sub satellite {
144		my $area=$relarea->satellite($installarea,$areaname);
145		$area->archname($self->arch());
146
127	–	# -- copy setup info - deprecated by toolbox copy method
128	–	#$relarea->copysetup($area->location());
129	–
147		# -- copy toolbox
148		my $rtb=$self->areatoolbox($relarea);
149		my $tb=$self->areatoolbox($area);
#	Line 148 | Line 165 | sub satellite {
165		return $area;
166		}
167
168	<	sub webget {
168	>	sub toolruntime {
169		my $self=shift;
170		my $area=shift;
154	–	my $url=shift;
171
172	<	my $handler=URL::URLhandler->new($area->cache());
173	<	return ($handler->get($url));
172	>	my $name=$area->location();
173	>	if ( ! defined $self->{toolruntime}{$name} ) {
174	>	require Runtime;
175	>	my $toolbox=$self->areatoolbox($area);
176	>	$self->{toolruntime}{$name}=Runtime->new();
177	>
178	>	# -- add scram area specific runtimes
179	>	$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
180	>	$area->location()."/lib/".$self->arch(),"path");
181	>	$self->{toolruntime}{$name}->addvar("PATH",
182	>	$area->location()."/bin/".$self->arch(),"path");
183	>	if ( defined $area->linkarea() ) {
184	>	my $reltop=$area->linkarea()->location();
185	>	$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
186	>	$reltop."/lib/".$self->arch(),"path");
187	>	$self->{toolruntime}{$name}->addvar("PATH",
188	>	$reltop."/bin/".$self->arch(),"path");
189	>	}
190	>
191	>	# -- get the runtime environment from all the tools
192	>	my $tool;
193	>	foreach $toolname ( $toolbox->tools() ) {
194	>	$tool=$toolbox->gettool($toolname);
195	>	if ( defined $tool ) {
196	>	# -- get runtime paths
197	>	foreach $f ( $tool->listtype("runtime_path")) {
198	>	foreach $val ( $tool->getfeature($f) ) {
199	>	$self->{toolruntime}{$name}->addvar($f,$val,"path");
200	>	}
201	>	}
202	>	# -- get runtime vars
203	>	foreach $f ( $tool->listtype("runtime")) {
204	>	foreach $val ( $tool->getfeature($f) ) {
205	>	$self->{toolruntime}{$name}->addvar($f,$val);
206	>	}
207	>	}
208	>	}
209	>	}
210	>
211	>	# -- Get the project level environment
212	>	my $runtimefile=$area->location()."/".$area->configurationdir()
213	>	."/Runtime";
214	>	if ( -f $runtimefile ) {
215	>	$self->{toolruntime}{$name}->file($runtimefile);
216	>	}
217	>	}
218	>	return $self->{toolruntime}{$name};
219	>	}
220	>
221	>	sub webget {
222	>	my $self=shift;
223	>	my $area=shift;
224	>	my $url=shift;
225	>
226	>	require URL::URLhandler;
227	>	my $handler=URL::URLhandler->new($area->cache());
228	>	return ($handler->download($url));
229		}
230
231		sub addareatoDB {
#	Line 175 | Line 246 | sub addareatoDB {
246		$self->scramprojectdb()->addarea($tagname,$version,$area);
247		}
248
178	–	sub spawnversion {
179	–	my $self=shift;
180	–	my $version=shift;
249
250	<	my $rv=0;
251	<	my $thisversion=$self->getversion();
252	<	if ( defined $version ) {
253	<	if ( $version ne $thisversion ) {
254	<	# first try to use the correct version
255	<	if ( -d $self->{scram_top}."/".$version ) {
256	<	$ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
257	<	$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
258	<	$self->verbose("Spawning SCRAM version $version");
259	<	my $rv=system("scram", @_)/256;
260	<	exit $rv;
261	<	}
262	<	else { # if not then simply warn
263	<	print "******* Warning : scram version inconsistent ********\n";
264	<	print "This version: $thisversion; Required version: $version\n";
265	<	print "*****************************************************\n";
266	<	print "\n";
267	<	}
268	<	}
269	<	}
270	<	else {
271	<	$self->error("Undefined value for version requested");
272	<	$rv=1;
273	<	}
274	<	return $rv;
275	<	}
250	>	sub removeareafromDB
251	>	{
252	>	###############################################################
253	>	# removearefromDB()                                           #
254	>	###############################################################
255	>	# modified : Thu Jun 14 10:46:22 2001 / SFA                   #
256	>	# params   : projectname, projectversion                      #
257	>	#          :                                                  #
258	>	#          :                                                  #
259	>	#          :                                                  #
260	>	# function : Remove project <projectname> from DB file.       #
261	>	#          :                                                  #
262	>	#          :                                                  #
263	>	###############################################################
264	>	my $self=shift;
265	>	my $projname=shift;
266	>	my $version=shift;
267	>
268	>	# -- Remove from the DB:
269	>	$self->scramprojectdb()->removearea($projname,$version);
270	>	}
271	>
272	>
273	>	sub spawnversion
274	>	{
275	>	###############################################################
276	>	# spawnversion                                                #
277	>	###############################################################
278	>	# modified : Fri Aug 10 15:42:08 2001 / SFA                   #
279	>	# params   :                                                  #
280	>	#          :                                                  #
281	>	#          :                                                  #
282	>	#          :                                                  #
283	>	# function : Check for version of scram to run, and run it.   #
284	>	#          :                                                  #
285	>	#          :                                                  #
286	>	###############################################################
287	>
288	>	my $self=shift;
289	>	my $version=shift;
290	>	my $rv=0;
291	>
292	>	my $thisversion=$self->getversion();
293	>
294	>	if ( defined $version )
295	>	{
296	>	if ( $version ne $thisversion )
297	>	{
298	>	# first try to use the correct version
299	>	if ( -d $self->{scram_top}."/".$version )
300	>	{
301	>	$ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
302	>	$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
303	>	$self->verbose("Spawning SCRAM version $version");
304	>	my $rv=system("scram", @_)/256;
305	>	exit $rv;
306	>	}
307	>	else
308	>	{
309	>	# if not then simply warn. Send output to STDERR:
310	>	if ( -t STDERR )
311	>	{
312	>	print STDERR "******* Warning : scram version inconsistent ********\n";
313	>	print STDERR "This version: $thisversion; Required version: $version\n";
314	>	print STDERR "*****************************************************\n";
315	>	print STDERR "\n";
316	>	}
317	>	}
318	>	}
319	>	}
320	>	else
321	>	{
322	>	$self->error("Undefined value for version requested");
323	>	$rv=1;
324	>	}
325	>	return $rv;
326	>	}
327
328		sub globalcache {
329		my $self=shift;
#	Line 296 | Line 415 | sub arch {
415		}
416
417		sub scramobjectinterface {
418	<	my $self=shift;
419	<	my $class=shift;
418	>	my $self=shift;
419	>	my $class=shift;
420
421	<	my $file;
422	<	($file=$class."\.pm")=~s/::/\//g;
423	<	$file=$ENV{TOOL_HOME}."/".$file;
421	>	my $file;
422	>	($file=$class."\.pm")=~s/::/\//g;
423	>	$file=$ENV{TOOL_HOME}."/".$file;
424
425	<	if ( ! -f $file ) {
426	<	$self->error("Unable to find $class in ".$ENV{TOOL_HOME});
427	<	}
428	<	print "--------------------- $class ------------------\n";
429	<	my $fh=FileHandle->new();
425	>	if ( ! -f $file ) {
426	>	$self->error("Unable to find $class in ".$ENV{TOOL_HOME});
427	>	}
428	>	print "--------------------- $class ------------------\n";
429	>	my $fh=FileHandle->new();
430		$fh->open("<$file");
431		while ( <$fh> ) {
432		if ( $_=~/#\s*Interface/g ) {
#	Line 331 | Line 450 | sub scramobjectinterface {
450		}
451		}
452		print "\n";
453	<	undef $fh;
453	>	undef $fh;
454		}
455
456		# -------------- Support Routines ------------------------------
#	Line 344 | Line 463 | sub _allprojectinitsearcher {
463		$search->addproject($$proj[0],$$proj[1]);
464		}
465		}
466	+	return $self->{projsearcher};
467		}
468
469		sub _projsearcher {

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines