ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.4
Committed: Wed Jun 13 15:43:34 2001 UTC (23 years, 11 months ago) by sashby
Branch: MAIN
Changes since 1.3: +19 -9 lines
Log Message:
ListDB function now only returns project list for current OS

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