ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.8
Committed: Fri Jul 13 09:59:09 2001 UTC (23 years, 10 months ago) by sashby
Branch: MAIN
Changes since 1.7: +4 -0 lines
Log Message:
Committing some more changes.

File Contents

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