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.11 by sashby, Wed May 30 12:47:01 2001 UTC vs.
Revision 1.22 by sashby, Fri Dec 10 13:41:42 2004 UTC

#	Line 29 | Line 29
29		package Scram::ScramFunctions;
30		use URL::URLcache;
31		use Utilities::Verbose;
32	+	use Utilities::IndexedFileStore;
33	+
34		require 5.004;
35
36		@ISA=qw(Utilities::Verbose);
#	Line 75 | Line 77 | sub project {
77
78		# -- download all tool description files
79		my $req=$self->arearequirements($area);
80	+	$area->toolboxversion($req->{configversion});
81	+
82		if ( defined $req ) {
83		$req->download($self->areatoolbox($area));
84		}
#	Line 82 | Line 86 | sub project {
86		return $area;
87		}
88
89	<	sub setuptoolsinarea {
90	<	my $self=shift;
91	<	my $area=shift;
92	<
93	<	# -- initialise
94	<	$self->_allprojectinitsearcher();
95	<
96	<	# -- create a new toolbox object
97	<	my $toolbox=$self->areatoolbox($area);
98	<	$toolbox->searcher($self->_allprojectinitsearcher());
99	<
100	<	if ( @_ ) {
101	<	# -- specific tool specified
102	<	if ( my $rv=$toolbox->toolsetup(@_) ) {
103	<	if ( $rv eq 1 ) {
104	<	print "Unknown tool $toolname @ARGV\n";
105	<	exit 1;
106	<	}
107	<	}
108	<	}
109	<	else {
110	<	# -- setup all tools specified in the requirements doc
111	<	my $reqs=$self->arearequirements($area);
112	<	$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
113	<	$reqs->setup($toolbox);
114	<	}
115	<	}
116	<
117	<	sub satellite {
118	<	my $self=shift;
119	<	my $name=shift;
120	<	my $version=shift;
121	<	my $installarea=shift;
122	<
123	<	my $areaname=undef;
120	<	if ( @_ ) {
121	<	$areaname=shift;
122	<	}
123	<
124	<	# -- look up scram database for location
125	<	my $relarea=$self->_lookupareaindb($name,$version);
126	<	if ( ! defined $relarea ) {
127	<	$self->error("Unable to Find Project $name $version");
128	<	}
89	>	sub setuptoolsinarea
90	>	{
91	>	my $self=shift;
92	>	my $area=shift;
93	>
94	>	# -- initialise
95	>	print "Initialising setup procedure......","\n";
96	>	$self->_allprojectinitsearcher();
97	>
98	>	# -- create a new toolbox object
99	>	my $toolbox=$self->areatoolbox($area);
100	>	$toolbox->searcher($self->_allprojectinitsearcher());
101	>
102	>	if ( @_ )
103	>	{
104	>	# -- specific tool specified
105	>	if ( my $rv=$toolbox->toolsetup(@_) )
106	>	{
107	>	if ( $rv eq 1 )
108	>	{
109	>	print "Unknown tool $toolname @ARGV\n";
110	>	exit 1;
111	>	}
112	>	}
113	>	}
114	>	else
115	>	{
116	>	# -- setup all tools specified in the requirements doc
117	>	print "Going to set up all tools....","\n\n";
118	>	my $reqs=$self->arearequirements($area);
119	>	$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
120	>	# reqs is a BuildSystem::Requirements object:
121	>	$reqs->setup($toolbox);
122	>	}
123	>	}
124
125	<	# -- fix for old broken areas
126	<	if ( (! defined $relarea->version()) || ($relarea->version() eq "") ) {
127	<	$relarea->version($version);
128	<	}
125	>	sub updatetoolsinarea
126	>	{
127	>	my $self=shift;
128	>	my $area=shift;
129
130	<	# -- create satellite
131	<	my $area=$relarea->satellite($installarea,$areaname);
137	<	$area->archname($self->arch());
130	>
131	>	my $toolbox=$self->areatoolbox($area);
132
133	<	# -- copy setup info - deprecated by toolbox copy method
134	<	#$relarea->copysetup($area->location());
133	>	print "Going to refresh the setup of tools....","\n\n";
134	>	my $currenttag = $area->toolboxversion();
135	>
136	>	# Get rid of the current cache:
137	>	my $cachename = $area->cache()->location();
138	>	system("mv","$cachename","$cachename".".$currenttag");
139	>	# Create a new one:
140	>	$area->_newcache();
141	>	my $reqs=$self->arearequirements($area);
142	>	$reqs->download();
143	>	$reqs->setup($toolbox);
144	>	print "Previous configuration tag : ",$currenttag,"\n";
145	>	$area->toolboxversion($reqs->{configversion});
146	>	print "Current configuration tag  : ",$area->toolboxversion(),"\n\n";
147	>	$area->save();
148	>	}
149
150	<	# -- copy toolbox
151	<	my $rtb=$self->areatoolbox($relarea);
152	<	my $tb=$self->areatoolbox($area);
153	<	$rtb->copytools($tb);
154	<
155	<	# -- copy configuration directory
156	<	if ( ! -d $area->location()."/".$area->configurationdir() ) {
157	<	use Utilities::AddDir;
158	<	AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
159	<	$area->location()."/".$area->configurationdir() );
160	<	}
161	<
162	<	# -- copy RequirementsDoc
163	<	if ( ! -f $area->requirementsdoc() ) {
164	<	use File::Copy;
165	<	copy( $relarea->requirementsdoc() , $area->requirementsdoc());
166	<	}
150	>	sub satellite
151	>	{
152	>	#
153	>	# Modified to suit new structure
154	>	#
155	>	my $self=shift;
156	>	my $name=shift;
157	>	my $version=shift;
158	>	my $installarea=shift; # Where to install (-dir option in project cmd);
159	>	my $areaname=undef;    # Name of the area (comes from -name option in project cmd);
160	>
161	>	if ( @_ )
162	>	{
163	>	$areaname=shift;
164	>	}
165	>
166	>	# Get location from SCRAMDB:
167	>	my $relarea=$self->_lookupareaindb($name,$version);
168	>
169	>	if ( ! defined $relarea )
170	>	{
171	>	$self->error("Unable to Find Project $name $version");
172	>	}
173	>
174	>	# Create a satellite area:
175	>	my $area=$relarea->satellite($installarea,$areaname);
176	>	$area->archname($self->arch());
177	>
178	>	# Copy the admin dir (and with it, the ToolCache):
179	>	$relarea->copysetup($area->location());
180	>
181	>	# Copy configuration directory contents:
182	>	if ( ! -d $area->location()."/".$area->configurationdir() )
183	>	{
184	>	use Utilities::AddDir;
185	>	AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
186	>	$area->location()."/".$area->configurationdir() );
187	>	}
188	>
189	>	# Make sourcecode dir:
190	>	if ( ! -d $area->location()."/".$area->sourcedir() )
191	>	{
192	>	use Utilities::AddDir;
193	>	AddDir::adddir($area->location()."/".$area->sourcedir());
194	>	}
195	>
196	>	# Copy RequirementsDoc:
197	>	if ( ! -f $area->requirementsdoc() )
198	>	{
199	>	use File::Copy;
200	>	copy( $relarea->requirementsdoc() , $area->requirementsdoc());
201	>	}
202
203	<	return $area;
204	<	}
203	>	return $area;
204	>	}
205
206		sub toolruntime {
207		my $self=shift;
208		my $area=shift;
209	+	my $ld_lib_path="";
210	+	my $bin_path="";
211
212		my $name=$area->location();
213	<	if ( ! defined $self->{toolruntime}{$name} ) {
214	<	require Runtime;
215	<	my $toolbox=$self->areatoolbox($area);
216	<	$self->{toolruntime}{$name}=Runtime->new();
217	<
218	<	# -- add scram area specific runtimes
219	<	$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
220	<	$area->location()."/lib/".$self->arch(),"path");
221	<	$self->{toolruntime}{$name}->addvar("PATH",
222	<	$area->location()."/bin/".$self->arch(),"path");
223	<	if ( defined $area->linkarea() ) {
224	<	my $reltop=$area->linkarea()->location();
225	<	$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
226	<	$reltop."/lib/".$self->arch(),"path");
227	<	$self->{toolruntime}{$name}->addvar("PATH",
228	<	$reltop."/bin/".$self->arch(),"path");
229	<	}
230	<
231	<	# -- get the runtime environment from all the tools
232	<	my $tool;
233	<	foreach $toolname ( $toolbox->tools() ) {
234	<	$tool=$toolbox->gettool($toolname);
235	<	if ( defined $tool ) {
236	<	# -- get runtime paths
237	<	foreach $f ( $tool->listtype("runtime_path")) {
238	<	foreach $val ( $tool->getfeature($f) ) {
239	<	$self->{toolruntime}{$name}->addvar($f,$val,"path");
240	<	}
241	<	}
242	<	# -- get runtime vars
243	<	foreach $f ( $tool->listtype("runtime")) {
244	<	foreach $val ( $tool->getfeature($f) ) {
245	<	$self->{toolruntime}{$name}->addvar($f,$val);
246	<	}
247	<	}
248	<	}
249	<	}
250	<
251	<	# -- Get the project level environment
252	<	my $runtimefile=$area->location()."/".$area->configurationdir()
253	<	."/Runtime";
254	<	if ( -f $runtimefile ) {
255	<	$self->{toolruntime}{$name}->file($runtimefile);
256	<	}
257	<	}
213	>
214	>	if ( ! defined $self->{toolruntime}{$name} )
215	>	{
216	>	require Runtime;
217	>	my $toolbox=$self->areatoolbox($area);
218	>	$self->{toolruntime}{$name}=Runtime->new();
219	>
220	>	# Test for SCRAM_ARCH/lib order:
221	>	if ( -d $area->location()."/".$self->arch())
222	>	{
223	>	$ld_lib_path = $area->location()."/".$self->arch()."/lib"
224	>	unless ( ! -d $area->location()."/".$self->arch()."/lib");
225	>	$bin_path = $area->location()."/".$self->arch()."/bin"
226	>	unless ( ! -d $area->location()."/".$self->arch()."/bin");
227	>	}
228	>	# Other way around:
229	>	elsif ( -d  $area->location()."/lib/".$self->arch())
230	>	{
231	>	$ld_lib_path = $area->location()."/lib/".$self->arch()
232	>	unless ( ! -d $area->location()."/lib/".$self->arch());
233	>	$bin_path = $area->location()."/bin/".$self->arch()
234	>	unless ( ! -d $area->location()."/bin/".$self->arch());
235	>	}
236	>	else
237	>	# Assume no arch so just use lib and bin:
238	>	{
239	>	$ld_lib_path = $area->location()."/lib";
240	>	$bin_path = $area->location()."/bin";
241	>	}
242	>
243	>	# -- Now set the scram area specific runtimes accordingly:
244	>	$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",$ld_lib_path,"path");
245	>	$self->{toolruntime}{$name}->addvar("PATH",$bin_path,"path");
246	>
247	>	# Check for a linked area:
248	>	if ( defined $area->linkarea() )
249	>	{
250	>	my $relarea=$area->linkarea();
251	>	# Now do the checks for the release area:
252	>	if ( -d $relarea->location()."/".$self->arch())
253	>	{
254	>	$ld_lib_path = $relarea->location()."/".$self->arch()."/lib"
255	>	unless ( ! -d $relarea->location()."/".$self->arch()."/lib");
256	>	$bin_path = $relarea->location()."/".$self->arch()."/bin"
257	>	unless ( ! -d $relarea->location()."/".$self->arch()."/bin");
258	>	}
259	>	# Other way around:
260	>	elsif ( -d  $relarea->location()."/lib/".$self->arch())
261	>	{
262	>	$ld_lib_path = $relarea->location()."/lib/".$self->arch()
263	>	unless ( ! -d $relarea->location()."/lib/".$self->arch());
264	>	$bin_path = $relarea->location()."/bin/".$self->arch()
265	>	unless ( ! -d $relarea->location()."/bin/".$self->arch());
266	>	}
267	>	else
268	>	# Assume no arch so just use lib and bin:
269	>	{
270	>	$ld_lib_path = $relarea->location()."/lib";
271	>	$bin_path = $relarea->location()."/bin";
272	>	}
273	>	# Add the release paths:
274	>	$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",$ld_lib_path,"path");
275	>	$self->{toolruntime}{$name}->addvar("PATH",$bin_path,"path");
276	>	}
277	>
278	>	# -- get the runtime environment from all the tools
279	>	my $tool;
280	>	foreach $toolname ( $toolbox->tools() )
281	>	{
282	>	$tool=$toolbox->gettool($toolname);
283	>	if ( defined $tool )
284	>	{
285	>	# -- get runtime paths
286	>	foreach $f ( $tool->listtype("runtime_path"))
287	>	{
288	>	foreach $val ( $tool->getfeature($f) )
289	>	{
290	>	$self->{toolruntime}{$name}->addvar($f,$val,"path");
291	>	}
292	>	}
293	>	# -- get runtime vars
294	>	foreach $f ( $tool->listtype("runtime"))
295	>	{
296	>	foreach $val ( $tool->getfeature($f) )
297	>	{
298	>	$self->{toolruntime}{$name}->addvar($f,$val);
299	>	}
300	>	}
301	>	}
302	>	}
303	>
304	>	# -- Get the project level environment
305	>	my $runtimefile=$area->location()."/".$area->configurationdir()."/Runtime";
306	>
307	>	if ( -f $runtimefile )
308	>	{
309	>	$self->{toolruntime}{$name}->file($runtimefile);
310	>	}
311	>	}
312		return $self->{toolruntime}{$name};
313	<	}
313	>	}
314
315		sub webget {
316		my $self=shift;
#	Line 225 | Line 324 | sub webget {
324
325		sub addareatoDB {
326		my $self=shift;
327	+	my $flag=shift;
328		my $area=shift;
329		my $tagname=shift;
330		my $version=shift;
#	Line 236 | Line 336 | sub addareatoDB {
336		if ( (! defined $tagname)  || ( $tagname eq "") ) {
337		$tagname=$area->name();
338		}
239	–
339		# -- Add to the DB
340	<	$self->scramprojectdb()->addarea($tagname,$version,$area);
340	>	$self->scramprojectdb()->addarea($flag,$tagname,$version,$area);
341		}
342
244	–	sub spawnversion {
245	–	my $self=shift;
246	–	my $version=shift;
343
344	<	my $rv=0;
345	<	my $thisversion=$self->getversion();
346	<	if ( defined $version ) {
347	<	if ( $version ne $thisversion ) {
348	<	# first try to use the correct version
349	<	if ( -d $self->{scram_top}."/".$version ) {
350	<	$ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
351	<	$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
352	<	$self->verbose("Spawning SCRAM version $version");
353	<	my $rv=system("scram", @_)/256;
354	<	exit $rv;
355	<	}
356	<	else { # if not then simply warn
357	<	print "******* Warning : scram version inconsistent ********\n";
358	<	print "This version: $thisversion; Required version: $version\n";
359	<	print "*****************************************************\n";
360	<	print "\n";
361	<	}
362	<	}
363	<	}
364	<	else {
365	<	$self->error("Undefined value for version requested");
366	<	$rv=1;
367	<	}
368	<	return $rv;
369	<	}
344	>	sub removeareafromDB
345	>	{
346	>	###############################################################
347	>	# removearefromDB()                                           #
348	>	###############################################################
349	>	# modified : Thu Jun 14 10:46:22 2001 / SFA                   #
350	>	# params   : projectname, projectversion                      #
351	>	#          :                                                  #
352	>	#          :                                                  #
353	>	#          :                                                  #
354	>	# function : Remove project <projectname> from DB file.       #
355	>	#          :                                                  #
356	>	#          :                                                  #
357	>	###############################################################
358	>	my $self=shift;
359	>	my $flag=shift;
360	>	my $projname=shift;
361	>	my $version=shift;
362	>
363	>	# -- Remove from the DB:
364	>	$self->scramprojectdb()->removearea($flag,$projname,$version);
365	>	}
366	>
367	>
368	>	sub spawnversion
369	>	{
370	>	###############################################################
371	>	# spawnversion                                                #
372	>	###############################################################
373	>	# modified : Fri Aug 10 15:42:08 2001 / SFA                   #
374	>	# params   :                                                  #
375	>	#          :                                                  #
376	>	#          :                                                  #
377	>	#          :                                                  #
378	>	# function : Check for version of scram to run, and run it.   #
379	>	#          :                                                  #
380	>	#          :                                                  #
381	>	###############################################################
382	>
383	>	my $self=shift;
384	>	my $version=shift;
385	>	my $rv=0;
386	>
387	>	my $thisversion=$self->getversion();
388	>
389	>	if ( defined $version )
390	>	{
391	>	if ( $version ne $thisversion )
392	>	{
393	>	# first try to use the correct version
394	>	if ( -d $self->{scram_top}."/".$version )
395	>	{
396	>	$ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
397	>	$ENV{SCRAM_TOOL_HOME}="$ENV{SCRAM_HOME}/src";
398	>	$self->verbose("Spawning SCRAM version $version");
399	>	my $rv=system($ENV{SCRAM_HOME}."/src/main/scram.pl", @_)/256;
400	>	exit $rv;
401	>	}
402	>	else
403	>	{
404	>	# if not then simply warn. Send output to STDERR:
405	>	if ( -t STDERR )
406	>	{
407	>	print STDERR "******* Warning : scram version inconsistent ********\n";
408	>	print STDERR "This version: $thisversion; Required version: $version\n";
409	>	print STDERR "*****************************************************\n";
410	>	print STDERR "\n";
411	>	}
412	>	}
413	>	}
414	>	}
415	>	else
416	>	{
417	>	$self->error("Undefined value for version requested");
418	>	$rv=1;
419	>	}
420	>	return $rv;
421	>	}
422
423		sub globalcache {
424		my $self=shift;
#	Line 328 | Line 476 | sub areatoolbox {
476		return $self->{toolboxes}{$name};
477		}
478
479	+	sub areatoolmanager
480	+	{
481	+	my $self=shift;
482	+	my $area=shift;
483	+
484	+	my $name=$area->location();
485	+
486	+	if ( ! defined $self->{toolmanagers}{$name} )
487	+	{
488	+	use BuildSystem::ToolManager;
489	+	$self->{toolmanagers}{$name}=ToolManager->new($area,$self->arch());
490	+	}
491	+
492	+	return $self->{toolmanagers}{$name};
493	+	}
494	+
495		sub arearequirements {
496		my $self=shift;
497		my $area=shift;
#	Line 367 | Line 531 | sub scramobjectinterface {
531
532		my $file;
533		($file=$class."\.pm")=~s/::/\//g;
534	<	$file=$ENV{TOOL_HOME}."/".$file;
534	>	$file=$ENV{SCRAM_TOOL_HOME}."/".$file;
535
536		if ( ! -f $file ) {
537	<	$self->error("Unable to find $class in ".$ENV{TOOL_HOME});
537	>	$self->error("Unable to find $class in ".$ENV{SCRAM_TOOL_HOME});
538		}
539		print "--------------------- $class ------------------\n";
540		my $fh=FileHandle->new();

Diff Legend

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