ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.9
Committed: Sun Jul 22 16:52:42 2001 UTC (23 years, 10 months ago) by sashby
Branch: MAIN
CVS Tags: V0_19_0
Changes since 1.8: +6 -15 lines
Log Message:
Remove prereq check for shell in scramcli.

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