ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.6
Committed: Tue Jul 10 15:04:15 2001 UTC (23 years, 10 months ago) by sashby
Branch: MAIN
Changes since 1.5: +2 -0 lines
Log Message:
Adding recent changes.

File Contents

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