ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.1
Committed: Mon Dec 18 09:48:00 2000 UTC (24 years, 5 months ago) by hpw
Branch: MAIN
CVS Tags: V0_18_2
Log Message:
Changes requested by Chris to make this run on NT.

File Contents

# User Rev Content
1 hpw 1.1 #!/usr/local/bin/perl5
2     # ^^^^^^^^^^^^^^^^^^^^
3     # we dont need this anymore to invoke perl but options placed here will be
4     # used.
5     #
6     # User Interface
7     #
8     # Make sure were running the right version
9    
10     versioncheck();
11    
12     # -- handle options
13     while ( $ARGV[0]=~/^-/) {
14     if ( $ARGV[0] eq "-verbose" ) {
15     shift @ARGV;
16     print "verbose mode for $ARGV[0] on\n";
17     scrambasics()->classverbose($ARGV[0],1);
18     }
19     elsif ( $ARGV[0] eq "-arch" ) {
20     shift @ARGV;
21     $ENV{SCRAM_ARCH}=$ARGV[0];
22     scrambasics()->arch($ARGV[0]);
23     }
24     else {
25     error("Unknown option $ARGV[0]");
26     }
27     shift @ARGV;
28     }
29    
30     $inputcmd=shift;
31     $found='false';
32     $bold = "\033[1m";
33     $rv=0;
34     $normal = "\033[0m";
35     $self={};
36    
37     @allowed_commands=qw(project build install version list arch setup runtime db tool url);
38     @dev_cmds=qw(devtest devint align);
39    
40    
41     if ( $inputcmd ne "" ) {
42     foreach $command ( (@allowed_commands,@dev_cmds) ) {
43     if ( $command=~/^$inputcmd/i) {
44     # Deal with a help request
45     do{ helpheader($command);
46     &{"help_".$command}; exit; } if $ARGV[0]=~/help/i;
47     $rv=&$command; $found='true';
48     last;
49     }
50     }
51     }
52    
53     if ( ! ( $found=~/true/ ) ) {
54     helpheader('Recognised Commands');
55     foreach $command ( @allowed_commands ) {
56     print " $bold scram ".$command.$normal."\n";
57     }
58     print "\n";
59     print "Help on individual commands available through\n\n";
60     print "$bold scram".$normal." command$bold help $normal\n\n";
61    
62     print "\nOptions:\n";
63     print "--------\n";
64     print $bold."-verbose ".$normal."Class : Activate the verbose".
65     "function on the specified class";
66     print "\n\n";
67     print $bold."-arch ".$normal."architecture : Set the architecture id".
68     "to that specified";
69     print "\n\n";
70     }
71     exit $rv;
72    
73     sub error {
74     my $string=shift;
75     print "scram : ".$string."\n";
76     exit 1;
77     }
78    
79     sub versioncheck {
80     my $version;
81    
82     if ( @_ ) {
83     $version=shift;
84     }
85     else {
86     # -- get version from local area
87     if ( ! localtop_find() ) {
88     LoadEnvFile();
89     my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
90     if ( -f $versionfile ) {
91     open (VERSION, "<".$versionfile);
92     $version=<VERSION>;
93     chomp $version;
94     }
95     }
96     }
97     if ( defined $version ) {
98     scrambasics()->spawnversion($version,@ARGV);
99     }
100     }
101    
102     #
103     #
104     # _procescmds(handlercoderef,refarrayofallowedcommands,
105     # refarrayofactualcommands,arrayofsubroutinestringstocall)
106     #
107     #
108     sub _processcmds {
109     my $optionhandler=shift;
110     my $allowed_commands=shift;
111     my $cmds=shift;
112     my @subs=@_;
113    
114     my $found=0;
115     # make a string from the subcommand levels
116     my $substring="";
117     if ( @subs ) {
118     $substring= join '_', @subs;
119     $substring=$substring."_";
120     }
121    
122     # Process options
123     if ( defined ${$cmds}[0] ) {
124     while ( ${$cmds}[0]=~/^-/) {
125     &{$optionhandler}( ${$cmds}[0],$cmds);
126     }
127    
128     my $inputcmd=shift @{$cmds};
129     if ( $inputcmd ne "" ) {
130     foreach $command ( @{$allowed_commands} ) {
131     if ( $command=~/^$inputcmd/i) {
132     # Deal with a help request
133     if ( ( defined $$cmds[0]) && $$cmds[0]=~/help/i ) {
134     &helpheader($command,@subs);
135     &{"help_".$substring.$command}; exit;
136     }
137     else {
138     #print "calling $substring".$command."(@{$cmds})\n";
139     &{$substring.$command}(@{$cmds}); $found=1;
140     last;
141     }
142     }
143     }
144     }
145     }
146     if ( ! $found ) {
147     &{$substring."error"}(@subs);
148     }
149     return $found;
150     }
151    
152    
153     sub help_build {
154     &build;
155     }
156    
157     sub align {
158     _localarea()->align();
159     }
160    
161     sub build {
162     # is this a based or free release?
163     FullEnvInit();
164     use BuildSystem::BuildSetup;
165     $ENV{MAKETARGETS}=join ' ',@ARGV;
166    
167     # -- set the runtime environment
168     my $toolrt=scrambasics()->toolruntime(_localarea());
169     $toolrt->sethash(\%Env);
170    
171     # -- set up the builder
172     my $bs=BuildSystem::BuildSetup->new(toolbox());
173     $rv=$bs->BuildSetup($ENV{THISDIR},@ARGV);
174     $rv;
175     }
176    
177     sub project {
178     my @args=@ARGV;
179    
180     my $devareaname="";
181     use Cwd;
182     my $installarea=cwd();
183    
184     # process options
185     while ( $args[0]=~"^-" ) {
186     if ( $args[0]=~/-n/ ) {
187     shift @args;
188     $devareaname=shift @args;
189     }
190     elsif ( $args[0]=~/-d/ ) { #installation area directory
191     shift @args;
192     $installarea=$args[0];
193     if ( ! -d $installarea ) {
194     error("$installarea does not exist");
195     }
196     shift @args;
197     }
198     else {
199     error("unknown option $args[0] to project command");
200     }
201     }
202    
203     # -- check what arguments have been passed
204     if ( $#args <0 || $#args>1 ) {
205     error("\"scram project help\" for usage info");
206     }
207     my $area; #somewhere to store the area object when we have it
208    
209     if ( ( $#args==0 ) && ($args[0]=~/:/) ) {
210     # -- must be a url to bootstrap from
211     $area=scrambasics()->project($args[0], $installarea,
212     $devareaname);
213     scrambasics()->setuptoolsinarea($area);
214     }
215     elsif ( $#args >0 ) {
216     # -- get the release area
217     my $relarea=scrambasics()->scramprojectdb()->getarea(@args);
218     if ( ! defined $relarea ) {
219     error("Unknown project @args");
220     }
221     # -- we need to spawn the correct scram version to handle it
222     unshift @ARGV, "project";
223     versioncheck($relarea->scramversion());
224    
225     # -- need to create a satellite area
226     $area=scrambasics()->satellite(@args,$installarea, $devareaname);
227     }
228     else {
229     error("\"scram project help\" for usage info");
230     }
231    
232     #
233     # Now create the directories specified in the interface
234     # There should be some better mechanism - TODO
235     #
236     chdir $area->location();
237     foreach $key ( keys %ENV ) {
238     if ( $key=~/^INT/ ) {
239     AddDir::adddir($ENV{$key});
240     }
241     }
242    
243     print "\nInstallation Procedure Complete. \n".
244     "Installation Located at:\n".$area->location()."\n";
245     }
246    
247     sub scrambasics {
248     require Scram::ScramFunctions;
249     if ( ! defined $scramobj ) {
250     environmentinit();
251     $scramobj=Scram::ScramFunctions->new();
252     $scramobj->arch($ENV{SCRAM_ARCH});
253     #$scramobj->verbosity(1);
254     }
255     return $scramobj;
256     }
257    
258     # ------------ url command --------------------------------------------
259     sub url {
260     @_=@ARGV;
261     localtop();
262     environmentinit();
263     my @allowed_cmds=qw(get);
264     _processcmds("_tooloptions", \@allowed_cmds, \@_, ("url"));
265     }
266    
267     sub url_get {
268     my $url=shift;
269     my $area=_localarea();
270    
271     ($uurl,$file)=scrambasics()->webget($area,$url);
272     print "$file\n";
273     }
274    
275     sub help_url {
276     print <<ENDTEXT;
277     URL information.
278    
279     SubCommands :
280     scram url get
281    
282     ENDTEXT
283     }
284    
285     sub help_url_get {
286     print <<ENDTEXT;
287     Description:
288     Return the location of the local copy of the specified url
289     Usage :
290     scram url get url
291    
292     ENDTEXT
293     }
294    
295     # ------------ tool command --------------------------------------------
296     sub tool {
297     @_=@ARGV;
298     localtop();
299     environmentinit();
300     my @allowed_cmds=qw(info list default setup);
301     _processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));
302     }
303    
304     sub tool_error {
305     error("Unknown tool subcommand : @_");
306     }
307    
308     sub tool_default {
309     if ( $#_ != 1 ) {
310     error("\"scram tool default help\" for usage information");
311     }
312     my $tool=shift;
313     my $version=shift;
314     print "Setting default version of $tool to $version\n";
315     # -- adjust the toolbox
316     toolbox()->setdefault($tool,$version);
317    
318     }
319    
320     sub tool_list {
321     my $area=_localarea();
322     print "Tool List for "; #.$area->name()." ".$area->version()."\n";
323     print "Location : ".$area->location()."\n";
324     print "+"x60;
325     print "\n";
326     foreach $t ( toolbox()->tools() ) {
327     my $vers=join / /, toolbox()->versions($t);
328     print $t." ".$vers." (default=".toolbox()->defaultversion($t).")\n";
329     }
330     }
331    
332     sub tool_info {
333     my $project=shift;
334     my $area=_localarea();
335     print "Tool Info as configured in ";
336     #.$area->name()." ".$area->version()."\n";
337     print "Location : ".$area->location()."\n";
338     print "+"x60;
339     print "\n";
340    
341     my @tools=toolbox()->gettool($project,@_);
342     foreach $t ( @tools ) {
343     if ( defined $t ) {
344     print "Name : ".$t->name();
345     print "\n";
346     print "Version : ".$t->version();
347     print "\n";
348     print "Docfile : ".$t->url();
349     print "\n";
350     print "+"x20;
351     print "\n";
352     @features=$t->features();
353     foreach $ft ( @features ) {
354     @vals=$t->getfeature($ft);
355     foreach $v ( @vals ) {
356     print $ft. "=$v\n";
357     }
358     }
359     }
360     }
361     }
362    
363     sub tool_setup {
364     print "Please use scram setup command\n";
365     }
366    
367     sub _tooloptions {
368     error("No Options defined for tool subcommand");
369     }
370    
371     sub help_tool {
372     print <<ENDTEXT;
373     Manage the tools in the scram area that define the areas environment.
374     tool subcommands :
375     list
376     info tool_name
377     default tool_name tool_version
378    
379     ENDTEXT
380     }
381    
382     sub help_tool_info {
383     print <<ENDTEXT;
384     Description:
385     Print out information on the specified tool in the current area
386     configuration.
387     Usage :
388     scram tool info tool_name [tool_version]
389    
390     ENDTEXT
391     }
392    
393     sub help_tool_list {
394     print <<ENDTEXT;
395     Description:
396     List of currently configured tools available in ther current scram
397     area
398     Usage :
399     scram tool list
400    
401     ENDTEXT
402     }
403    
404     sub help_tool_default {
405     print <<ENDTEXT;
406     Description:
407     Change the default version of a tool to be used in the area
408     Usage :
409     scram tool default tool_name tool_version
410    
411     ENDTEXT
412     }
413    
414     # ----------------------------------------------------------------------
415     sub _requirements {
416     if ( ! defined $reqsobj ) {
417     localtop();
418     my $area=_localarea();
419     scrambasics()->arearequirements($area)
420     }
421     return $reqsobj;
422     }
423    
424     sub _allprojectinitsearcher {
425     my $search=_projsearcher();
426     foreach $proj ( _scramprojdb()->list() ) {
427     $search->addproject($$proj[0],$$proj[1]);
428     }
429     }
430    
431     sub _projsearcher {
432     if ( ! defined $self->{projsearcher} ) {
433     require Scram::ProjectSearcher;
434     $self->{projsearcher}=Scram::ProjectSearcher->new(_scramprojdb());
435     }
436     return $self->{projsearcher};
437     }
438    
439     sub _scramprojdb {
440     return scrambasics()->scramprojectdb();
441     }
442    
443     sub runtime {
444     my $shell;
445     require Runtime;
446    
447     # process options
448     while ( $ARGV[0]=~"^-" ) {
449     if ( $ARGV[0]=~/-sh/ ) {
450     shift @ARGV;
451     $shell="sh";
452     next;
453     }
454     if ( $ARGV[0]=~/-csh/ ) { #installation area directory
455     shift @ARGV;
456     $shell="csh";
457     next;
458     }
459     print "Unknown Option $ARGV[0]\n";
460     exit 1;
461     }
462    
463     FullEnvInit();
464     if ( @ARGV ) {
465     my $runtime=Runtime->new();
466     my $arg=shift @ARGV;
467    
468     my $info=0;
469     if ( $arg eq "info" ) {
470     $arg=shift @ARGV;
471     $info=1;
472     }
473    
474     # --- determine filename
475     my $filename;
476     if ( -f $arg ) { # Is it a file?
477     $filename=$arg;
478     }
479     else {
480     # -- lets see if its a BuildFile location
481     $filename=_testfile($ENV{LOCALTOP}."/src/".$arg,
482     $ENV{RELEASETOP}."/src/".$arg,
483     $ENV{LOCALTOP}."/src/".$arg."/BuildFile",
484     $ENV{RELEASETOP}."/src/".$arg."/BuildFile");
485     if ( $filename eq "" ) {
486     print "Unable to find a file (or BuildFile) relating to ".
487     $arg."\n";
488     exit 1;
489     }
490     }
491     $runtime->file($filename);
492     if ( ! $info ) {
493     $runtime->printenv($shell);
494     }
495     else {
496     if ( @ARGV ) { #do we have a specific variable request?
497     _printvardoc($runtime,shift @ARGV);
498     }
499     else {
500     foreach $var ( $runtime->list() ) {
501     _printvardoc($runtime,$var);
502     }
503     }
504     }
505     undef $runtime;
506     }
507     else {
508     FullEnvInit();
509     # -- We have to clean up from the last runtime cmd - use env history
510     foreach $variable ( %ENV ) {
511     if ( $variable=~/^SCRAMRT_(.*)/ ) { #SCRAMRT are history retaining
512     my $var=$1;
513     $ENV{$var}=~s/\Q$ENV{$variable}\E//g;
514     $ENV{$var}=~s/^:*//; # Deal with any Path variables
515     #print "$variable : $ENV{$variable} \n$var : $ENV{$var}\n";
516     delete $ENV{$variable};
517     }
518     }
519    
520     # -- get the tool runtime environments
521     my $toolrt=scrambasics()->toolruntime(_localarea());
522     $toolrt->sethash(\%EnvRuntime);
523    
524     # -- create new SCRAMRT history vars.
525     foreach $variable ( keys %EnvRuntime ) {
526     printoutenv($shell,"SCRAMRT_$variable",$EnvRuntime{$variable});
527     #addvar("SCRAMRT_$variable", $EnvRuntime{$variable}, "");
528     }
529    
530     # TODO -- this stuff should dissappear with compiler description docs
531     # Now adapt as necessary - include base environment as well
532     if ( exists $ENV{LD_LIBRARY_PATH} ) {
533     addpath("LD_LIBRARY_PATH","$ENV{LD_LIBRARY_PATH}");
534     }
535     if ( exists $ENV{MANPATH} ) {
536     addpath("MANPATH","$ENV{MANPATH}");
537     }
538     addpath("PATH","$ENV{PATH}");
539    
540     # -- Print out as reqd
541     # TODO -- we can use the runtime class method once we have removed
542     # this stuff above
543     foreach $variable ( keys %EnvRuntime ) {
544     printoutenv($shell,$variable,$EnvRuntime{$variable});
545     }
546     }
547     }
548    
549     # Support rt for runtime
550    
551     sub _testfile {
552     my @files=@_;
553    
554     my $filename="";
555     foreach $file ( @files ) {
556     if ( -f $file ) {
557     $filename=$file;
558     last;
559     }
560     }
561     return $filename;
562     }
563    
564     sub _printvardoc {
565     my $runtime=shift;
566     my $var=shift;
567    
568     print $var." :\n";
569     print $runtime->doc($var);
570     print "\n";
571     }
572    
573     sub printoutenv {
574     my $shell=shift;
575     my $variable=shift;
576     my $value=shift;
577    
578     if ( $shell eq "csh" ) {
579     print "setenv $variable \"$value\";\n";
580     }
581     elsif ( $shell eq "sh" ) {
582     print "$variable=\"$value\";\n";
583     print "export $variable;\n";
584     }
585     }
586    
587     sub addpath {
588     my $name=shift;
589     my $val=shift;
590    
591     my $n;
592     my @env;
593     @env=split /:/, $EnvRuntime{$name};
594     foreach $n ( (split /:/, $val ) ){
595     if ( ! grep /^\Q$n\E$/, @env ) {
596     addvar($name,$n,":");
597     }
598     }
599     }
600    
601     sub addvar {
602     my $name=shift;
603     my $val=shift;
604     my $sep=shift;
605    
606     if ( $val ne "" ) {
607     if ( defined $EnvRuntime{$name} ) {
608     $EnvRuntime{$name}=$EnvRuntime{$name}.$sep.$val;
609     }
610     else {
611     $EnvRuntime{$name}=$val;
612     }
613     }
614     }
615    
616     sub FullEnvInit {
617     environmentinit();
618     localtop();
619     LoadEnvFile();
620     }
621    
622     sub environmentinit {
623     use Utilities::setarchitecture;
624     my $name;
625     my $value;
626    
627     $ENV{LatestBuildFile}=""; # stop recursive behaviour in make
628     if ( ! defined $ENV{SCRAM_ARCH} ) {
629     setarchitecture::setarch();
630     }
631     $ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
632     $ENV{INTsrc}="src";
633     $ENV{INTlog}="logs";
634     $ENV{INTlib}="lib/".$ENV{SCRAM_ARCH};
635    
636     ($ENV{SCRAM_BASEDIR}=$ENV{SCRAM_HOME})=~s/(.*)\/.*/$1/;
637     if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){
638     $ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration";
639     }
640     $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
641     if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) ){
642     if ( -d "$ENV{SCRAM_BASEDIR}/scramdb/" ) {
643     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_BASEDIR}/scramdb/project.lookup";
644     }
645     else {
646     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
647     }
648     }
649     $ENV{SCRAM_AVAILDIRS}="";
650     $ENV{SCRAM_AVAILFILES}="";
651     }
652    
653     sub _localarea {
654     if ( ! defined $self->{localarea} ) {
655     require Configuration::ConfigArea;
656     $self->{localarea}=Configuration::ConfigArea->new();
657     if ( ! defined $ENV{LOCALTOP} ) {
658     if ( $self->{localarea}->bootstrapfromlocation() ) {
659     # Were not in a local area
660     undef $self->{localarea};
661     }
662     else {
663     $self->{localarea}->archname(scrambasics()->arch());
664     }
665     }
666     else {
667     $self->{localarea}->bootstrapfromlocation($ENV{LOCALTOP});
668     }
669     }
670     return $self->{localarea};
671     }
672    
673     sub localtop_find {
674     my $rv=1;
675     if ( defined _localarea()) {
676     $rv=0;
677     $ENV{LOCALTOP}=_localarea()->location();
678     }
679     return $rv;
680     }
681    
682     sub localtop {
683     localtop_find();
684     if ( ! (defined $ENV{LOCALTOP}) ) {
685     print "Unable to locate the top of local release. Exiting\n";
686     exit 1;
687     }
688     ($ENV{THISDIR}=cwd)=~s/^\Q$ENV{LOCALTOP}\L//;
689     $ENV{THISDIR}=~s/^\///;
690     }
691    
692     sub LoadEnvFile {
693     _localarea()->copyenv(\%ENV);
694     }
695    
696     sub env {
697     print "Sorry - Not yet\n";
698     }
699    
700     sub devint {
701     my $class=shift @ARGV;
702     scrambasics()->scramobjectinterface($class);
703     }
704    
705     sub devtest {
706     require Utilities::TestClass;
707     my $class=shift @ARGV;
708    
709     my $tester;
710     my $path;
711    
712     #_initproject();
713     if ( $class=~/::/ ) {
714     ($path=$class)=~s/(.*)::.*/$1/;
715     }
716     $tester=Utilities::TestClass->new($class,
717     "$ENV{SCRAM_HOME}/src/$path/test/testdata");
718     $tester->dotest(@_);
719     }
720    
721     #
722     # Create a lookup tag in the site database
723     #
724     sub install {
725     localtop();
726     scrambasics()->addareatoDB(_localarea(),@ARGV);
727     _localarea()->align();
728     }
729    
730     sub help_install() {
731    
732     print <<ENDTEXT;
733     Associates a label with the current release in the SCRAM database.
734     This allows other users to refer to a centrally installed project by
735     this label rather than a remote url reference.
736    
737     Usage:
738    
739     $bold scram install $normal [project_tag [version_tag]]
740    
741     porject_tag : override default label (the project name of the current release)
742     version_tag : the version tag of the current release. If version is not
743     specified the base release version will be taken by default.
744    
745     ENDTEXT
746     }
747    
748     sub helpheader ($label) {
749     my $label=shift;
750     print <<ENDTEXT;
751     *************************************************************************
752     SCRAM HELP --------- $label
753     *************************************************************************
754     ENDTEXT
755     }
756    
757     sub version {
758     my $version=shift @ARGV;
759     my $thisversion;
760     my $scram_top;
761     my $cvsobject;
762    
763     ($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
764     $scram_top=$1;
765     if ( $version eq "" ) {
766     print "$thisversion";
767     # deal with links
768     $version=readlink $ENV{SCRAM_HOME};
769     if ( defined $version) {
770     print " ---> $version";
771     }
772     print "\n";
773     }
774     else {
775     if ( -d $scram_top."/".$version ) {
776     print "Version $version exists\n";
777     }
778     else {
779     print "Version $version not available locally\n";
780     print "Attempting download from the SCRAM repository\n";
781     # set up and configure the cvs module for SCRAM
782     require Utilities::CVSmodule;
783     $cvsobject=Utilities::CVSmodule->new();
784     $cvsobject->set_base(
785     "cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
786     $cvsobject->set_auth("pserver");
787     $cvsobject->set_user("anonymous");
788     $cvsobject->set_passkey("AA_:yZZ3e");
789     # Now check it out in the right place
790     chdir $scram_top or die "Unable to change to $scram_top $!\n";
791     $cvsobject->invokecvs( ( split / /,
792     "co -d $version -r $version SCRAM" ));
793    
794     # Get rid of cvs object now weve finished
795     $cvsobject=undef;
796     print "\n";
797     }
798     }
799     0;
800     }
801    
802     sub list {
803     &environmentinit;
804     if ( ! -f $ENV{SCRAM_LOOKUPDB} ) {
805     print "No installation database available - perhaps no projects".
806     " have been installed locally\n";
807     exit 1;
808     }
809     print "Installed Projects\n";
810     print "------------------\n";
811     print "|Project Name | Project Version |\n";
812     print "----------------------------------\n";
813     listDB(@ARGV);
814     }
815    
816     sub db {
817     my $subcmd=shift @ARGV;
818     &environmentinit;
819    
820     switch : {
821     if ( $subcmd eq 'link' ) {
822     scrambasics()->scramprojectdb()->link(@ARGV);
823     last switch;
824     }
825     if ( ! -f $ENV{SCRAM_LOOKUPDB} ) {
826     print "No installation database available - perhaps no projects".
827     "have been installed locally\n";
828     exit 1;
829     }
830     if ( $subcmd eq 'unlink' ) {
831     scrambasics()->scramprojectdb()->unlink(@ARGV);
832     last switch;
833     }
834     if ( $subcmd eq 'showlinks' ) {
835     my @links=scrambasics()->scramprojectdb()->listlinks();
836     foreach $link ( @links ) {
837     print $link."\n";
838     }
839     last switch;
840     }
841     } # end switch
842    
843     }
844    
845     sub listDB {
846     my $project="";
847     if ( @_ ) {
848     $project=shift;
849     }
850     my @prs=scrambasics()->scramprojectdb()->listall();
851     foreach $pr ( @prs ) {
852     if ( $project eq "" || $project eq $$pr[0] ) {
853     printf "%1s",$$pr[0];
854     printf "%25s\n",$$pr[1];
855     my $url=scrambasics()->scramprojectdb()->
856     getarea($$pr[0],$$pr[1])->location();
857     printf "--> %25s\n",$url;
858     }
859     }
860     0;
861     }
862    
863     sub arch {
864     &environmentinit();
865     print "$ENV{SCRAM_ARCH}\n";
866     }
867    
868    
869     #
870     # Setup a new tool
871     #
872    
873     sub setup {
874     my $interactive=0;
875    
876     # process options
877     while ( $ARGV[0]=~"^-" ) {
878     if ( $ARGV[0]=~/-i/ ) {
879     shift @ARGV;
880     $interactive=1;
881     }
882     else {
883     error("scram: unknown option $ARGV[0] to project command");
884     }
885     }
886    
887     localtop();
888     my $area=_localarea();
889     my $toolname=shift @ARGV;
890     my $insert=0;
891     toolbox()->interactive($interactive);
892    
893     # If no toolname specified then its a full setup
894     if ( $toolname eq "" ) {
895     # -- add architecture specific directories
896     use Utilities::AddDir;
897     AddDir::adddir($area->location()."/lib/$ENV{SCRAM_ARCH}");
898     AddDir::adddir($area->location()."/bin/$ENV{SCRAM_ARCH}");
899    
900     # -- check the releasetop area
901     # if the releasetop has the files copy them
902     my $releaseobj=_releasearea();
903     if ( $releaseobj->copysetup($ENV{LOCALTOP}) ) {
904     print "Doing Full Setup\n";
905     scrambasics()->setuptoolsinarea($area);
906     }
907     }
908     else {
909     scrambasics()->setuptoolsinarea($area, $toolname,@ARGV);
910     }
911     }
912    
913     sub _releasearea {
914     if ( !defined $self->{releasearea} ) {
915     require Configuration::ConfigArea;
916     $self->{releasearea}=Configuration::ConfigArea->new();
917     $self->{releasearea}->bootstrapfromlocation($ENV{RELEASETOP});
918     }
919     return $self->{releasearea};
920     }
921    
922     # get a toolbox object for the local area
923     sub toolbox {
924     if ( ! defined $toolbox ) {
925     localtop();
926     my $area=_localarea();
927     $toolbox=scrambasics()->areatoolbox($area);
928     }
929     return $toolbox;
930     }
931    
932     sub help_db {
933     print <<ENDTEXT;
934     scram database administration command.
935    
936     Usage:
937    
938     $bold scram db $normal subcommand
939    
940     subcommands:
941     link :
942     Make available an additional database for
943     project and list operations
944    
945     $bold scram db link $normal /a/directory/path/project.lookup
946    
947     unlink :
948     Remove a database from the link list. Note this does
949     not remove the database, just the link to it in scram.
950    
951     $bold scram db unlink $normal /a/directory/path/project.lookup
952    
953     showlinks :
954     List the databases that are linked in
955    
956     ENDTEXT
957     }
958    
959     sub help_setup {
960    
961     print <<ENDTEXT;
962     Allows installation/re-installation of a new tool/external package into an
963     already existing development area. If not toolname is specified,
964     the complete installation process is initiated.
965    
966     Usage:
967    
968     $bold scram setup [-i]$normal [toolname] [[version] [url]]
969    
970     toolname : The name of the tool setup file required.
971     version : where more than one version exists specify the version
972     url : when setting up a completely new tool specify the url too
973    
974     The -i option turns off the automatic search mechanism allowing for more
975     user interaction with the setup mechanism
976     ENDTEXT
977     }
978    
979     sub help_list {
980     print <<ENDTEXT;
981     List the available projects and versions installed in the local SCRAM database
982     (see scram install help)
983    
984     Usage:
985    
986     $bold scram list $normal [ProjectName]
987    
988     ENDTEXT
989     }
990    
991     sub help_project {
992     print <<ENDTEXT;
993     Setup a new project development area. The new area will appear in the current
994     working directory.
995     Usage:
996    
997     $bold scram project [-d install_area] [-n directory_name]$normal project_url [project_version]
998    
999     Options:
1000    
1001     project_url: The url of a scram bootstrap file.
1002     Currently supported types are:
1003     $bold Database label $normal
1004     Labels can be assigned to bootstrap files for easy
1005     access (See "scram install" command). If you
1006     specify a label you must also specify a project_version.
1007     e.g.
1008    
1009     scram project SCRAM V1_0
1010    
1011     scram project ORCA ORCA_1_1_1
1012    
1013     To see the list of installed projects use the
1014     "scram list" command.
1015    
1016     $bold file: $normal A regular file on an accessable file system
1017     e.g.
1018    
1019     file:~/myprojects/projecta/config/BootStrapFile
1020    
1021     project_version:
1022     Only for use with a database label
1023    
1024     -d install_area:
1025     Indicate a project installation area into which the new
1026     project area should appear. Default is the current working
1027     directory.
1028    
1029     -n directory_name:
1030     Specify the name of the SCRAM development area you wish to
1031     create.
1032    
1033     ENDTEXT
1034     }
1035    
1036     sub help_version {
1037     print <<ENDTEXT;
1038     With now $bold [version] $normal argument given, this command will simply
1039     print to standard output the current version number.
1040    
1041     Providing a version argument will cause that version to be downloaded and
1042     installed, if not already locally available.
1043    
1044    
1045     Usage:
1046     $bold scram version [version]$normal
1047    
1048     ENDTEXT
1049     }
1050    
1051     sub help_arch {
1052     print <<ENDTEXT;
1053     Print out the architecture flag for the current machine.
1054    
1055     Usage:
1056     $bold scram arch $normal
1057     ENDTEXT
1058     }
1059    
1060     sub help_runtime {
1061     print <<ENDTEXT;
1062     Echo to Standard Output the Runtime Environment for the current development area
1063     Output available in csh or sh flavours
1064    
1065     Usage:
1066     1) $bold scram runtime [-csh|-sh] $normal
1067     or
1068     2) $bold scram runtime [-csh|-sh] filename $normal
1069     or
1070     3) $bold scram runtime info filename [variable]$normal
1071    
1072     1) For the general configuration environment
1073     2) For environment described in filename or
1074     areatop/src/directory/BuildFile
1075     3) Display information concerning the environment in the given file
1076     (limited to variable if specified)
1077    
1078     The file for cases 2) and 3) are searched as follows :
1079     a) straightforward filename
1080     b) filename relative to local_area/src
1081     c) filename relative to release_area/src
1082     d) BuildFile relative to local_area/src
1083     e) BuildFile relative to release_area/src
1084    
1085     Examples:
1086    
1087     Setup the current environment to include the project Runtime Environment
1088     in a csh environment
1089    
1090     $bold eval `scram runtime -csh` $normal
1091    
1092     Setup the current environment to include the project Runtime Environment in a
1093     sh environment
1094    
1095     $bold eval `scram runtime -sh` $normal
1096    
1097    
1098     ENDTEXT
1099     }