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.24 by williamc, Fri Jun 4 16:56:10 1999 UTC vs.
Revision 1.29 by williamc, Tue Feb 22 16:13:00 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 runtime devtest);
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 devtest {
31	<	use Utilities::testclass;
32	<	my $class;
37	<	my $tester;
38	<
39	<	$class=shift @ARGV;
40	<	$tester=testclass->new($class);
41	<	$tester->dotest(@ARGV);
42	<	}
43	<
44	<	sub test_setup {
45	<	my $tool;
46	<	my $toolversion;
47	<	my $interactive=0;
48	<	my $listonly=0;
49	<
50	<	# process options
51	<	while ( $ARGV[0]=~"^-" ) { # turn on interactive setup mode
52	<	if ( $ARGV[0]=~/-i/ ) {
53	<	shift @ARGV;
54	<	$interactive=1;
55	<	print "Entering Interactive Setup Mode\n";
56	<	next;
57	<	}
58	<	if ( $ARGV[0]=~/-r/ ) {
59	<	shift @ARGV;
60	<	$listonly=1;
61	<	print "---------------- Project Requirements List -----------\n";
62	<	next;
63	<	}
64	<	print "Error : Unknown Option $ARGV[0]\n";
65	<	help_setup();
66	<	exit 1;
67	<	}
68	<	my $toolname=shift @ARGV;
69	<	my $version=shift @ARGV;
30	>	sub options {
31	>	help_options();
32	>	}
33
34	<	&FullEnvInit();
72	<	&RequirementsInit;
34	>	# --------- main command processing routines
35
36	<	if ( $toolname ne "" ) {
37	<	_setuptool($interactive, $toolname, $version);
38	<	}
39	<	else {
40	<	$reqobj->IteratorReset;
41	<	while ( ( $toolname=$reqobj->IteratorNext() ) ne "" ) {
42	<	if ( $listonly ) {
43	<	print $bold.$toolname.$normal.
44	<	" version ".$reqobj->Version($toolname)."\n";
45	<	}
46	<	else {
47	<	_setuptool
48	<	($interactive, $toolname, $reqobj->Version("$toolname"));
49	<	}
50	<	}
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 @ARGV);
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 _setuptool {
68	<	my $tool;
69	<	my $toolversion;
70	<	my $interactive=shift;
71	<	my $toolname=shift;
72	<	my $version=shift;
73	<
74	<
75	<	if ( ( $version eq "" ) && ( $interactive == 0 )) {
76	<	#if not specified set to that of req. doc
77	<	$version=$reqobj->Version($toolname);
78	<	}
79	<
80	<	# ideally try and download it if not already in .SCRAM
81	<	# Only scram toolbox files supported so far
82	<	if ( ! -e "$ENV{LOCALTOP}/.SCRAM/$toolname" ) {
83	<	&urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
84	<	.$toolname, "$ENV{LOCALTOP}/.SCRAM/$toolname") ;
85	<	}
86	<	use ToolSetup;
87	<	$tool=ToolSetup->new("$ENV{LOCALTOP}/.SCRAM/$toolname");
88	<
89	<	# check we have a version
90	<	if ( $interactive == 0 ) {
91	<	$tool->UnSetInteractive();
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	>	while ( ${$cmds}[0]=~/^-/) {
83	>	&{$optionhandler}( ${$cmds}[0],$cmds);
84	>	}
85	>
86	>	my $inputcmd=shift @{$cmds};
87	>	if ( $inputcmd ne "" ) {
88	>	foreach $command ( @{$allowed_commands} ) {
89	>	if ( $command=~/^$inputcmd/i) {
90	>	# Deal with a help request
91	>	if ( ( defined $$cmds[0]) && $$cmds[0]=~/help/i ) {
92	>	&helpheader($command,@subs);
93	>	&{"help_".$substring.$command}; exit;
94	>	}
95	>	else {
96	>	#print "calling $substring".$command."(@{$cmds})\n";
97	>	&{$substring.$command}(@{$cmds}); $found='true';
98	>	last;
99	>	}
100	>	}
101	>	}
102	>	}
103	>	return $found;
104	>	}
105	>
106	>	sub help_options {
107	>	helpheader('Main SCRAM options');
108	>	print "$bold -arch ".$normal."architecture \n";
109	>	print "\tPretend to be the specified architecture\n\n";
110	>	print "$bold -f $normal \n";
111	>	print "\tForced update of urls instead of using"
112	>	." the cached\n\tversions\n\n";
113	>	print "$bold -re $normal\n";
114	>	print "\tRequest Exit - Scram will ask the user to enter RETURN\n".
115	>	"\tat the end of the process rather than exiting directly\n";
116	>	print "\tUseful for use where scram is run as a forked process\n\n";
117	>	print "$bold -update ".$normal."string \n";
118	>	print "\tAs -f but only update the url that matches the \n";
119	>	print "\tgiven string\n\n";
120	>	print "$bold -verbose ".$normal."object \n";
121	>	print "\tTurn on the verbose mode for the specified object.\n";
122	>	print "\tThe special object \"all\" will turn on verbosity for\n";
123	>	print "\tall objects that support verbosity\n\n";
124	>	}
125	>
126	>	sub versioncheck {
127	>	my $version;
128	>	my $thisversion;
129	>
130	>	$thisversion=getversion();
131	>
132	>	if ( ! localtop_find() ) {
133	>	LoadEnvFile();
134	>	my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
135	>	if ( -f $versionfile ) {
136	>	open (VERSION, "<".$versionfile) ;
137	>	$version=<VERSION>;
138	>	chomp $version;
139	>	if ( $version ne $thisversion ) {
140	>	# first try to use the correct version
141	>	if ( -d $scram_top."/".$version ) {
142	>	$ENV{SCRAM_HOME}=$scram_top."/".$version;
143	>	system("scram", @ARGV);
144	>	exit;
145	>	}
146	>	else { # if not then simply warn
147	>	print "******* Warning : scram version inconsistent ********\n";
148	>	print "This version: $thisversion; Required version: $version";
149	>	print "*****************************************************\n";
150	>	print "\n";
151	>	}
152	>	}
153		}
118	–	else {
119	–	$tool->SetInteractive();
154		}
155	<	$tool->Setup($toolname, $version);
156	<
155	>	}
156	>
157	>	sub doctest {
158	>	$scram->doctest(@ARGV);
159		}
160
161		sub help_build {
#	Line 131 | Line 167 | sub build {
167		use BuildSetup;
168		$ENV{MAKETARGETS}=join ' ',@ARGV;
169		BuildSetup($ENV{THISDIR},@ARGV);
134	–	#       system("$ENV{TOOL_HOME}/BuildSetup",$ENV{THISDIR},@ARGV);
170		}
171
172		sub project {
#	Line 139 | Line 174 | sub project {
174		while ( $ARGV[0]=~"^-" ) {
175		if ( $ARGV[0]=~/-n/ ) {
176		shift @ARGV;
177	<	$ENV{devareaname}=shift @ARGV;
177	>	$self->setoptions("ConfigArea_name",shift @ARGV);
178		}
179	<	if ( $ARGV[0]=~/-d/ ) {  #installation area directory
145	<	shift @ARGV;
146	<	chdir $ARGV[0];
179	>	elsif ( $ARGV[0]=~/-d/ ) {  #installation area directory
180		shift @ARGV;
181	+	$self->setoptions("ConfigArea_location",shift @ARGV);
182	+	}
183	+	else {
184	+	print "scram: unknown option $ARGV[0] to project command\n";
185	+	exit;
186		}
187		}
188	<	my $project=shift @ARGV;
189	<	my $version=shift @ARGV;
190	<	environmentinit();
191	<	use File::Copy;
192	<	use Utilities::AddDir;
193	<
194	<	use BootStrapProject2;
195	<	# get the bootstrap files downloaded
196	<	#          BootStrapProject("$project\?\?$version");
159	<	$bootstrapper->BootStrap("$project\?\?$version");
160	<	# Go setup the rest of the environement, now we can
161	<	chdir $ENV{LOCALTOP};
162	<	&localtop;
163	<	LoadEnvFile();
164	<	#
165	<	# Now create the directories specified in the interface
166	<	#
167	<	foreach $key ( keys %ENV ) {
168	<	if ( $key=~/^INT/ ) {
169	<	AddDir::adddir($ENV{$key});
170	<	}
171	<	}
172	<	if ( ! -e "$ENV{LOCALTOP}/$ENV{projconfigdir}" ) {
173	<	system("cp", "-r", "$ENV{RELEASETOP}/$ENV{projconfigdir}",
174	<	"$ENV{LOCALTOP}/$ENV{projconfigdir}");
175	<	}
176	<	use clientfile;
177	<	BuildClientFile( $ENV{SCRAM_ProjReqsDoc} );
178	<	use Cwd;
179	<	print "\nInstallation Procedure Complete. \n".
188	>
189	>	# -- work out if we have a url or not
190	>	if ( $ARGV[0]=~/.*:.*/ ) {
191	>	$scram->project(@ARGV);
192	>	}
193	>	else {
194	>	$scram->basedarea(@ARGV);
195	>	}
196	>	print "\nInstallation Procedure Complete. \n".
197		"Installation Located at:\n".cwd()."\n";
198		}
199
200		sub runtime {
201		my $shell;
202	<	environmentinit();
186	<	localtop();
202	>	FullEnvInit();
203
204		# process options
205		while ( $ARGV[0]=~"^-" ) {
#	Line 200 | Line 216 | sub runtime {
216		print "Unknown Option $ARGV[0]\n";
217		exit 1;
218		}
219	<	open (file, "$ENV{LOCALTOP}/.SCRAM/$ENV{SCRAM_ARCH}/clientsettings" )
204	<	or die "Unable to open file ".
205	<	"$ENV{LOCALTOP}/.SCRAM/$ENV{SCRAM_ARCH}/clientsettings $!";
206	<	while( <file> ) {
207	<	chomp;
208	<	next if /^#/;
209	<	next if /^\s*$/;
210	<	($product, $version, $type, $variable, $value, @junk)=split /:/;
211	<	next if ( $variable=~/\&/ );
212	<	if ( $type=~/^R/ ) {
213	<	if ( ( $type=~/path/ ) ) { #type Rtype
214	<	addvar($variable,$value,":"); # Colon seperated
215	<	}
216	<	else {                   #type R
217	<	addvar($variable,$value," "); # Add with spaces
218	<	}
219	<	}
220	<	}
221	<	close file;
222	<	addvar("LD_LIBRARY_PATH","$ENV{LOCALTOP}/lib/$ENV{SCRAM_ARCH}",":");
223	<	addvar("PATH","$ENV{LOCALTOP}/bin/$ENV{SCRAM_ARCH}",":");
224	<	# We have to clean up from the last runtime cmd - use env history
225	<	foreach $variable ( %ENV ) {
226	<	if ( $variable=~/^SCRAMRT_(.*)/ ) { #SCRAMRT are history retaining
227	<	$ENV{$1}=~s/\Q$ENV{$variable}\N\:*//;
228	<	delete $ENV{$variable};
229	<	}
230	<	}
231	<	# create new SCRAMRT history vars.
232	<	foreach $variable ( keys %EnvRuntime ) {
233	<	addvar("SCRAMRT_$variable", $EnvRuntime{$variable}, "");
234	<	}
235	<	# Now adapt as necessary - include base environment as well
236	<	addvar("LD_LIBRARY_PATH","$ENV{LD_LIBRARY_PATH}",":");
237	<	addvar("PATH","$ENV{PATH}",":");
238	<	# Print out as reqd
239	<	foreach $variable ( keys %EnvRuntime ) {
240	<	if ( $shell eq "csh" ) {
241	<	print "setenv $variable \"$EnvRuntime{$variable}\";\n";
242	<	}
243	<	elsif ( $shell eq "sh" ) {
244	<	print "export $variable=$EnvRuntime{$variable};\n";
245	<	}
246	<	}
219	>	print "Not yet implemented\n";
220		}
221
222		# Support rt for runtime
223	+
224	+	sub printoutenv {
225	+	my $shell=shift;
226	+	my $variable=shift;
227	+	my $value=shift;
228	+
229	+	if ( $shell eq "csh" ) {
230	+	print "setenv $variable \"$value\";\n";
231	+	}
232	+	elsif ( $shell eq "sh" ) {
233	+	print "$variable=\"$value\";\n";
234	+	print "export $variable;\n";
235	+	}
236	+	}
237	+
238	+	sub addpath {
239	+	my $name=shift;
240	+	my $val=shift;
241	+
242	+	my $n;
243	+	my @env;
244	+	@env=split /:/, $EnvRuntime{$name};
245	+	foreach $n ( (split /:/, $val ) ){
246	+	if (  ! grep /^\Q$n\E$/, @env ) {
247	+	addvar($name,$n,":");
248	+	}
249	+	}
250	+	}
251	+
252		sub addvar {
253		my $name=shift;
254		my $val=shift;
#	Line 269 | Line 271 | sub FullEnvInit {
271		}
272
273		sub environmentinit {
274	<	use Utilities::setarchitecture;
274	>	#       use Utilities::setarchitecture;
275		my $name;
276		my $value;
277
278		$ENV{LatestBuildFile}=""; # stop recursive behaviour in make
279	<	setarchitecture::setarch();
279	>	#       setarchitecture::setarch();
280		$ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
281		$ENV{INTlib}="lib/$ENV{SCRAM_ARCH}";
282		$ENV{INTsrc}="src";
283		$ENV{INTbin}="bin/$ENV{SCRAM_ARCH}";
284		$ENV{INTlog}="logs";
285
286	<	if ( ! ( exists $ENV{SCRAM_HOME}) ){
287	<	$ENV{SCRAM_HOME}="/afs/cern.ch/cms/Releases";
286	<	print "Warning : Environment Variable SCRAM_HOME not set.\n";
287	<	print "Defaulting to $ENV{SCRAM_HOME}\n";
288	<	}
289	<	if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){
286	>	($ENV{SCRAM_BASEDIR}=$ENV{SCRAM_HOME})=~s/(.*)\/.*/$1/;
287	>	if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){
288		$ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration";
289		}
290		if ( ! ( exists $ENV{TOOL_HOME} ) ){
291		$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
292		}
293		if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) ){
294	<	$ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
294	>	if ( -d "$ENV{SCRAM_BASEDIR}/scramdb/" ) {
295	>	$ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_BASEDIR}/scramdb/project.lookup";
296	>	}
297	>	else {
298	>	$ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
299	>	}
300		}
301	+	$ENV{SCRAM_AVAILDIRS}="";
302	+	$ENV{SCRAM_AVAILFILES}="";
303		}
304
305	<	sub localtop {
305	>	sub localtop_find {
306		# find localtop
307		use Cwd;
308		my $thispath=cwd;
309	+	my $rv=1;
310	+
311		block: {
312		do {
313		if ( -e "$thispath/.SCRAM" ) {
314		$ENV{LOCALTOP}=$thispath;
315	+	$ENV{SCRAM_WORKDIR}="$ENV{LOCALTOP}/.SCRAM";
316	+	$rv=0;
317		last block;
318		}
319		} while ( ( $thispath=~s/(.*)\/.*/$1/ )=~/./  );
320	+	} #end block
321	+	return $rv;
322	+	}
323	+
324	+	sub localtop {
325	+	localtop_find();
326		if ( ! (defined $ENV{LOCALTOP}) ) {
327		print "Unable to locate the top of local release. Exiting\n";
328		exit 1;
329		}
315	–	} #end block
330		($ENV{THISDIR}=cwd)=~s/^\Q$ENV{LOCALTOP}\L//;
331		$ENV{THISDIR}=~s/^\///;
318	–	$ENV{SCRAM_WORKDIR}="$ENV{LOCALTOP}/.SCRAM";
332		}
333
334		sub LoadEnvFile {
#	Line 335 | Line 348 | sub env {
348		print "Sorry - Not yet\n";
349		}
350
338	–	sub RequirementsInit {
339	–	use Requirements;
340	–	$reqobj=Requirements->new($ENV{SCRAM_ProjReqsDoc});
341	–	}
342	–
351		#
352		# Create a lookup tag in the site database
353		#
354	<	sub install ( $tagname, $version ) {
354	>	sub install  {
355		my $tagname=shift @ARGV;
356		my $version=shift @ARGV;
357	+	$scram->install();
358	+	}
359
360	<	# create database entry
361	<	&FullEnvInit;
352	<	if ( $version eq "" ) {
353	<	$version=$ENV{SCRAM_PROJVERSION};
354	<	}
355	<	if ( $tagname eq "" ) {
356	<	$tagname=$ENV{SCRAM_PROJECTNAME};
357	<	}
358	<	my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
359	<	my $outfile="$ENV{SCRAM_CONFIG}/project.lookup.tmp";
360	<	open ( LOCALLOOKUPDB, "<$filename" );
361	<	open ( OUTFILE , ">$outfile" ) or die "Unable to open $outfile $!\n";
362	<	while ( <LOCALLOOKUPDB> ) {
363	<	if ( /^$tagname/ ) {
364	<	print "Related tag :".$_."\n";
365	<	if ( /$version/) {
366	<	print "$tagname $version already exists. Overwrite (y/n)\n";
367	<	if ( ! (<STDIN>=~/y/i ) ) {
368	<	print "Aborting install ...\n";
369	<	close OUTFILE;
370	<	close LOCALLOOKUPDB;
371	<	exit 1;
372	<	}
373	<	}
374	<	else {
375	<	print OUTFILE $_;
376	<	}
377	<	}
378	<	else {
379	<	print OUTFILE $_;
380	<	}
381	<	}
382	<	print OUTFILE "$tagname:$version:file:$ENV{LOCALTOP}".
383	<	"/.SCRAM/InstallFile\n";
384	<	close OUTFILE;
385	<	close LOCALLOOKUPDB;
386	<	copy ( "$outfile", "$filename" )
387	<	|| die "Unable to copy $! \n";
388	<
360	>	sub uninstall {
361	>	$scram->uninstall(@ARGV);
362		}
363
364		sub help_install()  {
#	Line 397 | Line 370 | this label rather than a remote url refe
370
371		Usage:
372
373	<	scram install [[label] [version]]
373	>	$bold   scram install $normal [project_tag [version_tag]]
374
375	<	label   : override default label (the project name of the current release)
376	<	version : the version tag of the current release. If version is not
375	>	porject_tag : override default label (the project name of the current release)
376	>	version_tag : the version tag of the current release. If version is not
377		specified the base release version will be taken by default.
378
379		ENDTEXT
380		exit;
381		}
382
383	<	sub helpheader ($label) {
384	<	my $label=shift;
385	<	print <<ENDTEXT;
386	<	*************************************************************************
387	<	SCRAM HELP --------- $label
388	<	*************************************************************************
389	<	ENDTEXT
383	>
384	>	sub getversion {
385	>	($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
386	>	$scram_top=$1;
387	>	$scram_version=$thisversion;
388	>	# deal with links
389	>	my $version=readlink $ENV{SCRAM_HOME};
390	>	if ( defined $version)  {
391	>	$scram_version=$version;
392	>	}
393	>	return $scram_version;
394		}
395
396		sub version {
#	Line 425 | Line 402 | sub version {
402		($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
403		$scram_top=$1;
404		if ( $version eq "" ) {
405	<	print "$thisversion\n";
405	>	print "$thisversion";
406	>	# deal with links
407	>	$version=readlink $ENV{SCRAM_HOME};
408	>	if ( defined $version)  {
409	>	print " ---> $version";
410	>	}
411	>	print "\n";
412		}
413		else {
414		if ( -d $scram_top."/".$version ) {
#	Line 433 | Line 416 | sub version {
416		}
417		else {
418		print "Version $version not available locally\n";
419	<	print "Attempting download from the SCRAM repository";
419	>	print "Attempting download from the SCRAM repository\n";
420		# set up and configure the cvs module for SCRAM
421	<	use Utilities::cvsmodule;
422	<	$cvsobject=cvsmodule->new();
421	>	use Utilities::CVSmodule;
422	>	$cvsobject=CVSmodule->new();
423		$cvsobject->set_base(
424		"cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
425		$cvsobject->set_auth("pserver");
#	Line 455 | Line 438 | sub version {
438		}
439
440		sub list {
458	–	&environmentinit;
459	–	my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
460	–	open ( LOCALLOOKUPDB, "<$filename" );
441		print "Installed Projects\n";
442		print "------------------\n";
443		print "|Project Name  | Project Version |\n";
444		print "----------------------------------\n";
445	<	while ( <LOCALLOOKUPDB> ) {
446	<	( $name, $version, $type, $url ) = split ":", $_;
445	>	#       listdb($filename);
446	>	my @areas=$scram->listprojects();
447	>	foreach $area ( @areas ) {
448	>	print $area->name()."\t".$area->version()."\n";
449	>	print "\t-->".$area->location()."\n";
450	>	}
451	>	}
452	>
453	>	sub area {
454	>	my $subcmd=shift @ARGV;
455	>
456	>	switch : {
457	>	if ( $subcmd eq 'link' ) {
458	>	$scram->link(@ARGV);
459	>	last switch;
460	>	}
461	>	elsif ( $subcmd eq 'unlink' ) {
462	>	$scram->unlink();
463	>	last switch;
464	>	}
465	>	elsif ( $subcmd eq 'install' ) {
466	>	install();
467	>	}
468	>	elsif ( $subcmd eq 'uninstall' ) {
469	>	uninstall();
470	>	}
471	>	}
472	>	}
473	>
474	>	sub db {
475	>	my $subcmd=shift @ARGV;
476	>	&environmentinit;
477	>
478	>	switch : {
479	>	if ( $subcmd eq 'link' ) {
480	>	dblink($ENV{SCRAM_LOOKUPDB},@ARGV);
481	>	last switch;
482	>	}
483	>	if ( $subcmd eq 'unlink' ) {
484	>	dbunlink($ENV{SCRAM_LOOKUPDB},@ARGV);
485	>	last switch;
486	>	}
487	>	if ( $subcmd eq 'showlinks' ) {
488	>	dblinklist($ENV{SCRAM_LOOKUPDB});
489	>	last switch;
490	>	}
491	>	} # end switch
492	>
493	>	}
494	>
495	>	sub dblinklist {
496	>	my $filename=shift;
497	>	open (LOCALLOOKUPDB, "<$filename")  or
498	>	die "Unable to open local database $!";
499	>	while (<LOCALLOOKUPDB>) {
500	>	if ( $_=~/\!DB (.*)/) {
501	>	print $1,"\n";
502	>	}
503	>	}
504	>	close LOCALLOOKUPDB;
505	>	}
506	>
507	>	sub dblink {
508	>	my $filename=shift;
509	>	my $newdbfilename=shift;
510	>	my $exists=0;
511	>
512	>	if ( -e $filename ) {
513	>	if ( -e $newdbfilename ) {
514	>	# Check if its already there
515	>	open (LOCALLOOKUPDB, "<$filename")  or
516	>	die "Unable to open local database $!";
517	>	while (<LOCALLOOKUPDB>) {
518	>	if ( $_=~/\!DB $newdbfilename/ ) {
519	>	$exists=1;
520	>	last;
521	>	}
522	>	}
523	>	close LOCALLOOKUPDB;
524	>	# Add it
525	>	if ( ! $exists ) {
526	>	open (LOCALLOOKUPDB, ">>$filename")  or
527	>	die "Unable to open local database $!";
528	>	print LOCALLOOKUPDB "\!DB $newdbfilename\n";
529	>	close LOCALLOOKUPDB;
530	>	}
531	>	}
532	>	else {
533	>	print "Unknown file $newdbfilename\n";
534	>	exit();
535	>	}
536	>	}
537	>	else {
538	>	print "Unknown file $filename $!\n";
539	>	exit();
540	>	}
541	>
542	>	}
543	>
544	>	sub dbunlink {
545	>	my $filename=shift;
546	>	my $dbfilename=shift;
547	>	if ( -e $filename ) {
548	>	# Check if its already there
549	>	open (LOCALLOOKUPDB, "<$filename")  or
550	>	die "Unable to open local database $!";
551	>	open (DBOUTFILE, ">$filename.tmp") or
552	>	die "Unable to open working file $!";
553	>	while (<LOCALLOOKUPDB>) {
554	>	if ( $_!~/\!DB $dbfilename/ ) {
555	>	print DBOUTFILE $_;
556	>	}
557	>	}
558	>	close LOCALLOOKUPDB;
559	>	close DBOUTFILE;
560	>	use File::Copy;
561	>	rename "$filename.tmp", $filename;
562	>	}
563	>	}
564	>
565	>	sub listdb {
566	>	my $filename=shift;
567	>	my $map;
568	>
569	>	use FileHandle;
570	>	my $fh=FileHandle->new();
571	>	open ( $fh, "<$filename" );
572	>	while ( $map=<$fh> ) {
573	>	if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
574	>	my $db=$1;
575	>	if ( -f $db ) {
576	>	listdb($db);
577	>	}
578	>	next;
579	>	}
580	>	( $name, $version, $type, $url ) = split ":", $map;
581		printf "%1s",$name;
582		printf "%25s\n",$version;
583		printf "--> %25s\n",$type.":".$url;
584		}
585	<	close LOCALLOOKUPDB;
585	>	close $fh;
586		}
587
588		sub arch {
589	<	&environmentinit();
476	<	print "$ENV{SCRAM_ARCH}\n";
589	>	print $scram->arch()->arch()."\n";
590		}
591
592	+	sub setupscram {
593	+	$scram=Scram::SCRAM2->new();
594	+	}
595
596	<	#
597	<	# Setup a new tool
598	<	#
596	>	# ------------ tool command --------------------------------------------
597	>	sub tool {
598	>	my @allowed_cmds=qw(setup info list);
599	>	_processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));
600	>	}
601	>
602	>	sub tool_setup {
603	>	my $tool=shift;
604	>
605	>	print "Setting Up Tool $tool\n";
606	>	$scram->setuptool($tool,@_);
607	>	}
608
609	+	sub tool_list {
610	+	my ($area,@tools)=$scram->tools();
611	+	print "Tool List for ".$area->name()." ".$area->version()."\n";
612	+	print "Location : ".$area->location()."\n";
613	+	print "+"x60;
614	+	print "\n";
615	+
616	+	foreach $t ( @tools ) {
617	+	print $t->name();
618	+	print " ";
619	+	print $t->version();
620	+	print "\n";
621	+	}
622	+	}
623	+
624	+	sub tool_info {
625	+	my $tool=shift;
626	+	print "Info on Tool $tool\n";
627	+	}
628	+
629	+	sub _tooloptions {
630	+	$scram->error("No Options defined for tool command");
631	+	}
632	+
633	+	sub help_tool_setup {
634	+	print <<ENDTEXT;
635	+	Description:
636	+	Set up the configuration parameters for a given tool
637	+	Usage :
638	+	scram tool setup tool_name [tool_version]
639	+
640	+	ENDTEXT
641	+	}
642	+
643	+	sub help_tool_info {
644	+	print <<ENDTEXT;
645	+	Description:
646	+	Print out information on the specified tool in the current area
647	+	configuration.
648	+	Usage :
649	+	scram tool info tool_name [tool_version]
650	+
651	+	ENDTEXT
652	+	}
653	+
654	+	sub help_tool_list {
655	+	print <<ENDTEXT;
656	+	Description:
657	+	List of currently configured tools available in ther current scram
658	+	area
659	+	Usage :
660	+	scram tool list
661	+
662	+	ENDTEXT
663	+	}
664	+
665	+	# ----------- setup command ------------------------------------------
666		sub setup {
667		my $toolname=shift @ARGV;
486	–	my $insert=0;
668
669	<	&FullEnvInit;
670	<	if ( $ENV{SCRAM_BootStrapFiles}!~/\Q$ENV{LOCALTOP}\N\/\.SCRAM/ ) {
671	<	$ENV{SCRAM_BootStrapFiles}="$ENV{LOCALTOP}/.SCRAM:".
491	<	$ENV{SCRAM_BootStrapFiles};
492	<	}
493	<	my $filebase="$ENV{LOCALTOP}/.SCRAM/$ENV{SCRAM_ARCH}";
494	<	rename "$filebase/clientsettings", "$filebase/clientsettings.old";
495	<	chdir $ENV{LOCALTOP}; # make sure we do this from the top dir
496	<	# If no toolname specified then its a full setup
497	<	if ( $toolname eq "" ) {
498	<	rename "$filebase/clientsettings_reqs",
499	<	"$filebase/clientsettings_reqs.old";
500	<	use clientfile;
501	<	BuildClientFile( $ENV{SCRAM_ProjReqsDoc} );
502	<	# Work-around for Broken ARCH directories
503	<	use Utilities::AddDir;
504	<	AddDir::adddir("$ENV{LOCALTOP}/lib/$ENV{SCRAM_ARCH}");
505	<	AddDir::adddir("$ENV{LOCALTOP}/bin/$ENV{SCRAM_ARCH}");
669	>	if ( ! defined $toolname ) {
670	>	# general area setup for new platform
671	>	print "****** Not implemented *****\n";
672		}
673		else {
674	<	# Check for the correct toolfile
509	<	# ideally try and download it if not already in .SCRAM
510	<	# Only scram toolbox files supported so far
511	<	if ( ! -e "$ENV{LOCALTOP}/.SCRAM/$toolname" ) {
512	<	&urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
513	<	.$toolname, "$ENV{LOCALTOP}/.SCRAM/$toolname") ;
514	<	}
515	<	# Parse the toolfile and update the clientsettings file
516	<	# currently just append to the end
517	<	use clientfile;
518	<	#create a new clientfile containing just the tool
519	<	clientfile::openclientfile('add');
520	<	clientfile::_tool("file:$toolname");
521	<	clientfile::closeclientfile();
522	<	#Now splice it in to the original - replacing the previous one if
523	<	#necessary - a bit of a hack to say the least -fortunately is
524	<	# already rewrittten for the next release!
525	<
526	<	open FILEIN, "$filebase/clientsettings" or die "$!\n";
527	<	while ( <FILEIN> ) {
528	<	push @filelines, $_;
529	<	next, if /^\s*#/;
530	<	chomp;
531	<	($toolkey=$_)=~s/(.*?:).*/$1/;
532	<	}
533	<	close FILEIN;
534	<	open FILEIN, "<$filebase/clientsettings.old";
535	<	open FILEOUT, ">$filebase/clientsettings.tmp";
536	<	while ( <FILEIN> ) {
537	<	if ( ( $_=~/^$toolkey/ ) ) {
538	<	if ( $insert==0 ) {
539	<	foreach $line ( @filelines ) {
540	<	print FILEOUT $line;
541	<	}
542	<	$insert=1;
543	<	}
544	<	next;
545	<	}
546	<	else {
547	<	print FILEOUT $_;
548	<	}
549	<	}
550	<	if ( $insert==0 ) {
551	<	foreach $line ( @filelines ) {
552	<	print FILEOUT $line;
553	<	}
554	<	}
555	<	close FILEOUT;
556	<	close FILE;
557	<	rename "$filebase/clientsettings.tmp", "$filebase/clientsettings";
674	>	$scram->setuptool($toolname);
675		}
676	<
676	>
677	>	}
678	>
679	>	sub devtest {
680	>	use Utilities::TestClass;
681	>	my $class=shift @ARGV;
682	>
683	>	$scram->devtest($class);
684	>	}
685	>
686	>	# ------------------- HELP routines ----------------------------------
687	>
688	>
689	>	sub help_db {
690	>	print <<ENDTEXT;
691	>	scram database administration command.
692	>
693	>	Usage:
694	>
695	>	$bold scram db $normal subcommand
696	>
697	>	subcommands:
698	>	link :
699	>	Make available an additional database for
700	>	project and list operations
701	>
702	>	$bold scram db link $normal /a/directory/path/project.lookup
703	>
704	>	unlink :
705	>	Remove a database from the link list. Note this does
706	>	not remove the database, just the link to it in scram.
707	>
708	>	$bold scram db unlink $normal /a/directory/path/project.lookup
709	>
710	>	showlinks :
711	>	List the databases that are linked in
712	>
713	>	ENDTEXT
714		}
715
716		sub help_setup {
#	Line 575 | Line 729 | ENDTEXT
729		exit;
730		}
731
732	+	sub help_area {
733	+	print <<ENDTEXT;
734	+	Provides access to Scram development area management tools
735	+
736	+	Usage:
737	+
738	+	$bold   scram area $normal [link|unlink|install|uninstall] options
739	+
740	+	Description of subcommnads:
741	+
742	+	${bold}scram area link ${normal}project_tag version_tag
743	+	Attatch the scram area corresponding to the current working directory
744	+	to the named project and version in the central installation
745	+	(see scram list)
746	+
747	+	${bold}scram area unlink $normal
748	+	Break a link with the central installation
749	+
750	+	${bold}scram area install ${normal}[project_tag [version_tag]]
751	+	Create an entry for the current area in the central installation database
752	+	(admin permissions required)
753	+
754	+	${bold}scram area uninstall ${normal}[project_tag [version_tag]]
755	+	Delete entry for the current area in the central installation database
756	+	(admin permissions required)
757	+
758	+	ENDTEXT
759	+	exit;
760	+	}
761	+
762		sub help_list {
763		print <<ENDTEXT;
764	<	Create an entry in the SCRAM database so that an installed project can be
765	<	referenced in the 'project' command by a tag/version combination.
582	<	Usage: (command to be issued from inside an installed project)
764	>	List the available projects and versions installed in the local SCRAM database
765	>	(see scram install help)
766
767	<	$bold   scram install $normal [project_tag [version_tag]]
767	>	Usage:
768	>
769	>	$bold   scram list $normal
770
586	–	If not specified the project_tag and version_tag default to the project
587	–	name and version of the installation.
771		ENDTEXT
772		exit;
773		}
774	+
775		sub help_project {
776		print <<ENDTEXT;
777		Setup a new project development area. The new area will appear in the current
#	Line 630 | Line 814 | project_version:
814		Specify the name of the SCRAM development area you wish to
815		create.
816
633	–	-n dir_name     :
634	–	Specify name of the new development area directory
817		ENDTEXT
818		}
819
#	Line 661 | Line 843 | Usage:
843		ENDTEXT
844		}
845
846	<	sub help_devtest {
846	>	sub help_tool {
847		print <<ENDTEXT;
848	<	For SCRAM development only. Allows testing of new features.
667	<
668	<	Usage:
669	<	$bold   scram devtest
848	>	Manage the tools in the scram area that define the areas environment.
849		ENDTEXT
850		}
851
#	Line 688 | Line 867 | in a csh environment
867		Setup the current environment to include the project Runtime Environment in a
868		sh environment
869
870	<	$bold  `scram runtime -sh` $normal
870	>	$bold  eval `scram runtime -sh` $normal
871	>
872	>
873	>	ENDTEXT
874	>	}
875	>
876	>	sub helpheader {
877	>	my $label=shift;
878	>	my @sub=@_;
879
880	+	my $substring;
881	+	if ( @sub ) {
882	+	$substring=join ' - ', @sub;
883	+	}
884	+	else {
885	+	$substring="";
886	+	}
887	+	print <<ENDTEXT;
888	+	*************************************************************************
889	+	SCRAM HELP ---------$bold scram $substring $label $normal
890	+	*************************************************************************
891		ENDTEXT
892		}

Diff Legend

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