ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.55
Committed: Fri Oct 4 17:38:15 2002 UTC (22 years, 7 months ago) by sashby
Branch: MAIN
Changes since 1.54: +6 -1 lines
Log Message:
Some tests of new CompilerMap tag.

File Contents

# User Rev Content
1 sashby 1.26 # -*-perl-*-
2 sashby 1.2 #===========================================================================#
3 sashby 1.15 # NAME: scramcli #
4 sashby 1.2 #===========================================================================#
5     # DATE: Mon May 28 11:36:18 2001 #
6     # AUTHOR: C. Williams #
7     # MAINTAINER: Shaun Ashby #
8     #===========================================================================#
9     # DESCRIPTION: The main scram program (NOTE: this is wrapped at runtime to #
10     # set up the path to the SCRAM Perl modules). #
11 sashby 1.15 # #
12 sashby 1.2 #===========================================================================#
13 sashby 1.36 # V1.36: V0_19_3 release ready Wed Feb 20 13:41:56 2002 #
14 sashby 1.40 # V1.39: NR fixes included (no references to "which" anywhere) #
15 sashby 1.44 # V1.44: Added -f options to set/project. Added simple parser to #
16     # remove duplicate lib entries. #
17 sashby 1.46 # V1.46: V0_19_4 release ready Tue May 21 12:35:14 2002 #
18 sashby 1.52 # V1.52: V0_19_6p1 prerelease Tue May 21 13:53:14 2002 #
19 sashby 1.53 # V1.53: V0_19_6 release Mon Aug 19 15:51:43 2002 #
20 sashby 1.36 #===========================================================================#
21 sashby 1.2
22 sashby 1.54
23     # scram set development notes:
24     #
25     # o added new command "set"
26     # o created new subroutine "set"
27     # o added help routines
28     #
29     #
30 sashby 1.55 # Things that could be added:
31     #
32     # template generator to create tool template/ bootstrapfile template
33     #
34     #
35     #
36 sashby 1.54 #
37    
38    
39 sashby 1.29 # Verbose mode:
40 sashby 1.31 &local_verbose("MAIN");
41 sashby 1.29
42 sashby 1.19 $main::bold = "";
43     $main::normal = "";
44     $main::line = "-"x80;
45     $main::lookupobject = "";
46 sashby 1.15
47 sashby 1.10 # Test whether the output from SCRAM is being redirected, or
48     # not (prevents escape signals from being printed to STDOUT if
49 sashby 1.25 # STDOUT is redirected to a file or piped):
50 sashby 1.11 if ( -t STDIN && -t STDOUT )
51     {
52     $bold = "\033[1m";
53     $normal = "\033[0m";
54     }
55    
56 sashby 1.2 # Allowed main and dev commands:
57 sashby 1.54 @allowed_commands=qw(project build install version list listcompact remove arch setup runtime setroot db tool url set);
58 sashby 1.18 @dev_cmds=qw(devtest devint align);
59 hpw 1.1
60 sashby 1.2 # Check for prerequisites:
61     prerequisitecheck();
62     # Check for version consistency:
63 hpw 1.1 versioncheck();
64    
65 sashby 1.28
66 sashby 1.2 # Parse arguments (look for "-verbose" or "-arch" then shift):
67     while ( $ARGV[0] =~ /^-/)
68     {
69     if ( $ARGV[0] eq "-verbose" )
70     {
71 sashby 1.27 # Enable verbose for main as well, by default when -verbose mode selected:
72     $ENV{'SCRAMDEBUG'} = 1;
73 sashby 1.2 shift @ARGV;
74     # If no argument (i.e. class to activate "verbose" for) do nothing:
75     if (defined ($ARGV[0]))
76     {
77 sashby 1.21 print "Verbose mode for $ARGV[0] switched ".$bold."ON".$normal."\n" ;
78 sashby 1.2 scrambasics()->classverbose($ARGV[0],1);
79     }
80     }
81     elsif ( $ARGV[0] eq "-arch" )
82     {
83     shift @ARGV;
84     $ENV{SCRAM_ARCH}=$ARGV[0];
85     scrambasics()->arch($ARGV[0]);
86     }
87     else
88     {
89 sashby 1.31 ReportError("Unknown option $ARGV[0]");
90 sashby 1.2 }
91     shift @ARGV;
92     }
93    
94     # Shift args to get input command:
95 hpw 1.1 $inputcmd=shift;
96     $found='false';
97     $rv=0;
98     $self={};
99    
100 sashby 1.2 # Check that input command is defined, and then
101     # run a scram subroutine for the command or show
102     # some help:
103     if ( $inputcmd ne "" )
104     {
105     foreach $command ( (@allowed_commands,@dev_cmds) )
106     {
107     if ( $command =~ /^$inputcmd/i)
108     {
109     # Deal with a help request
110     do
111     {
112     helpheader($command);
113     &{"help_".$command};
114     exit;
115     } if $ARGV[0] =~ /help/i;
116     $rv=&$command;
117     $found='true';
118     last;
119     }
120     }
121     }
122    
123     if ( ! ( $found =~ /true/ ) )
124     {
125     helpheader('Recognised Commands');
126     foreach $command ( @allowed_commands )
127     {
128     print " $bold scram ".$command.$normal."\n";
129     }
130     print "\n";
131     print "Help on individual commands available through\n\n";
132     print "$bold scram".$normal." command$bold help $normal\n\n";
133    
134     print "\nOptions:\n";
135     print "--------\n";
136     print $bold."-verbose ".$normal."Class : Activate the verbose ".
137     "function on the specified class";
138     print "\n\n";
139     print $bold."-arch ".$normal."architecture : Set the architecture id ".
140     "to that specified";
141     print "\n\n";
142     }
143 hpw 1.1
144 sashby 1.2 # Exit with exit status of subroutine
145     # that was executed in line 80:
146 hpw 1.1 exit $rv;
147 sashby 1.2
148    
149    
150    
151 sashby 1.21
152    
153    
154    
155    
156 sashby 1.2 ######################################################################################
157     ## Subroutine definitions ##
158     ######################################################################################
159    
160 sashby 1.54 sub set
161     {
162     ###############################################################
163     # set #
164     ###############################################################
165     # modified : Fri Aug 23 14:01:41 2002 / SFA #
166     # params : #
167     # : #
168     # : #
169     # : #
170     # function : Set some user flags, mostly for BuildSystem. #
171     # : #
172     # : #
173     # : #
174     ###############################################################
175    
176     my $mk = "localflags.mk";
177    
178     #
179     # Valid flags:
180     #
181     # compiler type (Linux__2.4 only)
182     #
183     # library types to use
184     #
185     #
186     # Make sure that if file already exists, it is backed up.
187     # Aim to be able to use this command to alter the MAKEFILE flags without
188     # having to force the user to scram b very_clean to zap the directory contents.
189     # No change to main makefile required, since this file will be "-include"d in basics.mk.
190    
191     # Perhaps use a file called "subarch.map" in .SCRAM to check for validity of subarch flags?
192    
193    
194     }
195    
196    
197     sub help_set
198     {
199     ###############################################################
200     # help_set() #
201     ###############################################################
202     # modified : Fri Aug 23 14:07:23 2002 #
203     # params : #
204     # : #
205     # : #
206     # : #
207     # function : Show help for the scram set command. #
208     # : #
209     # : #
210     ###############################################################
211     &local_verbose("help_set");
212    
213     print <<ENDTEXT;
214     No help available yet. Still in development.
215     ENDTEXT
216     return (0);
217     }
218    
219    
220 sashby 1.31 sub ReportError
221 sashby 1.2 {
222     ###############################################################
223 sashby 1.31 # ReportError(string) #
224 sashby 1.2 ###############################################################
225     # modified : Mon May 28 11:26:47 2001 / SFA #
226     # params : Error messsage string #
227     # : #
228     # : #
229     # : #
230 sashby 1.31 # function : Exit with an error string. Print string to #
231     # : STDERR if using pipes. #
232 sashby 1.2 # : #
233     ###############################################################
234     my $string=shift;
235 sashby 1.31 &local_verbose("ReportError");
236 sashby 1.28
237 sashby 1.31 if ( -t STDERR ) # Make sure that errors go to STDERR
238     { # when using pipes
239     print STDERR "\n","SCRAM error: ".$string."\n";
240     }
241     else
242     {
243     print "\n","SCRAM error: ".$string."\n";
244     }
245 sashby 1.5 exit (1);
246 sashby 1.2 }
247    
248     sub prerequisitecheck
249     {
250     ###############################################################
251     # prerequisitecheck() #
252     ###############################################################
253     # modified : Mon May 28 11:26:52 2001 / SFA #
254     # params : None. #
255     # : #
256     # : #
257     # : #
258     # function : Check for prerequisite programs. #
259 sashby 1.9 # : Don't bother checking for shell: too much hassle.#
260     # : (and doesn't work outside of HEPiX scheme) #
261 sashby 1.2 ###############################################################
262     my $reqdmake="gmake";
263 sashby 1.31 &local_verbose("prerequisitecheck");
264 sashby 1.38
265     # We must have gmake. Check this or exit if no gmake:
266     my $gmake_version_info=`$reqdmake -v`;
267     if ( $? == 0 )
268 sashby 1.2 {
269     return (0);
270     }
271     else
272     {
273     print "It appears that you do not have all prerequisite","\n";
274     print "programs. To run SCRAM, you must have:","\n";
275     print "\n";
276     print " - GNU make (gmake)","\n";
277     print "\n";
278 sashby 1.9 print "Please make sure that this program is present.","\n\n";
279 sashby 1.2 exit (1);
280     }
281     }
282    
283     sub versioncheck
284     {
285     ###############################################################
286     # versioncheck(version) #
287     ###############################################################
288     # modified : Mon May 28 11:27:06 2001 / SFA #
289     # params : version (optional) #
290     # : #
291     # : #
292     # : #
293     # function : Check for scram version info. #
294     # : #
295     # : #
296     ###############################################################
297     my $version;
298 sashby 1.31 &local_verbose("versioncheck");
299 sashby 1.2
300     if ( @_ )
301     {
302     $version=shift;
303     }
304     else
305     {
306     # -- get version from local area
307     if ( ! localtop_find() )
308     {
309 hpw 1.1 LoadEnvFile();
310     my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
311 sashby 1.2 if ( -f $versionfile )
312     {
313     open (VERSION, "<".$versionfile);
314 hpw 1.1 $version=<VERSION>;
315     chomp $version;
316 sashby 1.2 }
317 hpw 1.1 }
318 sashby 1.2 }
319     if ( defined $version )
320     {
321     scrambasics()->spawnversion($version,@ARGV);
322     }
323     }
324    
325    
326     sub _processcmds
327     {
328     ###############################################################
329     # _processcmds(handlercoderef,refarrayofallowedcommands, #
330     # refarrayofactualcommands, #
331     # arrayofsubroutinestringstocall) #
332     # #
333     ###############################################################
334     # modified : Mon May 28 11:27:12 2001 / SFA #
335     # params : #
336     # : #
337     # : #
338     # : #
339     # function : #
340     # : #
341     # : #
342     ###############################################################
343 sashby 1.31 &local_verbose("_processcmds");
344 sashby 1.28
345 sashby 1.2 my $optionhandler=shift;
346     my $allowed_commands=shift;
347     my $cmds=shift;
348     my @subs=@_;
349     my $found=0;
350 sashby 1.35 my $rv = 0;
351 sashby 1.2
352     # make a string from the subcommand levels
353     my $substring="";
354     if ( @subs )
355     {
356     $substring= join '_', @subs;
357     $substring=$substring."_";
358     }
359    
360     # Process options
361     if (defined ${$cmds}[0])
362     {
363     while ( ${$cmds}[0] =~ /^-/)
364     {
365     &{$optionhandler}( ${$cmds}[0],$cmds);
366     }
367 hpw 1.1
368 sashby 1.2 my $inputcmd=shift @{$cmds};
369     if ( $inputcmd ne "" )
370     {
371     foreach $command ( @{$allowed_commands} )
372     {
373     if ( $command =~ /^$inputcmd/i)
374     {
375     # Deal with a help request
376     if ( ( defined $$cmds[0]) && $$cmds[0] =~ /help/i )
377     {
378     &helpheader($command,@subs);
379     &{"help_".$substring.$command}; exit;
380     }
381     else
382     {
383 sashby 1.35 $rv=&{$substring.$command}(@{$cmds});
384 sashby 1.2 $found=1;
385     last;
386     }
387     }
388     }
389     }
390     }
391    
392     if ( ! $found )
393     {
394     &{$substring."error"}(@subs);
395 sashby 1.34 return (1);
396 hpw 1.1 }
397 sashby 1.35 # Return the status of the command subrtn executed:
398     return $rv;
399 sashby 1.2 }
400    
401    
402     sub help_build
403     {
404     ###############################################################
405     # help_build() #
406     ###############################################################
407     # modified : Mon May 28 11:27:23 2001 / SFA #
408     # params : #
409     # : #
410     # : #
411     # : #
412     # function : Show help for the scram build command #
413     # : #
414     # : #
415     ###############################################################
416 sashby 1.31 &local_verbose("help_build");
417 sashby 1.28
418 sashby 1.2 print <<ENDTEXT;
419     Information for building binaries and libraries.
420    
421     Subcommands:
422    
423     scram (b)uild lib/bin
424    
425     Command is run from the src directory.
426    
427     ENDTEXT
428 sashby 1.6 # Also run "build" dir because this will run "gmake help":
429     &build();
430 sashby 1.34 return (0);
431 sashby 1.2 }
432    
433    
434     sub align
435     {
436     ###############################################################
437     # align() #
438     ###############################################################
439     # modified : Mon May 28 11:27:27 2001 / SFA #
440     # params : #
441     # : #
442     # : #
443     # : #
444     # function : #
445     # : #
446     # : #
447     ###############################################################
448 sashby 1.31 &local_verbose("align");
449 sashby 1.2 _localarea()->align();
450     }
451    
452 sashby 1.49 sub build
453 sashby 1.2 {
454     ###############################################################
455     # build() #
456     ###############################################################
457     # modified : Mon May 28 11:27:34 2001 / SFA #
458     # params : #
459     # : #
460     # : #
461     # : #
462     # function : Compile project. #
463     # : #
464     # : #
465     ###############################################################
466 sashby 1.31 &local_verbose("build");
467 sashby 1.50
468 sashby 1.2 # is this a based or free release?
469     FullEnvInit();
470     use BuildSystem::BuildSetup;
471     $ENV{MAKETARGETS}=join ' ',@ARGV;
472 sashby 1.50
473 sashby 1.2 # -- set the runtime environment
474     my $toolrt=scrambasics()->toolruntime(_localarea());
475     $toolrt->sethash(\%Env);
476 sashby 1.50
477 sashby 1.2 # -- set up the builder
478     my $bs=BuildSystem::BuildSetup->new(toolbox());
479     $rv=$bs->BuildSetup($ENV{THISDIR},@ARGV);
480 sashby 1.34 return $rv;
481 sashby 1.2 }
482    
483 sashby 1.49 sub buildn
484 sashby 1.48 {
485     ###############################################################
486     # build() #
487     ###############################################################
488     # modified : Mon May 28 11:27:34 2001 / SFA #
489     # params : #
490     # : #
491     # : #
492     # : #
493     # function : Compile project. #
494     # : #
495 sashby 1.49 # : Currently NOT working properly....! #
496 sashby 1.48 ###############################################################
497     &local_verbose("build");
498     use BuildSystem::Build;
499     use BuildSystem::BuildSetup;
500    
501     # Init the environment:
502     FullEnvInit();
503     $ENV{MAKETARGETS}=join ' ',@ARGV;
504 sashby 1.50
505 sashby 1.48 # Set the runtime environment:
506     my $toolrt=scrambasics()->toolruntime(_localarea());
507     $toolrt->sethash(\%Env);
508    
509     # Set up the builder:
510     my $build = BuildSystem::Build->new(_localarea(),toolbox());
511    
512     # Invoke a build:
513     my $buildreport = $build->build($ENV{THISDIR}, @ARGV);
514 sashby 1.50
515 sashby 1.48 # Print the info from the build:
516     $buildreport->reportBuildStatus();
517     }
518    
519 sashby 1.2 sub project
520     {
521     ###############################################################
522     # project() #
523     ###############################################################
524     # modified : Mon May 28 11:27:38 2001 / SFA #
525     # params : #
526     # : #
527     # : #
528     # : #
529     # function : Set up a project area. #
530     # : #
531     # : #
532     ###############################################################
533 sashby 1.31 &local_verbose("project");
534 sashby 1.28
535 sashby 1.2 my @args=@ARGV;
536    
537     my $devareaname="";
538     use Cwd;
539     my $installarea=cwd();
540 sashby 1.19
541 sashby 1.2 # process options
542     while ( $args[0] =~ "^-" )
543     {
544     if ( $args[0] =~ /-n/ )
545     {
546     shift @args;
547     $devareaname=shift @args;
548     }
549     elsif ( $args[0] =~ /-d/ ) #installation area directory
550     {
551     shift @args;
552     $installarea=$args[0];
553     if ( ! -d $installarea )
554     {
555 sashby 1.31 ReportError("$installarea does not exist");
556 sashby 1.2 }
557     shift @args;
558     }
559     else
560     {
561 sashby 1.31 ReportError("Unknown option $args[0] to project command");
562 sashby 1.2 }
563     }
564 sashby 1.42
565 sashby 1.2 # -- check what arguments have been passed
566 sashby 1.42 if ( $#args <0 || $#args>3 )
567 sashby 1.2 {
568 sashby 1.31 ReportError("\"scram project help\" for usage info.");
569 sashby 1.2 }
570     my $area; #somewhere to store the area object when we have it
571    
572 sashby 1.42 if ( $args[0] =~ /:/ )
573     {
574     # Get the bootstrapfile:
575     my $bootstrapfile=shift @args;
576 sashby 1.2 # -- must be a url to bootstrap from
577 sashby 1.42 print "Bootstrapping using ",$bootstrapfile,"\n";
578     $area=scrambasics()->project($bootstrapfile, $installarea,
579 sashby 1.2 $devareaname);
580 sashby 1.42
581 sashby 1.21 # Need to set the sitename for the setup process:
582     if (defined ($area))
583     {
584 sashby 1.42 # Check for a config file argument:
585     my $flag=shift @args;
586     my $file=shift @args;
587    
588     # Make sure the extra flag is -f, followed by a valid filename:
589     if ( $flag =~ /-f/ )
590     {
591     # OK, flag is valid. Is there a filename arg given?:
592     if ( $file =~ /.*conf$/)
593     {
594     $ENV{LOCCMSTOOLS}=$file;
595     }
596     else
597     {
598     # The file doesn't look like a conf file:
599     ReportError("Invalid file given as arg to project command.");
600     }
601     }
602    
603 sashby 1.33 # We have an area so we can invoke method. First,
604     # establish our site name. See if there is an environment
605     # setting:
606     if ( ! $ENV{'SITENAME'})
607     {
608     $ENV{'SITENAME'} = $area->sitename();
609     }
610 sashby 1.22 $ENV{'PROJECTDIR'} = $area->location();
611 sashby 1.21 }
612 sashby 1.42 else
613     {
614     ReportError("No project area defined. Cannot continue.");
615     }
616 sashby 1.21
617 sashby 1.19 # Initialize the lookup table:
618     use Scram::AutoToolSetup;
619     $lookupobject = Scram::AutoToolSetup->new();
620 sashby 1.42
621     print "Setting up tools in project area","\n";
622 sashby 1.40
623 sashby 1.19 # Now run the full setup for the area:
624 sashby 1.2 scrambasics()->setuptoolsinarea($area);
625     }
626     elsif ( $#args >0 )
627     {
628     # -- get the release area
629     print "Getting release area....","\n";
630     my $relarea=scrambasics()->scramprojectdb()->getarea(@args);
631     if ( ! defined $relarea )
632     {
633 sashby 1.31 ReportError("Unknown project @args");
634 sashby 1.2 }
635    
636     # -- we need to spawn the correct scram version to handle it:
637     unshift @ARGV, "project";
638     print "Checking SCRAM version....","\n";
639     versioncheck($relarea->scramversion());
640 hpw 1.1
641 sashby 1.2 # -- need to create a satellite area:
642     print "Creating satellite area....","\n";
643     $area=scrambasics()->satellite(@args,$installarea, $devareaname);
644     }
645     else
646     {
647 sashby 1.31 ReportError("\"scram project help\" for usage info.");
648 sashby 1.2 }
649     #
650     # Now create the directories specified in the interface
651     # There should be some better mechanism - TODO
652     #
653     print "Creating directories....","\n";
654     chdir $area->location();
655     foreach $key ( keys %ENV )
656     {
657     if ( $key =~ /^INT/ )
658     {
659     AddDir::adddir($ENV{$key});
660     }
661     }
662 sashby 1.5 # Final message
663 sashby 1.2 print "\n\nInstallation procedure complete.\n";
664     print "Installation Located at:\n\n\t\t".$bold.$area->location().$normal."\n\n";
665 sashby 1.34 return(0);
666 sashby 1.2 }
667    
668    
669     sub scrambasics
670     {
671     ###############################################################
672     # scrambasics() #
673     ###############################################################
674     # modified : Mon May 28 11:27:44 2001 / SFA #
675     # params : #
676     # : #
677     # : #
678     # : #
679     # function : #
680     # : #
681     # : #
682     ###############################################################
683 sashby 1.31 &local_verbose("scrambasics");
684 sashby 1.28
685 sashby 1.2 require Scram::ScramFunctions;
686     if ( ! defined $scramobj )
687     {
688     environmentinit();
689     $scramobj=Scram::ScramFunctions->new();
690     $scramobj->arch($ENV{SCRAM_ARCH});
691     }
692     return $scramobj;
693     }
694    
695     sub url
696     {
697     ###############################################################
698     # url() #
699     ###############################################################
700     # modified : Mon May 28 11:27:48 2001 / SFA #
701     # params : #
702     # : #
703     # : #
704     # : #
705     # function : #
706     # : #
707     # : #
708     ###############################################################
709 sashby 1.31 &local_verbose("url");
710 sashby 1.28
711 sashby 1.2 @_=@ARGV;
712     localtop();
713     environmentinit();
714     my @allowed_cmds=qw(get);
715 sashby 1.34 my $rv=_processcmds("_tooloptions", \@allowed_cmds, \@_, ("url"));
716     return $rv;
717 sashby 1.2 }
718    
719     sub url_get
720     {
721     ###############################################################
722     # url_get() #
723     ###############################################################
724     # modified : Mon May 28 11:27:52 2001 / SFA #
725     # params : #
726     # : #
727     # : #
728     # : #
729     # function : #
730     # : #
731     # : #
732     ###############################################################
733 sashby 1.31 &local_verbose("url_get");
734 sashby 1.28
735 sashby 1.2 my $url=shift;
736     my $area=_localarea();
737    
738     ($uurl,$file)=scrambasics()->webget($area,$url);
739 sashby 1.34 print "$file\n";
740     return (0);
741 sashby 1.2 }
742 hpw 1.1
743 sashby 1.2 sub help_url
744     {
745     ###############################################################
746     # help_url() #
747     ###############################################################
748     # modified : Mon May 28 11:28:06 2001 / SFA #
749     # params : #
750     # : #
751     # : #
752     # : #
753     # function : Show help for the scram url command. #
754     # : #
755     # : #
756     ###############################################################
757 sashby 1.31 &local_verbose("help_url");
758 sashby 1.28
759 sashby 1.2 print <<ENDTEXT;
760 hpw 1.1 URL information.
761 sashby 1.2
762     Subcommands:
763    
764 hpw 1.1 scram url get
765    
766     ENDTEXT
767 sashby 1.34 return (0);
768 sashby 1.2 }
769 hpw 1.1
770 sashby 1.2 sub help_url_get
771     {
772     ###############################################################
773     # help_url_get() #
774     ###############################################################
775     # modified : Mon May 28 11:28:11 2001 / SFA #
776     # params : #
777     # : #
778     # : #
779     # : #
780     # function : Show help for the scram url get command. #
781     # : #
782     # : #
783     ###############################################################
784 sashby 1.31 &local_verbose("help_url_get");
785 sashby 1.28
786 sashby 1.2 print <<ENDTEXT;
787 hpw 1.1 Description:
788     Return the location of the local copy of the specified url
789     Usage :
790     scram url get url
791    
792     ENDTEXT
793 sashby 1.34 return (0);
794 sashby 1.2 }
795 hpw 1.1
796     # ------------ tool command --------------------------------------------
797 sashby 1.2 sub tool
798     {
799     ###############################################################
800     # tool() #
801     ###############################################################
802     # modified : Mon May 28 11:28:16 2001 / SFA #
803     # params : #
804     # : #
805     # : #
806     # : #
807     # function : #
808     # : #
809     # : #
810     ###############################################################
811 sashby 1.31 &local_verbose("tool");
812 sashby 1.28
813 sashby 1.2 @_=@ARGV;
814     localtop();
815     environmentinit();
816 sashby 1.40 my @allowed_cmds=qw(info list default setup tag remove);
817 sashby 1.34 my $rv=_processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));
818     return $rv;
819 sashby 1.2 }
820    
821     sub tool_error
822     {
823     ###############################################################
824     # tool_error(error_string) #
825     ###############################################################
826     # modified : Mon May 28 11:28:20 2001 / SFA #
827     # params : Error message string. #
828     # : #
829     # : #
830     # : #
831     # function : Show an error message for tool command. #
832     # : #
833     # : #
834     ###############################################################
835 sashby 1.31 &local_verbose("tool_error");
836 sashby 1.28
837 sashby 1.31 ReportError("Unknown tool subcommand : @_");
838 sashby 1.2 }
839    
840     sub tool_default
841     {
842     ###############################################################
843     # tool_default() #
844     ###############################################################
845     # modified : Mon May 28 11:28:24 2001 / SFA #
846     # params : #
847     # : #
848     # : #
849     # : #
850     # function : #
851     # : #
852     # : #
853     ###############################################################
854 sashby 1.31 &local_verbose("tool_default");
855 sashby 1.28
856 sashby 1.2 if ( $#_ != 1 )
857     {
858 sashby 1.31 ReportError("\"scram tool default help\" for usage information");
859 sashby 1.2 }
860     my $tool=shift;
861     my $version=shift;
862     print "Setting default version of $tool to $version\n";
863     # -- adjust the toolbox
864     toolbox()->setdefault($tool,$version);
865 sashby 1.34 return (0);
866 sashby 1.2 }
867    
868     sub tool_list
869     {
870     ###############################################################
871     # tool_list() #
872     ###############################################################
873     # modified : Mon May 28 11:28:27 2001 / SFA #
874     # params : #
875     # : #
876     # : #
877     # : #
878     # function : List the tools defined in toolbox. #
879     # : #
880     # : #
881     ###############################################################
882 sashby 1.31 &local_verbose("tool_list");
883 sashby 1.28
884 sashby 1.2 my $area=_localarea();
885     my $locationstring="Tool list for location ".$area->location();
886     my $length=length($locationstring);
887    
888 sashby 1.14 print "\n",$locationstring,"\n";
889 sashby 1.2 print "+"x $length;
890     print "\n";
891     print "\n";
892    
893     foreach $t ( toolbox()->tools() )
894     {
895     my $vers=join / /, toolbox()->versions($t);
896 sashby 1.14 print " ".$t." ".$vers." (default=".toolbox()->defaultversion($t).")\n";
897 sashby 1.2 }
898 sashby 1.14 print "\n";
899 sashby 1.34 return (0);
900 sashby 1.2 }
901    
902     sub tool_info
903     {
904     ###############################################################
905     # tool_info() #
906     ###############################################################
907     # modified : Mon May 28 11:28:30 2001 / SFA #
908     # params : #
909     # : #
910     # : #
911     # : #
912     # function : Show info for available tools. #
913     # : #
914     # : #
915     ###############################################################
916 sashby 1.31 &local_verbose("tool_info");
917 sashby 1.28
918 sashby 1.2 my $project=shift;
919     my $area=_localarea();
920     my $locationstring="Tool info as configured in location ".$area->location();
921     my $length=length($locationstring);
922 sashby 1.35 my $rv=0;
923 sashby 1.2
924     print $locationstring,"\n";
925     print "+"x $length;
926     print "\n";
927     print "\n";
928    
929     my @tools=toolbox()->gettool($project,@_);
930 sashby 1.32
931 sashby 1.2 foreach $t ( @tools )
932     {
933     if ( defined $t )
934     {
935     print "Name : ".$t->name();
936     print "\n";
937     print "Version : ".$t->version();
938     print "\n";
939     print "Docfile : ".$t->url();
940     print "\n";
941     print "+"x20;
942     print "\n";
943     @features=$t->features();
944     foreach $ft ( @features )
945     {
946     @vals=$t->getfeature($ft);
947     foreach $v ( @vals )
948     {
949 hpw 1.1 print $ft. "=$v\n";
950 sashby 1.2 }
951     }
952     }
953 sashby 1.8 else
954     {
955     print "Tool $t is not defined for this project area.","\n";
956 sashby 1.35 $rv=1;
957 sashby 1.8 }
958 sashby 1.2 }
959 sashby 1.35 return $rv;
960 sashby 1.2 }
961 hpw 1.1
962 sashby 1.32 sub tool_tag
963     {
964     ###############################################################
965     # tool_tag() #
966     ###############################################################
967     # modified : Mon May 28 11:28:30 2001 / SFA #
968     # params : #
969     # : #
970     # : #
971     # : #
972     # function : Show value of tool tag <tagname>. #
973     # : #
974     # : #
975     ###############################################################
976     &local_verbose("tool_tag");
977    
978     my $toolname=shift;
979     chomp (my $tagname=shift);
980     my $area=_localarea();
981     my @tools=toolbox()->gettool($toolname,@_);
982    
983     foreach $t ( @tools )
984     {
985     # If we have a hash for this tool, proceed:
986     if ( defined $t )
987     {
988     # Get the features:
989     @features=$t->features();
990     # If a tag name was supplied then try to get the value,
991     # otherwise just display all tag+value pairs defined:
992     if ( defined $tagname )
993     {
994     foreach $feature (@features)
995     {
996     print $t->getfeature($feature),"\n" if ($feature eq $tagname);
997     }
998     }
999     else
1000     {
1001     # Loop over features:
1002     foreach $ft ( @features )
1003     {
1004     @vals=$t->getfeature($ft);
1005     foreach $v ( @vals )
1006     {
1007     print $ft,"\n";
1008     }
1009     }
1010     }
1011     }
1012     else
1013     {
1014 sashby 1.34 return (1);
1015 sashby 1.32 }
1016     }
1017     }
1018    
1019 sashby 1.2 sub tool_setup
1020     {
1021     ###############################################################
1022     # tool_setup() #
1023     ###############################################################
1024     # modified : Mon May 28 11:28:35 2001 / SFA #
1025     # params : #
1026     # : #
1027     # : #
1028     # : #
1029     # function : #
1030     # : #
1031     # : #
1032     ###############################################################
1033 sashby 1.31 &local_verbose("tool_setup");
1034 sashby 1.2 print "Please use scram setup command\n";
1035 sashby 1.34 return (1);
1036 sashby 1.2 }
1037    
1038 sashby 1.40 sub tool_remove
1039     {
1040     ###############################################################
1041     # tool_remove() #
1042     ###############################################################
1043     # modified : Fri Apr 26 11:18:35 2002 / SFA #
1044     # params : #
1045     # : #
1046     # : #
1047     # : #
1048     # function : Remove the tool from the project area. #
1049     # : #
1050     # : #
1051     ###############################################################
1052     &local_verbose("tool_remove");
1053     my $tool_name = shift;
1054     # Translate to lower case:
1055     $tool_name =~ tr[A-Z][a-z];
1056    
1057     my $here=_localarea()->location();
1058     my @tools_hash=toolbox()->gettool($tool_name,@_);
1059     my $adminfile=$here."/.SCRAM/".$ENV{SCRAM_ARCH}."/admin";
1060     my $newadminfile=$here."/.SCRAM/".$ENV{SCRAM_ARCH}."/admin.new";
1061     my $foundtool=0;
1062    
1063     $lncount=0;
1064    
1065     if (defined $tools_hash[0]) # Check that the tool is defined in this area
1066     {
1067     my $tool_version=$tools_hash[0]->version();
1068     print "\n";
1069     my $toolstring=$tool_name."_".$tool_version;
1070     print "Tool exists in project area ",$here,
1071     "\n...removing ",$toolstring," from admin file:\n\n";
1072     open (ADMIN, "<".$adminfile);
1073     open (NEWADMIN, ">".$newadminfile);
1074    
1075     while (<ADMIN>)
1076     {
1077     # First we look for a line matching the tool name:
1078     if ($_ =~ /$tool_name/)
1079     {
1080     $foundtool=1;
1081     }
1082     # Once we have found the tool, check the next two lines for
1083     # matching version. End after the two version lines have been read:
1084     elsif (($foundtool == 1) && ($_ =~ /$tool_version/) && ($lncount < 2))
1085     {
1086     $lncount++;
1087     next;
1088     }
1089     else
1090     {
1091     # We write this to our new admin file:
1092     print NEWADMIN $_;
1093     }
1094     }
1095     close(ADMIN);
1096     close(NEWADMIN);
1097    
1098     # Rename the new admin file:
1099     rename($newadminfile, $adminfile) || ReportError("Unable to rename admin file.");
1100     # Create variables pointing to the files we're going to remove:
1101     my $tooldesc=$here."/.SCRAM/ToolFiles/".$toolstring;
1102     my $tooldat=$here."/.SCRAM/".$ENV{SCRAM_ARCH}."/".$toolstring.".dat";
1103    
1104     print "Removing ".$tooldesc."\n";
1105     # Remove the tool description:
1106     unlink($tooldesc) || ReportError("Unable to remove tool description file.");
1107     print "Removing ".$tooldat."\n";
1108     # Remove the dat file:
1109     unlink($tooldat) || ReportError("Unable to remove ".$toolstring.".dat file");
1110     print "..done.","\n";
1111     }
1112     else
1113     {
1114     ReportError("Tool \"".$tool_name."\" is not defined in this project area!\n");
1115     }
1116     return (0);
1117     }
1118    
1119 sashby 1.2 sub _tooloptions
1120     {
1121     ###############################################################
1122     # _tooloptions(error_string) #
1123     ###############################################################
1124     # modified : Mon May 28 11:28:38 2001 / SFA #
1125     # params : Error message string. #
1126     # : #
1127     # : #
1128     # : #
1129     # function : #
1130     # : #
1131     # : #
1132     ###############################################################
1133 sashby 1.31 &local_verbose("_tooloptions");
1134     ReportError("No Options defined for tool subcommand");
1135 sashby 1.2 }
1136    
1137     sub help_tool
1138     {
1139     ###############################################################
1140     # help_tool() #
1141     ###############################################################
1142     # modified : Mon May 28 11:28:41 2001 / SFA #
1143     # params : #
1144     # : #
1145     # : #
1146     # : #
1147     # function : Show help for tool command. #
1148     # : #
1149     # : #
1150     ###############################################################
1151 sashby 1.31 &local_verbose("help_tool");
1152 sashby 1.28
1153 sashby 1.2 print <<ENDTEXT;
1154 hpw 1.1 Manage the tools in the scram area that define the areas environment.
1155 sashby 1.40 Tool subcommands:
1156 sashby 1.2
1157 hpw 1.1 list
1158 sashby 1.40 info <tool_name>
1159     default <tool_name> <tool_version>
1160     tag <tool_name> <tag_name>
1161     remove <tool_name>
1162    
1163 hpw 1.1 ENDTEXT
1164 sashby 1.34 return (0);
1165 sashby 1.2 }
1166 hpw 1.1
1167 sashby 1.2 sub help_tool_info
1168     {
1169     ###############################################################
1170     # help_tool_info() #
1171     ###############################################################
1172     # modified : Mon May 28 11:28:45 2001 / SFA #
1173     # params : #
1174     # : #
1175     # : #
1176     # : #
1177     # function : Show help for tool info command. #
1178     # : #
1179     # : #
1180     ###############################################################
1181 sashby 1.31 &local_verbose("help_tool_info");
1182 sashby 1.28
1183 sashby 1.2 print <<ENDTEXT;
1184 hpw 1.1 Description:
1185     Print out information on the specified tool in the current area
1186     configuration.
1187     Usage :
1188     scram tool info tool_name [tool_version]
1189    
1190     ENDTEXT
1191 sashby 1.34 return (0);
1192 sashby 1.2 }
1193 hpw 1.1
1194 sashby 1.2 sub help_tool_list
1195     {
1196     ###############################################################
1197     # help_tool_list() #
1198     ###############################################################
1199     # modified : Mon May 28 11:28:50 2001 / SFA #
1200     # params : #
1201     # : #
1202     # : #
1203     # : #
1204     # function : Show help for tool info command. #
1205     # : #
1206     # : #
1207     ###############################################################
1208 sashby 1.31 &local_verbose("help_tool_list");
1209 sashby 1.28
1210 sashby 1.2 print <<ENDTEXT;
1211 hpw 1.1 Description:
1212     List of currently configured tools available in ther current scram
1213     area
1214     Usage :
1215     scram tool list
1216    
1217     ENDTEXT
1218 sashby 1.34 return (0);
1219 sashby 1.2 }
1220 hpw 1.1
1221 sashby 1.2 sub help_tool_default
1222     {
1223     ###############################################################
1224     # help_tool_default() #
1225     ###############################################################
1226     # modified : Mon May 28 11:28:54 2001 / SFA #
1227     # params : #
1228     # : #
1229     # : #
1230     # : #
1231     # function : #
1232     # : #
1233     # : #
1234     ###############################################################
1235 sashby 1.31 &local_verbose("help_tool_default");
1236 sashby 1.28
1237 sashby 1.2 print <<ENDTEXT;
1238 hpw 1.1 Description:
1239     Change the default version of a tool to be used in the area
1240     Usage :
1241     scram tool default tool_name tool_version
1242    
1243     ENDTEXT
1244 sashby 1.34 return (0);
1245 sashby 1.2 }
1246 sashby 1.32
1247    
1248     sub help_tool_tag
1249     {
1250     ###############################################################
1251     # help_tool_tag() #
1252     ###############################################################
1253     # modified : Mon May 28 11:28:45 2001 / SFA #
1254     # params : #
1255     # : #
1256     # : #
1257     # : #
1258     # function : Show help for tool tag command. #
1259     # : #
1260     # : #
1261     ###############################################################
1262     &local_verbose("help_tool_tag");
1263    
1264     print <<ENDTEXT;
1265     Description:
1266     Print out the value of a variable (tag) for the specified tool in the
1267 sashby 1.46 current area configuration. If no tag name is given, then all known tag
1268     names are printed to STDOUT.
1269 sashby 1.32 Usage :
1270 sashby 1.46 scram tool tag tool_name [tag_name]
1271 sashby 1.32
1272     ENDTEXT
1273 sashby 1.34 return (0);
1274 sashby 1.32 }
1275    
1276 sashby 1.40 sub help_tool_remove
1277     {
1278     ###############################################################
1279     # help_tool_remove() #
1280     ###############################################################
1281     # modified : #
1282     # params : #
1283     # : #
1284     # : #
1285     # : #
1286     # function : Show help for tool remove command. #
1287     # : #
1288     # : #
1289     ###############################################################
1290     &local_verbose("help_tool_remove");
1291    
1292     print <<ENDTEXT;
1293     Description:
1294     Remove the specified tool from the current project area
1295     Usage :
1296     scram tool remove tool_name
1297    
1298     ENDTEXT
1299     return (0);
1300     }
1301    
1302    
1303 hpw 1.1
1304     # ----------------------------------------------------------------------
1305 sashby 1.2 sub _requirements
1306     {
1307     ###############################################################
1308     # _requirements() #
1309     ###############################################################
1310     # modified : Mon May 28 11:28:59 2001 / SFA #
1311     # params : #
1312     # : #
1313     # : #
1314     # : #
1315     # function : #
1316     # : #
1317     # : #
1318     ###############################################################
1319 sashby 1.31 &local_verbose("_requirements");
1320 sashby 1.28
1321 sashby 1.2 if ( ! defined $reqsobj )
1322     {
1323     localtop();
1324     my $area=_localarea();
1325     scrambasics()->arearequirements($area);
1326     }
1327     return $reqsobj;
1328     }
1329    
1330     sub _allprojectinitsearcher
1331     {
1332     ###############################################################
1333     # _allprojectinitsearcher() #
1334     ###############################################################
1335     # modified : Mon May 28 11:29:03 2001 / SFA #
1336     # params : #
1337     # : #
1338     # : #
1339     # : #
1340     # function : #
1341     # : #
1342     # : #
1343     ###############################################################
1344 sashby 1.31 &local_verbose("_allprojectinitsearcher");
1345 sashby 1.28
1346 sashby 1.2 my $search=_projsearcher();
1347     foreach $proj ( _scramprojdb()->list() )
1348     {
1349     $search->addproject($$proj[0],$$proj[1]);
1350     }
1351     }
1352    
1353     sub _projsearcher
1354     {
1355     ###############################################################
1356     # _projsearcher() #
1357     ###############################################################
1358     # modified : Mon May 28 11:29:05 2001 / SFA #
1359     # params : #
1360     # : #
1361     # : #
1362     # : #
1363     # function : #
1364     # : #
1365     # : #
1366     ###############################################################
1367 sashby 1.31 &local_verbose("_projsearcher");
1368 sashby 1.28
1369 sashby 1.2 if ( ! defined $self->{projsearcher} )
1370     {
1371     require Scram::ProjectSearcher;
1372     $self->{projsearcher}=Scram::ProjectSearcher->new(_scramprojdb());
1373     }
1374     return $self->{projsearcher};
1375     }
1376    
1377     sub _scramprojdb
1378     {
1379     ###############################################################
1380     # _scramprodb() #
1381     ###############################################################
1382     # modified : Mon May 28 11:29:10 2001 / SFA #
1383     # params : #
1384     # : #
1385     # : #
1386     # : #
1387     # function : #
1388     # : #
1389     # : #
1390     ###############################################################
1391 sashby 1.31 &local_verbose("_scramprojdb");
1392 sashby 1.28
1393 sashby 1.2 return scrambasics()->scramprojectdb();
1394     }
1395    
1396     sub runtime
1397     {
1398     ###############################################################
1399     # runtime() #
1400     ###############################################################
1401     # modified : Mon May 28 11:29:13 2001 / SFA #
1402     # params : shell type (-sh for Bourne, -csh for C/tcsh) #
1403     # : #
1404     # : #
1405     # : #
1406     # function : Get/set runtime environment. #
1407     # : #
1408     # : #
1409     ###############################################################
1410 sashby 1.31 &local_verbose("runtime");
1411 sashby 1.28
1412 sashby 1.2 my $shell;
1413     require Runtime;
1414    
1415 sashby 1.35 # Exit unless we have some args:
1416     if ($ARGV[0] !~ "^-" ) {ReportError("Insufficient arguments. A shell must be given.\n")};
1417    
1418 sashby 1.2 # process options
1419     while ( $ARGV[0] =~ "^-" )
1420     {
1421     if ( $ARGV[0] =~ /-sh/ )
1422     {
1423     shift @ARGV;
1424     $shell="sh";
1425     next;
1426     }
1427     if ( $ARGV[0] =~ /-csh/ ) #installation area directory
1428     {
1429     shift @ARGV;
1430     $shell="csh";
1431     next;
1432     }
1433 sashby 1.31 ReportError("Unknown Option $ARGV[0]\n");
1434 sashby 1.2 }
1435 sashby 1.12
1436 sashby 1.2 FullEnvInit();
1437 sashby 1.12
1438 sashby 1.2 if ( @ARGV )
1439     {
1440     my $runtime=Runtime->new();
1441     my $arg=shift @ARGV;
1442    
1443     my $info=0;
1444     if ( $arg eq "info" )
1445     {
1446     $arg=shift @ARGV;
1447     $info=1;
1448     }
1449    
1450     # --- determine filename
1451     my $filename;
1452     if ( -f $arg ) # Is it a file?
1453     {
1454     $filename=$arg;
1455     }
1456     else
1457     {
1458     # -- lets see if its a BuildFile location
1459     $filename=_testfile($ENV{LOCALTOP}."/src/".$arg,
1460     $ENV{RELEASETOP}."/src/".$arg,
1461     $ENV{LOCALTOP}."/src/".$arg."/BuildFile",
1462     $ENV{RELEASETOP}."/src/".$arg."/BuildFile");
1463     if ( $filename eq "" )
1464     {
1465 sashby 1.31 ReportError("Unable to find a file (or BuildFile) relating to ".
1466     $arg."\n");
1467 sashby 1.2 }
1468     }
1469     $runtime->file($filename);
1470     if ( ! $info )
1471     {
1472     $runtime->printenv($shell);
1473     }
1474     else
1475     {
1476     if ( @ARGV ) #do we have a specific variable request?
1477     {
1478     _printvardoc($runtime,shift @ARGV);
1479     }
1480     else
1481     {
1482     foreach $var ( $runtime->list() )
1483     {
1484     _printvardoc($runtime,$var);
1485     }
1486     }
1487     }
1488     undef $runtime;
1489     }
1490     else
1491     {
1492     FullEnvInit();
1493     # -- We have to clean up from the last runtime cmd - use env history
1494     foreach $variable ( %ENV )
1495     {
1496     if ( $variable =~ /^SCRAMRT_(.*)/ ) #SCRAMRT are history retaining
1497     {
1498 hpw 1.1 my $var=$1;
1499 sashby 1.2 $ENV{$var} =~ s/\Q$ENV{$variable}\E//g;
1500     $ENV{$var} =~ s/^:*//; # Deal with any Path variables
1501 sashby 1.47 undef $ENV{$variable};
1502 sashby 1.2 }
1503     }
1504 hpw 1.1
1505 sashby 1.2 # -- get the tool runtime environments
1506     my $toolrt=scrambasics()->toolruntime(_localarea());
1507     $toolrt->sethash(\%EnvRuntime);
1508    
1509     # -- create new SCRAMRT history vars.
1510     foreach $variable ( keys %EnvRuntime )
1511     {
1512     printoutenv($shell,"SCRAMRT_$variable",$EnvRuntime{$variable});
1513     }
1514 hpw 1.1
1515 sashby 1.2 # TODO -- this stuff should dissappear with compiler description docs
1516     # Now adapt as necessary - include base environment as well
1517     if ( exists $ENV{LD_LIBRARY_PATH} )
1518     {
1519     addpath("LD_LIBRARY_PATH","$ENV{LD_LIBRARY_PATH}");
1520     }
1521     if ( exists $ENV{MANPATH} )
1522     {
1523     addpath("MANPATH","$ENV{MANPATH}");
1524     }
1525     addpath("PATH","$ENV{PATH}");
1526    
1527     # -- Print out as reqd
1528     # TODO -- we can use the runtime class method once we have removed
1529     # this stuff above
1530     foreach $variable ( keys %EnvRuntime )
1531     {
1532     printoutenv($shell,$variable,$EnvRuntime{$variable});
1533     }
1534 sashby 1.12
1535 sashby 1.30 # Export a copy of LOCALTOP, renamed as a new variable:
1536     printoutenv($shell,"LOCALRT",$ENV{LOCALTOP});
1537 sashby 1.2 }
1538 sashby 1.34 return (0);
1539 sashby 1.2 }
1540 hpw 1.1
1541     # Support rt for runtime
1542    
1543 sashby 1.2 sub _testfile
1544     {
1545     ###############################################################
1546     # _testfile() #
1547     ###############################################################
1548     # modified : Mon May 28 11:29:21 2001 / SFA #
1549     # params : #
1550     # : #
1551     # : #
1552     # : #
1553     # function : #
1554     # : #
1555     # : #
1556     ###############################################################
1557 sashby 1.31 &local_verbose("_testfile");
1558 sashby 1.28
1559 sashby 1.2 my @files=@_;
1560     my $filename="";
1561    
1562     foreach $file ( @files )
1563     {
1564     if ( -f $file )
1565     {
1566     $filename=$file;
1567     last;
1568     }
1569     }
1570     return $filename;
1571     }
1572    
1573     sub _printvardoc
1574     {
1575     ###############################################################
1576     # _printvardoc() #
1577     ###############################################################
1578     # modified : Mon May 28 11:29:25 2001 / SFA #
1579     # params : #
1580     # : #
1581     # : #
1582     # : #
1583     # function : #
1584     # : #
1585     # : #
1586     ###############################################################
1587 sashby 1.31 &local_verbose("_printvardoc");
1588 sashby 1.28
1589 sashby 1.2 my $runtime=shift;
1590     my $var=shift;
1591    
1592     print $var." :\n";
1593     print $runtime->doc($var);
1594     print "\n";
1595     }
1596    
1597     sub printoutenv
1598     {
1599     ###############################################################
1600     # printoutenv() #
1601     ###############################################################
1602     # modified : Mon May 28 11:29:28 2001 / SFA #
1603     # params : #
1604     # : #
1605     # : #
1606     # : #
1607     # function : #
1608     # : #
1609     # : #
1610     ###############################################################
1611 sashby 1.31 &local_verbose("printoutenv");
1612 sashby 1.28
1613 sashby 1.2 my $shell=shift;
1614     my $variable=shift;
1615     my $value=shift;
1616    
1617     if ( $shell eq "csh" )
1618     {
1619     print "setenv $variable \"$value\";\n";
1620     }
1621     elsif ( $shell eq "sh" )
1622     {
1623     print "$variable=\"$value\";\n";
1624     print "export $variable;\n";
1625     }
1626     }
1627    
1628     sub addpath
1629     {
1630     ###############################################################
1631     # addpath() #
1632     ###############################################################
1633     # modified : Mon May 28 11:29:32 2001 / SFA #
1634     # params : #
1635     # : #
1636     # : #
1637     # : #
1638     # function : #
1639     # : #
1640     # : #
1641     ###############################################################
1642 sashby 1.31 &local_verbose("addpath");
1643 sashby 1.28
1644 sashby 1.2 my $name=shift;
1645     my $val=shift;
1646    
1647     my $n;
1648     my @env;
1649     @env=split /:/, $EnvRuntime{$name};
1650     foreach $n ( (split /:/, $val ) )
1651     {
1652     if ( ! grep /^\Q$n\E$/, @env )
1653     {
1654     addvar($name,$n,":");
1655     }
1656     }
1657     }
1658 hpw 1.1
1659 sashby 1.2 sub addvar
1660     {
1661     ###############################################################
1662     # addvar() #
1663     ###############################################################
1664     # modified : Mon May 28 11:29:35 2001 / SFA #
1665     # params : #
1666     # : #
1667     # : #
1668     # : #
1669     # function : #
1670     # : #
1671     # : #
1672     ###############################################################
1673 sashby 1.31 &local_verbose("addvar");
1674 sashby 1.28
1675 sashby 1.2 my $name=shift;
1676     my $val=shift;
1677     my $sep=shift;
1678    
1679     if ( $val ne "" )
1680     {
1681     if ( defined $EnvRuntime{$name} )
1682     {
1683 hpw 1.1 $EnvRuntime{$name}=$EnvRuntime{$name}.$sep.$val;
1684 sashby 1.2 }
1685     else
1686     {
1687 hpw 1.1 $EnvRuntime{$name}=$val;
1688 sashby 1.2 }
1689     }
1690     }
1691    
1692     sub FullEnvInit
1693     {
1694     ###############################################################
1695     # FullEnvInit() #
1696     ###############################################################
1697     # modified : Mon May 28 11:29:38 2001 / SFA #
1698     # params : #
1699     # : #
1700     # : #
1701     # : #
1702     # function : #
1703     # : #
1704     # : #
1705     ###############################################################
1706 sashby 1.31 &local_verbose("FullEnvInit");
1707 sashby 1.28
1708 sashby 1.2 environmentinit();
1709     localtop();
1710     LoadEnvFile();
1711     }
1712    
1713     sub environmentinit
1714     {
1715     ###############################################################
1716     # environmentinit() #
1717     ###############################################################
1718     # modified : Mon May 28 11:29:41 2001 / SFA #
1719     # params : #
1720     # : #
1721     # : #
1722     # : #
1723     # function : Set the environment variables needed #
1724     # : by scram (arch, home etc.) #
1725     # : #
1726     ###############################################################
1727 sashby 1.31 &local_verbose("environmentinit");
1728 sashby 1.28
1729 sashby 1.2 use Utilities::setarchitecture;
1730 sashby 1.23
1731 sashby 1.2 my $name;
1732     my $value;
1733    
1734     $ENV{LatestBuildFile}=""; # stop recursive behaviour in make
1735 sashby 1.23
1736 sashby 1.2 if ( ! defined $ENV{SCRAM_ARCH} )
1737     {
1738     setarchitecture::setarch();
1739     }
1740     $ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
1741     $ENV{INTsrc}="src";
1742     $ENV{INTlog}="logs";
1743     $ENV{INTlib}="lib/".$ENV{SCRAM_ARCH};
1744    
1745     ($ENV{SCRAM_BASEDIR}=$ENV{SCRAM_HOME}) =~ s/(.*)\/.*/$1/;
1746     if ( ! ( exists $ENV{SCRAM_CONFIG} ) )
1747     {
1748     $ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration";
1749     }
1750     $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
1751     if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) )
1752     {
1753     if ( -d "$ENV{SCRAM_BASEDIR}/scramdb/" )
1754     {
1755     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_BASEDIR}/scramdb/project.lookup";
1756     }
1757     else
1758     {
1759     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
1760     }
1761     }
1762     $ENV{SCRAM_AVAILDIRS}="";
1763     $ENV{SCRAM_AVAILFILES}="";
1764     }
1765    
1766     sub _localarea
1767     {
1768     ###############################################################
1769     # _localarea() #
1770     ###############################################################
1771     # modified : Mon May 28 11:29:47 2001 / SFA #
1772     # params : #
1773     # : #
1774     # : #
1775     # : #
1776     # function : #
1777     # : #
1778     # : #
1779     ###############################################################
1780 sashby 1.31 &local_verbose("_localarea");
1781 sashby 1.28
1782 sashby 1.2 if ( ! defined $self->{localarea} )
1783     {
1784     require Configuration::ConfigArea;
1785     $self->{localarea}=Configuration::ConfigArea->new();
1786     if ( ! defined $ENV{LOCALTOP} )
1787     {
1788     if ( $self->{localarea}->bootstrapfromlocation() )
1789     {
1790 hpw 1.1 # Were not in a local area
1791     undef $self->{localarea};
1792 sashby 1.2 }
1793     else
1794     {
1795     $self->{localarea}->archname(scrambasics()->arch());
1796     }
1797     }
1798     else
1799     {
1800     $self->{localarea}->bootstrapfromlocation($ENV{LOCALTOP});
1801     }
1802     }
1803     return $self->{localarea};
1804     }
1805    
1806     sub localtop_find
1807     {
1808     ###############################################################
1809     # localtop_find() #
1810     ###############################################################
1811     # modified : Mon May 28 11:29:50 2001 / SFA #
1812     # params : #
1813     # : #
1814     # : #
1815     # : #
1816     # function : #
1817     # : #
1818     # : #
1819     ###############################################################
1820 sashby 1.31 &local_verbose("localtop_find");
1821 sashby 1.28
1822 sashby 1.2 my $rv=1;
1823     if ( defined _localarea())
1824     {
1825     $rv=0;
1826     $ENV{LOCALTOP}=_localarea()->location();
1827     }
1828     return $rv;
1829     }
1830    
1831     sub localtop
1832     {
1833     ###############################################################
1834     # localtop() #
1835     ###############################################################
1836     # modified : Mon May 28 11:29:54 2001 / SFA #
1837     # params : #
1838     # : #
1839     # : #
1840     # : #
1841 sashby 1.5 # function : Find the top directory of local release area. #
1842 sashby 1.2 # : #
1843     # : #
1844     ###############################################################
1845 sashby 1.31 &local_verbose("localtop");
1846 sashby 1.28
1847 sashby 1.2 localtop_find();
1848 sashby 1.30
1849     # localtop_find() should set the variable LOCALTOP if we're
1850     # in a project area. This behaviour should take precedence.
1851     if ( defined ($ENV{LOCALTOP}))
1852     {
1853     # We're in a project area. Do whatever is necessary:
1854     ($ENV{THISDIR}=cwd) =~ s/^\Q$ENV{LOCALTOP}\L//;
1855     }
1856     else
1857 sashby 1.2 {
1858 sashby 1.30 # Not in a project area. See if we've used "setroot" to set
1859     # LOCALRT. If so, use that as LOCALTOP, otherwise say goodbye:
1860     if ( defined ($ENV{'LOCALRT'}))
1861     {
1862     $ENV{LOCALTOP} = $ENV{'LOCALRT'};
1863     ($ENV{THISDIR}=cwd) =~ s/^\Q$ENV{LOCALTOP}\L//;
1864     }
1865     else
1866     {
1867 sashby 1.31 ReportError("Unable to locate the top of local release. Exitting.\n");
1868 sashby 1.30 }
1869 sashby 1.2 }
1870     $ENV{THISDIR} =~ s/^\///;
1871     }
1872    
1873     sub LoadEnvFile
1874     {
1875     ###############################################################
1876     # LoadEnvFile() #
1877     ###############################################################
1878     # modified : Mon May 28 11:29:58 2001 / SFA #
1879     # params : #
1880     # : #
1881     # : #
1882     # : #
1883     # function : #
1884     # : #
1885     # : #
1886     ###############################################################
1887 sashby 1.31 &local_verbose("LoadEnvFile");
1888 sashby 1.28
1889 sashby 1.2 _localarea()->copyenv(\%ENV);
1890     }
1891    
1892     sub env
1893     {
1894     ###############################################################
1895     # env() #
1896     ###############################################################
1897     # modified : Mon May 28 11:30:00 2001 / SFA #
1898     # params : #
1899     # : #
1900     # : #
1901     # : #
1902     # function : #
1903     # : #
1904     # : #
1905     ###############################################################
1906 sashby 1.31 &local_verbose("env");
1907 sashby 1.28
1908 hpw 1.1 print "Sorry - Not yet\n";
1909 sashby 1.2 }
1910 hpw 1.1
1911 sashby 1.2 sub devint
1912     {
1913     ###############################################################
1914     # devint() #
1915     ###############################################################
1916     # modified : Mon May 28 11:30:03 2001 / SFA #
1917     # params : #
1918     # : #
1919     # : #
1920     # : #
1921     # function : #
1922     # : #
1923     # : #
1924     ###############################################################
1925 sashby 1.31 &local_verbose("devint");
1926 sashby 1.28
1927 sashby 1.2 my $class=shift @ARGV;
1928     scrambasics()->scramobjectinterface($class);
1929     }
1930    
1931     sub devtest
1932     {
1933     ###############################################################
1934     # devtest() #
1935     ###############################################################
1936     # modified : Mon May 28 11:30:06 2001 / SFA #
1937     # params : #
1938     # : #
1939     # : #
1940     # : #
1941     # function : #
1942     # : #
1943     # : #
1944     ###############################################################
1945 sashby 1.31 &local_verbose("devtest");
1946 sashby 1.28
1947 sashby 1.2 require Utilities::TestClass;
1948     my $class=shift @ARGV;
1949    
1950     my $tester;
1951     my $path;
1952    
1953     if ( $class =~ /::/ )
1954     {
1955     ($path=$class) =~ s/(.*)::.*/$1/;
1956     }
1957     $tester=Utilities::TestClass->new($class,
1958     "$ENV{SCRAM_HOME}/src/$path/test/testdata");
1959     $tester->dotest(@_);
1960     }
1961 hpw 1.1
1962     #
1963     # Create a lookup tag in the site database
1964     #
1965 sashby 1.2 sub install
1966     {
1967     ###############################################################
1968     # install() #
1969     ###############################################################
1970     # modified : Mon May 28 11:30:09 2001 / SFA #
1971     # params : #
1972     # : #
1973     # : #
1974     # : #
1975     # function : Install a project. Updates project.lookup #
1976     # : files found in /scramdb. #
1977     # : #
1978     ###############################################################
1979 sashby 1.31 &local_verbose("install");
1980 sashby 1.28
1981 sashby 1.2 localtop();
1982    
1983     scrambasics()->addareatoDB(_localarea(),@ARGV);
1984     _localarea()->align();
1985 sashby 1.34 return (0);
1986 sashby 1.2 }
1987    
1988     sub help_install()
1989     {
1990     ###############################################################
1991     # help_install() #
1992     ###############################################################
1993     # modified : Mon May 28 11:30:12 2001 / SFA #
1994     # params : #
1995     # : #
1996     # : #
1997     # : #
1998 sashby 1.28 # function : Show help for the install command. #
1999 sashby 1.2 # : #
2000     # : #
2001     ###############################################################
2002 sashby 1.31 &local_verbose("help_install");
2003 sashby 1.28
2004 sashby 1.2 print <<ENDTEXT;
2005 hpw 1.1 Associates a label with the current release in the SCRAM database.
2006     This allows other users to refer to a centrally installed project by
2007     this label rather than a remote url reference.
2008    
2009     Usage:
2010    
2011     $bold scram install $normal [project_tag [version_tag]]
2012    
2013 sashby 1.46 project_tag : override default label (the project name of the current release)
2014 hpw 1.1 version_tag : the version tag of the current release. If version is not
2015     specified the base release version will be taken by default.
2016    
2017     ENDTEXT
2018 sashby 1.34 return (0);
2019 sashby 1.2 }
2020 hpw 1.1
2021 sashby 1.2 sub helpheader ($label)
2022     {
2023     ###############################################################
2024     # helpheader(label) #
2025     ###############################################################
2026     # modified : Mon May 28 11:30:17 2001 / SFA #
2027     # params : label for the header. #
2028     # : #
2029     # : #
2030     # : #
2031     # function : Prints a header for the help command of #
2032     # : scram command "label". #
2033     # : #
2034     ###############################################################
2035 sashby 1.31 &local_verbose("helpheader");
2036 sashby 1.28
2037 sashby 1.2 my $label=shift;
2038    
2039     print <<ENDTEXT;
2040    
2041 hpw 1.1 *************************************************************************
2042 sashby 1.2 SCRAM HELP --------- $label
2043 hpw 1.1 *************************************************************************
2044 sashby 1.2
2045 hpw 1.1 ENDTEXT
2046 sashby 1.34 return (0);
2047 sashby 1.2 }
2048 hpw 1.1
2049 sashby 1.2 sub version
2050     {
2051     ###############################################################
2052     # version() #
2053     ###############################################################
2054     # modified : Mon May 28 11:30:24 2001 / SFA #
2055     # params : #
2056     # : #
2057     # : #
2058     # : #
2059     # function : Get the version of scram being used. #
2060     # : #
2061     # : #
2062     ###############################################################
2063 sashby 1.31 &local_verbose("version");
2064 sashby 1.28
2065 sashby 1.2 my $version=shift @ARGV;
2066     my $thisversion;
2067     my $scram_top;
2068     my $cvsobject;
2069    
2070     ($thisversion=$ENV{SCRAM_HOME}) =~ s/(.*)\///;
2071     $scram_top=$1;
2072     if ( $version eq "" )
2073     {
2074     print "$thisversion";
2075     # deal with links
2076     $version=readlink $ENV{SCRAM_HOME};
2077     if ( defined $version)
2078     {
2079     print " ---> $version";
2080     }
2081     print "\n";
2082     }
2083     else
2084     {
2085     if ( -d $scram_top."/".$version )
2086     {
2087     print "Version $version exists\n";
2088     }
2089     else
2090     {
2091     print "Version $version not available locally\n";
2092     print "Attempting download from the SCRAM repository\n";
2093     # set up and configure the cvs module for SCRAM
2094     require Utilities::CVSmodule;
2095     $cvsobject=Utilities::CVSmodule->new();
2096 sashby 1.51 # This will need to be changed to make it more generic:
2097 sashby 1.2 $cvsobject->set_base(
2098     "cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
2099     $cvsobject->set_auth("pserver");
2100     $cvsobject->set_user("anonymous");
2101     $cvsobject->set_passkey("AA_:yZZ3e");
2102     # Now check it out in the right place
2103     chdir $scram_top or die "Unable to change to $scram_top $!\n";
2104     $cvsobject->invokecvs( ( split / /,
2105     "co -d $version -r $version SCRAM" ));
2106 hpw 1.1
2107 sashby 1.51 # Get rid of cvs object now we've finished
2108 sashby 1.2 $cvsobject=undef;
2109     print "\n";
2110     }
2111     }
2112 sashby 1.34 return (0);
2113 sashby 1.2 }
2114    
2115     sub list
2116     {
2117     ###############################################################
2118     # list() #
2119     ###############################################################
2120     # modified : Mon May 28 11:30:28 2001 / SFA #
2121     # params : #
2122     # : #
2123     # : #
2124     # : #
2125     # function : List available projects. #
2126     # : #
2127     # : #
2128     ###############################################################
2129 sashby 1.31 &local_verbose("list");
2130 sashby 1.2 &environmentinit;
2131    
2132     my $linebold = "$bold"."$line"."$normal";
2133     my $pjname = "Project Name";
2134     my $pjversion = "Project Version";
2135     my $pjlocation = "Project Location";
2136 sashby 1.5 my $headstring = sprintf("| %-12s | %-24s | %-33s |",$pjname,$pjversion,$pjlocation);
2137 sashby 1.2
2138     if ( ! -f $ENV{SCRAM_LOOKUPDB} )
2139     {
2140 sashby 1.31 ReportError
2141     ("\nNo installation database available - perhaps no projects\nhave been installed locally?\n");
2142 sashby 1.2 }
2143 sashby 1.4 print "\n","Listing installed projects....","\n\n";
2144 sashby 1.2 print $linebold,"\n";
2145     print $headstring."\n";
2146     print $linebold,"\n\n";
2147     listDB(@ARGV);
2148     print "\n";
2149 sashby 1.34 return (0);
2150 sashby 1.2 }
2151    
2152 sashby 1.54 sub listcompact
2153     {
2154     ###############################################################
2155     # listcompact() #
2156     ###############################################################
2157     # modified : Fri Aug 30 14:21:52 2002 / SFA #
2158     # params : #
2159     # : #
2160     # : #
2161     # : #
2162     # function : List available projects in compact and non-fancy #
2163     # : format. Mainly for use in scripts. #
2164     # : #
2165     ###############################################################
2166     &local_verbose("list");
2167     &environmentinit;
2168    
2169     if ( ! -f $ENV{SCRAM_LOOKUPDB} )
2170     {
2171     ReportError
2172     ("\nNo installation database available - perhaps no projects\nhave been installed locally?\n");
2173     }
2174    
2175     listDB('compact',@ARGV);
2176    
2177     return (0);
2178     }
2179 sashby 1.2
2180     sub remove
2181     {
2182     ###############################################################
2183     # remove(project) #
2184     ###############################################################
2185     # modified : Mon May 28 11:30:31 2001 / SFA #
2186 sashby 1.5 # params : project name, project version #
2187 sashby 1.2 # : #
2188     # : #
2189     # : #
2190     # function : Remove the named project from the project.lookup #
2191     # : file (scram database). #
2192     # : #
2193 sashby 1.28 ###############################################################
2194 sashby 1.31 &local_verbose("remove");
2195 sashby 1.28
2196 sashby 1.5 my $projectname=shift @ARGV;
2197     my $projectversion=shift @ARGV;
2198    
2199     # Check there were sufficient args:
2200     if ($projectname eq "" || $projectversion eq "")
2201     {
2202 sashby 1.31 ReportError("\"scram remove help\" for usage info.");
2203 sashby 1.5 }
2204     else
2205     {
2206     scrambasics()->removeareafromDB($projectname,$projectversion);
2207     }
2208 sashby 1.34 return (0);
2209 sashby 1.2 }
2210    
2211     sub db
2212     {
2213     ###############################################################
2214     # db() #
2215     ###############################################################
2216     # modified : Mon May 28 11:30:35 2001 / SFA #
2217 sashby 1.5 # params : "link", "unlink" or "show(links )" #
2218 sashby 1.2 # : #
2219     # : #
2220     # : #
2221     # function : Show project info stored in scramdb. Link/unlink #
2222     # : project database files, or show linked databases.#
2223     # : #
2224     ###############################################################
2225 sashby 1.31 &local_verbose("db");
2226 sashby 1.28
2227 sashby 1.2 my $subcmd=shift @ARGV;
2228 sashby 1.37 my $db=shift @ARGV;
2229    
2230 sashby 1.2 # Make sure we have an argument, or tell the user:
2231     if ( ! defined($subcmd))
2232     {
2233     &help_db;
2234     print "\n";
2235     exit (1);
2236     }
2237 sashby 1.37
2238     # If there is a file arg, test it to make sure it exists:
2239     if ( $subcmd eq 'link' ||
2240     $subcmd eq 'unlink' )
2241     {
2242     if ( -f $db )
2243     {
2244     print "Found DB file....",$db,"\n";
2245     }
2246     else
2247     {
2248     ReportError("Could not find a DB ".$db."\n");
2249     }
2250     }
2251 sashby 1.2 &environmentinit;
2252    
2253     # First, check for a database area:
2254     if ( ! -f $ENV{SCRAM_LOOKUPDB} )
2255     {
2256 sashby 1.31 ReportError
2257     ("\nNo installation database available - perhaps no projects\nhave been installed locally?\n");
2258 sashby 1.2 }
2259     print "\n","Current scram database: ";
2260     print $bold."$ENV{SCRAM_LOOKUPDB}".$normal."\n\n";
2261    
2262     switch :
2263     {
2264     if ( $subcmd eq 'link' )
2265     {
2266 sashby 1.37 scrambasics()->scramprojectdb()->link($db);
2267     print "\n","Linked ",$db," to current scram database.","\n\n";
2268 sashby 1.2 last switch;
2269     }
2270     if ( $subcmd eq 'unlink' )
2271     {
2272 sashby 1.37 scrambasics()->scramprojectdb()->unlink($db);
2273     print "\n","Unlinked ",$db," from current scram database.","\n\n";
2274 sashby 1.2 last switch;
2275     }
2276     if ( $subcmd eq 'showlinks'
2277     || $subcmd eq 'showlink'
2278     || $subcmd eq 'show')
2279     {
2280     my @links=scrambasics()->scramprojectdb()->listlinks();
2281     # Are there any links defined?:
2282     if ( defined($links[0]) )
2283     {
2284     print "\n","The following scram databases are linked to the current scram database: ","\n\n";
2285     foreach $link ( @links )
2286     {
2287     print " ".$link."\n";
2288     }
2289     print "\n";
2290     }
2291     else
2292     {
2293     print "There are no databases linked.","\n\n";
2294     }
2295     last switch;
2296     }
2297     } # end switch
2298 sashby 1.34 return (0);
2299 sashby 1.2 }
2300 hpw 1.1
2301 sashby 1.2 sub listDB
2302     {
2303     ###############################################################
2304     # listDB() #
2305     ###############################################################
2306     # modified : Mon May 28 11:30:39 2001 / SFA #
2307     # params : Project name #
2308     # : #
2309 sashby 1.4 # function : List projects. Only those projects that were #
2310     # : installed on the user's current OS will be #
2311     # : displayed (slight anomaly here: some projects #
2312     # : were installed on SunOS_5.6 so won't appear if #
2313     # : the user's current platform is SunOS_5.7...). #
2314 sashby 1.2 # : #
2315     ###############################################################
2316 sashby 1.31 &local_verbose("listDB");
2317 sashby 1.28
2318 sashby 1.2 my $project="";
2319 sashby 1.14 my $projectexists=0;
2320     my @missingareas;
2321 sashby 1.54 my $localoption;
2322    
2323 sashby 1.2 if ( @_ )
2324     {
2325 sashby 1.54 $localoption=shift;
2326     if ($localoption ne 'compact' )
2327     {
2328     $project=$localoption;
2329     }
2330     else
2331     {
2332     $project=shift;
2333     }
2334 sashby 1.2 }
2335 sashby 1.5
2336 sashby 1.2 my @prs=scrambasics()->scramprojectdb()->listall();
2337 sashby 1.5
2338     # Check to see if there are any projects:
2339     if ( ! defined @prs )
2340     {
2341     print "\t\t>>>> No locally installed projects! <<<<","\n";
2342 sashby 1.34 return (1);
2343 sashby 1.5 }
2344 sashby 1.14
2345 sashby 1.5 # Iterate over the project list:
2346 sashby 1.2 foreach $pr ( @prs )
2347     {
2348 sashby 1.14 my $url='NULL';
2349    
2350 sashby 1.2 if ( $project eq "" || $project eq $$pr[0] )
2351     {
2352 sashby 1.14 # Check that the area exists (i.e. check that a configarea object
2353     # is returned before attempting to test its' location:
2354     my $possiblearea=scrambasics()->scramprojectdb()->getarea($$pr[0],$$pr[1]);
2355    
2356     if ( defined ($possiblearea))
2357 sashby 1.4 {
2358 sashby 1.14 $url=$possiblearea->location();
2359     if ($project eq $$pr[0]) {$projectexists=1};
2360     }
2361    
2362     # Check that the path to the project area is readable:
2363     if ( -d $url )
2364     {
2365     # Check that there exists an installation for
2366     # our current architecture. Check for a bin and
2367     # a lib directory:
2368     if ( -d "$url/bin/$ENV{SCRAM_ARCH}" || -d "$url/lib/$ENV{SCRAM_ARCH}" )
2369 sashby 1.12 {
2370 sashby 1.54 # For compact printing, put everything on one line:
2371     if ($localoption eq 'compact')
2372     {
2373     printf "%-15s %-25s %-50s\n",$$pr[0],$$pr[1],$url;
2374     }
2375     else
2376     # Print full, as usual:
2377     {
2378     # Stagger the printed lines to allow easier
2379     # copying using the mouse:
2380     printf " %-15s %-25s \n",$$pr[0],$$pr[1];
2381     printf "%45s%-30s\n","--> ",$bold.$url.$normal;
2382     }
2383 sashby 1.12 }
2384 sashby 1.14 }
2385     else
2386     {
2387     # We have an area that is unreadable. Push an entry onto the array:
2388     push @missingareas, sprintf ">> Project area MISSING: %-10s %-20s \n",$$pr[0],$$pr[1];
2389 sashby 1.4 }
2390 sashby 1.2 }
2391     }
2392 sashby 1.14
2393     if ( ! $projectexists && $project ne "" )
2394     {
2395     print "\t\t>>>> No locally installed $project projects! <<<<","\n";
2396 sashby 1.34 return(1);
2397 sashby 1.14 }
2398 sashby 1.54
2399     if ($localoption ne 'compact')
2400     {
2401     print "\n\n","Projects available for platform >> ".$bold."$ENV{SCRAM_ARCH}".$normal." <<\n";
2402     print "\n";
2403 sashby 1.31
2404 sashby 1.54 # Print out a list of areas that are missing:
2405     if ( @missingareas )
2406     {
2407     ReportError(@missingareas);
2408     }
2409 sashby 1.14 }
2410    
2411 sashby 1.31 # Otherwise exit nicely:
2412     return(0);
2413 sashby 1.2 }
2414    
2415     sub arch
2416     {
2417     ###############################################################
2418     # arch() #
2419     ###############################################################
2420     # modified : Mon May 28 11:30:41 2001 / SFA #
2421     # params : #
2422     # : #
2423     # : #
2424     # : #
2425     # function : Show the information about current architecture. #
2426     # : #
2427     # : #
2428     ###############################################################
2429 sashby 1.31 &local_verbose("arch");
2430 sashby 1.2 &environmentinit();
2431 sashby 1.10
2432     print "$ENV{SCRAM_ARCH}\n";
2433 sashby 1.34 return (0);
2434 sashby 1.2 }
2435 hpw 1.1
2436    
2437     #
2438     # Setup a new tool
2439     #
2440 sashby 1.2 sub setup
2441     {
2442 sashby 1.46 ###############################################################
2443     # setup #
2444     ###############################################################
2445     # modified : Tue May 21 12:40:24 2002 / SFA #
2446     # params : #
2447     # : #
2448     # : #
2449     # : #
2450     # function : setup tool box or a tool. #
2451     # : #
2452     # : #
2453     # : #
2454     ###############################################################
2455 sashby 1.2 my $interactive=0;
2456 sashby 1.43 my $toolsfile;
2457    
2458 sashby 1.2 # process options
2459     while ( $ARGV[0] =~ "^-" )
2460     {
2461     if ( $ARGV[0] =~ /-i/ )
2462     {
2463     shift @ARGV;
2464     $interactive=1;
2465 sashby 1.20 print "Running interactive setup....","\n";
2466 sashby 1.43 }
2467     elsif ( $ARGV[0] =~ /-f/ )
2468     {
2469     shift @ARGV;
2470     $toolsfile=$ARGV[0];
2471     if ($toolsfile =~ /\.conf$/ || -d $toolsfile) # File must end in ".conf" or be a dir...
2472     {
2473     # Set the location of the tools file:
2474     $ENV{LOCCMSTOOLS}=$toolsfile;
2475     }
2476     else
2477     {
2478     print "Expecting a tools file filename ( \"-f\" flag) but none given....","\n";
2479     print "Hint: the filename MUST end with \".conf\"","\n\n";
2480     }
2481     shift @ARGV;
2482     }
2483 sashby 1.2 else
2484     {
2485 sashby 1.31 ReportError("Unknown option $ARGV[0] to setup command");
2486 sashby 1.43 }
2487 sashby 1.2 }
2488 sashby 1.42
2489 sashby 1.2 localtop();
2490    
2491     my $area=_localarea();
2492 sashby 1.21 # We have a local area so we can invoke
2493 sashby 1.33 # method to get the sitename.
2494     # See if there is an environment setting:
2495     if ( ! $ENV{'SITENAME'})
2496     {
2497     $ENV{'SITENAME'} = $area->sitename();
2498     }
2499 sashby 1.22 $ENV{'PROJECTDIR'} = $area->location();
2500    
2501 sashby 1.2 my $toolname=shift @ARGV;
2502     my $insert=0;
2503 sashby 1.19
2504 sashby 1.2 toolbox()->interactive($interactive);
2505    
2506 sashby 1.20 # Initialize the lookup table:
2507     use Scram::AutoToolSetup;
2508     $lookupobject = Scram::AutoToolSetup->new();
2509 sashby 1.41
2510 sashby 1.2 # If no toolname specified then its a full setup
2511     if ( $toolname eq "" )
2512     {
2513     # -- add architecture specific directories
2514     use Utilities::AddDir;
2515 sashby 1.22 AddDir::adddir($ENV{'PROJECTDIR'}."/lib/$ENV{SCRAM_ARCH}");
2516     AddDir::adddir($ENV{'PROJECTDIR'}."/bin/$ENV{SCRAM_ARCH}");
2517 sashby 1.2 # -- check the releasetop area
2518     # if the releasetop has the files copy them
2519     my $releaseobj=_releasearea();
2520     if ( $releaseobj->copysetup($ENV{LOCALTOP}) )
2521     {
2522     print "Doing Full Setup\n";
2523 sashby 1.20 # Run the full setup for the area:
2524 sashby 1.2 scrambasics()->setuptoolsinarea($area);
2525     }
2526     }
2527     else
2528     {
2529 sashby 1.20 print "Running setup for tool ",$toolname,"...","\n";
2530 sashby 1.2 scrambasics()->setuptoolsinarea($area, $toolname,@ARGV);
2531     }
2532 sashby 1.34 return (0);
2533 sashby 1.2 }
2534 sashby 1.11
2535 sashby 1.12 sub setroot
2536     {
2537     ###############################################################
2538     # setroot #
2539     ###############################################################
2540     # modified : Wed Nov 7 16:22:25 2001 / SFA #
2541     # params : #
2542     # : #
2543     # : #
2544     # : #
2545     # function : #
2546     # : #
2547     # : #
2548     # : #
2549     ###############################################################
2550 sashby 1.31 &local_verbose("setroot");
2551 sashby 1.12 my $shell = shift @ARGV;
2552    
2553     # Check the shell argument...this must be supplied:
2554     if ($shell =~ "^-" )
2555     {
2556     # Remove the hyphen:
2557     $shell =~ s/-//;
2558 sashby 1.31 if ($shell ne "sh" && $shell ne "csh") {ReportError("No shell given! Exitting.");}
2559 sashby 1.12 }
2560     else
2561     {
2562 sashby 1.31 ReportError("No shell given! Exitting.");
2563 sashby 1.12 }
2564    
2565     my $projectname=shift @ARGV;
2566     my $projectversion=shift @ARGV;
2567    
2568     # Check there were sufficient args:
2569     if ($projectname eq "" || $projectversion eq "")
2570     {
2571 sashby 1.31 ReportError("\"scram setroot help\" for usage info.");
2572 sashby 1.12 }
2573     else
2574     {
2575 sashby 1.13 # And on we go. Let's find a release area for this project/version:
2576 sashby 1.12 my $releasearea = scrambasics()->scramprojectdb()->getarea($projectname,$projectversion);
2577 sashby 1.31 ReportError("No release area!!") if ( ! defined ($releasearea));
2578    
2579 sashby 1.12 # The info we need is stored in a hash and can be accessed using the key ENV.
2580 sashby 1.30 # If LOCALTOP is not defined, look for RELEASETOP:
2581     if ( ${${$releasearea}{'ENV'}}{'LOCALTOP'} eq '' )
2582 sashby 1.12 {
2583 sashby 1.30 if ( ${${$releasearea}{'ENV'}}{'RELEASETOP'} ne '' )
2584 sashby 1.12 {
2585 sashby 1.30 printoutenv($shell,"LOCALRT",${${$releasearea}{'ENV'}}{'RELEASETOP'});
2586 sashby 1.12 }
2587     }
2588 sashby 1.30 else
2589     # LOCALTOP is set so we can use it.
2590     # Set LOCALRT to LOCALTOP and return:
2591 sashby 1.12 {
2592 sashby 1.30 printoutenv($shell,"LOCALRT",${${$releasearea}{'ENV'}}{'LOCALTOP'});
2593 sashby 1.34 }
2594     }
2595     return (0);
2596 sashby 1.12 }
2597    
2598 sashby 1.2
2599     sub _releasearea
2600     {
2601     ###############################################################
2602     # _releasearea() #
2603     ###############################################################
2604     # modified : Mon May 28 11:30:50 2001 / SFA #
2605     # params : #
2606     # : #
2607     # : #
2608     # : #
2609     # function : #
2610     # : #
2611     # : #
2612     ###############################################################
2613 sashby 1.31 &local_verbose("_releasearea");
2614 sashby 1.28
2615 sashby 1.2 if ( !defined $self->{releasearea} )
2616     {
2617     require Configuration::ConfigArea;
2618     $self->{releasearea}=Configuration::ConfigArea->new();
2619     $self->{releasearea}->bootstrapfromlocation($ENV{RELEASETOP});
2620     }
2621     return $self->{releasearea};
2622     }
2623 hpw 1.1
2624     # get a toolbox object for the local area
2625 sashby 1.2 sub toolbox
2626     {
2627     ###############################################################
2628     # toolbox() #
2629     ###############################################################
2630     # modified : Mon May 28 11:30:53 2001 / SFA #
2631     # params : #
2632     # : #
2633     # : #
2634     # : #
2635     # function : #
2636     # : #
2637     # : #
2638     ###############################################################
2639 sashby 1.31 &local_verbose("toolbox");
2640 sashby 1.28
2641 sashby 1.2 if ( ! defined $toolbox )
2642     {
2643     localtop();
2644     my $area=_localarea();
2645     $toolbox=scrambasics()->areatoolbox($area);
2646     }
2647     return $toolbox;
2648     }
2649 sashby 1.27
2650    
2651     sub local_verbose
2652     {
2653     ###############################################################
2654     # local_verbose #
2655     ###############################################################
2656     # modified : Mon Jan 21 12:38:02 2002 / SFA #
2657     # params : Only debug env variable (switch) #
2658     # : #
2659     # : #
2660     # : #
2661     # function : Enable verbose mode for package "main" (i.e. #
2662     # : this wrapped script) #
2663     # : #
2664     # : #
2665     ###############################################################
2666     my $subroutine=shift;
2667 sashby 1.31
2668 sashby 1.28 if ($ENV{'SCRAMDEBUG'})
2669 sashby 1.30 {
2670     print "-------- [verbose mode]: subname >> ",$subroutine,"\n";
2671     }
2672     }
2673 sashby 1.2
2674     sub help_db
2675     {
2676     ###############################################################
2677     # help_db() #
2678     ###############################################################
2679     # modified : Mon May 28 11:30:56 2001 / SFA #
2680     # params : #
2681     # : #
2682     # : #
2683     # : #
2684     # function : Show help for scram db command. #
2685     # : #
2686     # : #
2687     ###############################################################
2688 sashby 1.31 &local_verbose("help_db");
2689 sashby 1.28
2690 sashby 1.2 print <<ENDTEXT;
2691 hpw 1.1 scram database administration command.
2692    
2693     Usage:
2694    
2695     $bold scram db $normal subcommand
2696    
2697 sashby 1.2 Subcommands:
2698    
2699 hpw 1.1 link :
2700     Make available an additional database for
2701     project and list operations
2702    
2703     $bold scram db link $normal /a/directory/path/project.lookup
2704    
2705     unlink :
2706     Remove a database from the link list. Note this does
2707     not remove the database, just the link to it in scram.
2708    
2709     $bold scram db unlink $normal /a/directory/path/project.lookup
2710    
2711     showlinks :
2712 sashby 1.46 List the databases that are linked in.
2713 hpw 1.1
2714     ENDTEXT
2715 sashby 1.34 return (0);
2716 sashby 1.2 }
2717 hpw 1.1
2718 sashby 1.2 sub help_setup
2719     {
2720     ###############################################################
2721     # help_setup() #
2722     ###############################################################
2723     # modified : Mon May 28 11:31:02 2001 / SFA #
2724     # params : #
2725     # : #
2726     # : #
2727     # : #
2728     # function : Show help for scram setup command. #
2729     # : #
2730     # : #
2731     ###############################################################
2732 sashby 1.31 &local_verbose("help_setup");
2733 sashby 1.28
2734 sashby 1.2 print <<ENDTEXT;
2735 hpw 1.1 Allows installation/re-installation of a new tool/external package into an
2736 sashby 1.46 already existing development area. If no toolname is specified,
2737 hpw 1.1 the complete installation process is initiated.
2738    
2739     Usage:
2740    
2741 sashby 1.43 $bold scram setup [-i] [-f cmstools.conf] $normal [toolname] [[version] [url]]
2742 hpw 1.1
2743     toolname : The name of the tool setup file required.
2744 sashby 1.46 version : where more than one version exists, specify the version.
2745     url : when setting up a completely new tool specify the url too.
2746 hpw 1.1
2747     The -i option turns off the automatic search mechanism allowing for more
2748 sashby 1.43 user interaction with the setup mechanism.
2749    
2750     The -f option allows the user to supply a valid path to a cmstools file (the filename
2751     MUST end in ".conf")
2752    
2753 hpw 1.1 ENDTEXT
2754 sashby 1.34 return (0);
2755 sashby 1.2 }
2756 hpw 1.1
2757 sashby 1.2 sub help_list
2758     {
2759     ###############################################################
2760     # help_list() #
2761     ###############################################################
2762     # modified : Mon May 28 11:31:09 2001 / SFA #
2763     # params : #
2764     # : #
2765     # : #
2766     # : #
2767     # function : Show help for scram list command. #
2768     # : #
2769     # : #
2770     ###############################################################
2771 sashby 1.31 &local_verbose("help_list");
2772 sashby 1.28
2773 sashby 1.2 print <<ENDTEXT;
2774 hpw 1.1 List the available projects and versions installed in the local SCRAM database
2775 sashby 1.46 (see scram install help).
2776 hpw 1.1
2777     Usage:
2778    
2779 sashby 1.24 $bold scram list $normal [ProjectName]
2780 hpw 1.1
2781     ENDTEXT
2782 sashby 1.34 return (0);
2783 sashby 1.2 }
2784 sashby 1.54
2785     sub help_listcompact
2786     {
2787     ###############################################################
2788     # help_listcompact() #
2789     ###############################################################
2790     # modified : Mon May 28 11:31:09 2001 / SFA #
2791     # params : #
2792     # : #
2793     # : #
2794     # : #
2795     # function : Show help for scram listcompact command. #
2796     # : #
2797     # : #
2798     ###############################################################
2799     &local_verbose("help_list");
2800    
2801     print <<ENDTEXT;
2802     List the available projects and versions installed in the local SCRAM database
2803     (see scram install help) but without fancy formatting or header strings.
2804    
2805     Usage:
2806    
2807     $bold scram listcompact $normal [ProjectName]
2808    
2809     The project name, version and installation directory are printed on STDOUT, separated
2810     by spaces for use in scripts.
2811    
2812     ENDTEXT
2813     return (0);
2814     }
2815    
2816 sashby 1.2
2817     sub help_remove
2818     {
2819     ###############################################################
2820     # help_remove() #
2821     ###############################################################
2822     # modified : Mon May 28 11:31:12 2001 / SFA #
2823     # params : #
2824     # : #
2825     # : #
2826     # : #
2827     # function : Show help for scram remove command. #
2828     # : #
2829     # : #
2830     ###############################################################
2831 sashby 1.31 &local_verbose("help_remove");
2832 sashby 1.28
2833 sashby 1.2 print <<ENDTEXT;
2834 sashby 1.5 Remove a project entry from scram database file (\"project.lookup\").
2835 sashby 1.2
2836     Usage:
2837    
2838 sashby 1.24 $bold scram remove $normal [ProjectName] [Version]
2839 sashby 1.2
2840     ENDTEXT
2841 sashby 1.34 return (0);
2842 sashby 1.2 }
2843 hpw 1.1
2844 sashby 1.2 sub help_project
2845     {
2846     ###############################################################
2847     # help_project() #
2848     ###############################################################
2849     # modified : Mon May 28 11:31:16 2001 / SFA #
2850     # params : #
2851     # : #
2852     # : #
2853     # : #
2854     # function : Show help for scram project command. #
2855     # : #
2856     # : #
2857     ###############################################################
2858 sashby 1.31 &local_verbose("help_project");
2859 sashby 1.28
2860 sashby 1.2 print <<ENDTEXT;
2861 hpw 1.1 Setup a new project development area. The new area will appear in the current
2862     working directory.
2863     Usage:
2864    
2865 sashby 1.43 $bold scram project [-d install_area] [-n directory_name]$normal project_url [project_version] [-f cmstools.conf]
2866 hpw 1.1
2867     Options:
2868    
2869     project_url: The url of a scram bootstrap file.
2870 sashby 1.46
2871 hpw 1.1 Currently supported types are:
2872 sashby 1.46
2873 hpw 1.1 $bold Database label $normal
2874     Labels can be assigned to bootstrap files for easy
2875     access (See "scram install" command). If you
2876     specify a label you must also specify a project_version.
2877     e.g.
2878    
2879     scram project ORCA ORCA_1_1_1
2880    
2881     To see the list of installed projects use the
2882     "scram list" command.
2883    
2884 sashby 1.46 $bold file: $normal A regular file on an accessible file system
2885 hpw 1.1 e.g.
2886    
2887     file:~/myprojects/projecta/config/BootStrapFile
2888    
2889 sashby 1.43
2890     Use the "-f" flag followed by a valid filename (which MUST end in ".conf") to
2891     allow auto setup to proceed without reading files from a repository (standalone mode).
2892    
2893    
2894 hpw 1.1 project_version:
2895 sashby 1.46 Only for use with a database label.
2896 hpw 1.1
2897     -d install_area:
2898     Indicate a project installation area into which the new
2899     project area should appear. Default is the current working
2900     directory.
2901    
2902     -n directory_name:
2903     Specify the name of the SCRAM development area you wish to
2904     create.
2905 sashby 1.46
2906    
2907 hpw 1.1 ENDTEXT
2908 sashby 1.34 return (0);
2909 sashby 1.2 }
2910 hpw 1.1
2911 sashby 1.2 sub help_version
2912     {
2913     ###############################################################
2914     # help_version() #
2915     ###############################################################
2916     # modified : Mon May 28 11:31:23 2001 / SFA #
2917     # params : #
2918     # : #
2919     # : #
2920     # : #
2921     # function : Show help for scram version command. #
2922     # : #
2923     # : #
2924     ###############################################################
2925 sashby 1.31 &local_verbose("help_version");
2926 sashby 1.28
2927 sashby 1.2 print <<ENDTEXT;
2928     With no $bold [version] $normal argument given, this command will simply
2929 hpw 1.1 print to standard output the current version number.
2930    
2931     Providing a version argument will cause that version to be downloaded and
2932     installed, if not already locally available.
2933    
2934    
2935     Usage:
2936     $bold scram version [version]$normal
2937    
2938     ENDTEXT
2939 sashby 1.34 return (0);
2940 sashby 1.2 }
2941 hpw 1.1
2942 sashby 1.2 sub help_arch
2943     {
2944     ###############################################################
2945     # help_arch() #
2946     ###############################################################
2947     # modified : Mon May 28 11:31:33 2001 / SFA #
2948     # params : #
2949     # : #
2950     # : #
2951     # : #
2952     # function : Show help for scram arch command. #
2953     # : #
2954     # : #
2955     ###############################################################
2956 sashby 1.31 &local_verbose("help_arch");
2957 sashby 1.28
2958 sashby 1.2 print <<ENDTEXT;
2959 hpw 1.1 Print out the architecture flag for the current machine.
2960    
2961     Usage:
2962     $bold scram arch $normal
2963     ENDTEXT
2964 sashby 1.34 return (0);
2965 sashby 1.2 }
2966 hpw 1.1
2967 sashby 1.2 sub help_runtime
2968     {
2969     ###############################################################
2970     # help_runtime() #
2971     ###############################################################
2972     # modified : Mon May 28 11:31:37 2001 / SFA #
2973     # params : #
2974     # : #
2975     # : #
2976     # : #
2977     # function : Show help for scram runtime command. #
2978     # : #
2979     # : #
2980     ###############################################################
2981 sashby 1.31 &local_verbose("help_runtime");
2982 sashby 1.28
2983 sashby 1.2 print <<ENDTEXT;
2984 hpw 1.1 Echo to Standard Output the Runtime Environment for the current development area
2985     Output available in csh or sh flavours
2986    
2987     Usage:
2988     1) $bold scram runtime [-csh|-sh] $normal
2989     or
2990     2) $bold scram runtime [-csh|-sh] filename $normal
2991     or
2992     3) $bold scram runtime info filename [variable]$normal
2993    
2994     1) For the general configuration environment
2995     2) For environment described in filename or
2996     areatop/src/directory/BuildFile
2997     3) Display information concerning the environment in the given file
2998     (limited to variable if specified)
2999    
3000     The file for cases 2) and 3) are searched as follows :
3001     a) straightforward filename
3002     b) filename relative to local_area/src
3003     c) filename relative to release_area/src
3004     d) BuildFile relative to local_area/src
3005     e) BuildFile relative to release_area/src
3006    
3007     Examples:
3008    
3009     Setup the current environment to include the project Runtime Environment
3010     in a csh environment
3011    
3012     $bold eval `scram runtime -csh` $normal
3013    
3014     Setup the current environment to include the project Runtime Environment in a
3015     sh environment
3016    
3017     $bold eval `scram runtime -sh` $normal
3018    
3019 sashby 1.12 ENDTEXT
3020 sashby 1.34 return (0);
3021 sashby 1.12 }
3022    
3023    
3024     sub help_setroot
3025     {
3026     ###############################################################
3027     # help_setroot #
3028     ###############################################################
3029     # modified : Wed Nov 7 16:23:32 2001 / SFA #
3030     # params : #
3031     # : #
3032     # : #
3033     # : #
3034     # function : #
3035     # : #
3036     # : #
3037     # : #
3038     ###############################################################
3039 sashby 1.31 &local_verbose("help_setroot");
3040 sashby 1.28
3041 sashby 1.12 print <<ENDTEXT;
3042     Set a SCRAM-aware variable which points to a particular project area. This
3043     permits the setting of the runtime environment outside of the project area.
3044    
3045     Usage:
3046 sashby 1.24 $bold scram setroot [-sh|-csh] [ProjectName] [Version] $normal
3047 sashby 1.12
3048 sashby 1.24 To set the environment:
3049 sashby 1.12
3050 sashby 1.24 $bold eval `scram setroot [-sh|-csh] [ProjectName] [Version]` $normal
3051 hpw 1.1
3052     ENDTEXT
3053 sashby 1.34 return (0);
3054 sashby 1.2 }