ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.22
Committed: Tue Dec 4 19:24:03 2001 UTC (23 years, 5 months ago) by sashby
Branch: MAIN
Changes since 1.21: +6 -4 lines
Log Message: 
*** empty log message ***

File Contents

# User Rev Content
1 sashby 1.2 #===========================================================================#
2 sashby 1.15 # NAME: scramcli #
3 sashby 1.2 #===========================================================================#
4     # #
5     # DATE: Mon May 28 11:36:18 2001 #
6     # #
7     # AUTHOR: C. Williams #
8     # MAINTAINER: Shaun Ashby #
9     # MOD LOG: #
10     # #
11     #===========================================================================#
12     # DESCRIPTION: The main scram program (NOTE: this is wrapped at runtime to #
13     # set up the path to the SCRAM Perl modules). #
14 sashby 1.15 # #
15 sashby 1.2 #===========================================================================#
16    
17 sashby 1.19 $main::bold = "";
18     $main::normal = "";
19     $main::line = "-"x80;
20     $main::lookupobject = "";
21 sashby 1.15
22 sashby 1.10 # Test whether the output from SCRAM is being redirected, or
23     # not (prevents escape signals from being printed to STDOUT if
24     # STDOUT is redirected to a file):
25 sashby 1.11 if ( -t STDIN && -t STDOUT )
26     {
27     $bold = "\033[1m";
28     $normal = "\033[0m";
29     }
30    
31 sashby 1.2 # Allowed main and dev commands:
32 sashby 1.13 @allowed_commands=qw(project build install version list remove arch setup runtime setroot db tool url);
33 sashby 1.18 @dev_cmds=qw(devtest devint align);
34 hpw 1.1
35 sashby 1.2 # Check for prerequisites:
36     prerequisitecheck();
37     # Check for version consistency:
38 hpw 1.1 versioncheck();
39    
40 sashby 1.2 # Parse arguments (look for "-verbose" or "-arch" then shift):
41     while ( $ARGV[0] =~ /^-/)
42     {
43     if ( $ARGV[0] eq "-verbose" )
44     {
45     shift @ARGV;
46     # If no argument (i.e. class to activate "verbose" for) do nothing:
47     if (defined ($ARGV[0]))
48     {
49 sashby 1.21 print "Verbose mode for $ARGV[0] switched ".$bold."ON".$normal."\n" ;
50 sashby 1.2 scrambasics()->classverbose($ARGV[0],1);
51     }
52     }
53     elsif ( $ARGV[0] eq "-arch" )
54     {
55     shift @ARGV;
56     $ENV{SCRAM_ARCH}=$ARGV[0];
57     scrambasics()->arch($ARGV[0]);
58     }
59     else
60     {
61     error("Unknown option $ARGV[0]");
62     }
63     shift @ARGV;
64     }
65    
66     # Shift args to get input command:
67 hpw 1.1 $inputcmd=shift;
68     $found='false';
69     $rv=0;
70     $self={};
71    
72 sashby 1.2 # Check that input command is defined, and then
73     # run a scram subroutine for the command or show
74     # some help:
75     if ( $inputcmd ne "" )
76     {
77     foreach $command ( (@allowed_commands,@dev_cmds) )
78     {
79     if ( $command =~ /^$inputcmd/i)
80     {
81     # Deal with a help request
82     do
83     {
84     helpheader($command);
85     &{"help_".$command};
86     exit;
87     } if $ARGV[0] =~ /help/i;
88     $rv=&$command;
89     $found='true';
90     last;
91     }
92     }
93     }
94    
95     if ( ! ( $found =~ /true/ ) )
96     {
97     helpheader('Recognised Commands');
98     foreach $command ( @allowed_commands )
99     {
100     print " $bold scram ".$command.$normal."\n";
101     }
102     print "\n";
103     print "Help on individual commands available through\n\n";
104     print "$bold scram".$normal." command$bold help $normal\n\n";
105    
106     print "\nOptions:\n";
107     print "--------\n";
108     print $bold."-verbose ".$normal."Class : Activate the verbose ".
109     "function on the specified class";
110     print "\n\n";
111     print $bold."-arch ".$normal."architecture : Set the architecture id ".
112     "to that specified";
113     print "\n\n";
114     }
115 hpw 1.1
116 sashby 1.2 # Exit with exit status of subroutine
117     # that was executed in line 80:
118 hpw 1.1 exit $rv;
119    
120 sashby 1.2
121    
122    
123    
124    
125    
126    
127 sashby 1.21
128    
129    
130    
131    
132 sashby 1.2 ######################################################################################
133     ## Subroutine definitions ##
134     ######################################################################################
135    
136     sub error
137     {
138     ###############################################################
139     # error(string) #
140     ###############################################################
141     # modified : Mon May 28 11:26:47 2001 / SFA #
142     # params : Error messsage string #
143     # : #
144     # : #
145     # : #
146     # function : Exit with an error string. #
147     # : #
148     # : #
149     ###############################################################
150     my $string=shift;
151 sashby 1.5 print "\n","scram : ".$string."\n";
152     exit (1);
153 sashby 1.2 }
154    
155     sub prerequisitecheck
156     {
157     ###############################################################
158     # prerequisitecheck() #
159     ###############################################################
160     # modified : Mon May 28 11:26:52 2001 / SFA #
161     # params : None. #
162     # : #
163     # : #
164     # : #
165     # function : Check for prerequisite programs. #
166 sashby 1.9 # : Don't bother checking for shell: too much hassle.#
167     # : (and doesn't work outside of HEPiX scheme) #
168 sashby 1.2 ###############################################################
169     my $reqdmake="gmake";
170 sashby 1.9 # We must have gmake. Use "which" to get the gmake command
171     # ("whereis" doesn't work on SunOS):
172 sashby 1.2 chomp(($makeprog)=(`which gmake` =~ /.*\/(\w+)/));
173     # Now test that requirements are satisfied:
174 sashby 1.9 if ( $makeprog eq "$reqdmake" )
175 sashby 1.2 {
176     return (0);
177     }
178     else
179     {
180     print "It appears that you do not have all prerequisite","\n";
181     print "programs. To run SCRAM, you must have:","\n";
182     print "\n";
183     print " - GNU make (gmake)","\n";
184     print "\n";
185 sashby 1.9 print "Please make sure that this program is present.","\n\n";
186 sashby 1.2 exit (1);
187     }
188     }
189    
190     sub versioncheck
191     {
192     ###############################################################
193     # versioncheck(version) #
194     ###############################################################
195     # modified : Mon May 28 11:27:06 2001 / SFA #
196     # params : version (optional) #
197     # : #
198     # : #
199     # : #
200     # function : Check for scram version info. #
201     # : #
202     # : #
203     ###############################################################
204     my $version;
205    
206     if ( @_ )
207     {
208     $version=shift;
209     }
210     else
211     {
212     # -- get version from local area
213     if ( ! localtop_find() )
214     {
215 hpw 1.1 LoadEnvFile();
216     my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
217 sashby 1.2 if ( -f $versionfile )
218     {
219     open (VERSION, "<".$versionfile);
220 hpw 1.1 $version=<VERSION>;
221     chomp $version;
222 sashby 1.2 }
223 hpw 1.1 }
224 sashby 1.2 }
225     if ( defined $version )
226     {
227     scrambasics()->spawnversion($version,@ARGV);
228     }
229     }
230    
231    
232     sub _processcmds
233     {
234     ###############################################################
235     # _processcmds(handlercoderef,refarrayofallowedcommands, #
236     # refarrayofactualcommands, #
237     # arrayofsubroutinestringstocall) #
238     # #
239     ###############################################################
240     # modified : Mon May 28 11:27:12 2001 / SFA #
241     # params : #
242     # : #
243     # : #
244     # : #
245     # function : #
246     # : #
247     # : #
248     ###############################################################
249     my $optionhandler=shift;
250     my $allowed_commands=shift;
251     my $cmds=shift;
252     my @subs=@_;
253     my $found=0;
254    
255     # make a string from the subcommand levels
256     my $substring="";
257     if ( @subs )
258     {
259     $substring= join '_', @subs;
260     $substring=$substring."_";
261     }
262    
263     # Process options
264     if (defined ${$cmds}[0])
265     {
266     while ( ${$cmds}[0] =~ /^-/)
267     {
268     &{$optionhandler}( ${$cmds}[0],$cmds);
269     }
270 hpw 1.1
271 sashby 1.2 my $inputcmd=shift @{$cmds};
272     if ( $inputcmd ne "" )
273     {
274     foreach $command ( @{$allowed_commands} )
275     {
276     if ( $command =~ /^$inputcmd/i)
277     {
278     # Deal with a help request
279     if ( ( defined $$cmds[0]) && $$cmds[0] =~ /help/i )
280     {
281     &helpheader($command,@subs);
282     &{"help_".$substring.$command}; exit;
283     }
284     else
285     {
286     &{$substring.$command}(@{$cmds});
287     $found=1;
288     last;
289     }
290     }
291     }
292     }
293     }
294    
295     if ( ! $found )
296     {
297     &{$substring."error"}(@subs);
298 hpw 1.1 }
299 sashby 1.2 return $found;
300     }
301    
302    
303     sub help_build
304     {
305     ###############################################################
306     # help_build() #
307     ###############################################################
308     # modified : Mon May 28 11:27:23 2001 / SFA #
309     # params : #
310     # : #
311     # : #
312     # : #
313     # function : Show help for the scram build command #
314     # : #
315     # : #
316     ###############################################################
317     print <<ENDTEXT;
318     Information for building binaries and libraries.
319    
320     Subcommands:
321    
322     scram (b)uild lib/bin
323    
324     Command is run from the src directory.
325    
326     ENDTEXT
327 sashby 1.6 # Also run "build" dir because this will run "gmake help":
328     &build();
329 sashby 1.2 }
330    
331    
332     sub align
333     {
334     ###############################################################
335     # align() #
336     ###############################################################
337     # modified : Mon May 28 11:27:27 2001 / SFA #
338     # params : #
339     # : #
340     # : #
341     # : #
342     # function : #
343     # : #
344     # : #
345     ###############################################################
346     _localarea()->align();
347     }
348    
349     sub build
350     {
351     ###############################################################
352     # build() #
353     ###############################################################
354     # modified : Mon May 28 11:27:34 2001 / SFA #
355     # params : #
356     # : #
357     # : #
358     # : #
359     # function : Compile project. #
360     # : #
361     # : #
362     ###############################################################
363    
364     # is this a based or free release?
365     FullEnvInit();
366     use BuildSystem::BuildSetup;
367     $ENV{MAKETARGETS}=join ' ',@ARGV;
368    
369     # -- set the runtime environment
370     my $toolrt=scrambasics()->toolruntime(_localarea());
371     $toolrt->sethash(\%Env);
372    
373     # -- set up the builder
374     my $bs=BuildSystem::BuildSetup->new(toolbox());
375     $rv=$bs->BuildSetup($ENV{THISDIR},@ARGV);
376     $rv;
377     }
378    
379     sub project
380     {
381     ###############################################################
382     # project() #
383     ###############################################################
384     # modified : Mon May 28 11:27:38 2001 / SFA #
385     # params : #
386     # : #
387     # : #
388     # : #
389     # function : Set up a project area. #
390     # : #
391     # : #
392     ###############################################################
393     my @args=@ARGV;
394    
395     my $devareaname="";
396     use Cwd;
397     my $installarea=cwd();
398 sashby 1.19
399 sashby 1.2 # process options
400     while ( $args[0] =~ "^-" )
401     {
402     if ( $args[0] =~ /-n/ )
403     {
404     shift @args;
405     $devareaname=shift @args;
406     }
407     elsif ( $args[0] =~ /-d/ ) #installation area directory
408     {
409     shift @args;
410     $installarea=$args[0];
411     if ( ! -d $installarea )
412     {
413     error("$installarea does not exist");
414     }
415     shift @args;
416     }
417     else
418     {
419     error("Unknown option $args[0] to project command");
420     }
421     }
422    
423     # -- check what arguments have been passed
424     if ( $#args <0 || $#args>1 )
425     {
426 sashby 1.5 error("\"scram project help\" for usage info.");
427 sashby 1.2 }
428     my $area; #somewhere to store the area object when we have it
429    
430     if ( ( $#args == 0 ) && ($args[0] =~ /:/) )
431     {
432     # -- must be a url to bootstrap from
433 sashby 1.7 print "Bootstrapping using ",$args[0],"\n";
434 sashby 1.2 $area=scrambasics()->project($args[0], $installarea,
435     $devareaname);
436 sashby 1.7 print "Setting up tools in project area","\n";
437 sashby 1.19
438 sashby 1.21 # Need to set the sitename for the setup process:
439     if (defined ($area))
440     {
441     # We have an area so we can invoke method:
442     $ENV{'SITENAME'} = $area->sitename();
443 sashby 1.22 $ENV{'PROJECTDIR'} = $area->location();
444 sashby 1.21 }
445    
446 sashby 1.19 # Initialize the lookup table:
447     use Scram::AutoToolSetup;
448     $lookupobject = Scram::AutoToolSetup->new();
449    
450     # Now run the full setup for the area:
451 sashby 1.2 scrambasics()->setuptoolsinarea($area);
452     }
453     elsif ( $#args >0 )
454     {
455     # -- get the release area
456     print "Getting release area....","\n";
457     my $relarea=scrambasics()->scramprojectdb()->getarea(@args);
458     if ( ! defined $relarea )
459     {
460     error("Unknown project @args");
461     }
462    
463     # -- we need to spawn the correct scram version to handle it:
464     unshift @ARGV, "project";
465     print "Checking SCRAM version....","\n";
466     versioncheck($relarea->scramversion());
467 hpw 1.1
468 sashby 1.2 # -- need to create a satellite area:
469     print "Creating satellite area....","\n";
470     $area=scrambasics()->satellite(@args,$installarea, $devareaname);
471     }
472     else
473     {
474 sashby 1.5 error("\"scram project help\" for usage info.");
475 sashby 1.2 }
476     #
477     # Now create the directories specified in the interface
478     # There should be some better mechanism - TODO
479     #
480     print "Creating directories....","\n";
481     chdir $area->location();
482     foreach $key ( keys %ENV )
483     {
484     if ( $key =~ /^INT/ )
485     {
486     AddDir::adddir($ENV{$key});
487     }
488     }
489 sashby 1.5 # Final message
490 sashby 1.2 print "\n\nInstallation procedure complete.\n";
491     print "Installation Located at:\n\n\t\t".$bold.$area->location().$normal."\n\n";
492     }
493    
494    
495     sub scrambasics
496     {
497     ###############################################################
498     # scrambasics() #
499     ###############################################################
500     # modified : Mon May 28 11:27:44 2001 / SFA #
501     # params : #
502     # : #
503     # : #
504     # : #
505     # function : #
506     # : #
507     # : #
508     ###############################################################
509     require Scram::ScramFunctions;
510     if ( ! defined $scramobj )
511     {
512     environmentinit();
513     $scramobj=Scram::ScramFunctions->new();
514     $scramobj->arch($ENV{SCRAM_ARCH});
515     }
516     return $scramobj;
517     }
518    
519     sub url
520     {
521     ###############################################################
522     # url() #
523     ###############################################################
524     # modified : Mon May 28 11:27:48 2001 / SFA #
525     # params : #
526     # : #
527     # : #
528     # : #
529     # function : #
530     # : #
531     # : #
532     ###############################################################
533     @_=@ARGV;
534     localtop();
535     environmentinit();
536     my @allowed_cmds=qw(get);
537     _processcmds("_tooloptions", \@allowed_cmds, \@_, ("url"));
538     }
539    
540     sub url_get
541     {
542     ###############################################################
543     # url_get() #
544     ###############################################################
545     # modified : Mon May 28 11:27:52 2001 / SFA #
546     # params : #
547     # : #
548     # : #
549     # : #
550     # function : #
551     # : #
552     # : #
553     ###############################################################
554     my $url=shift;
555     my $area=_localarea();
556    
557     ($uurl,$file)=scrambasics()->webget($area,$url);
558 hpw 1.1 print "$file\n";
559 sashby 1.2 }
560 hpw 1.1
561 sashby 1.2 sub help_url
562     {
563     ###############################################################
564     # help_url() #
565     ###############################################################
566     # modified : Mon May 28 11:28:06 2001 / SFA #
567     # params : #
568     # : #
569     # : #
570     # : #
571     # function : Show help for the scram url command. #
572     # : #
573     # : #
574     ###############################################################
575     print <<ENDTEXT;
576 hpw 1.1 URL information.
577 sashby 1.2
578     Subcommands:
579    
580 hpw 1.1 scram url get
581    
582     ENDTEXT
583 sashby 1.2 }
584 hpw 1.1
585 sashby 1.2 sub help_url_get
586     {
587     ###############################################################
588     # help_url_get() #
589     ###############################################################
590     # modified : Mon May 28 11:28:11 2001 / SFA #
591     # params : #
592     # : #
593     # : #
594     # : #
595     # function : Show help for the scram url get command. #
596     # : #
597     # : #
598     ###############################################################
599     print <<ENDTEXT;
600 hpw 1.1 Description:
601     Return the location of the local copy of the specified url
602     Usage :
603     scram url get url
604    
605     ENDTEXT
606 sashby 1.2 }
607 hpw 1.1
608     # ------------ tool command --------------------------------------------
609 sashby 1.2 sub tool
610     {
611     ###############################################################
612     # tool() #
613     ###############################################################
614     # modified : Mon May 28 11:28:16 2001 / SFA #
615     # params : #
616     # : #
617     # : #
618     # : #
619     # function : #
620     # : #
621     # : #
622     ###############################################################
623     @_=@ARGV;
624     localtop();
625     environmentinit();
626     my @allowed_cmds=qw(info list default setup);
627     _processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));
628     }
629    
630     sub tool_error
631     {
632     ###############################################################
633     # tool_error(error_string) #
634     ###############################################################
635     # modified : Mon May 28 11:28:20 2001 / SFA #
636     # params : Error message string. #
637     # : #
638     # : #
639     # : #
640     # function : Show an error message for tool command. #
641     # : #
642     # : #
643     ###############################################################
644     error("Unknown tool subcommand : @_");
645     }
646    
647     sub tool_default
648     {
649     ###############################################################
650     # tool_default() #
651     ###############################################################
652     # modified : Mon May 28 11:28:24 2001 / SFA #
653     # params : #
654     # : #
655     # : #
656     # : #
657     # function : #
658     # : #
659     # : #
660     ###############################################################
661     if ( $#_ != 1 )
662     {
663     error("\"scram tool default help\" for usage information");
664     }
665     my $tool=shift;
666     my $version=shift;
667     print "Setting default version of $tool to $version\n";
668     # -- adjust the toolbox
669     toolbox()->setdefault($tool,$version);
670     }
671    
672     sub tool_list
673     {
674     ###############################################################
675     # tool_list() #
676     ###############################################################
677     # modified : Mon May 28 11:28:27 2001 / SFA #
678     # params : #
679     # : #
680     # : #
681     # : #
682     # function : List the tools defined in toolbox. #
683     # : #
684     # : #
685     ###############################################################
686     my $area=_localarea();
687     my $locationstring="Tool list for location ".$area->location();
688     my $length=length($locationstring);
689    
690 sashby 1.14 print "\n",$locationstring,"\n";
691 sashby 1.2 print "+"x $length;
692     print "\n";
693     print "\n";
694    
695     foreach $t ( toolbox()->tools() )
696     {
697     my $vers=join / /, toolbox()->versions($t);
698 sashby 1.14 print " ".$t." ".$vers." (default=".toolbox()->defaultversion($t).")\n";
699 sashby 1.2 }
700 sashby 1.14 print "\n";
701 sashby 1.2 }
702    
703     sub tool_info
704     {
705     ###############################################################
706     # tool_info() #
707     ###############################################################
708     # modified : Mon May 28 11:28:30 2001 / SFA #
709     # params : #
710     # : #
711     # : #
712     # : #
713     # function : Show info for available tools. #
714     # : #
715     # : #
716     ###############################################################
717     my $project=shift;
718     my $area=_localarea();
719     my $locationstring="Tool info as configured in location ".$area->location();
720     my $length=length($locationstring);
721    
722     print $locationstring,"\n";
723     print "+"x $length;
724     print "\n";
725     print "\n";
726    
727     my @tools=toolbox()->gettool($project,@_);
728     foreach $t ( @tools )
729     {
730     if ( defined $t )
731     {
732     print "Name : ".$t->name();
733     print "\n";
734     print "Version : ".$t->version();
735     print "\n";
736     print "Docfile : ".$t->url();
737     print "\n";
738     print "+"x20;
739     print "\n";
740     @features=$t->features();
741     foreach $ft ( @features )
742     {
743     @vals=$t->getfeature($ft);
744     foreach $v ( @vals )
745     {
746 hpw 1.1 print $ft. "=$v\n";
747 sashby 1.2 }
748     }
749     }
750 sashby 1.8 else
751     {
752     print "Tool $t is not defined for this project area.","\n";
753     }
754 sashby 1.2 }
755     }
756 hpw 1.1
757 sashby 1.2 sub tool_setup
758     {
759     ###############################################################
760     # tool_setup() #
761     ###############################################################
762     # modified : Mon May 28 11:28:35 2001 / SFA #
763     # params : #
764     # : #
765     # : #
766     # : #
767     # function : #
768     # : #
769     # : #
770     ###############################################################
771     print "Please use scram setup command\n";
772     }
773    
774     sub _tooloptions
775     {
776     ###############################################################
777     # _tooloptions(error_string) #
778     ###############################################################
779     # modified : Mon May 28 11:28:38 2001 / SFA #
780     # params : Error message string. #
781     # : #
782     # : #
783     # : #
784     # function : #
785     # : #
786     # : #
787     ###############################################################
788     error("No Options defined for tool subcommand");
789     }
790    
791     sub help_tool
792     {
793     ###############################################################
794     # help_tool() #
795     ###############################################################
796     # modified : Mon May 28 11:28:41 2001 / SFA #
797     # params : #
798     # : #
799     # : #
800     # : #
801     # function : Show help for tool command. #
802     # : #
803     # : #
804     ###############################################################
805     print <<ENDTEXT;
806 hpw 1.1 Manage the tools in the scram area that define the areas environment.
807 sashby 1.2 tool subcommands:
808    
809 hpw 1.1 list
810     info tool_name
811     default tool_name tool_version
812    
813     ENDTEXT
814 sashby 1.2 }
815 hpw 1.1
816 sashby 1.2 sub help_tool_info
817     {
818     ###############################################################
819     # help_tool_info() #
820     ###############################################################
821     # modified : Mon May 28 11:28:45 2001 / SFA #
822     # params : #
823     # : #
824     # : #
825     # : #
826     # function : Show help for tool info command. #
827     # : #
828     # : #
829     ###############################################################
830     print <<ENDTEXT;
831 hpw 1.1 Description:
832     Print out information on the specified tool in the current area
833     configuration.
834     Usage :
835     scram tool info tool_name [tool_version]
836    
837     ENDTEXT
838 sashby 1.2 }
839 hpw 1.1
840 sashby 1.2 sub help_tool_list
841     {
842     ###############################################################
843     # help_tool_list() #
844     ###############################################################
845     # modified : Mon May 28 11:28:50 2001 / SFA #
846     # params : #
847     # : #
848     # : #
849     # : #
850     # function : Show help for tool info command. #
851     # : #
852     # : #
853     ###############################################################
854     print <<ENDTEXT;
855 hpw 1.1 Description:
856     List of currently configured tools available in ther current scram
857     area
858     Usage :
859     scram tool list
860    
861     ENDTEXT
862 sashby 1.2 }
863 hpw 1.1
864 sashby 1.2 sub help_tool_default
865     {
866     ###############################################################
867     # help_tool_default() #
868     ###############################################################
869     # modified : Mon May 28 11:28:54 2001 / SFA #
870     # params : #
871     # : #
872     # : #
873     # : #
874     # function : #
875     # : #
876     # : #
877     ###############################################################
878     print <<ENDTEXT;
879 hpw 1.1 Description:
880     Change the default version of a tool to be used in the area
881     Usage :
882     scram tool default tool_name tool_version
883    
884     ENDTEXT
885 sashby 1.2 }
886 hpw 1.1
887     # ----------------------------------------------------------------------
888 sashby 1.2 sub _requirements
889     {
890     ###############################################################
891     # _requirements() #
892     ###############################################################
893     # modified : Mon May 28 11:28:59 2001 / SFA #
894     # params : #
895     # : #
896     # : #
897     # : #
898     # function : #
899     # : #
900     # : #
901     ###############################################################
902     if ( ! defined $reqsobj )
903     {
904     localtop();
905     my $area=_localarea();
906     scrambasics()->arearequirements($area);
907     }
908     return $reqsobj;
909     }
910    
911     sub _allprojectinitsearcher
912     {
913     ###############################################################
914     # _allprojectinitsearcher() #
915     ###############################################################
916     # modified : Mon May 28 11:29:03 2001 / SFA #
917     # params : #
918     # : #
919     # : #
920     # : #
921     # function : #
922     # : #
923     # : #
924     ###############################################################
925     my $search=_projsearcher();
926     foreach $proj ( _scramprojdb()->list() )
927     {
928     $search->addproject($$proj[0],$$proj[1]);
929     }
930     }
931    
932     sub _projsearcher
933     {
934     ###############################################################
935     # _projsearcher() #
936     ###############################################################
937     # modified : Mon May 28 11:29:05 2001 / SFA #
938     # params : #
939     # : #
940     # : #
941     # : #
942     # function : #
943     # : #
944     # : #
945     ###############################################################
946     if ( ! defined $self->{projsearcher} )
947     {
948     require Scram::ProjectSearcher;
949     $self->{projsearcher}=Scram::ProjectSearcher->new(_scramprojdb());
950     }
951     return $self->{projsearcher};
952     }
953    
954     sub _scramprojdb
955     {
956     ###############################################################
957     # _scramprodb() #
958     ###############################################################
959     # modified : Mon May 28 11:29:10 2001 / SFA #
960     # params : #
961     # : #
962     # : #
963     # : #
964     # function : #
965     # : #
966     # : #
967     ###############################################################
968     return scrambasics()->scramprojectdb();
969     }
970    
971     sub runtime
972     {
973     ###############################################################
974     # runtime() #
975     ###############################################################
976     # modified : Mon May 28 11:29:13 2001 / SFA #
977     # params : shell type (-sh for Bourne, -csh for C/tcsh) #
978     # : #
979     # : #
980     # : #
981     # function : Get/set runtime environment. #
982     # : #
983     # : #
984     ###############################################################
985     my $shell;
986     require Runtime;
987    
988     # process options
989     while ( $ARGV[0] =~ "^-" )
990     {
991     if ( $ARGV[0] =~ /-sh/ )
992     {
993     shift @ARGV;
994     $shell="sh";
995     next;
996     }
997     if ( $ARGV[0] =~ /-csh/ ) #installation area directory
998     {
999     shift @ARGV;
1000     $shell="csh";
1001     next;
1002     }
1003     print "Unknown Option $ARGV[0]\n";
1004     exit 1;
1005     }
1006 sashby 1.12
1007 sashby 1.2 FullEnvInit();
1008 sashby 1.12
1009 sashby 1.2 if ( @ARGV )
1010     {
1011     my $runtime=Runtime->new();
1012     my $arg=shift @ARGV;
1013    
1014     my $info=0;
1015     if ( $arg eq "info" )
1016     {
1017     $arg=shift @ARGV;
1018     $info=1;
1019     }
1020    
1021     # --- determine filename
1022     my $filename;
1023     if ( -f $arg ) # Is it a file?
1024     {
1025     $filename=$arg;
1026     }
1027     else
1028     {
1029     # -- lets see if its a BuildFile location
1030     $filename=_testfile($ENV{LOCALTOP}."/src/".$arg,
1031     $ENV{RELEASETOP}."/src/".$arg,
1032     $ENV{LOCALTOP}."/src/".$arg."/BuildFile",
1033     $ENV{RELEASETOP}."/src/".$arg."/BuildFile");
1034     if ( $filename eq "" )
1035     {
1036     print "Unable to find a file (or BuildFile) relating to ".
1037     $arg."\n";
1038     exit 1;
1039     }
1040     }
1041     $runtime->file($filename);
1042     if ( ! $info )
1043     {
1044     $runtime->printenv($shell);
1045     }
1046     else
1047     {
1048     if ( @ARGV ) #do we have a specific variable request?
1049     {
1050     _printvardoc($runtime,shift @ARGV);
1051     }
1052     else
1053     {
1054     foreach $var ( $runtime->list() )
1055     {
1056     _printvardoc($runtime,$var);
1057     }
1058     }
1059     }
1060     undef $runtime;
1061     }
1062     else
1063     {
1064     FullEnvInit();
1065     # -- We have to clean up from the last runtime cmd - use env history
1066     foreach $variable ( %ENV )
1067     {
1068     if ( $variable =~ /^SCRAMRT_(.*)/ ) #SCRAMRT are history retaining
1069     {
1070 hpw 1.1 my $var=$1;
1071 sashby 1.2 $ENV{$var} =~ s/\Q$ENV{$variable}\E//g;
1072     $ENV{$var} =~ s/^:*//; # Deal with any Path variables
1073 hpw 1.1 delete $ENV{$variable};
1074 sashby 1.2 }
1075     }
1076 hpw 1.1
1077 sashby 1.2 # -- get the tool runtime environments
1078     my $toolrt=scrambasics()->toolruntime(_localarea());
1079     $toolrt->sethash(\%EnvRuntime);
1080    
1081     # -- create new SCRAMRT history vars.
1082     foreach $variable ( keys %EnvRuntime )
1083     {
1084     printoutenv($shell,"SCRAMRT_$variable",$EnvRuntime{$variable});
1085     }
1086 hpw 1.1
1087 sashby 1.2 # TODO -- this stuff should dissappear with compiler description docs
1088     # Now adapt as necessary - include base environment as well
1089     if ( exists $ENV{LD_LIBRARY_PATH} )
1090     {
1091     addpath("LD_LIBRARY_PATH","$ENV{LD_LIBRARY_PATH}");
1092     }
1093     if ( exists $ENV{MANPATH} )
1094     {
1095     addpath("MANPATH","$ENV{MANPATH}");
1096     }
1097     addpath("PATH","$ENV{PATH}");
1098    
1099     # -- Print out as reqd
1100     # TODO -- we can use the runtime class method once we have removed
1101     # this stuff above
1102     foreach $variable ( keys %EnvRuntime )
1103     {
1104     printoutenv($shell,$variable,$EnvRuntime{$variable});
1105     }
1106 sashby 1.12
1107     # Export the local and release top:
1108     printoutenv($shell,"LOCALTOP",$ENV{LOCALTOP});
1109     printoutenv($shell,"RELEASETOP",$ENV{RELEASETOP});
1110    
1111 sashby 1.2 }
1112     }
1113 hpw 1.1
1114     # Support rt for runtime
1115    
1116 sashby 1.2 sub _testfile
1117     {
1118     ###############################################################
1119     # _testfile() #
1120     ###############################################################
1121     # modified : Mon May 28 11:29:21 2001 / SFA #
1122     # params : #
1123     # : #
1124     # : #
1125     # : #
1126     # function : #
1127     # : #
1128     # : #
1129     ###############################################################
1130     my @files=@_;
1131     my $filename="";
1132    
1133     foreach $file ( @files )
1134     {
1135     if ( -f $file )
1136     {
1137     $filename=$file;
1138     last;
1139     }
1140     }
1141     return $filename;
1142     }
1143    
1144     sub _printvardoc
1145     {
1146     ###############################################################
1147     # _printvardoc() #
1148     ###############################################################
1149     # modified : Mon May 28 11:29:25 2001 / SFA #
1150     # params : #
1151     # : #
1152     # : #
1153     # : #
1154     # function : #
1155     # : #
1156     # : #
1157     ###############################################################
1158     my $runtime=shift;
1159     my $var=shift;
1160    
1161     print $var." :\n";
1162     print $runtime->doc($var);
1163     print "\n";
1164     }
1165    
1166     sub printoutenv
1167     {
1168     ###############################################################
1169     # printoutenv() #
1170     ###############################################################
1171     # modified : Mon May 28 11:29:28 2001 / SFA #
1172     # params : #
1173     # : #
1174     # : #
1175     # : #
1176     # function : #
1177     # : #
1178     # : #
1179     ###############################################################
1180     my $shell=shift;
1181     my $variable=shift;
1182     my $value=shift;
1183    
1184     if ( $shell eq "csh" )
1185     {
1186     print "setenv $variable \"$value\";\n";
1187     }
1188     elsif ( $shell eq "sh" )
1189     {
1190     print "$variable=\"$value\";\n";
1191     print "export $variable;\n";
1192     }
1193     }
1194    
1195     sub addpath
1196     {
1197     ###############################################################
1198     # addpath() #
1199     ###############################################################
1200     # modified : Mon May 28 11:29:32 2001 / SFA #
1201     # params : #
1202     # : #
1203     # : #
1204     # : #
1205     # function : #
1206     # : #
1207     # : #
1208     ###############################################################
1209     my $name=shift;
1210     my $val=shift;
1211    
1212     my $n;
1213     my @env;
1214     @env=split /:/, $EnvRuntime{$name};
1215     foreach $n ( (split /:/, $val ) )
1216     {
1217     if ( ! grep /^\Q$n\E$/, @env )
1218     {
1219     addvar($name,$n,":");
1220     }
1221     }
1222     }
1223 hpw 1.1
1224 sashby 1.2 sub addvar
1225     {
1226     ###############################################################
1227     # addvar() #
1228     ###############################################################
1229     # modified : Mon May 28 11:29:35 2001 / SFA #
1230     # params : #
1231     # : #
1232     # : #
1233     # : #
1234     # function : #
1235     # : #
1236     # : #
1237     ###############################################################
1238     my $name=shift;
1239     my $val=shift;
1240     my $sep=shift;
1241    
1242     if ( $val ne "" )
1243     {
1244     if ( defined $EnvRuntime{$name} )
1245     {
1246 hpw 1.1 $EnvRuntime{$name}=$EnvRuntime{$name}.$sep.$val;
1247 sashby 1.2 }
1248     else
1249     {
1250 hpw 1.1 $EnvRuntime{$name}=$val;
1251 sashby 1.2 }
1252     }
1253     }
1254    
1255     sub FullEnvInit
1256     {
1257     ###############################################################
1258     # FullEnvInit() #
1259     ###############################################################
1260     # modified : Mon May 28 11:29:38 2001 / SFA #
1261     # params : #
1262     # : #
1263     # : #
1264     # : #
1265     # function : #
1266     # : #
1267     # : #
1268     ###############################################################
1269     environmentinit();
1270     localtop();
1271     LoadEnvFile();
1272     }
1273    
1274     sub environmentinit
1275     {
1276     ###############################################################
1277     # environmentinit() #
1278     ###############################################################
1279     # modified : Mon May 28 11:29:41 2001 / SFA #
1280     # params : #
1281     # : #
1282     # : #
1283     # : #
1284     # function : Set the environment variables needed #
1285     # : by scram (arch, home etc.) #
1286     # : #
1287     ###############################################################
1288     use Utilities::setarchitecture;
1289     my $name;
1290     my $value;
1291    
1292     $ENV{LatestBuildFile}=""; # stop recursive behaviour in make
1293     if ( ! defined $ENV{SCRAM_ARCH} )
1294     {
1295     setarchitecture::setarch();
1296     }
1297     $ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
1298     $ENV{INTsrc}="src";
1299     $ENV{INTlog}="logs";
1300     $ENV{INTlib}="lib/".$ENV{SCRAM_ARCH};
1301    
1302     ($ENV{SCRAM_BASEDIR}=$ENV{SCRAM_HOME}) =~ s/(.*)\/.*/$1/;
1303     if ( ! ( exists $ENV{SCRAM_CONFIG} ) )
1304     {
1305     $ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration";
1306     }
1307     $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
1308     if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) )
1309     {
1310     if ( -d "$ENV{SCRAM_BASEDIR}/scramdb/" )
1311     {
1312     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_BASEDIR}/scramdb/project.lookup";
1313     }
1314     else
1315     {
1316     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
1317     }
1318     }
1319     $ENV{SCRAM_AVAILDIRS}="";
1320     $ENV{SCRAM_AVAILFILES}="";
1321     }
1322    
1323     sub _localarea
1324     {
1325     ###############################################################
1326     # _localarea() #
1327     ###############################################################
1328     # modified : Mon May 28 11:29:47 2001 / SFA #
1329     # params : #
1330     # : #
1331     # : #
1332     # : #
1333     # function : #
1334     # : #
1335     # : #
1336     ###############################################################
1337     if ( ! defined $self->{localarea} )
1338     {
1339     require Configuration::ConfigArea;
1340     $self->{localarea}=Configuration::ConfigArea->new();
1341     if ( ! defined $ENV{LOCALTOP} )
1342     {
1343     if ( $self->{localarea}->bootstrapfromlocation() )
1344     {
1345 hpw 1.1 # Were not in a local area
1346     undef $self->{localarea};
1347 sashby 1.2 }
1348     else
1349     {
1350     $self->{localarea}->archname(scrambasics()->arch());
1351     }
1352     }
1353     else
1354     {
1355     $self->{localarea}->bootstrapfromlocation($ENV{LOCALTOP});
1356     }
1357     }
1358     return $self->{localarea};
1359     }
1360    
1361     sub localtop_find
1362     {
1363     ###############################################################
1364     # localtop_find() #
1365     ###############################################################
1366     # modified : Mon May 28 11:29:50 2001 / SFA #
1367     # params : #
1368     # : #
1369     # : #
1370     # : #
1371     # function : #
1372     # : #
1373     # : #
1374     ###############################################################
1375     my $rv=1;
1376     if ( defined _localarea())
1377     {
1378     $rv=0;
1379     $ENV{LOCALTOP}=_localarea()->location();
1380     }
1381     return $rv;
1382     }
1383    
1384     sub localtop
1385     {
1386     ###############################################################
1387     # localtop() #
1388     ###############################################################
1389     # modified : Mon May 28 11:29:54 2001 / SFA #
1390     # params : #
1391     # : #
1392     # : #
1393     # : #
1394 sashby 1.5 # function : Find the top directory of local release area. #
1395 sashby 1.2 # : #
1396     # : #
1397     ###############################################################
1398     localtop_find();
1399    
1400     if ( ! (defined $ENV{LOCALTOP}) )
1401     {
1402     print "Unable to locate the top of local release. Exitting.\n";
1403     exit 1;
1404     }
1405     ($ENV{THISDIR}=cwd) =~ s/^\Q$ENV{LOCALTOP}\L//;
1406     $ENV{THISDIR} =~ s/^\///;
1407     }
1408    
1409     sub LoadEnvFile
1410     {
1411     ###############################################################
1412     # LoadEnvFile() #
1413     ###############################################################
1414     # modified : Mon May 28 11:29:58 2001 / SFA #
1415     # params : #
1416     # : #
1417     # : #
1418     # : #
1419     # function : #
1420     # : #
1421     # : #
1422     ###############################################################
1423     _localarea()->copyenv(\%ENV);
1424     }
1425    
1426     sub env
1427     {
1428     ###############################################################
1429     # env() #
1430     ###############################################################
1431     # modified : Mon May 28 11:30:00 2001 / SFA #
1432     # params : #
1433     # : #
1434     # : #
1435     # : #
1436     # function : #
1437     # : #
1438     # : #
1439     ###############################################################
1440 hpw 1.1 print "Sorry - Not yet\n";
1441 sashby 1.2 }
1442 hpw 1.1
1443 sashby 1.2 sub devint
1444     {
1445     ###############################################################
1446     # devint() #
1447     ###############################################################
1448     # modified : Mon May 28 11:30:03 2001 / SFA #
1449     # params : #
1450     # : #
1451     # : #
1452     # : #
1453     # function : #
1454     # : #
1455     # : #
1456     ###############################################################
1457     my $class=shift @ARGV;
1458     scrambasics()->scramobjectinterface($class);
1459     }
1460    
1461     sub devtest
1462     {
1463     ###############################################################
1464     # devtest() #
1465     ###############################################################
1466     # modified : Mon May 28 11:30:06 2001 / SFA #
1467     # params : #
1468     # : #
1469     # : #
1470     # : #
1471     # function : #
1472     # : #
1473     # : #
1474     ###############################################################
1475     require Utilities::TestClass;
1476     my $class=shift @ARGV;
1477    
1478     my $tester;
1479     my $path;
1480    
1481     #_initproject();
1482     if ( $class =~ /::/ )
1483     {
1484     ($path=$class) =~ s/(.*)::.*/$1/;
1485     }
1486     $tester=Utilities::TestClass->new($class,
1487     "$ENV{SCRAM_HOME}/src/$path/test/testdata");
1488     $tester->dotest(@_);
1489     }
1490 hpw 1.1
1491     #
1492     # Create a lookup tag in the site database
1493     #
1494 sashby 1.2 sub install
1495     {
1496     ###############################################################
1497     # install() #
1498     ###############################################################
1499     # modified : Mon May 28 11:30:09 2001 / SFA #
1500     # params : #
1501     # : #
1502     # : #
1503     # : #
1504     # function : Install a project. Updates project.lookup #
1505     # : files found in /scramdb. #
1506     # : #
1507     ###############################################################
1508     localtop();
1509    
1510     scrambasics()->addareatoDB(_localarea(),@ARGV);
1511     _localarea()->align();
1512     }
1513    
1514     sub help_install()
1515     {
1516     ###############################################################
1517     # help_install() #
1518     ###############################################################
1519     # modified : Mon May 28 11:30:12 2001 / SFA #
1520     # params : #
1521     # : #
1522     # : #
1523     # : #
1524     # function : Show help for the install command. #
1525     # : #
1526     # : #
1527     ###############################################################
1528     print <<ENDTEXT;
1529 hpw 1.1 Associates a label with the current release in the SCRAM database.
1530     This allows other users to refer to a centrally installed project by
1531     this label rather than a remote url reference.
1532    
1533     Usage:
1534    
1535     $bold scram install $normal [project_tag [version_tag]]
1536    
1537     porject_tag : override default label (the project name of the current release)
1538     version_tag : the version tag of the current release. If version is not
1539     specified the base release version will be taken by default.
1540    
1541     ENDTEXT
1542 sashby 1.2 }
1543 hpw 1.1
1544 sashby 1.2 sub helpheader ($label)
1545     {
1546     ###############################################################
1547     # helpheader(label) #
1548     ###############################################################
1549     # modified : Mon May 28 11:30:17 2001 / SFA #
1550     # params : label for the header. #
1551     # : #
1552     # : #
1553     # : #
1554     # function : Prints a header for the help command of #
1555     # : scram command "label". #
1556     # : #
1557     ###############################################################
1558     my $label=shift;
1559    
1560     print <<ENDTEXT;
1561    
1562 hpw 1.1 *************************************************************************
1563 sashby 1.2 SCRAM HELP --------- $label
1564 hpw 1.1 *************************************************************************
1565 sashby 1.2
1566 hpw 1.1 ENDTEXT
1567 sashby 1.2 }
1568 hpw 1.1
1569 sashby 1.2 sub version
1570     {
1571     ###############################################################
1572     # version() #
1573     ###############################################################
1574     # modified : Mon May 28 11:30:24 2001 / SFA #
1575     # params : #
1576     # : #
1577     # : #
1578     # : #
1579     # function : Get the version of scram being used. #
1580     # : #
1581     # : #
1582     ###############################################################
1583     my $version=shift @ARGV;
1584     my $thisversion;
1585     my $scram_top;
1586     my $cvsobject;
1587    
1588     ($thisversion=$ENV{SCRAM_HOME}) =~ s/(.*)\///;
1589     $scram_top=$1;
1590     if ( $version eq "" )
1591     {
1592     print "$thisversion";
1593     # deal with links
1594     $version=readlink $ENV{SCRAM_HOME};
1595     if ( defined $version)
1596     {
1597     print " ---> $version";
1598     }
1599     print "\n";
1600     }
1601     else
1602     {
1603     if ( -d $scram_top."/".$version )
1604     {
1605     print "Version $version exists\n";
1606     }
1607     else
1608     {
1609     print "Version $version not available locally\n";
1610     print "Attempting download from the SCRAM repository\n";
1611     # set up and configure the cvs module for SCRAM
1612     require Utilities::CVSmodule;
1613     $cvsobject=Utilities::CVSmodule->new();
1614     $cvsobject->set_base(
1615     "cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
1616     $cvsobject->set_auth("pserver");
1617     $cvsobject->set_user("anonymous");
1618     $cvsobject->set_passkey("AA_:yZZ3e");
1619     # Now check it out in the right place
1620     chdir $scram_top or die "Unable to change to $scram_top $!\n";
1621     $cvsobject->invokecvs( ( split / /,
1622     "co -d $version -r $version SCRAM" ));
1623 hpw 1.1
1624 sashby 1.2 # Get rid of cvs object now weve finished
1625     $cvsobject=undef;
1626     print "\n";
1627     }
1628     }
1629     0;
1630     }
1631    
1632     sub list
1633     {
1634     ###############################################################
1635     # list() #
1636     ###############################################################
1637     # modified : Mon May 28 11:30:28 2001 / SFA #
1638     # params : #
1639     # : #
1640     # : #
1641     # : #
1642     # function : List available projects. #
1643     # : #
1644     # : #
1645     ###############################################################
1646     &environmentinit;
1647    
1648     my $linebold = "$bold"."$line"."$normal";
1649     my $pjname = "Project Name";
1650     my $pjversion = "Project Version";
1651     my $pjlocation = "Project Location";
1652 sashby 1.5 my $headstring = sprintf("| %-12s | %-24s | %-33s |",$pjname,$pjversion,$pjlocation);
1653 sashby 1.2
1654     if ( ! -f $ENV{SCRAM_LOOKUPDB} )
1655     {
1656     print "\n","No installation database available - perhaps no projects".
1657     " have been installed locally?\n";
1658     exit 1;
1659     }
1660 sashby 1.4 print "\n","Listing installed projects....","\n\n";
1661 sashby 1.2 print $linebold,"\n";
1662     print $headstring."\n";
1663     print $linebold,"\n\n";
1664     listDB(@ARGV);
1665     print "\n";
1666     }
1667    
1668    
1669     sub remove
1670     {
1671     ###############################################################
1672     # remove(project) #
1673     ###############################################################
1674     # modified : Mon May 28 11:30:31 2001 / SFA #
1675 sashby 1.5 # params : project name, project version #
1676 sashby 1.2 # : #
1677     # : #
1678     # : #
1679     # function : Remove the named project from the project.lookup #
1680     # : file (scram database). #
1681     # : #
1682 sashby 1.5 ###############################################################
1683     my $projectname=shift @ARGV;
1684     my $projectversion=shift @ARGV;
1685    
1686     # Check there were sufficient args:
1687     if ($projectname eq "" || $projectversion eq "")
1688     {
1689     error("\"scram remove help\" for usage info.");
1690     &help_remove;
1691     exit (0);
1692     }
1693     else
1694     {
1695     scrambasics()->removeareafromDB($projectname,$projectversion);
1696     }
1697     0;
1698 sashby 1.2 }
1699    
1700     sub db
1701     {
1702     ###############################################################
1703     # db() #
1704     ###############################################################
1705     # modified : Mon May 28 11:30:35 2001 / SFA #
1706 sashby 1.5 # params : "link", "unlink" or "show(links )" #
1707 sashby 1.2 # : #
1708     # : #
1709     # : #
1710     # function : Show project info stored in scramdb. Link/unlink #
1711     # : project database files, or show linked databases.#
1712     # : #
1713     ###############################################################
1714     my $subcmd=shift @ARGV;
1715    
1716     # Make sure we have an argument, or tell the user:
1717     if ( ! defined($subcmd))
1718     {
1719     &help_db;
1720     print "\n";
1721     exit (1);
1722     }
1723    
1724     &environmentinit;
1725    
1726     # First, check for a database area:
1727     if ( ! -f $ENV{SCRAM_LOOKUPDB} )
1728     {
1729     print "\n","No installation database available - perhaps no projects".
1730     "have been installed locally?\n";
1731     exit (1);
1732     }
1733     print "\n","Current scram database: ";
1734     print $bold."$ENV{SCRAM_LOOKUPDB}".$normal."\n\n";
1735    
1736     switch :
1737     {
1738     if ( $subcmd eq 'link' )
1739     {
1740     print "\n","Linked @ARGV to current scram database.","\n\n";
1741     scrambasics()->scramprojectdb()->link(@ARGV);
1742     last switch;
1743     }
1744     if ( $subcmd eq 'unlink' )
1745     {
1746     print "\n","Unlinked @ARGV from current scram database.","\n\n";
1747     scrambasics()->scramprojectdb()->unlink(@ARGV);
1748     last switch;
1749     }
1750     if ( $subcmd eq 'showlinks'
1751     || $subcmd eq 'showlink'
1752     || $subcmd eq 'show')
1753     {
1754     my @links=scrambasics()->scramprojectdb()->listlinks();
1755     # Are there any links defined?:
1756     if ( defined($links[0]) )
1757     {
1758     print "\n","The following scram databases are linked to the current scram database: ","\n\n";
1759     foreach $link ( @links )
1760     {
1761     print " ".$link."\n";
1762     }
1763     print "\n";
1764     }
1765     else
1766     {
1767     print "There are no databases linked.","\n\n";
1768     }
1769     last switch;
1770     }
1771     } # end switch
1772     }
1773 hpw 1.1
1774 sashby 1.2 sub listDB
1775     {
1776     ###############################################################
1777     # listDB() #
1778     ###############################################################
1779     # modified : Mon May 28 11:30:39 2001 / SFA #
1780     # params : Project name #
1781     # : #
1782 sashby 1.4 # function : List projects. Only those projects that were #
1783     # : installed on the user's current OS will be #
1784     # : displayed (slight anomaly here: some projects #
1785     # : were installed on SunOS_5.6 so won't appear if #
1786     # : the user's current platform is SunOS_5.7...). #
1787 sashby 1.2 # : #
1788     ###############################################################
1789     my $project="";
1790 sashby 1.14 my $projectexists=0;
1791     my @missingareas;
1792    
1793 sashby 1.2 if ( @_ )
1794     {
1795     $project=shift;
1796     }
1797 sashby 1.5
1798 sashby 1.2 my @prs=scrambasics()->scramprojectdb()->listall();
1799 sashby 1.5
1800     # Check to see if there are any projects:
1801     if ( ! defined @prs )
1802     {
1803     print "\t\t>>>> No locally installed projects! <<<<","\n";
1804     return (0);
1805     }
1806 sashby 1.14
1807 sashby 1.5 # Iterate over the project list:
1808 sashby 1.2 foreach $pr ( @prs )
1809     {
1810 sashby 1.14 my $url='NULL';
1811    
1812 sashby 1.2 if ( $project eq "" || $project eq $$pr[0] )
1813     {
1814 sashby 1.14 # Check that the area exists (i.e. check that a configarea object
1815     # is returned before attempting to test its' location:
1816     my $possiblearea=scrambasics()->scramprojectdb()->getarea($$pr[0],$$pr[1]);
1817    
1818     if ( defined ($possiblearea))
1819 sashby 1.4 {
1820 sashby 1.14 $url=$possiblearea->location();
1821     if ($project eq $$pr[0]) {$projectexists=1};
1822     }
1823    
1824     # Check that the path to the project area is readable:
1825     if ( -d $url )
1826     {
1827     # Check that there exists an installation for
1828     # our current architecture. Check for a bin and
1829     # a lib directory:
1830     if ( -d "$url/bin/$ENV{SCRAM_ARCH}" || -d "$url/lib/$ENV{SCRAM_ARCH}" )
1831 sashby 1.12 {
1832     # Stagger the printed lines to allow easier
1833     # copying using the mouse:
1834     printf " %-15s %-25s \n",$$pr[0],$$pr[1];
1835     printf "%45s%-30s\n","--> ",$bold.$url.$normal;
1836     }
1837 sashby 1.14 }
1838     else
1839     {
1840     # We have an area that is unreadable. Push an entry onto the array:
1841     push @missingareas, sprintf ">> Project area MISSING: %-10s %-20s \n",$$pr[0],$$pr[1];
1842 sashby 1.4 }
1843 sashby 1.2 }
1844     }
1845 sashby 1.14
1846     if ( ! $projectexists && $project ne "" )
1847     {
1848     print "\t\t>>>> No locally installed $project projects! <<<<","\n";
1849     return(0);
1850     }
1851    
1852     # Print out a list of areas that are missing:
1853     if ( @missingareas )
1854     {
1855     print "\n\n\n\n\n\n";
1856     print $line,"\n";
1857     print @missingareas;
1858     print $line,"\n";
1859     }
1860    
1861 sashby 1.4 print "\n\n","Projects available for platform >> ".$bold."$ENV{SCRAM_ARCH}".$normal." <<\n";
1862     print "\n";
1863 sashby 1.2 0;
1864     }
1865    
1866     sub arch
1867     {
1868     ###############################################################
1869     # arch() #
1870     ###############################################################
1871     # modified : Mon May 28 11:30:41 2001 / SFA #
1872     # params : #
1873     # : #
1874     # : #
1875     # : #
1876     # function : Show the information about current architecture. #
1877     # : #
1878     # : #
1879     ###############################################################
1880     &environmentinit();
1881 sashby 1.10
1882     print "$ENV{SCRAM_ARCH}\n";
1883 sashby 1.2 }
1884 hpw 1.1
1885    
1886     #
1887     # Setup a new tool
1888     #
1889    
1890 sashby 1.2 sub setup
1891     {
1892     ###############################################################
1893     # setup() #
1894     ###############################################################
1895     # modified : Mon May 28 11:30:45 2001 / SFA #
1896     # params : #
1897     # : #
1898     # : #
1899     # : #
1900     # function : Setup tools. #
1901     # : #
1902     # : #
1903     ###############################################################
1904     my $interactive=0;
1905    
1906     # process options
1907     while ( $ARGV[0] =~ "^-" )
1908     {
1909     if ( $ARGV[0] =~ /-i/ )
1910     {
1911     shift @ARGV;
1912     $interactive=1;
1913 sashby 1.20 print "Running interactive setup....","\n";
1914 hpw 1.1 }
1915 sashby 1.2 else
1916     {
1917 sashby 1.20 error("Unknown option $ARGV[0] to setup command");
1918 hpw 1.1 }
1919 sashby 1.2 }
1920 hpw 1.1
1921 sashby 1.2 localtop();
1922    
1923     my $area=_localarea();
1924 sashby 1.21 # We have a local area so we can invoke
1925     # method to get the sitename:
1926 sashby 1.22 $ENV{'SITENAME'} = $area->sitename();
1927     $ENV{'PROJECTDIR'} = $area->location();
1928    
1929 sashby 1.2 my $toolname=shift @ARGV;
1930     my $insert=0;
1931 sashby 1.19
1932 sashby 1.2 toolbox()->interactive($interactive);
1933    
1934 sashby 1.20 # Initialize the lookup table:
1935     use Scram::AutoToolSetup;
1936     $lookupobject = Scram::AutoToolSetup->new();
1937    
1938 sashby 1.2 # If no toolname specified then its a full setup
1939     if ( $toolname eq "" )
1940     {
1941     # -- add architecture specific directories
1942     use Utilities::AddDir;
1943 sashby 1.22 AddDir::adddir($ENV{'PROJECTDIR'}."/lib/$ENV{SCRAM_ARCH}");
1944     AddDir::adddir($ENV{'PROJECTDIR'}."/bin/$ENV{SCRAM_ARCH}");
1945 sashby 1.2 # -- check the releasetop area
1946     # if the releasetop has the files copy them
1947     my $releaseobj=_releasearea();
1948     if ( $releaseobj->copysetup($ENV{LOCALTOP}) )
1949     {
1950     print "Doing Full Setup\n";
1951 sashby 1.20 # Run the full setup for the area:
1952 sashby 1.2 scrambasics()->setuptoolsinarea($area);
1953     }
1954     }
1955     else
1956     {
1957 sashby 1.20 print "Running setup for tool ",$toolname,"...","\n";
1958 sashby 1.2 scrambasics()->setuptoolsinarea($area, $toolname,@ARGV);
1959     }
1960     }
1961 sashby 1.11
1962    
1963 sashby 1.12 sub setroot
1964     {
1965     ###############################################################
1966     # setroot #
1967     ###############################################################
1968     # modified : Wed Nov 7 16:22:25 2001 / SFA #
1969     # params : #
1970     # : #
1971     # : #
1972     # : #
1973     # function : #
1974     # : #
1975     # : #
1976     # : #
1977     ###############################################################
1978     my $shell = shift @ARGV;
1979    
1980     # Check the shell argument...this must be supplied:
1981     if ($shell =~ "^-" )
1982     {
1983     # Remove the hyphen:
1984     $shell =~ s/-//;
1985     if ($shell ne "sh" && $shell ne "csh") {print "No shell given! Exitting.","\n"; exit(1);}
1986     }
1987     else
1988     {
1989     print "No shell given! Exitting.","\n";
1990     exit(1);
1991     }
1992    
1993     my $projectname=shift @ARGV;
1994     my $projectversion=shift @ARGV;
1995    
1996     # Check there were sufficient args:
1997     if ($projectname eq "" || $projectversion eq "")
1998     {
1999     error("\"scram setroot help\" for usage info.");
2000     &help_setroot;
2001     exit (0);
2002     }
2003     else
2004     {
2005 sashby 1.13 # Reset the LOCALTOP/RELEASETOP vars:
2006     $ENV{'LOCALTOP'}='';
2007     $ENV{'RELEASETOP'}='';
2008    
2009     # And on we go. Let's find a release area for this project/version:
2010 sashby 1.12 my $releasearea = scrambasics()->scramprojectdb()->getarea($projectname,$projectversion);
2011     print "No release area!!","\n" if ( ! defined ($releasearea));
2012 sashby 1.13
2013 sashby 1.12 # The info we need is stored in a hash and can be accessed using the key ENV.
2014     # Location info is accessed using keys LOCALTOP and RELEASETOP:
2015     foreach $key (keys %{${$releasearea}{'ENV'}})
2016     {
2017     if ( $key eq "LOCALTOP" || $key eq "RELEASETOP" )
2018     {
2019     printoutenv($shell,$key,${${$releasearea}{'ENV'}}{$key});
2020     }
2021     }
2022    
2023     # If LOCALTOP isn't defined, make it the same as RELEASETOP:
2024 sashby 1.13 if ( $ENV{'LOCALTOP'} eq '' )
2025 sashby 1.12 {
2026     printoutenv($shell,"LOCALTOP",${${$releasearea}{'ENV'}}{'RELEASETOP'});
2027     }
2028 sashby 1.13 0;
2029 sashby 1.12 }
2030     }
2031    
2032 sashby 1.2
2033     sub _releasearea
2034     {
2035     ###############################################################
2036     # _releasearea() #
2037     ###############################################################
2038     # modified : Mon May 28 11:30:50 2001 / SFA #
2039     # params : #
2040     # : #
2041     # : #
2042     # : #
2043     # function : #
2044     # : #
2045     # : #
2046     ###############################################################
2047     if ( !defined $self->{releasearea} )
2048     {
2049     require Configuration::ConfigArea;
2050     $self->{releasearea}=Configuration::ConfigArea->new();
2051     $self->{releasearea}->bootstrapfromlocation($ENV{RELEASETOP});
2052     }
2053     return $self->{releasearea};
2054     }
2055 hpw 1.1
2056     # get a toolbox object for the local area
2057 sashby 1.2 sub toolbox
2058     {
2059     ###############################################################
2060     # toolbox() #
2061     ###############################################################
2062     # modified : Mon May 28 11:30:53 2001 / SFA #
2063     # params : #
2064     # : #
2065     # : #
2066     # : #
2067     # function : #
2068     # : #
2069     # : #
2070     ###############################################################
2071     if ( ! defined $toolbox )
2072     {
2073     localtop();
2074     my $area=_localarea();
2075     $toolbox=scrambasics()->areatoolbox($area);
2076     }
2077     return $toolbox;
2078     }
2079    
2080     sub help_db
2081     {
2082     ###############################################################
2083     # help_db() #
2084     ###############################################################
2085     # modified : Mon May 28 11:30:56 2001 / SFA #
2086     # params : #
2087     # : #
2088     # : #
2089     # : #
2090     # function : Show help for scram db command. #
2091     # : #
2092     # : #
2093     ###############################################################
2094     print <<ENDTEXT;
2095 hpw 1.1 scram database administration command.
2096    
2097     Usage:
2098    
2099     $bold scram db $normal subcommand
2100    
2101 sashby 1.2 Subcommands:
2102    
2103 hpw 1.1 link :
2104     Make available an additional database for
2105     project and list operations
2106    
2107     $bold scram db link $normal /a/directory/path/project.lookup
2108    
2109     unlink :
2110     Remove a database from the link list. Note this does
2111     not remove the database, just the link to it in scram.
2112    
2113     $bold scram db unlink $normal /a/directory/path/project.lookup
2114    
2115     showlinks :
2116     List the databases that are linked in
2117    
2118     ENDTEXT
2119 sashby 1.2 }
2120 hpw 1.1
2121 sashby 1.2 sub help_setup
2122     {
2123     ###############################################################
2124     # help_setup() #
2125     ###############################################################
2126     # modified : Mon May 28 11:31:02 2001 / SFA #
2127     # params : #
2128     # : #
2129     # : #
2130     # : #
2131     # function : Show help for scram setup command. #
2132     # : #
2133     # : #
2134     ###############################################################
2135     print <<ENDTEXT;
2136 hpw 1.1 Allows installation/re-installation of a new tool/external package into an
2137     already existing development area. If not toolname is specified,
2138     the complete installation process is initiated.
2139    
2140     Usage:
2141    
2142     $bold scram setup [-i]$normal [toolname] [[version] [url]]
2143    
2144     toolname : The name of the tool setup file required.
2145     version : where more than one version exists specify the version
2146     url : when setting up a completely new tool specify the url too
2147    
2148     The -i option turns off the automatic search mechanism allowing for more
2149     user interaction with the setup mechanism
2150     ENDTEXT
2151 sashby 1.2 }
2152 hpw 1.1
2153 sashby 1.2 sub help_list
2154     {
2155     ###############################################################
2156     # help_list() #
2157     ###############################################################
2158     # modified : Mon May 28 11:31:09 2001 / SFA #
2159     # params : #
2160     # : #
2161     # : #
2162     # : #
2163     # function : Show help for scram list command. #
2164     # : #
2165     # : #
2166     ###############################################################
2167     print <<ENDTEXT;
2168 hpw 1.1 List the available projects and versions installed in the local SCRAM database
2169     (see scram install help)
2170    
2171     Usage:
2172    
2173     $bold scram list $normal [ProjectName]
2174    
2175     ENDTEXT
2176 sashby 1.2 }
2177    
2178     sub help_remove
2179     {
2180     ###############################################################
2181     # help_remove() #
2182     ###############################################################
2183     # modified : Mon May 28 11:31:12 2001 / SFA #
2184     # params : #
2185     # : #
2186     # : #
2187     # : #
2188     # function : Show help for scram remove command. #
2189     # : #
2190     # : #
2191     ###############################################################
2192     print <<ENDTEXT;
2193 sashby 1.5 Remove a project entry from scram database file (\"project.lookup\").
2194 sashby 1.2
2195     Usage:
2196    
2197 sashby 1.5 $bold scram remove $normal [ProjectName] [Version]
2198 sashby 1.2
2199     ENDTEXT
2200     }
2201 hpw 1.1
2202 sashby 1.2 sub help_project
2203     {
2204     ###############################################################
2205     # help_project() #
2206     ###############################################################
2207     # modified : Mon May 28 11:31:16 2001 / SFA #
2208     # params : #
2209     # : #
2210     # : #
2211     # : #
2212     # function : Show help for scram project command. #
2213     # : #
2214     # : #
2215     ###############################################################
2216     print <<ENDTEXT;
2217 hpw 1.1 Setup a new project development area. The new area will appear in the current
2218     working directory.
2219     Usage:
2220    
2221     $bold scram project [-d install_area] [-n directory_name]$normal project_url [project_version]
2222    
2223     Options:
2224    
2225     project_url: The url of a scram bootstrap file.
2226     Currently supported types are:
2227     $bold Database label $normal
2228     Labels can be assigned to bootstrap files for easy
2229     access (See "scram install" command). If you
2230     specify a label you must also specify a project_version.
2231     e.g.
2232    
2233     scram project SCRAM V1_0
2234    
2235     scram project ORCA ORCA_1_1_1
2236    
2237     To see the list of installed projects use the
2238     "scram list" command.
2239    
2240     $bold file: $normal A regular file on an accessable file system
2241     e.g.
2242    
2243     file:~/myprojects/projecta/config/BootStrapFile
2244    
2245     project_version:
2246     Only for use with a database label
2247    
2248     -d install_area:
2249     Indicate a project installation area into which the new
2250     project area should appear. Default is the current working
2251     directory.
2252    
2253     -n directory_name:
2254     Specify the name of the SCRAM development area you wish to
2255     create.
2256    
2257     ENDTEXT
2258 sashby 1.2 }
2259 hpw 1.1
2260 sashby 1.2 sub help_version
2261     {
2262     ###############################################################
2263     # help_version() #
2264     ###############################################################
2265     # modified : Mon May 28 11:31:23 2001 / SFA #
2266     # params : #
2267     # : #
2268     # : #
2269     # : #
2270     # function : Show help for scram version command. #
2271     # : #
2272     # : #
2273     ###############################################################
2274     print <<ENDTEXT;
2275     With no $bold [version] $normal argument given, this command will simply
2276 hpw 1.1 print to standard output the current version number.
2277    
2278     Providing a version argument will cause that version to be downloaded and
2279     installed, if not already locally available.
2280    
2281    
2282     Usage:
2283     $bold scram version [version]$normal
2284    
2285     ENDTEXT
2286 sashby 1.2 }
2287 hpw 1.1
2288 sashby 1.2 sub help_arch
2289     {
2290     ###############################################################
2291     # help_arch() #
2292     ###############################################################
2293     # modified : Mon May 28 11:31:33 2001 / SFA #
2294     # params : #
2295     # : #
2296     # : #
2297     # : #
2298     # function : Show help for scram arch command. #
2299     # : #
2300     # : #
2301     ###############################################################
2302     print <<ENDTEXT;
2303 hpw 1.1 Print out the architecture flag for the current machine.
2304    
2305     Usage:
2306     $bold scram arch $normal
2307     ENDTEXT
2308 sashby 1.2 }
2309 hpw 1.1
2310 sashby 1.2 sub help_runtime
2311     {
2312     ###############################################################
2313     # help_runtime() #
2314     ###############################################################
2315     # modified : Mon May 28 11:31:37 2001 / SFA #
2316     # params : #
2317     # : #
2318     # : #
2319     # : #
2320     # function : Show help for scram runtime command. #
2321     # : #
2322     # : #
2323     ###############################################################
2324     print <<ENDTEXT;
2325 hpw 1.1 Echo to Standard Output the Runtime Environment for the current development area
2326     Output available in csh or sh flavours
2327    
2328     Usage:
2329     1) $bold scram runtime [-csh|-sh] $normal
2330     or
2331     2) $bold scram runtime [-csh|-sh] filename $normal
2332     or
2333     3) $bold scram runtime info filename [variable]$normal
2334    
2335     1) For the general configuration environment
2336     2) For environment described in filename or
2337     areatop/src/directory/BuildFile
2338     3) Display information concerning the environment in the given file
2339     (limited to variable if specified)
2340    
2341     The file for cases 2) and 3) are searched as follows :
2342     a) straightforward filename
2343     b) filename relative to local_area/src
2344     c) filename relative to release_area/src
2345     d) BuildFile relative to local_area/src
2346     e) BuildFile relative to release_area/src
2347    
2348     Examples:
2349    
2350     Setup the current environment to include the project Runtime Environment
2351     in a csh environment
2352    
2353     $bold eval `scram runtime -csh` $normal
2354    
2355     Setup the current environment to include the project Runtime Environment in a
2356     sh environment
2357    
2358     $bold eval `scram runtime -sh` $normal
2359    
2360 sashby 1.12 ENDTEXT
2361     }
2362    
2363    
2364     sub help_setroot
2365     {
2366     ###############################################################
2367     # help_setroot #
2368     ###############################################################
2369     # modified : Wed Nov 7 16:23:32 2001 / SFA #
2370     # params : #
2371     # : #
2372     # : #
2373     # : #
2374     # function : #
2375     # : #
2376     # : #
2377     # : #
2378     ###############################################################
2379     print <<ENDTEXT;
2380     Set a SCRAM-aware variable which points to a particular project area. This
2381     permits the setting of the runtime environment outside of the project area.
2382    
2383     Usage:
2384     $bold scram setroot $normal [ProjectName] [Version]
2385    
2386    
2387 hpw 1.1
2388     ENDTEXT
2389 sashby 1.2 }