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.22 by williamc, Wed Apr 14 09:46:02 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
1	>	#!/usr/local/bin/perl5 -w
2		#
3		# User Interface
4		#
5
6	<	$inputcmd=shift;
7	<	$found='false';
6	>	# Make sure were running the right version
7	>	#versioncheck();
8	>
9		$bold  = "\033[1m";
10		$normal = "\033[0m";
11	<	@allowed_commands=qw(project build install version list arch setup);
11	>	@allowed_commands=qw(area project tool options install list arch version setup runtime db devtest doctest);
12
13	<	if ( $inputcmd ne "" ) {
14	<	foreach $command ( @allowed_commands ) {
15	<	if ( $command=~/^$inputcmd/i) {
16	<	# Deal with a help request
16	<	do{     helpheader($command);
17	<	&{"help_".$command}; exit; } if $ARGV[0]=~/help/i;
18	<	&$command; $found='true';
19	<	last;
20	<	}
21	<	}
22	<	}
13	>	use Scram::SCRAM2;
14	>	setupscram();
15	>
16	>	$found=_processcmds("_mainoptions",\@allowed_commands,\@ARGV);
17
18		if ( ! ( $found=~/true/ ) ) {
19		helpheader('Recognised Commands');
#	Line 29 | Line 23 | if ( ! ( $found=~/true/ ) ) {
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 {
#	Line 40 | Line 169 | sub build {
169		use BuildSetup;
170		$ENV{MAKETARGETS}=join ' ',@ARGV;
171		BuildSetup($ENV{THISDIR},@ARGV);
43	–	#       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	<	&localtop;
197	<	chdir $ENV{LOCALTOP};
198	<	use BootStrapProject;
63	<	# get the bootstrap files downloaded
64	<	BootStrapProject("$project\?\?$version");
65	<	# Go setup the rest of the environement, now we can
66	<	LoadEnvFile();
67	<	#
68	<	# Now create the directories specified in the interface
69	<	#
70	<	foreach $key ( keys %ENV ) {
71	<	if ( $key=~/^INT/ ) {
72	<	AddDir::adddir($ENV{$key});
73	<	}
74	<	}
75	<	if ( ! -e "$ENV{LOCALTOP}/$ENV{projconfigdir}" ) {
76	<	system("cp", "-r", "$ENV{RELEASETOP}/$ENV{projconfigdir}",
77	<	"$ENV{LOCALTOP}/$ENV{projconfigdir}");
78	<	}
79	<	use clientfile;
80	<	BuildClientFile( $ENV{SCRAM_ProjReqsDoc} );
81	<	use Cwd;
82	<	print "\nInstallation Procedure Complete. \n".
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 {
270		environmentinit();
271		localtop();
#	Line 90 | 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/cms/Releases";
107	<	print "Warning : Environment Variable SCRAM_HOME not set.\n";
108	<	print "Defaulting to $ENV{SCRAM_HOME}\n";
109	<	}
110	<	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;
331		}
136	–	} #end block
332		($ENV{THISDIR}=cwd)=~s/^\Q$ENV{LOCALTOP}\L//;
333		$ENV{THISDIR}=~s/^\///;
139	–	$ENV{SCRAM_WORKDIR}="$ENV{LOCALTOP}/.SCRAM";
334		}
335
336		sub LoadEnvFile {
#	Line 159 | 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	<	&FullEnvInit;
168	<	if ( $version eq "" ) {
169	<	$version=$ENV{SCRAM_PROJVERSION};
170	<	}
171	<	if ( $tagname eq "" ) {
172	<	$tagname=$ENV{SCRAM_PROJECTNAME};
173	<	}
174	<	my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
175	<	my $outfile="$ENV{SCRAM_CONFIG}/project.lookup.tmp";
176	<	open ( LOCALLOOKUPDB, "<$filename" );
177	<	open ( OUTFILE , ">$outfile" ) or die "Unable to open $outfile $!\n";
178	<	while ( <LOCALLOOKUPDB> ) {
179	<	if ( /^$tagname/ ) {
180	<	print "Related tag :".$_."\n";
181	<	if ( /$version/) {
182	<	print "$tagname $version already exists. Overwrite (y/n)\n";
183	<	if ( ! (<STDIN>=~/y/i ) ) {
184	<	print "Aborting install ...\n";
185	<	close OUTFILE;
186	<	close LOCALLOOKUPDB;
187	<	exit 1;
188	<	}
189	<	}
190	<	else {
191	<	print OUTFILE $_;
192	<	}
193	<	}
194	<	else {
195	<	print OUTFILE $_;
196	<	}
197	<	}
198	<	print OUTFILE "$tagname:$version:file:$ENV{LOCALTOP}".
199	<	"/.SCRAM/InstallFile\n";
200	<	close OUTFILE;
201	<	close LOCALLOOKUPDB;
202	<	copy ( "$outfile", "$filename" )
203	<	|| die "Unable to copy $! \n";
204	<
362	>	sub uninstall {
363	>	$scram->uninstall(@_);
364		}
365
366		sub help_install()  {
208	–
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 213 | 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 {
240	–	&environmentinit;
241	–	my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
242	–	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	<	#
617	<	# Setup a new tool
618	<	#
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	<	&FullEnvInit;
750	<	if ( $ENV{SCRAM_BootStrapFiles}!~/$ENV{LOCALTOP}\/\.SCRAM/ ) {
751	<	$ENV{SCRAM_BootStrapFiles}="$ENV{LOCALTOP}/.SCRAM:".
272	<	$ENV{SCRAM_BootStrapFiles};
273	<	}
274	<	# If no toolname specified then its a full setup
275	<	if ( $toolname eq "" ) {
276	<	my $filebase="$ENV{LOCALTOP}/.SCRAM/$ENV{SCRAM_ARCH}";
277	<	rename "$filebase/clientsettings", "$filebase/clientsettings.old";
278	<	rename "$filebase/clientsettings_reqs",
279	<	"$filebase/clientsettings_reqs.old";
280	<	use clientfile;
281	<	BuildClientFile( $ENV{SCRAM_ProjReqsDoc} );
749	>	if ( ! defined $toolname ) {
750	>	# general area setup for new platform
751	>	print "****** Not yet implemented *****\n";
752		}
753		else {
754	<	# Check for the correct toolfile
755	<	# ideally try and download it if not already in .SCRAM
286	<	# Only scram toolbox files supported so far
287	<	if ( ! -e "$ENV{LOCALTOP}/.SCRAM/$toolname" ) {
288	<	&urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
289	<	.$toolname, "$ENV{LOCALTOP}/.SCRAM/$toolname") ;
290	<	}
291	<	# Parse the toolfile and update the clientsettings file
292	<	# currently just append to the end
293	<	use clientfile;
294	<	clientfile::openclientfile('add');
295	<	clientfile::_tool("file:$toolname");
296	<	closeclientfile;
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	<	Allows installation of a new tool/external package into an already
801	<	existing area. If not toolname is specified, the complete installation
305	<	process is initiated.
800	>	Configure an already existing working area. Useful when porting to new
801	>	platforms etc.
802
803		Usage:
804
805	<	$bold scram setup $normal [toolname]
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
311	–	toolname : The name of the tool setup file required.
837		ENDTEXT
838		exit;
839		}
840
841		sub help_list {
842		print <<ENDTEXT;
843	<	Create an entry in the SCRAM database so that an installed project can be
844	<	referenced in the 'project' command by a tag/version combination.
845	<	Usage: (command to be issued from inside an installed project)
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 install $normal [project_tag [version_tag]]
848	>	$bold   scram list $normal
849
324	–	If not specified the project_tag and version_tag default to the project
325	–	name and version of the installation.
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] $normal project_url [project_version]
860	>	$bold scram project [-d install_area] [-n directory_name]$normal project_url [project_version]
861
862		Options:
863
#	Line 363 | Line 888 | project_version:
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	<	Print the version number of scram
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 $normal
911	>	$bold scram version [version]$normal
912
913		ENDTEXT
914		}
#	Line 384 | Line 921 | 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