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.4 by williamc, Wed Aug 30 09:47:39 2000 UTC vs.
Revision 1.18 by sashby, Thu Nov 15 21:18:16 2001 UTC

#	Line 18 | Line 18
18		# areatoolbox(ConfigArea) : return the toolbox of the specified area
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
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 26 | 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={};
53	<	bless $self, $class;
54	<	# -- default settings
34	<	$self->{cachedir}=$ENV{HOME}."/.SCRAM/globalcache";
35	<	$self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
36	<	return $self;
52	>	my $val=shift;
53	>
54	>	$ENV{"VERBOSE_".$class}=$val;
55		}
56
57		sub project {
#	Line 64 | 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 118 | Line 144 | sub satellite {
144		my $area=$relarea->satellite($installarea,$areaname);
145		$area->archname($self->arch());
146
121	–	# -- copy setup info - deprecated by toolbox copy method
122	–	#$relarea->copysetup($area->location());
123	–
147		# -- copy toolbox
148		my $rtb=$self->areatoolbox($relarea);
149		my $tb=$self->areatoolbox($area);
#	Line 142 | Line 165 | sub satellite {
165		return $area;
166		}
167
168	+	sub toolruntime {
169	+	my $self=shift;
170	+	my $area=shift;
171	+
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 {
232		my $self=shift;
233		my $area=shift;
#	Line 160 | Line 246 | sub addareatoDB {
246		$self->scramprojectdb()->addarea($tagname,$version,$area);
247		}
248
249	+
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	+
305	+	my $rv=system("scram", @_)/256;
306	+	exit $rv;
307	+	}
308	+	else
309	+	{ # if not then simply warn
310	+	print "******* Warning : scram version inconsistent ********\n";
311	+	print "This version: $thisversion; Required version: $version\n";
312	+	print "*****************************************************\n";
313	+	print "\n";
314	+	}
315	+	}
316	+	}
317	+	else
318	+	{
319	+	$self->error("Undefined value for version requested");
320	+	$rv=1;
321	+	}
322	+	return $rv;
323	+	}
324	+
325		sub globalcache {
326		my $self=shift;
327		if ( @_ ) {
#	Line 185 | Line 347 | sub scramprojectdb {
347		}
348		return $self->{scramprojectsdb};
349		}
350	+
351	+	sub getversion {
352	+	my $self=shift;
353	+
354	+	my $thisversion;
355	+	($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
356	+	my $scram_top=$1;
357	+	my $scram_version=$thisversion;
358	+	# deal with links
359	+	my $version=readlink $ENV{SCRAM_HOME};
360	+	if ( defined $version)  {
361	+	$scram_version=$version;
362	+	}
363	+	return $scram_version;
364	+	}
365
366		sub areatoolbox {
367		my $self=shift;
#	Line 194 | Line 371 | sub areatoolbox {
371		if ( ! defined $self->{toolboxes}{$name} ) {
372		# -- create a new toolbox object
373		require BuildSystem::ToolBox;
374	<	$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
374	>	$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
375	>	$self->arch());
376		$self->{toolboxes}{$name}->verbosity($self->verbosity());
377		}
378		return $self->{toolboxes}{$name};
#	Line 233 | Line 411 | sub arch {
411		:$self->{arch};
412		}
413
414	+	sub scramobjectinterface {
415	+	my $self=shift;
416	+	my $class=shift;
417	+
418	+	my $file;
419	+	($file=$class."\.pm")=~s/::/\//g;
420	+	$file=$ENV{TOOL_HOME}."/".$file;
421	+
422	+	if ( ! -f $file ) {
423	+	$self->error("Unable to find $class in ".$ENV{TOOL_HOME});
424	+	}
425	+	print "--------------------- $class ------------------\n";
426	+	my $fh=FileHandle->new();
427	+	$fh->open("<$file");
428	+	while ( <$fh> ) {
429	+	if ( $_=~/#\s*Interface/g ) {
430	+	$intregion=1;
431	+	next;
432	+	}
433	+	if ( $intregion ) { # if we are in the interface documentation
434	+	if ( ( $_!~/^#/ ) || ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
435	+	$intregion=0;
436	+	next;
437	+	}
438	+	print $_;
439	+	if ( $_=~/^#\s*(.*)\((.*)\)?:(.*)/ ) {
440	+	$interface=$1;
441	+	$args=$2;
442	+	$rest=$3;
443	+	next if ($interface eq "");
444	+	push @interfaces,$interface;
445	+	$interfaceargs{$interface}=$args;
446	+	}
447	+	}
448	+	}
449	+	print "\n";
450	+	undef $fh;
451	+	}
452	+
453		# -------------- Support Routines ------------------------------
454
455
#	Line 243 | Line 460 | sub _allprojectinitsearcher {
460		$search->addproject($$proj[0],$$proj[1]);
461		}
462		}
463	+	return $self->{projsearcher};
464		}
465
466		sub _projsearcher {

Diff Legend

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