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.3 by williamc, Wed Aug 30 09:31:31 2000 UTC vs.
Revision 1.20 by sashby, Fri Feb 8 09:50:20 2002 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 98 | Line 124 | sub satellite {
124		my $version=shift;
125		my $installarea=shift;
126
127	<	my $areaname="";
127	>	my $areaname=undef;
128		if ( @_ ) {
129		$areaname=shift;
130		}
#	Line 109 | Line 135 | sub satellite {
135		$self->error("Unable to Find Project $name $version");
136		}
137
138	+	# -- fix for old broken areas
139	+	if ( (! defined $relarea->version()) || ($relarea->version() eq "") ) {
140	+	$relarea->version($version);
141	+	}
142	+
143		# -- create satellite
144		my $area=$relarea->satellite($installarea,$areaname);
145		$area->archname($self->arch());
146
116	–	# -- copy setup info - deprecated by toolbox copy method
117	–	#$relarea->copysetup($area->location());
118	–
147		# -- copy toolbox
148		my $rtb=$self->areatoolbox($relarea);
149		my $tb=$self->areatoolbox($area);
#	Line 137 | 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 155 | 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	+	my $rv=system("scram", @_)/256;
305	+	exit $rv;
306	+	}
307	+	else
308	+	{ # if not then simply warn
309	+	print "******* Warning : scram version inconsistent ********\n";
310	+	print "This version: $thisversion; Required version: $version\n";
311	+	print "*****************************************************\n";
312	+	print "\n";
313	+	}
314	+	}
315	+	}
316	+	else
317	+	{
318	+	$self->error("Undefined value for version requested");
319	+	$rv=1;
320	+	}
321	+	return $rv;
322	+	}
323	+
324		sub globalcache {
325		my $self=shift;
326		if ( @_ ) {
#	Line 180 | Line 346 | sub scramprojectdb {
346		}
347		return $self->{scramprojectsdb};
348		}
349	+
350	+	sub getversion {
351	+	my $self=shift;
352	+
353	+	my $thisversion;
354	+	($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
355	+	my $scram_top=$1;
356	+	my $scram_version=$thisversion;
357	+	# deal with links
358	+	my $version=readlink $ENV{SCRAM_HOME};
359	+	if ( defined $version)  {
360	+	$scram_version=$version;
361	+	}
362	+	return $scram_version;
363	+	}
364
365		sub areatoolbox {
366		my $self=shift;
#	Line 189 | Line 370 | sub areatoolbox {
370		if ( ! defined $self->{toolboxes}{$name} ) {
371		# -- create a new toolbox object
372		require BuildSystem::ToolBox;
373	<	$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
373	>	$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
374	>	$self->arch());
375		$self->{toolboxes}{$name}->verbosity($self->verbosity());
376		}
377		return $self->{toolboxes}{$name};
#	Line 228 | Line 410 | sub arch {
410		:$self->{arch};
411		}
412
413	+	sub scramobjectinterface {
414	+	my $self=shift;
415	+	my $class=shift;
416	+
417	+	my $file;
418	+	($file=$class."\.pm")=~s/::/\//g;
419	+	$file=$ENV{TOOL_HOME}."/".$file;
420	+
421	+	if ( ! -f $file ) {
422	+	$self->error("Unable to find $class in ".$ENV{TOOL_HOME});
423	+	}
424	+	print "--------------------- $class ------------------\n";
425	+	my $fh=FileHandle->new();
426	+	$fh->open("<$file");
427	+	while ( <$fh> ) {
428	+	if ( $_=~/#\s*Interface/g ) {
429	+	$intregion=1;
430	+	next;
431	+	}
432	+	if ( $intregion ) { # if we are in the interface documentation
433	+	if ( ( $_!~/^#/ ) || ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
434	+	$intregion=0;
435	+	next;
436	+	}
437	+	print $_;
438	+	if ( $_=~/^#\s*(.*)\((.*)\)?:(.*)/ ) {
439	+	$interface=$1;
440	+	$args=$2;
441	+	$rest=$3;
442	+	next if ($interface eq "");
443	+	push @interfaces,$interface;
444	+	$interfaceargs{$interface}=$args;
445	+	}
446	+	}
447	+	}
448	+	print "\n";
449	+	undef $fh;
450	+	}
451	+
452		# -------------- Support Routines ------------------------------
453
454
#	Line 238 | Line 459 | sub _allprojectinitsearcher {
459		$search->addproject($$proj[0],$$proj[1]);
460		}
461		}
462	+	return $self->{projsearcher};
463		}
464
465		sub _projsearcher {

Diff Legend

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