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.7 by williamc, Thu Mar 18 08:01:59 1999 UTC vs.
Revision 1.32 by williamc, Wed Mar 29 09:46:58 2000 UTC

#	Line 1 | Line 1
1	<	#!/usr/local/bin/perl5 -I$SCRAM_HOME/src -I/afs/cern.ch/user/w/williamc/public/SCRAM/src
2	<
1	>	#!/usr/local/bin/perl5 -w
2		#
3		# User Interface
4		#
5
6	<	$inputcmd=shift;
7	<	$found='false';
9	<	@allowed_commands=qw(project build env install version list arch);
6	>	# Make sure were running the right version
7	>	#versioncheck();
8
9	<	foreach $command ( @allowed_commands ) {
10	<	do { &$command; $found='true'; last;} if ( $inputcmd=~/^$command\Z/i);
11	<	}
9	>	$bold  = "\033[1m";
10	>	$normal = "\033[0m";
11	>	@allowed_commands=qw(area project tool options install list arch version setup runtime db devtest doctest);
12	>
13	>	use Scram::SCRAM2;
14	>	setupscram();
15	>
16	>	$found=_processcmds("_mainoptions",\@allowed_commands,\@ARGV);
17
18		if ( ! ( $found=~/true/ ) ) {
19	<	print "scram help\n--------\n";
17	<	print "Recognised Commands: \n";
19	>	helpheader('Recognised Commands');
20		foreach $command ( @allowed_commands ) {
21	<	print "       ".$command."\n";
21	>	print "      $bold scram ".$command.$normal."\n";
22		}
23	+	print "\n";
24	+	print "Help on individual commands available through\n\n";
25	+	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();
32	+	}
33	+
34	+	# --------- main command processing routines
35	+
36	+	sub _mainoptions {
37	+	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";
126	+	}
127	+
128	+	sub versioncheck {
129	+	my $version;
130	+	my $thisversion;
131	+
132	+	$thisversion=getversion();
133	+
134	+	if ( ! localtop_find() ) {
135	+	LoadEnvFile();
136	+	my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
137	+	if ( -f $versionfile ) {
138	+	open (VERSION, "<".$versionfile) ;
139	+	$version=<VERSION>;
140	+	chomp $version;
141	+	if ( $version ne $thisversion ) {
142	+	# first try to use the correct version
143	+	if ( -d $scram_top."/".$version ) {
144	+	$ENV{SCRAM_HOME}=$scram_top."/".$version;
145	+	system("scram", @ARGV);
146	+	exit;
147	+	}
148	+	else { # if not then simply warn
149	+	print "******* Warning : scram version inconsistent ********\n";
150	+	print "This version: $thisversion; Required version: $version";
151	+	print "*****************************************************\n";
152	+	print "\n";
153	+	}
154	+	}
155	+	}
156	+	}
157	+	}
158	+
159	+	sub doctest {
160	+	$scram->doctest(@ARGV);
161		}
162
163	+	sub help_build {
164	+	&build;
165	+	}
166		sub build {
167		# is this a based or free release?
168		FullEnvInit();
169		use BuildSetup;
170	+	$ENV{MAKETARGETS}=join ' ',@ARGV;
171		BuildSetup($ENV{THISDIR},@ARGV);
28	–	#       system("$ENV{TOOL_HOME}/BuildSetup",$ENV{THISDIR},@ARGV);
172		}
173
174		sub project {
175		# process options
176		while ( $ARGV[0]=~"^-" ) {
177	<	if ( (shift @ARGV)=~/-d/ ) {  #installation area directory
178	<	chdir $ARGV[0];
177	>	if ( $ARGV[0]=~/-n/ ) {
178	>	shift @ARGV;
179	>	$scram->setoption("ConfigArea_name",shift @ARGV);
180	>	}
181	>	elsif ( $ARGV[0]=~/-d/ ) {  #installation area directory
182		shift @ARGV;
183	+	$scram->setoption("ConfigArea_location",shift @ARGV);
184	+	}
185	+	else {
186	+	print "scram: unknown option $ARGV[0] to project command\n";
187	+	exit;
188		}
189		}
190	<	my $project=shift @ARGV;
191	<	my $version=shift @ARGV;
192	<	environmentinit();
193	<	use File::Copy;
194	<	use Utilities::AddDir;
195	<
196	<	use BootStrapProject;
197	<	# get the bootstrap files downloaded
198	<	BootStrapProject("$project\?\?$version");
199	<	# Go setup the rest of the environement, now we can
200	<	chdir $ENV{LOCALTOP};
201	<	&localtop;
202	<	LoadEnvFile();
203	<	#
204	<	# Now create the directories specified in the interface
205	<	#
206	<	foreach $key ( keys %ENV ) {
207	<	if ( $key=~/^INT/ ) {
208	<	AddDir::adddir($ENV{$key});
209	<	}
210	<	}
211	<	if ( ! -e "$ENV{LOCALTOP}/$ENV{projconfigdir}" ) {
212	<	system("cp", "-r", "$ENV{RELEASETOP}/$ENV{projconfigdir}",
213	<	"$ENV{LOCALTOP}/$ENV{projconfigdir}");
214	<	}
215	<	use clientfile;
216	<	BuildClientFile( $ENV{SCRAM_ProjReqsDoc} );
217	<	use Cwd;
218	<	print "Installation Located at:\n".cwd()."\n";
219	<	print "Press RETURN to exit\n";
220	<	$junk=<STDIN>;
190	>
191	>	# -- work out if we have a url or not
192	>	if ( $ARGV[0]=~/.*:.*/ ) {
193	>	$scram->project(@ARGV);
194	>	}
195	>	else {
196	>	$scram->basedarea(@ARGV);
197	>	}
198	>	print "\nInstallation Procedure Complete. \n".
199	>	"Installation Located at:\n".cwd()."\n";
200	>	}
201	>
202	>	sub runtime {
203	>	my $shell;
204	>	FullEnvInit();
205	>
206	>	# process options
207	>	while ( $ARGV[0]=~"^-" ) {
208	>	if ( $ARGV[0]=~/-sh/ ) {
209	>	shift @ARGV;
210	>	$shell="sh";
211	>	next;
212	>	}
213	>	if ( $ARGV[0]=~/-csh/ ) {  #installation area directory
214	>	shift @ARGV;
215	>	$shell="csh";
216	>	next;
217	>	}
218	>	print "Unknown Option $ARGV[0]\n";
219	>	exit 1;
220	>	}
221	>	print "Not yet implemented\n";
222	>	}
223	>
224	>	# Support rt for runtime
225	>
226	>	sub printoutenv {
227	>	my $shell=shift;
228	>	my $variable=shift;
229	>	my $value=shift;
230	>
231	>	if ( $shell eq "csh" ) {
232	>	print "setenv $variable \"$value\";\n";
233	>	}
234	>	elsif ( $shell eq "sh" ) {
235	>	print "$variable=\"$value\";\n";
236	>	print "export $variable;\n";
237	>	}
238	>	}
239	>
240	>	sub addpath {
241	>	my $name=shift;
242	>	my $val=shift;
243	>
244	>	my $n;
245	>	my @env;
246	>	@env=split /:/, $EnvRuntime{$name};
247	>	foreach $n ( (split /:/, $val ) ){
248	>	if (  ! grep /^\Q$n\E$/, @env ) {
249	>	addvar($name,$n,":");
250	>	}
251	>	}
252	>	}
253	>
254	>	sub addvar {
255	>	my $name=shift;
256	>	my $val=shift;
257	>	my $sep=shift;
258	>
259	>	if ( $val ne "" ) {
260	>	if ( defined $EnvRuntime{$name} ) {
261	>	$EnvRuntime{$name}=$EnvRuntime{$name}.$sep.$val;
262	>	}
263	>	else {
264	>	$EnvRuntime{$name}=$val;
265	>	}
266	>	}
267		}
268
269		sub FullEnvInit {
#	Line 76 | Line 273 | sub FullEnvInit {
273		}
274
275		sub environmentinit {
276	<	use Utilities::setarchitecture;
276	>	#       use Utilities::setarchitecture;
277		my $name;
278		my $value;
279
280		$ENV{LatestBuildFile}=""; # stop recursive behaviour in make
281	<	setarchitecture::setarch();
281	>	#       setarchitecture::setarch();
282		$ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
283		$ENV{INTlib}="lib/$ENV{SCRAM_ARCH}";
284		$ENV{INTsrc}="src";
285		$ENV{INTbin}="bin/$ENV{SCRAM_ARCH}";
286		$ENV{INTlog}="logs";
287
288	<	if ( ! ( exists $ENV{SCRAM_HOME}) ){
289	<	$ENV{SCRAM_HOME}="/afs/cern.ch/user/w/williamc/public/SCRAM";
93	<	print "Warning : Environment Variable SCRAM_HOME not set.\n";
94	<	print "Defaulting to $ENV{SCRAM_HOME}\n";
95	<	}
96	<	if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){
288	>	($ENV{SCRAM_BASEDIR}=$ENV{SCRAM_HOME})=~s/(.*)\/.*/$1/;
289	>	if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){
290		$ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration";
291		}
292		if ( ! ( exists $ENV{TOOL_HOME} ) ){
293		$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
294		}
295		if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) ){
296	<	$ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
296	>	if ( -d "$ENV{SCRAM_BASEDIR}/scramdb/" ) {
297	>	$ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_BASEDIR}/scramdb/project.lookup";
298	>	}
299	>	else {
300	>	$ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
301	>	}
302		}
303	+	$ENV{SCRAM_AVAILDIRS}="";
304	+	$ENV{SCRAM_AVAILFILES}="";
305		}
306
307	<	sub localtop {
307	>	sub localtop_find {
308		# find localtop
309		use Cwd;
310		my $thispath=cwd;
311	+	my $rv=1;
312	+
313		block: {
314		do {
315		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
323	+	return $rv;
324	+	}
325	+
326	+	sub localtop {
327	+	localtop_find();
328		if ( ! (defined $ENV{LOCALTOP}) ) {
329		print "Unable to locate the top of local release. Exiting\n";
330	<	exit 1
330	>	exit 1;
331		}
332	<	} #end block
123	<	($ENV{THISDIR}=cwd)=~s/^$ENV{LOCALTOP}//;
332	>	($ENV{THISDIR}=cwd)=~s/^\Q$ENV{LOCALTOP}\L//;
333		$ENV{THISDIR}=~s/^\///;
125	–	$ENV{SCRAM_WORKDIR}="$ENV{LOCALTOP}/.SCRAM";
334		}
335
336		sub LoadEnvFile {
#	Line 145 | Line 353 | sub env {
353		#
354		# Create a lookup tag in the site database
355		#
356	<	sub install ( $tagname, $version ) {
356	>	sub install  {
357		my $tagname=shift @ARGV;
358		my $version=shift @ARGV;
359	+	$scram->install();
360	+	}
361
362	<	# create database entry
363	<	do { &help_install; } if $tagname=~/help/i;
154	<	&FullEnvInit;
155	<	if ( $version eq "" ) {
156	<	$version=$ENV{SCRAM_PROJVERSION};
157	<	}
158	<	if ( $tagname eq "" ) {
159	<	$tagname=$ENV{SCRAM_PROJECTNAME};
160	<	}
161	<	my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
162	<	my $outfile="$ENV{SCRAM_CONFIG}/project.lookup.tmp";
163	<	open ( LOCALLOOKUPDB, "<$filename" );
164	<	open ( OUTFILE , ">$outfile" );
165	<	while ( <LOCALLOOKUPDB> ) {
166	<	if ( /^$tagname/ ) {
167	<	print "Related tag :".$_."\n";
168	<	if ( /$version/) {
169	<	print "$tagname $version already exists. Overwrite (y/n)\n";
170	<	if ( ! (<STDIN>=~/y/i ) ) {
171	<	print "Aborting install ...\n";
172	<	close OUTFILE;
173	<	close LOCALLOOKUPDB;
174	<	exit 1;
175	<	}
176	<	}
177	<	else {
178	<	print OUTFILE $_;
179	<	}
180	<	}
181	<	else {
182	<	print OUTFILE $_;
183	<	}
184	<	}
185	<	print OUTFILE "$tagname:$version:file:$ENV{LOCALTOP}".
186	<	"/.SCRAM/InstallFile\n";
187	<	close OUTFILE;
188	<	close LOCALLOOKUPDB;
189	<	copy ( "$outfile", "$filename" )
190	<	|| die "Unable to copy $! \n";
191	<
362	>	sub uninstall {
363	>	$scram->uninstall(@_);
364		}
365
366		sub help_install()  {
195	–
196	–	helpheader("install");
367		print <<ENDTEXT;
368		Associates a label with the current release in the SCRAM database.
369		This allows other users to refer to a centrally installed project by
#	Line 201 | Line 371 | this label rather than a remote url refe
371
372		Usage:
373
374	<	scram install [[label] [version]]
374	>	$bold   scram install $normal [project_tag [version_tag]]
375
376	<	label   : override default label (the project name of the current release)
377	<	version : the version tag of the current release. If version is not
376	>	porject_tag : override default label (the project name of the current release)
377	>	version_tag : the version tag of the current release. If version is not
378		specified the base release version will be taken by default.
379
380		ENDTEXT
381		exit;
382		}
383
384	<	sub helpheader ($label) {
385	<	my $label=shift;
386	<	print <<ENDTEXT;
387	<	*************************************************************************
388	<	SCRAM HELP --------- $label
389	<	*************************************************************************
390	<	ENDTEXT
384	>
385	>	sub getversion {
386	>	($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
387	>	$scram_top=$1;
388	>	$scram_version=$thisversion;
389	>	# deal with links
390	>	my $version=readlink $ENV{SCRAM_HOME};
391	>	if ( defined $version)  {
392	>	$scram_version=$version;
393	>	}
394	>	return $scram_version;
395		}
396
397		sub version {
398	<	print "Scram version : prototype\n";
398	>	my $version=shift; # @ARGV;
399	>	my $thisversion;
400	>	my $scram_top;
401	>	my $cvsobject;
402	>
403	>	($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
404	>	$scram_top=$1;
405	>	if ( (! defined $version) ||  ($version eq "") ) {
406	>	print "$thisversion";
407	>	# deal with links
408	>	$version=readlink $ENV{SCRAM_HOME};
409	>	if ( defined $version)  {
410	>	print " ---> $version";
411	>	}
412	>	print "\n";
413	>	}
414	>	else {
415	>	if ( -d $scram_top."/".$version ) {
416	>	print "Version $version exists\n";
417	>	}
418	>	else {
419	>	print "Version $version not available locally\n";
420	>	print "Attempting download from the SCRAM repository\n";
421	>	# set up and configure the cvs module for SCRAM
422	>	use Utilities::CVSmodule;
423	>	$cvsobject=CVSmodule->new();
424	>	$cvsobject->set_base(
425	>	"cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
426	>	$cvsobject->set_auth("pserver");
427	>	$cvsobject->set_user("anonymous");
428	>	$cvsobject->set_passkey("AA_:yZZ3e");
429	>	# Now check it out in the right place
430	>	chdir $scram_top or die "Unable to change to $scram_top $!\n";
431	>	$cvsobject->invokecvs( ( split / /,
432	>	"co -d $version -r $version SCRAM" ));
433	>
434	>	# Get rid of cvs object now weve finished
435	>	$cvsobject=undef;
436	>	print "\n";
437	>	}
438	>	}
439		}
440
441		sub list {
228	–	&environmentinit;
229	–	my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
230	–	open ( LOCALLOOKUPDB, "<$filename" );
442		print "Installed Projects\n";
443		print "------------------\n";
444		print "|Project Name  | Project Version |\n";
445		print "----------------------------------\n";
446	<	while ( <LOCALLOOKUPDB> ) {
447	<	( $name, $version, $type, $url ) = split ":", $_;
446	>	#       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	>	}
486	>	}
487	>
488	>	sub db {
489	>	my $subcmd=shift @ARGV;
490	>	&environmentinit;
491	>
492	>	switch : {
493	>	if ( $subcmd eq 'link' ) {
494	>	dblink($ENV{SCRAM_LOOKUPDB},@ARGV);
495	>	last switch;
496	>	}
497	>	if ( $subcmd eq 'unlink' ) {
498	>	dbunlink($ENV{SCRAM_LOOKUPDB},@ARGV);
499	>	last switch;
500	>	}
501	>	if ( $subcmd eq 'showlinks' ) {
502	>	dblinklist($ENV{SCRAM_LOOKUPDB});
503	>	last switch;
504	>	}
505	>	} # end switch
506	>
507	>	}
508	>
509	>	sub dblinklist {
510	>	my $filename=shift;
511	>	open (LOCALLOOKUPDB, "<$filename")  or
512	>	die "Unable to open local database $!";
513	>	while (<LOCALLOOKUPDB>) {
514	>	if ( $_=~/\!DB (.*)/) {
515	>	print $1,"\n";
516	>	}
517	>	}
518	>	close LOCALLOOKUPDB;
519	>	}
520	>
521	>	sub dblink {
522	>	my $filename=shift;
523	>	my $newdbfilename=shift;
524	>	my $exists=0;
525	>
526	>	if ( -e $filename ) {
527	>	if ( -e $newdbfilename ) {
528	>	# Check if its already there
529	>	open (LOCALLOOKUPDB, "<$filename")  or
530	>	die "Unable to open local database $!";
531	>	while (<LOCALLOOKUPDB>) {
532	>	if ( $_=~/\!DB $newdbfilename/ ) {
533	>	$exists=1;
534	>	last;
535	>	}
536	>	}
537	>	close LOCALLOOKUPDB;
538	>	# Add it
539	>	if ( ! $exists ) {
540	>	open (LOCALLOOKUPDB, ">>$filename")  or
541	>	die "Unable to open local database $!";
542	>	print LOCALLOOKUPDB "\!DB $newdbfilename\n";
543	>	close LOCALLOOKUPDB;
544	>	}
545	>	}
546	>	else {
547	>	print "Unknown file $newdbfilename\n";
548	>	exit();
549	>	}
550	>	}
551	>	else {
552	>	print "Unknown file $filename $!\n";
553	>	exit();
554	>	}
555	>
556	>	}
557	>
558	>	sub dbunlink {
559	>	my $filename=shift;
560	>	my $dbfilename=shift;
561	>	if ( -e $filename ) {
562	>	# Check if its already there
563	>	open (LOCALLOOKUPDB, "<$filename")  or
564	>	die "Unable to open local database $!";
565	>	open (DBOUTFILE, ">$filename.tmp") or
566	>	die "Unable to open working file $!";
567	>	while (<LOCALLOOKUPDB>) {
568	>	if ( $_!~/\!DB $dbfilename/ ) {
569	>	print DBOUTFILE $_;
570	>	}
571	>	}
572	>	close LOCALLOOKUPDB;
573	>	close DBOUTFILE;
574	>	use File::Copy;
575	>	rename "$filename.tmp", $filename;
576	>	}
577	>	}
578	>
579	>	sub listdb {
580	>	my $filename=shift;
581	>	my $map;
582	>
583	>	use FileHandle;
584	>	my $fh=FileHandle->new();
585	>	open ( $fh, "<$filename" );
586	>	while ( $map=<$fh> ) {
587	>	if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
588	>	my $db=$1;
589	>	if ( -f $db ) {
590	>	listdb($db);
591	>	}
592	>	next;
593	>	}
594	>	( $name, $version, $type, $url ) = split ":", $map;
595		printf "%1s",$name;
596		printf "%25s\n",$version;
597		printf "--> %25s\n",$type.":".$url;
598		}
599	<	close LOCALLOOKUPDB;
599	>	close $fh;
600		}
601
602		sub arch {
603	<	&environmentinit();
604	<	print "$ENV{SCRAM_ARCH}\n";
603	>	print $scram->arch()->arch()."\n";
604	>	}
605	>
606	>	sub setupscram {
607	>	$scram=Scram::SCRAM2->new();
608	>	}
609	>
610	>	# ------------ tool command --------------------------------------------
611	>	sub tool {
612	>	my @allowed_cmds=qw(setup info list feature);
613	>	_processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));
614	>	}
615	>
616	>	sub tool_feature {
617	>	my $expression=shift;
618	>	my ($area,@tools)=$scram->tools(@_);
619	>
620	>	if ( $#tools<0 ) {
621	>	print "@_ not found in this area\n";
622	>	exit();
623	>	}
624	>
625	>	# process the expression
626	>	my @vals=();
627	>	my ($name,$rest)=split /=/, $expression, 2;
628	>	@vals=split /,/, $rest;
629	>	if ( defined $name && $name ne "" ) {
630	>	foreach $t ( @tools ) {
631	>	$t->clearfeature($name);
632	>	$t->addfeature($name,@vals);
633	>	$t->save();
634	>	}
635	>	}
636	>	else {
637	>	$scram->error("Badly formed expression $expression");
638	>	}
639	>	}
640	>
641	>	sub tool_setup {
642	>	my $tool=shift;
643	>
644	>	print "Setting Up Tool $tool\n";
645	>	$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();
674	>	}
675	>
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");
702	>	}
703	>
704	>	sub help_tool_setup {
705	>	print <<ENDTEXT;
706	>	Description:
707	>	Set up the configuration parameters for a given tool
708	>	Usage :
709	>	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";
756	>	}
757	>
758	>	}
759	>
760	>	sub devtest {
761	>	use Utilities::TestClass;
762	>	my $class=shift @ARGV;
763	>
764	>	$scram->devtest($class);
765	>	}
766	>
767	>	# ------------------- HELP routines ----------------------------------
768	>
769	>
770	>	sub help_db {
771	>	print <<ENDTEXT;
772	>	scram database administration command.
773	>
774	>	Usage:
775	>
776	>	$bold scram db $normal subcommand
777	>
778	>	subcommands:
779	>	link :
780	>	Make available an additional database for
781	>	project and list operations
782	>
783	>	$bold scram db link $normal /a/directory/path/project.lookup
784	>
785	>	unlink :
786	>	Remove a database from the link list. Note this does
787	>	not remove the database, just the link to it in scram.
788	>
789	>	$bold scram db unlink $normal /a/directory/path/project.lookup
790	>
791	>	showlinks :
792	>	List the databases that are linked in
793	>
794	>	ENDTEXT
795	>	}
796	>
797	>	sub help_setup {
798	>
799	>	print <<ENDTEXT;
800	>	Configure an already existing working area. Useful when porting to new
801	>	platforms etc.
802	>
803	>	Usage:
804	>
805	>	$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)
825	>
826	>	${bold}scram area unlink $normal
827	>	Break a link with the central installation
828	>
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)
836	>
837	>	ENDTEXT
838	>	exit;
839	>	}
840	>
841	>	sub help_list {
842	>	print <<ENDTEXT;
843	>	List the available projects and versions installed in the local SCRAM database
844	>	(see scram install help)
845	>
846	>	Usage:
847	>
848	>	$bold   scram list $normal
849	>
850	>	ENDTEXT
851	>	exit;
852	>	}
853	>
854	>	sub help_project {
855	>	print <<ENDTEXT;
856	>	Setup a new project development area. The new area will appear in the current
857	>	working directory.
858	>	Usage:
859	>
860	>	$bold scram project [-d install_area] [-n directory_name]$normal project_url [project_version]
861	>
862	>	Options:
863	>
864	>	project_url: The url of a scram bootstrap file.
865	>	Currently supported types are:
866	>	$bold Database label $normal
867	>	Labels can be assigned to bootstrap files for easy
868	>	access (See "scram install" command). If you
869	>	specify a label you must also specify a project_version.
870	>	e.g.
871	>
872	>	scram project SCRAM V1_0
873	>
874	>	scram project ORCA ORCA_1_1_1
875	>
876	>	To see the list of installed projects use the
877	>	"scram list" command.
878	>
879	>	$bold file: $normal A regular file on an accessable file system
880	>	e.g.
881	>
882	>	file:~/myprojects/projecta/config/BootStrapFile
883	>
884	>	project_version:
885	>	Only for use with a database label
886	>
887	>	-d install_area:
888	>	Indicate a project installation area into which the new
889	>	project area should appear. Default is the current working
890	>	directory.
891	>
892	>	-n directory_name:
893	>	Specify the name of the SCRAM development area you wish to
894	>	create.
895	>
896	>	ENDTEXT
897	>	}
898	>
899	>	sub help_version {
900	>	print <<ENDTEXT;
901	>	With no $bold [version] $normal argument given, this command will simply
902	>	print to standard output the current version number.
903	>
904	>	Providing a version argument will cause that version to be downloaded and
905	>	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]
908	>
909	>
910	>	Usage:
911	>	$bold scram version [version]$normal
912	>
913	>	ENDTEXT
914	>	}
915	>
916	>	sub help_arch {
917	>	print <<ENDTEXT;
918	>	Print out the architecture flag for the current machine.
919	>
920	>	Usage:
921	>	$bold   scram arch $normal
922	>	ENDTEXT
923	>	}
924	>
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	>
937	>	sub help_runtime {
938	>	print <<ENDTEXT;
939	>	Echo to Standard Output the Runtime Environment for the current development area
940	>	Output available in csh or sh flavours
941	>
942	>	Usage:
943	>	$bold   scram runtime [-csh|-sh] $normal
944	>
945	>	Examples:
946	>
947	>	Setup the current environment to include the project Runtime Environment
948	>	in a csh environment
949	>
950	>	$bold  eval `scram runtime -csh` $normal
951	>
952	>	Setup the current environment to include the project Runtime Environment in a
953	>	sh environment
954	>
955	>	$bold  eval `scram runtime -sh` $normal
956	>
957	>
958	>	ENDTEXT
959	>	}
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