ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.5
Committed: Mon Jun 18 15:19:51 2001 UTC (23 years, 11 months ago) by sashby
Branch: MAIN
Changes since 1.4: +38 -19 lines
Log Message:
Added remove function so installed projects can be removed from DB

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