ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/scram

Comparing COMP/SCRAM/src/scram (file contents):
Revision 1.32 by williamc, Wed Mar 29 09:46:58 2000 UTC vs.
Revision 1.33 by williamc, Mon Aug 28 08:19:03 2000 UTC

#	Line 1 | Line 1
1	<	#!/usr/local/bin/perl5 -w
1	>	#!/usr/local/bin/perl5
2	>	# ^^^^^^^^^^^^^^^^^^^^
3	>	# we dont need this anymore to invoke perl but options placed here will be
4	>	# used.
5		#
6		# User Interface
7		#
5	–
8		# Make sure were running the right version
7	–	#versioncheck();
9
10	+	versioncheck();
11	+
12	+	$inputcmd=shift;
13	+	$found='false';
14		$bold  = "\033[1m";
15	+	$rv=0;
16		$normal = "\033[0m";
17	<	@allowed_commands=qw(area project tool options install list arch version setup runtime db devtest doctest);
17	>	$self={};
18
19	<	use Scram::SCRAM2;
20	<	setupscram();
19	>	@allowed_commands=qw(project build install version list arch setup runtime db tool);
20	>	@dev_cmds=qw(devtest align);
21
22	<	$found=_processcmds("_mainoptions",\@allowed_commands,\@ARGV);
22	>	if ( $inputcmd ne "" ) {
23	>	foreach $command ( (@allowed_commands,@dev_cmds) ) {
24	>	if ( $command=~/^$inputcmd/i) {
25	>	# Deal with a help request
26	>	do{     helpheader($command);
27	>	&{"help_".$command}; exit; } if $ARGV[0]=~/help/i;
28	>	$rv=&$command; $found='true';
29	>	last;
30	>	}
31	>	}
32	>	}
33
34		if ( ! ( $found=~/true/ ) ) {
35		helpheader('Recognised Commands');
#	Line 23 | Line 39 | if ( ! ( $found=~/true/ ) ) {
39		print "\n";
40		print "Help on individual commands available through\n\n";
41		print "$bold       scram".$normal." command$bold help $normal\n\n";
26	–	print "Main options can be seen with\n";
27	–	print "$bold       scram options help$normal\n\n";
28	–	}
29	–
30	–	sub options {
31	–	help_options();
42		}
43	+	exit $rv;
44
45	<	# --------- main command processing routines
46	<
47	<	sub _mainoptions {
48	<	my $option=shift;
38	<	my $cmds=shift;
39	<
40	<	if ( $option eq "-f" ) {
41	<	# force update of urls
42	<	shift @$cmds;
43	<	$scram->setoption("url_update", 1);
44	<	}
45	<	elsif ( $option eq "-update" ) {
46	<	# force update of urls
47	<	shift @$cmds;
48	<	$scram->setoption("url_update", shift @$cmds);
49	<	}
50	<	elsif ( $option eq "-arch" ) {
51	<	# pretend to be a different architecture
52	<	shift @$cmds;
53	<	my $arch=$scram->arch();
54	<	$arch->arch(shift @$cmds);
55	<	}
56	<	elsif ( $option eq "-verbose" ) {
57	<	shift @$cmds;
58	<	$scram->setoption("verbose_".$$cmds[0],1);
59	<	print "Verbose turned on for $$cmds[0]\n";
60	<	shift @$cmds;
61	<	}
62	<	else {
63	<	$scram->error("Unknown Option $option");
64	<	}
65	<	}
66	<
67	<	sub _processcmds {
68	<	my $optionhandler=shift;
69	<	my $allowed_commands=shift;
70	<	my $cmds=shift;
71	<	my @subs=@_;
72	<
73	<	my $found='false';
74	<	# make a string from the subcommand levels
75	<	my $substring="";
76	<	if ( @subs ) {
77	<	$substring= join '_', @subs;
78	<	$substring=$substring."_";
79	<	}
80	<
81	<	# Process options
82	<	if ( defined ${$cmds}[0] ) {
83	<	while ( ${$cmds}[0]=~/^-/) {
84	<	&{$optionhandler}( ${$cmds}[0],$cmds);
85	<	}
86	<
87	<	my $inputcmd=shift @{$cmds};
88	<	if ( $inputcmd ne "" ) {
89	<	foreach $command ( @{$allowed_commands} ) {
90	<	if ( $command=~/^$inputcmd/i) {
91	<	# Deal with a help request
92	<	if ( ( defined $$cmds[0]) && $$cmds[0]=~/help/i ) {
93	<	&helpheader($command,@subs);
94	<	&{"help_".$substring.$command}; exit;
95	<	}
96	<	else {
97	<	#print "calling $substring".$command."(@{$cmds})\n";
98	<	&{$substring.$command}(@{$cmds}); $found='true';
99	<	last;
100	<	}
101	<	}
102	<	}
103	<	}
104	<	}
105	<	return $found;
106	<	}
107	<
108	<	sub help_options {
109	<	helpheader('Main SCRAM options');
110	<	print "$bold -arch ".$normal."architecture \n";
111	<	print "\tPretend to be the specified architecture\n\n";
112	<	print "$bold -f $normal \n";
113	<	print "\tForced update of urls instead of using"
114	<	." the cached\n\tversions\n\n";
115	<	print "$bold -re $normal\n";
116	<	print "\tRequest Exit - Scram will ask the user to enter RETURN\n".
117	<	"\tat the end of the process rather than exiting directly\n";
118	<	print "\tUseful for use where scram is run as a forked process\n\n";
119	<	print "$bold -update ".$normal."string \n";
120	<	print "\tAs -f but only update the url that matches the \n";
121	<	print "\tgiven string\n\n";
122	<	print "$bold -verbose ".$normal."object \n";
123	<	print "\tTurn on the verbose mode for the specified object.\n";
124	<	print "\tThe special object \"all\" will turn on verbosity for\n";
125	<	print "\tall objects that support verbosity\n\n";
45	>	sub error {
46	>	my $string=shift;
47	>	print "scram : ".$string."\n";
48	>	exit 1;
49		}
50
51		sub versioncheck {
#	Line 131 | Line 54 | sub versioncheck {
54
55		$thisversion=getversion();
56
57	<	if ( ! localtop_find() ) {
58	<	LoadEnvFile();
59	<	my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
60	<	if ( -f $versionfile ) {
61	<	open (VERSION, "<".$versionfile) ;
57	>	if ( @_ ) {
58	>	$version=shift;
59	>	}
60	>	else {
61	>	if ( ! localtop_find() ) {
62	>	LoadEnvFile();
63	>	my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
64	>	if ( -f $versionfile ) {
65	>	open (VERSION, "<".$versionfile);
66		$version=<VERSION>;
67		chomp $version;
68	+	}
69	+	}
70	+	}
71	+	if ( defined $version ) {
72		if ( $version ne $thisversion ) {
73		# first try to use the correct version
74		if ( -d $scram_top."/".$version ) {
75		$ENV{SCRAM_HOME}=$scram_top."/".$version;
76	<	system("scram", @ARGV);
77	<	exit;
76	>	my $rv=system("scram", @ARGV)/256;
77	>	exit $rv;
78		}
79		else { # if not then simply warn
80		print "******* Warning : scram version inconsistent ********\n";
#	Line 153 | Line 84 | sub versioncheck {
84		}
85		}
86		}
156	–	}
87		}
88
89	<	sub doctest {
90	<	$scram->doctest(@ARGV);
89	>	sub _processcmds {
90	>	my $optionhandler=shift;
91	>	my $allowed_commands=shift;
92	>	my $cmds=shift;
93	>	my @subs=@_;
94	>
95	>	my $found='false';
96	>	# make a string from the subcommand levels
97	>	my $substring="";
98	>	if ( @subs ) {
99	>	$substring= join '_', @subs;
100	>	$substring=$substring."_";
101	>	}
102	>
103	>	# Process options
104	>	if ( defined ${$cmds}[0] ) {
105	>	while ( ${$cmds}[0]=~/^-/) {
106	>	&{$optionhandler}( ${$cmds}[0],$cmds);
107	>	}
108	>
109	>	my $inputcmd=shift @{$cmds};
110	>	if ( $inputcmd ne "" ) {
111	>	foreach $command ( @{$allowed_commands} ) {
112	>	if ( $command=~/^$inputcmd/i) {
113	>	# Deal with a help request
114	>	if ( ( defined $$cmds[0]) && $$cmds[0]=~/help/i ) {
115	>	&helpheader($command,@subs);
116	>	&{"help_".$substring.$command}; exit;
117	>	}
118	>	else {
119	>	#print "calling $substring".$command."(@{$cmds})\n";
120	>	&{$substring.$command}(@{$cmds}); $found='true';
121	>	last;
122	>	}
123	>	}
124	>	}
125	>	}
126	>	}
127	>	return $found;
128		}
129
130	+
131		sub help_build {
132		&build;
133		}
134	+
135	+	sub align {
136	+	_localarea()->align();
137	+	}
138	+
139		sub build {
140		# is this a based or free release?
141		FullEnvInit();
142	<	use BuildSetup;
142	>	use BuildSystem::BuildSetup;
143		$ENV{MAKETARGETS}=join ' ',@ARGV;
144	<	BuildSetup($ENV{THISDIR},@ARGV);
144	>	my $bs=BuildSystem::BuildSetup->new(toolbox());
145	>	$rv=$bs->BuildSetup($ENV{THISDIR},@ARGV);
146	>	$rv;
147		}
148
149		sub project {
150	+	my @args=@ARGV;
151	+
152	+	my $devareaname="";
153	+	use Cwd;
154	+	my $installarea=cwd();
155	+
156		# process options
157	<	while ( $ARGV[0]=~"^-" ) {
158	<	if ( $ARGV[0]=~/-n/ ) {
159	<	shift @ARGV;
160	<	$scram->setoption("ConfigArea_name",shift @ARGV);
157	>	while ( $args[0]=~"^-" ) {
158	>	if ( $args[0]=~/-n/ ) {
159	>	shift @args;
160	>	$devareaname=shift @args;
161		}
162	<	elsif ( $ARGV[0]=~/-d/ ) {  #installation area directory
163	<	shift @ARGV;
164	<	$scram->setoption("ConfigArea_location",shift @ARGV);
162	>	elsif ( $args[0]=~/-d/ ) {  #installation area directory
163	>	shift @args;
164	>	$installarea=$args[0];
165	>	if ( ! -d $installarea ) {
166	>	error("$installarea does not exist");
167	>	}
168	>	shift @args;
169		}
170		else {
171	<	print "scram: unknown option $ARGV[0] to project command\n";
187	<	exit;
171	>	error("unknown option $args[0] to project command");
172		}
173		}
174
175	<	# -- work out if we have a url or not
176	<	if ( $ARGV[0]=~/.*:.*/ ) {
177	<	$scram->project(@ARGV);
175	>	# -- check what arguments have been passed
176	>	if ( $#args <0 || $#args>1 ) {
177	>	error("\"scram project help\" for usage info");
178	>	}
179	>	my $area; #somewhere to store the area object when we have it
180	>
181	>	if ( ( $#args==0 ) && ($args[0]=~/:/) ) {
182	>	# -- must be a url to bootstrap from
183	>	$area=scrambasics()->project($args[0], $installarea,
184	>	$devareaname);
185	>	scrambasics()->setuptoolsinarea($area);
186	>	}
187	>	elsif ( $#args >0 ) {
188	>	# -- need to create a satellite area
189	>	$area=scrambasics()->satellite(@args,$installarea, $devareaname);
190		}
191		else {
192	<	$scram->basedarea(@ARGV);
192	>	error("\"scram project help\" for usage info");
193	>	}
194	>
195	>	#
196	>	# Now create the directories specified in the interface
197	>	# There should be some better mechanism - TODO
198	>	#
199	>	chdir $area->location();
200	>	foreach $key ( keys %ENV ) {
201	>	if ( $key=~/^INT/ ) {
202	>	AddDir::adddir($ENV{$key});
203	>	}
204	>	}
205	>
206	>	print "\nInstallation Procedure Complete. \n".
207	>	"Installation Located at:\n".$area->location()."\n";
208	>	}
209	>
210	>	sub scrambasics {
211	>	require Scram::ScramFunctions;
212	>	if ( ! defined $scramobj ) {
213	>	environmentinit();
214	>	$scramobj=Scram::ScramFunctions->new();
215	>	$scramobj->arch($ENV{SCRAM_ARCH});
216	>	#$scramobj->verbosity(1);
217	>	}
218	>	return $scramobj;
219	>	}
220	>
221	>	# ------------ tool command --------------------------------------------
222	>	sub tool {
223	>	@_=@ARGV;
224	>	localtop();
225	>	environmentinit();
226	>	my @allowed_cmds=qw(info list default);
227	>	_processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));
228	>	}
229	>
230	>	sub tool_default {
231	>	if ( $#_ != 1 ) {
232	>	error("\"scram tool default help\" for usage information");
233	>	}
234	>	my $tool=shift;
235	>	my $version=shift;
236	>	print "Setting default version of $tool to $version\n";
237	>	# -- adjust the toolbox
238	>	toolbox()->setdefault($tool,$version);
239	>
240	>	}
241	>
242	>	sub tool_list {
243	>	my $area=_localarea();
244	>	print "Tool List for "; #.$area->name()." ".$area->version()."\n";
245	>	print "Location : ".$area->location()."\n";
246	>	print "+"x60;
247	>	print "\n";
248	>	foreach $t ( toolbox()->tools() ) {
249	>	my $vers=join / /, toolbox()->versions($t);
250	>	print $t." ".$vers." (default=".toolbox()->defaultversion($t).")\n";
251	>	}
252	>	}
253	>
254	>	sub tool_info {
255	>	my $project=shift;
256	>	my $area=_localarea();
257	>	print "Tool Info as configured in ";
258	>	#.$area->name()." ".$area->version()."\n";
259	>	print "Location : ".$area->location()."\n";
260	>	print "+"x60;
261	>	print "\n";
262	>
263	>	my @tools=toolbox()->gettool($project,@_);
264	>	foreach $t ( @tools ) {
265	>	if ( defined $t ) {
266	>	print "Name : ".$t->name();
267	>	print "\n";
268	>	print "Version : ".$t->version();
269	>	print "\n";
270	>	print "Docfile : ".$t->url();
271	>	print "\n";
272	>	print "+"x20;
273	>	print "\n";
274	>	@features=$t->features();
275	>	foreach $ft ( @features ) {
276	>	@vals=$t->getfeature($ft);
277	>	foreach $v ( @vals ) {
278	>	print $ft. "=$v\n";
279	>	}
280	>	}
281	>	}
282	>	}
283	>	}
284	>
285	>	sub _tooloptions {
286	>	error("No Options defined for tool subcommand");
287	>	}
288	>
289	>	sub help_tool {
290	>	print <<ENDTEXT;
291	>	Manage the tools in the scram area that define the areas environment.
292	>	tool subcommands :
293	>	list
294	>	info tool_name
295	>	default tool_name tool_version
296	>
297	>	ENDTEXT
298	>	}
299	>
300	>	sub help_tool_info {
301	>	print <<ENDTEXT;
302	>	Description:
303	>	Print out information on the specified tool in the current area
304	>	configuration.
305	>	Usage :
306	>	scram tool info tool_name [tool_version]
307	>
308	>	ENDTEXT
309	>	}
310	>
311	>	sub help_tool_list {
312	>	print <<ENDTEXT;
313	>	Description:
314	>	List of currently configured tools available in ther current scram
315	>	area
316	>	Usage :
317	>	scram tool list
318	>
319	>	ENDTEXT
320	>	}
321	>
322	>	sub help_tool_default {
323	>	print <<ENDTEXT;
324	>	Description:
325	>	Change the default version of a tool to be used in the area
326	>	Usage :
327	>	scram tool default tool_name tool_version
328	>
329	>	ENDTEXT
330	>	}
331	>
332	>	# ----------------------------------------------------------------------
333	>	sub _requirements {
334	>	if ( ! defined $reqsobj ) {
335	>	localtop();
336	>	my $area=_localarea();
337	>	scrambasics()->arearequirements($area)
338	>	}
339	>	return $reqsobj;
340	>	}
341	>
342	>	sub _allprojectinitsearcher {
343	>	my $search=_projsearcher();
344	>	foreach $proj ( _scramprojdb()->list() ) {
345	>	$search->addproject($$proj[0],$$proj[1]);
346		}
347	<	print "\nInstallation Procedure Complete. \n".
348	<	"Installation Located at:\n".cwd()."\n";
347	>	}
348	>
349	>	sub _projsearcher {
350	>	if ( ! defined $self->{projsearcher} ) {
351	>	require Scram::ProjectSearcher;
352	>	$self->{projsearcher}=Scram::ProjectSearcher->new(_scramprojdb());
353	>	}
354	>	return $self->{projsearcher};
355	>	}
356	>
357	>	sub _scramprojdb {
358	>	return scrambasics()->scramprojectdb();
359		}
360
361		sub runtime {
362		my $shell;
363	<	FullEnvInit();
363	>	require Runtime;
364
365		# process options
366		while ( $ARGV[0]=~"^-" ) {
#	Line 218 | Line 377 | sub runtime {
377		print "Unknown Option $ARGV[0]\n";
378		exit 1;
379		}
380	<	print "Not yet implemented\n";
380	>
381	>	FullEnvInit();
382	>	if ( @ARGV ) {
383	>	my $runtime=Runtime->new();
384	>	my $arg=shift @ARGV;
385	>
386	>	my $info=0;
387	>	if ( $arg eq "info" ) {
388	>	$arg=shift @ARGV;
389	>	$info=1;
390	>	}
391	>
392	>	# --- determine filename
393	>	my $filename;
394	>	if ( -f $arg ) { # Is it a file?
395	>	$filename=$arg;
396	>	}
397	>	else {
398	>	# -- lets see if its a BuildFile location
399	>	$filename=_testfile($ENV{LOCALTOP}."/src/".$arg,
400	>	$ENV{RELEASETOP}."/src/".$arg,
401	>	$ENV{LOCALTOP}."/src/".$arg."/BuildFile",
402	>	$ENV{RELEASETOP}."/src/".$arg."/BuildFile");
403	>	if ( $filename eq "" ) {
404	>	print "Unable to find a file (or BuildFile) relating to ".
405	>	$arg."\n";
406	>	exit 1;
407	>	}
408	>	}
409	>	$runtime->file($filename);
410	>	if ( ! $info ) {
411	>	$runtime->printenv($shell);
412	>	}
413	>	else {
414	>	if ( @ARGV ) { #do we have a specific variable request?
415	>	_printvardoc($runtime,shift @ARGV);
416	>	}
417	>	else {
418	>	foreach $var ( $runtime->list() ) {
419	>	_printvardoc($runtime,$var);
420	>	}
421	>	}
422	>	}
423	>	undef $runtime;
424	>	}
425	>	else {
426	>	FullEnvInit();
427	>	# We have to clean up from the last runtime cmd - use env history
428	>	foreach $variable ( %ENV ) {
429	>	if ( $variable=~/^SCRAMRT_(.*)/ ) { #SCRAMRT are history retaining
430	>	my $var=$1;
431	>	$ENV{$var}=~s/\Q$ENV{$variable}\E//g;
432	>	$ENV{$var}=~s/^:*//;  # Deal with any Path variables
433	>	#print "$variable : $ENV{$variable} \n$var : $ENV{$var}\n";
434	>	delete $ENV{$variable};
435	>	}
436	>	}
437	>
438	>	# -- Set SCRAM release area paths
439	>	addpath("LD_LIBRARY_PATH","$ENV{LOCALTOP}/lib/$ENV{SCRAM_ARCH}");
440	>	addpath("LD_LIBRARY_PATH","$ENV{RELEASETOP}/lib/$ENV{SCRAM_ARCH}");
441	>
442	>	# -- get the tool runtime environments
443	>	my $toolbox=toolbox();
444	>	foreach $tool ( $toolbox->tools() ) {
445	>	$tool=$toolbox->gettool($tool);
446	>
447	>	if ( defined $tool ) {
448	>	# -- get runtime paths
449	>	foreach $f ( $tool->listtype("runtime_path")) {
450	>	foreach $val ( $tool->getfeature($f) ) {
451	>	addpath($f,$val);
452	>	}
453	>	}
454	>	# -- get runtime vars
455	>	foreach $f ( $tool->listtype("runtime")) {
456	>	foreach $val ( $tool->getfeature($f) ) {
457	>	$EnvRuntime{$f}=$val;
458	>	}
459	>	}
460	>	}
461	>	}
462	>
463	>	addpath("PATH","$ENV{LOCALTOP}/bin/$ENV{SCRAM_ARCH}");
464	>	addpath("PATH","$ENV{RELEASETOP}/bin/$ENV{SCRAM_ARCH}");
465	>
466	>	# Now get the general project environment
467	>	open ( SCRAMENV, "<$ENV{LOCALTOP}/$ENV{projconfigdir}/Runtime" );
468	>	while ( <SCRAMENV> ) {
469	>	chomp;
470	>	next if /^#/;
471	>	next if /^\s*$/;
472	>	($name, $value)=split /=/;
473	>	addvar($name, (eval $value)," ");
474	>	}
475	>	close SCRAMENV;
476	>
477	>	# create new SCRAMRT history vars.
478	>	foreach $variable ( keys %EnvRuntime ) {
479	>	printoutenv($shell,"SCRAMRT_$variable",$EnvRuntime{$variable});
480	>	#addvar("SCRAMRT_$variable", $EnvRuntime{$variable}, "");
481	>	}
482	>	# Now adapt as necessary - include base environment as well
483	>	if ( exists $ENV{LD_LIBRARY_PATH} ) {
484	>	addpath("LD_LIBRARY_PATH","$ENV{LD_LIBRARY_PATH}");
485	>	}
486	>	if ( exists $ENV{MANPATH} ) {
487	>	addpath("MANPATH","$ENV{MANPATH}");
488	>	}
489	>	addpath("PATH","$ENV{PATH}");
490	>	# Print out as reqd
491	>	foreach $variable ( keys %EnvRuntime ) {
492	>	printoutenv($shell,$variable,$EnvRuntime{$variable});
493	>	}
494	>	}
495		}
496
497		# Support rt for runtime
498
499	+	sub _testfile {
500	+	my @files=@_;
501	+
502	+	my $filename="";
503	+	foreach $file ( @files ) {
504	+	if ( -f $file ) {
505	+	$filename=$file;
506	+	last;
507	+	}
508	+	}
509	+	return $filename;
510	+	}
511	+
512	+	sub _printvardoc {
513	+	my $runtime=shift;
514	+	my $var=shift;
515	+
516	+	print $var." :\n";
517	+	print $runtime->doc($var);
518	+	print "\n";
519	+	}
520	+
521		sub printoutenv {
522		my $shell=shift;
523		my $variable=shift;
#	Line 273 | Line 568 | sub FullEnvInit {
568		}
569
570		sub environmentinit {
571	<	#       use Utilities::setarchitecture;
571	>	use Utilities::setarchitecture;
572		my $name;
573		my $value;
574
575		$ENV{LatestBuildFile}=""; # stop recursive behaviour in make
576	<	#       setarchitecture::setarch();
576	>	setarchitecture::setarch();
577		$ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
578		$ENV{INTlib}="lib/$ENV{SCRAM_ARCH}";
579		$ENV{INTsrc}="src";
#	Line 304 | Line 599 | sub environmentinit {
599		$ENV{SCRAM_AVAILFILES}="";
600		}
601
602	+	sub _localarea {
603	+	if ( ! defined $self->{localarea} ) {
604	+	require Configuration::ConfigArea;
605	+	$self->{localarea}=Configuration::ConfigArea->new();
606	+	if ( ! defined $ENV{LOCALTOP} ) {
607	+	if ( $self->{localarea}->bootstrapfromlocation() ) {
608	+	# Were not in a local area
609	+	undef $self->{localarea};
610	+	}
611	+	else {
612	+	$self->{localarea}->archname(scrambasics()->arch());
613	+	}
614	+	}
615	+	else {
616	+	$self->{localarea}->bootstrapfromlocation($ENV{LOCALTOP});
617	+	}
618	+	}
619	+	return $self->{localarea};
620	+	}
621	+
622		sub localtop_find {
308	–	# find localtop
309	–	use Cwd;
310	–	my $thispath=cwd;
623		my $rv=1;
624	<
625	<	block: {
626	<	do {
627	<	if ( -e "$thispath/.SCRAM" ) {
316	<	$ENV{LOCALTOP}=$thispath;
317	<	$ENV{SCRAM_WORKDIR}="$ENV{LOCALTOP}/.SCRAM";
318	<	$rv=0;
319	<	last block;
320	<	}
321	<	} while ( ( $thispath=~s/(.*)\/.*/$1/ )=~/./  );
322	<	} #end block
624	>	if ( defined _localarea()) {
625	>	$rv=0;
626	>	$ENV{LOCALTOP}=_localarea()->location();
627	>	}
628		return $rv;
629		}
630
#	Line 334 | Line 639 | sub localtop {
639		}
640
641		sub LoadEnvFile {
642	<	open ( SCRAMENV, "<$ENV{SCRAM_WORKDIR}/Environment" ) ||
338	<	die "Cant find Environment file $!\n";
339	<	while ( <SCRAMENV> ) {
340	<	chomp;
341	<	next if /^#/;
342	<	next if /^\s*$/ ;
343	<	($name, $value)=split /=/;
344	<	eval "\$ENV{${name}}=\"$value\"";
345	<	}
346	<	close SCRAMENV;
642	>	_localarea()->copyenv(\%ENV);
643		}
644
645		sub env {
646		print "Sorry - Not yet\n";
647		}
648
649	+	sub devtest {
650	+	require Utilities::TestClass;
651	+	my $class=shift @ARGV;
652	+
653	+	my $tester;
654	+	my $path;
655	+
656	+	#_initproject();
657	+	if ( $class=~/::/ ) {
658	+	($path=$class)=~s/(.*)::.*/$1/;
659	+	}
660	+	$tester=Utilities::TestClass->new($class,
661	+	"$ENV{SCRAM_HOME}/src/$path/test/testdata");
662	+	$tester->dotest(@_);
663	+	}
664	+
665		#
666		# Create a lookup tag in the site database
667		#
668	<	sub install  {
669	<	my $tagname=shift @ARGV;
670	<	my $version=shift @ARGV;
671	<	$scram->install();
360	<	}
361	<
362	<	sub uninstall {
363	<	$scram->uninstall(@_);
668	>	sub install {
669	>	localtop();
670	>	scrambasics()->addareatoDB(_localarea(),@ARGV);
671	>	_localarea()->align();
672		}
673
674		sub help_install()  {
675	+
676		print <<ENDTEXT;
677		Associates a label with the current release in the SCRAM database.
678		This allows other users to refer to a centrally installed project by
#	Line 378 | Line 687 | version_tag : the version tag of the cur
687		specified the base release version will be taken by default.
688
689		ENDTEXT
381	–	exit;
690		}
691
692	+	sub helpheader ($label) {
693	+	my $label=shift;
694	+	print <<ENDTEXT;
695	+	*************************************************************************
696	+	SCRAM HELP --------- $label
697	+	*************************************************************************
698	+	ENDTEXT
699	+	}
700
701		sub getversion {
702		($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
#	Line 395 | Line 711 | sub getversion {
711		}
712
713		sub version {
714	<	my $version=shift; # @ARGV;
714	>	my $version=shift @ARGV;
715		my $thisversion;
716		my $scram_top;
717		my $cvsobject;
718
719		($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
720		$scram_top=$1;
721	<	if ( (! defined $version) ||  ($version eq "") ) {
721	>	if ( $version eq "" ) {
722		print "$thisversion";
723		# deal with links
724		$version=readlink $ENV{SCRAM_HOME};
#	Line 420 | Line 736 | sub version {
736		print "Attempting download from the SCRAM repository\n";
737		# set up and configure the cvs module for SCRAM
738		use Utilities::CVSmodule;
739	<	$cvsobject=CVSmodule->new();
739	>	$cvsobject=Utilities::CVSmodule->new();
740		$cvsobject->set_base(
741		"cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
742		$cvsobject->set_auth("pserver");
#	Line 436 | Line 752 | sub version {
752		print "\n";
753		}
754		}
755	+	0;
756		}
757
758		sub list {
759	+	&environmentinit;
760	+	my $filename="$ENV{SCRAM_LOOKUPDB}";
761	+	if ( ! -f $ENV{SCRAM_LOOKUPDB} ) {
762	+	print "No installation database available - perhaps no projects".
763	+	" have been installed locally\n";
764	+	exit 1;
765	+	}
766		print "Installed Projects\n";
767		print "------------------\n";
768		print "|Project Name  | Project Version |\n";
769		print "----------------------------------\n";
770	<	#       listdb($filename);
447	<	my @areas=$scram->listprojects();
448	<	foreach $area ( @areas ) {
449	<	print $area->name()."\t".$area->version()."\n";
450	<	print "\t-->".$area->location()."\n";
451	<	}
452	<	}
453	<
454	<	sub area {
455	<	my $subcmd=shift;
456	<
457	<	switch : {
458	<	if ( $subcmd eq 'link' ) {
459	<	$scram->link(@ARGV);
460	<	last switch;
461	<	}
462	<	elsif ( $subcmd eq 'unlink' ) {
463	<	$scram->unlink();
464	<	last switch;
465	<	}
466	<	elsif ( $subcmd eq 'install' ) {
467	<	install(@_);
468	<	}
469	<	elsif ( $subcmd eq 'uninstall' ) {
470	<	uninstall(@_);
471	<	}
472	<	elsif ( $subcmd eq 'info' ) {
473	<	area_info(@_);
474	<	}
475	<	}
476	<	}
477	<
478	<	sub area_info {
479	<	my $area=$scram->basearea(@_);
480	<	if ( defined $area ) {
481	<	print "Linked to : ".$area->location()."\n";
482	<	}
483	<	else {
484	<	print "Area not linked\n";
485	<	}
770	>	listdb($filename);
771		}
772
773		sub db {
#	Line 494 | Line 779 | sub db {
779		dblink($ENV{SCRAM_LOOKUPDB},@ARGV);
780		last switch;
781		}
782	+	if ( ! -f $ENV{SCRAM_LOOKUPDB} ) {
783	+	print "No installation database available - perhaps no projects".
784	+	"have been installed locally\n";
785	+	exit 1;
786	+	}
787		if ( $subcmd eq 'unlink' ) {
788		dbunlink($ENV{SCRAM_LOOKUPDB},@ARGV);
789		last switch;
#	Line 545 | Line 835 | sub dblink {
835		}
836		else {
837		print "Unknown file $newdbfilename\n";
838	<	exit();
838	>	exit 1;
839		}
840		}
841		else {
842		print "Unknown file $filename $!\n";
843	<	exit();
843	>	exit 1;
844		}
845
846		}
#	Line 597 | Line 887 | sub listdb {
887		printf "--> %25s\n",$type.":".$url;
888		}
889		close $fh;
890	+	0;
891		}
892
893		sub arch {
894	<	print $scram->arch()->arch()."\n";
894	>	&environmentinit();
895	>	print "$ENV{SCRAM_ARCH}\n";
896		}
897
606	–	sub setupscram {
607	–	$scram=Scram::SCRAM2->new();
608	–	}
898
899	<	# ------------ tool command --------------------------------------------
900	<	sub tool {
901	<	my @allowed_cmds=qw(setup info list feature);
902	<	_processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));
903	<	}
899	>	#
900	>	# Setup a new tool
901	>	#
902	>
903	>	sub setup {
904	>	my $interactive=0;
905
906	<	sub tool_feature {
907	<	my $expression=shift;
908	<	my ($area,@tools)=$scram->tools(@_);
906	>	# process options
907	>	while ( $ARGV[0]=~"^-" ) {
908	>	if ( $ARGV[0]=~/-i/ ) {
909	>	shift @ARGV;
910	>	$interactive=1;
911	>	}
912	>	else {
913	>	error("scram: unknown option $ARGV[0] to project command");
914	>	}
915	>	}
916
917	<	if ( $#tools<0 ) {
918	<	print "@_ not found in this area\n";
919	<	exit();
920	<	}
917	>	localtop();
918	>	my $area=_localarea();
919	>	my $toolname=shift @ARGV;
920	>	my $insert=0;
921	>	toolbox()->interactive($interactive);
922	>
923	>	# If no toolname specified then its a full setup
924	>	if ( $toolname eq "" ) {
925	>	# -- add architecture specific directories
926	>	use Utilities::AddDir;
927	>	AddDir::adddir($area->location()."/lib/$ENV{SCRAM_ARCH}");
928	>	AddDir::adddir($area->location()."/bin/$ENV{SCRAM_ARCH}");
929
930	<	# process the expression
931	<	my @vals=();
932	<	my ($name,$rest)=split /=/, $expression, 2;
933	<	@vals=split /,/, $rest;
934	<	if ( defined $name && $name ne "" ) {
935	<	foreach $t ( @tools ) {
631	<	$t->clearfeature($name);
632	<	$t->addfeature($name,@vals);
633	<	$t->save();
930	>	# -- check the releasetop area
931	>	# if the releasetop has the files copy them
932	>	my $releaseobj=_releasearea();
933	>	if ( $releaseobj->copysetup($ENV{LOCALTOP}) ) {
934	>	print "Doing Full Setup\n";
935	>	scrambasics()->setuptoolsinarea($area);
936		}
937		}
938		else {
939	<	$scram->error("Badly formed expression $expression");
939	>	scrambasics()->setuptoolsinarea($area, $toolname,@ARGV);
940		}
941		}
942
943	<	sub tool_setup {
944	<	my $tool=shift;
945	<
946	<	print "Setting Up Tool $tool\n";
947	<	$scram->setuptool($tool,@_);
646	<	}
647	<
648	<	sub tool_list {
649	<	my ($area,@tools)=$scram->tools();
650	<	print "Tool List for ".$area->name()." ".$area->version()."\n";
651	<	print "Location : ".$area->location()."\n";
652	<	print "+"x60;
653	<	print "\n";
654	<
655	<	foreach $t ( @tools ) {
656	<	print $t->name();
657	<	print " ";
658	<	print $t->version();
659	<	print "\n";
660	<	}
661	<	}
662	<
663	<	sub tool_info {
664	<
665	<	my ($area,@tools)=$scram->tools(@_);
666	<	print "Tool Info as configured in ".
667	<	$area->name()." ".$area->version()."\n";
668	<	print "Location : ".$area->location()."\n";
669	<	print "+"x60;
670	<	print "\n";
671	<	if ( $#tools<0 ) {
672	<	print "@_ not found in this area\n";
673	<	exit();
943	>	sub _releasearea {
944	>	if ( !defined $self->{releasearea} ) {
945	>	require Configuration::ConfigArea;
946	>	$self->{releasearea}=Configuration::ConfigArea->new();
947	>	$self->{releasearea}->bootstrapfromlocation($ENV{RELEASETOP});
948		}
949	<
676	<	my (@features, @vals);
677	<	foreach $t ( @tools ) {
678	<	print "Name : ".$t->name();
679	<	print "\n";
680	<	print "Version : ".$t->version();
681	<	print "\n";
682	<	print "URL : ".$t->url();
683	<	print "\n";
684	<	print "cached in : ".$t->file();
685	<	print "\n";
686	<	print "+"x20;
687	<	print "\n";
688	<	@features=$t->features();
689	<	foreach $ft ( @features ) {
690	<	@vals=$t->getfeature($ft);
691	<	foreach $v ( @vals ) {
692	<	print $ft. "=$v\n";
693	<	}
694	<	}
695	<	}
696	<
697	<
698	<	}
699	<
700	<	sub _tooloptions {
701	<	$scram->error("No Options defined for tool subcommand");
949	>	return $self->{releasearea};
950		}
951
952	<	sub help_tool_setup {
953	<	print <<ENDTEXT;
954	<	Description:
955	<	Set up the configuration parameters for a given tool
956	<	Usage :
957	<	scram tool setup tool_name [tool_version]
710	<
711	<	ENDTEXT
712	<	}
713	<
714	<	sub help_tool_info {
715	<	print <<ENDTEXT;
716	<	Description:
717	<	Print out information on the specified tool in the current area
718	<	configuration.
719	<	Usage :
720	<	scram tool info tool_name [tool_version]
721	<
722	<	ENDTEXT
723	<	}
724	<
725	<	sub help_tool_feature {
726	<	print <<ENDTEXT;
727	<	Description:
728	<	Override value(s) of any feature of any given tool
729	<	Usage:
730	<	scram tool feature feature=var1[,var2,var3,...] Tool [version]
731	<	ENDTEXT
732	<	}
733	<
734	<	sub help_tool_list {
735	<	print <<ENDTEXT;
736	<	Description:
737	<	List of currently configured tools available in ther current scram
738	<	area
739	<	Usage :
740	<	scram tool list
741	<
742	<	ENDTEXT
743	<	}
744	<
745	<	# ----------- setup command ------------------------------------------
746	<	sub setup {
747	<	my $toolname=shift @ARGV;
748	<
749	<	if ( ! defined $toolname ) {
750	<	# general area setup for new platform
751	<	print "****** Not yet implemented *****\n";
752	<	}
753	<	else {
754	<	print "For tool setup, please see$bold scram tool setup$normal".
755	<	" command\n";
952	>	# get a toolbox object for the local area
953	>	sub toolbox {
954	>	if ( ! defined $toolbox ) {
955	>	localtop();
956	>	my $area=_localarea();
957	>	$toolbox=scrambasics()->areatoolbox($area);
958		}
959	<
959	>	return $toolbox;
960		}
961
760	–	sub devtest {
761	–	use Utilities::TestClass;
762	–	my $class=shift @ARGV;
763	–
764	–	$scram->devtest($class);
765	–	}
766	–
767	–	# ------------------- HELP routines ----------------------------------
768	–
769	–
962		sub help_db {
963		print <<ENDTEXT;
964		scram database administration command.
#	Line 797 | Line 989 | ENDTEXT
989		sub help_setup {
990
991		print <<ENDTEXT;
992	<	Configure an already existing working area. Useful when porting to new
993	<	platforms etc.
992	>	Allows installation/re-installation of a new tool/external package into an
993	>	already existing development area. If not toolname is specified,
994	>	the complete installation process is initiated.
995
996		Usage:
997
998	<	$bold scram setup $normal
806	<
807	<	ENDTEXT
808	<	exit;
809	<	}
810	<
811	<	sub help_area {
812	<	print <<ENDTEXT;
813	<	Provides access to Scram development area management tools
814	<
815	<	Usage:
816	<
817	<	$bold   scram area $normal [link|unlink|install|uninstall] options
818	<
819	<	Description of subcommnads:
820	<
821	<	${bold}scram area link ${normal}project_tag version_tag
822	<	Attatch the scram area corresponding to the current working directory
823	<	to the named project and version in the central installation
824	<	(see scram list)
998	>	$bold scram setup [-i]$normal [toolname] [[version] [url]]
999
1000	<	${bold}scram area unlink $normal
1001	<	Break a link with the central installation
1002	<
829	<	${bold}scram area install ${normal}[project_tag [version_tag]]
830	<	Create an entry for the current area in the central installation database
831	<	(admin permissions required)
832	<
833	<	${bold}scram area uninstall ${normal}[project_tag [version_tag]]
834	<	Delete entry for the current area in the central installation database
835	<	(admin permissions required)
1000	>	toolname : The name of the tool setup file required.
1001	>	version  : where more than one version exists specify the version
1002	>	url      : when setting up a completely new tool specify the url too
1003
1004	+	The -i option turns off the automatic search mechanism allowing for more
1005	+	user interaction with the setup mechanism
1006		ENDTEXT
838	–	exit;
1007		}
1008
1009		sub help_list {
#	Line 848 | Line 1016 | Usage:
1016		$bold   scram list $normal
1017
1018		ENDTEXT
851	–	exit;
1019		}
1020
1021		sub help_project {
#	Line 898 | Line 1065 | ENDTEXT
1065
1066		sub help_version {
1067		print <<ENDTEXT;
1068	<	With no $bold [version] $normal argument given, this command will simply
1068	>	With now $bold [version] $normal argument given, this command will simply
1069		print to standard output the current version number.
1070
1071		Providing a version argument will cause that version to be downloaded and
1072		installed, if not already locally available.
906	–	[Coming soon: When available locally, your current development area will
907	–	then be associated with the specified scram version rather than the default]
1073
1074
1075		Usage:
#	Line 922 | Line 1087 | Usage:
1087		ENDTEXT
1088		}
1089
925	–	sub help_tool {
926	–	print <<ENDTEXT;
927	–	Manage the tools in the scram area that define the areas environment.
928	–	tool subcommands :
929	–	list
930	–	setup
931	–	feature
932	–	info
933	–
934	–	ENDTEXT
935	–	}
936	–
1090		sub help_runtime {
1091		print <<ENDTEXT;
1092		Echo to Standard Output the Runtime Environment for the current development area
1093		Output available in csh or sh flavours
1094
1095		Usage:
1096	<	$bold   scram runtime [-csh|-sh] $normal
1096	>	1) $bold   scram runtime [-csh|-sh] $normal
1097	>	or
1098	>	2) $bold   scram runtime [-csh|-sh] filename $normal
1099	>	or
1100	>	3) $bold   scram runtime info filename [variable]$normal
1101	>
1102	>	1) For the general configuration environment
1103	>	2) For environment described in filename or
1104	>	areatop/src/directory/BuildFile
1105	>	3) Display information concerning the environment in the given file
1106	>	(limited to variable if specified)
1107	>
1108	>	The file for cases 2) and 3) are searched as follows :
1109	>	a) straightforward filename
1110	>	b) filename relative to local_area/src
1111	>	c) filename relative to release_area/src
1112	>	d) BuildFile relative to local_area/src
1113	>	e) BuildFile relative to release_area/src
1114
1115		Examples:
1116
#	Line 957 | Line 1127 | sh environment
1127
1128		ENDTEXT
1129		}
960	–
961	–	sub helpheader {
962	–	my $label=shift;
963	–	my @sub=@_;
964	–
965	–	my $substring;
966	–	if ( @sub ) {
967	–	$substring=join ' - ', @sub;
968	–	}
969	–	else {
970	–	$substring="";
971	–	}
972	–	print <<ENDTEXT;
973	–	*************************************************************************
974	–	SCRAM HELP ---------$bold scram $substring $label $normal
975	–	*************************************************************************
976	–	ENDTEXT
977	–	}

Diff Legend

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