ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.13
Committed: Thu Nov 8 10:55:47 2001 UTC (23 years, 6 months ago) by sashby
Branch: MAIN
Changes since 1.12: +10 -5 lines
Log Message: 
Modified setroot command.

File Contents

# User Rev Content
1 sashby 1.12 #!/usr/bin/env 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 sashby 1.10 $bold = "";
18 sashby 1.11 $normal = "";
19 sashby 1.10 # Test whether the output from SCRAM is being redirected, or
20     # not (prevents escape signals from being printed to STDOUT if
21     # STDOUT is redirected to a file):
22 sashby 1.11 if ( -t STDIN && -t STDOUT )
23     {
24     $bold = "\033[1m";
25     $normal = "\033[0m";
26     }
27    
28 sashby 1.5 $line = "-"x80;
29 sashby 1.2
30     # Allowed main and dev commands:
31 sashby 1.13 @allowed_commands=qw(project build install version list remove arch setup runtime setroot db tool url);
32     @dev_cmds=qw(devtest devint align autoset);
33 hpw 1.1
34 sashby 1.2 # Check for prerequisites:
35     prerequisitecheck();
36     # Check for version consistency:
37 hpw 1.1 versioncheck();
38    
39    
40 sashby 1.2 # Parse arguments (look for "-verbose" or "-arch" then shift):
41     while ( $ARGV[0] =~ /^-/)
42     {
43     if ( $ARGV[0] eq "-verbose" )
44     {
45     shift @ARGV;
46     # If no argument (i.e. class to activate "verbose" for) do nothing:
47     if (defined ($ARGV[0]))
48     {
49     print "\nverbose mode for $ARGV[0] switched ".$bold."ON".$normal."\n" ;
50     scrambasics()->classverbose($ARGV[0],1);
51     }
52     }
53     elsif ( $ARGV[0] eq "-arch" )
54     {
55     shift @ARGV;
56     $ENV{SCRAM_ARCH}=$ARGV[0];
57     scrambasics()->arch($ARGV[0]);
58     }
59     else
60     {
61     error("Unknown option $ARGV[0]");
62     }
63     shift @ARGV;
64     }
65    
66     # Shift args to get input command:
67 hpw 1.1 $inputcmd=shift;
68     $found='false';
69     $rv=0;
70     $self={};
71    
72    
73 sashby 1.2 # Check that input command is defined, and then
74     # run a scram subroutine for the command or show
75     # some help:
76     if ( $inputcmd ne "" )
77     {
78     foreach $command ( (@allowed_commands,@dev_cmds) )
79     {
80     if ( $command =~ /^$inputcmd/i)
81     {
82     # Deal with a help request
83     do
84     {
85     helpheader($command);
86     &{"help_".$command};
87     exit;
88     } if $ARGV[0] =~ /help/i;
89     $rv=&$command;
90     $found='true';
91     last;
92     }
93     }
94     }
95    
96     if ( ! ( $found =~ /true/ ) )
97     {
98     helpheader('Recognised Commands');
99     foreach $command ( @allowed_commands )
100     {
101     print " $bold scram ".$command.$normal."\n";
102     }
103     print "\n";
104     print "Help on individual commands available through\n\n";
105     print "$bold scram".$normal." command$bold help $normal\n\n";
106    
107     print "\nOptions:\n";
108     print "--------\n";
109     print $bold."-verbose ".$normal."Class : Activate the verbose ".
110     "function on the specified class";
111     print "\n\n";
112     print $bold."-arch ".$normal."architecture : Set the architecture id ".
113     "to that specified";
114     print "\n\n";
115     }
116 hpw 1.1
117 sashby 1.2 # Exit with exit status of subroutine
118     # that was executed in line 80:
119 hpw 1.1 exit $rv;
120    
121 sashby 1.2
122    
123    
124    
125    
126    
127    
128     ######################################################################################
129     ## Subroutine definitions ##
130     ######################################################################################
131    
132     sub error
133     {
134     ###############################################################
135     # error(string) #
136     ###############################################################
137     # modified : Mon May 28 11:26:47 2001 / SFA #
138     # params : Error messsage string #
139     # : #
140     # : #
141     # : #
142     # function : Exit with an error string. #
143     # : #
144     # : #
145     ###############################################################
146     my $string=shift;
147 sashby 1.5 print "\n","scram : ".$string."\n";
148     exit (1);
149 sashby 1.2 }
150    
151     sub prerequisitecheck
152     {
153     ###############################################################
154     # prerequisitecheck() #
155     ###############################################################
156     # modified : Mon May 28 11:26:52 2001 / SFA #
157     # params : None. #
158     # : #
159     # : #
160     # : #
161     # function : Check for prerequisite programs. #
162 sashby 1.9 # : Don't bother checking for shell: too much hassle.#
163     # : (and doesn't work outside of HEPiX scheme) #
164 sashby 1.2 ###############################################################
165     my $reqdmake="gmake";
166 sashby 1.9 # We must have gmake. Use "which" to get the gmake command
167     # ("whereis" doesn't work on SunOS):
168 sashby 1.2 chomp(($makeprog)=(`which gmake` =~ /.*\/(\w+)/));
169     # Now test that requirements are satisfied:
170 sashby 1.9 if ( $makeprog eq "$reqdmake" )
171 sashby 1.2 {
172     return (0);
173     }
174     else
175     {
176     print "It appears that you do not have all prerequisite","\n";
177     print "programs. To run SCRAM, you must have:","\n";
178     print "\n";
179     print " - GNU make (gmake)","\n";
180     print "\n";
181 sashby 1.9 print "Please make sure that this program is present.","\n\n";
182 sashby 1.2 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 sashby 1.12
988 sashby 1.2 FullEnvInit();
989 sashby 1.12
990 sashby 1.2 if ( @ARGV )
991     {
992     my $runtime=Runtime->new();
993     my $arg=shift @ARGV;
994    
995     my $info=0;
996     if ( $arg eq "info" )
997     {
998     $arg=shift @ARGV;
999     $info=1;
1000     }
1001    
1002     # --- determine filename
1003     my $filename;
1004     if ( -f $arg ) # Is it a file?
1005     {
1006     $filename=$arg;
1007     }
1008     else
1009     {
1010     # -- lets see if its a BuildFile location
1011     $filename=_testfile($ENV{LOCALTOP}."/src/".$arg,
1012     $ENV{RELEASETOP}."/src/".$arg,
1013     $ENV{LOCALTOP}."/src/".$arg."/BuildFile",
1014     $ENV{RELEASETOP}."/src/".$arg."/BuildFile");
1015     if ( $filename eq "" )
1016     {
1017     print "Unable to find a file (or BuildFile) relating to ".
1018     $arg."\n";
1019     exit 1;
1020     }
1021     }
1022     $runtime->file($filename);
1023     if ( ! $info )
1024     {
1025     $runtime->printenv($shell);
1026     }
1027     else
1028     {
1029     if ( @ARGV ) #do we have a specific variable request?
1030     {
1031     _printvardoc($runtime,shift @ARGV);
1032     }
1033     else
1034     {
1035     foreach $var ( $runtime->list() )
1036     {
1037     _printvardoc($runtime,$var);
1038     }
1039     }
1040     }
1041     undef $runtime;
1042     }
1043     else
1044     {
1045     FullEnvInit();
1046     # -- We have to clean up from the last runtime cmd - use env history
1047     foreach $variable ( %ENV )
1048     {
1049     if ( $variable =~ /^SCRAMRT_(.*)/ ) #SCRAMRT are history retaining
1050     {
1051 hpw 1.1 my $var=$1;
1052 sashby 1.2 $ENV{$var} =~ s/\Q$ENV{$variable}\E//g;
1053     $ENV{$var} =~ s/^:*//; # Deal with any Path variables
1054 hpw 1.1 delete $ENV{$variable};
1055 sashby 1.2 }
1056     }
1057 hpw 1.1
1058 sashby 1.2 # -- get the tool runtime environments
1059     my $toolrt=scrambasics()->toolruntime(_localarea());
1060     $toolrt->sethash(\%EnvRuntime);
1061    
1062     # -- create new SCRAMRT history vars.
1063     foreach $variable ( keys %EnvRuntime )
1064     {
1065     printoutenv($shell,"SCRAMRT_$variable",$EnvRuntime{$variable});
1066     }
1067 hpw 1.1
1068 sashby 1.2 # TODO -- this stuff should dissappear with compiler description docs
1069     # Now adapt as necessary - include base environment as well
1070     if ( exists $ENV{LD_LIBRARY_PATH} )
1071     {
1072     addpath("LD_LIBRARY_PATH","$ENV{LD_LIBRARY_PATH}");
1073     }
1074     if ( exists $ENV{MANPATH} )
1075     {
1076     addpath("MANPATH","$ENV{MANPATH}");
1077     }
1078     addpath("PATH","$ENV{PATH}");
1079    
1080     # -- Print out as reqd
1081     # TODO -- we can use the runtime class method once we have removed
1082     # this stuff above
1083     foreach $variable ( keys %EnvRuntime )
1084     {
1085     printoutenv($shell,$variable,$EnvRuntime{$variable});
1086     }
1087 sashby 1.12
1088     # Export the local and release top:
1089     printoutenv($shell,"LOCALTOP",$ENV{LOCALTOP});
1090     printoutenv($shell,"RELEASETOP",$ENV{RELEASETOP});
1091    
1092 sashby 1.2 }
1093     }
1094 hpw 1.1
1095     # Support rt for runtime
1096    
1097 sashby 1.2 sub _testfile
1098     {
1099     ###############################################################
1100     # _testfile() #
1101     ###############################################################
1102     # modified : Mon May 28 11:29:21 2001 / SFA #
1103     # params : #
1104     # : #
1105     # : #
1106     # : #
1107     # function : #
1108     # : #
1109     # : #
1110     ###############################################################
1111     my @files=@_;
1112     my $filename="";
1113    
1114     foreach $file ( @files )
1115     {
1116     if ( -f $file )
1117     {
1118     $filename=$file;
1119     last;
1120     }
1121     }
1122     return $filename;
1123     }
1124    
1125     sub _printvardoc
1126     {
1127     ###############################################################
1128     # _printvardoc() #
1129     ###############################################################
1130     # modified : Mon May 28 11:29:25 2001 / SFA #
1131     # params : #
1132     # : #
1133     # : #
1134     # : #
1135     # function : #
1136     # : #
1137     # : #
1138     ###############################################################
1139     my $runtime=shift;
1140     my $var=shift;
1141    
1142     print $var." :\n";
1143     print $runtime->doc($var);
1144     print "\n";
1145     }
1146    
1147     sub printoutenv
1148     {
1149     ###############################################################
1150     # printoutenv() #
1151     ###############################################################
1152     # modified : Mon May 28 11:29:28 2001 / SFA #
1153     # params : #
1154     # : #
1155     # : #
1156     # : #
1157     # function : #
1158     # : #
1159     # : #
1160     ###############################################################
1161     my $shell=shift;
1162     my $variable=shift;
1163     my $value=shift;
1164    
1165     if ( $shell eq "csh" )
1166     {
1167     print "setenv $variable \"$value\";\n";
1168     }
1169     elsif ( $shell eq "sh" )
1170     {
1171     print "$variable=\"$value\";\n";
1172     print "export $variable;\n";
1173     }
1174     }
1175    
1176     sub addpath
1177     {
1178     ###############################################################
1179     # addpath() #
1180     ###############################################################
1181     # modified : Mon May 28 11:29:32 2001 / SFA #
1182     # params : #
1183     # : #
1184     # : #
1185     # : #
1186     # function : #
1187     # : #
1188     # : #
1189     ###############################################################
1190     my $name=shift;
1191     my $val=shift;
1192    
1193     my $n;
1194     my @env;
1195     @env=split /:/, $EnvRuntime{$name};
1196     foreach $n ( (split /:/, $val ) )
1197     {
1198     if ( ! grep /^\Q$n\E$/, @env )
1199     {
1200     addvar($name,$n,":");
1201     }
1202     }
1203     }
1204 hpw 1.1
1205 sashby 1.2 sub addvar
1206     {
1207     ###############################################################
1208     # addvar() #
1209     ###############################################################
1210     # modified : Mon May 28 11:29:35 2001 / SFA #
1211     # params : #
1212     # : #
1213     # : #
1214     # : #
1215     # function : #
1216     # : #
1217     # : #
1218     ###############################################################
1219     my $name=shift;
1220     my $val=shift;
1221     my $sep=shift;
1222    
1223     if ( $val ne "" )
1224     {
1225     if ( defined $EnvRuntime{$name} )
1226     {
1227 hpw 1.1 $EnvRuntime{$name}=$EnvRuntime{$name}.$sep.$val;
1228 sashby 1.2 }
1229     else
1230     {
1231 hpw 1.1 $EnvRuntime{$name}=$val;
1232 sashby 1.2 }
1233     }
1234     }
1235    
1236     sub FullEnvInit
1237     {
1238     ###############################################################
1239     # FullEnvInit() #
1240     ###############################################################
1241     # modified : Mon May 28 11:29:38 2001 / SFA #
1242     # params : #
1243     # : #
1244     # : #
1245     # : #
1246     # function : #
1247     # : #
1248     # : #
1249     ###############################################################
1250     environmentinit();
1251     localtop();
1252     LoadEnvFile();
1253     }
1254    
1255     sub environmentinit
1256     {
1257     ###############################################################
1258     # environmentinit() #
1259     ###############################################################
1260     # modified : Mon May 28 11:29:41 2001 / SFA #
1261     # params : #
1262     # : #
1263     # : #
1264     # : #
1265     # function : Set the environment variables needed #
1266     # : by scram (arch, home etc.) #
1267     # : #
1268     ###############################################################
1269     use Utilities::setarchitecture;
1270     my $name;
1271     my $value;
1272    
1273     $ENV{LatestBuildFile}=""; # stop recursive behaviour in make
1274     if ( ! defined $ENV{SCRAM_ARCH} )
1275     {
1276     setarchitecture::setarch();
1277     }
1278     $ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
1279     $ENV{INTsrc}="src";
1280     $ENV{INTlog}="logs";
1281     $ENV{INTlib}="lib/".$ENV{SCRAM_ARCH};
1282    
1283     ($ENV{SCRAM_BASEDIR}=$ENV{SCRAM_HOME}) =~ s/(.*)\/.*/$1/;
1284     if ( ! ( exists $ENV{SCRAM_CONFIG} ) )
1285     {
1286     $ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration";
1287     }
1288     $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
1289     if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) )
1290     {
1291     if ( -d "$ENV{SCRAM_BASEDIR}/scramdb/" )
1292     {
1293     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_BASEDIR}/scramdb/project.lookup";
1294     }
1295     else
1296     {
1297     $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
1298     }
1299     }
1300     $ENV{SCRAM_AVAILDIRS}="";
1301     $ENV{SCRAM_AVAILFILES}="";
1302     }
1303    
1304     sub _localarea
1305     {
1306     ###############################################################
1307     # _localarea() #
1308     ###############################################################
1309     # modified : Mon May 28 11:29:47 2001 / SFA #
1310     # params : #
1311     # : #
1312     # : #
1313     # : #
1314     # function : #
1315     # : #
1316     # : #
1317     ###############################################################
1318     if ( ! defined $self->{localarea} )
1319     {
1320     require Configuration::ConfigArea;
1321     $self->{localarea}=Configuration::ConfigArea->new();
1322     if ( ! defined $ENV{LOCALTOP} )
1323     {
1324     if ( $self->{localarea}->bootstrapfromlocation() )
1325     {
1326 hpw 1.1 # Were not in a local area
1327     undef $self->{localarea};
1328 sashby 1.2 }
1329     else
1330     {
1331     $self->{localarea}->archname(scrambasics()->arch());
1332     }
1333     }
1334     else
1335     {
1336     $self->{localarea}->bootstrapfromlocation($ENV{LOCALTOP});
1337     }
1338     }
1339     return $self->{localarea};
1340     }
1341    
1342     sub localtop_find
1343     {
1344     ###############################################################
1345     # localtop_find() #
1346     ###############################################################
1347     # modified : Mon May 28 11:29:50 2001 / SFA #
1348     # params : #
1349     # : #
1350     # : #
1351     # : #
1352     # function : #
1353     # : #
1354     # : #
1355     ###############################################################
1356     my $rv=1;
1357     if ( defined _localarea())
1358     {
1359     $rv=0;
1360     $ENV{LOCALTOP}=_localarea()->location();
1361     }
1362     return $rv;
1363     }
1364    
1365     sub localtop
1366     {
1367     ###############################################################
1368     # localtop() #
1369     ###############################################################
1370     # modified : Mon May 28 11:29:54 2001 / SFA #
1371     # params : #
1372     # : #
1373     # : #
1374     # : #
1375 sashby 1.5 # function : Find the top directory of local release area. #
1376 sashby 1.2 # : #
1377     # : #
1378     ###############################################################
1379     localtop_find();
1380    
1381     if ( ! (defined $ENV{LOCALTOP}) )
1382     {
1383     print "Unable to locate the top of local release. Exitting.\n";
1384     exit 1;
1385     }
1386     ($ENV{THISDIR}=cwd) =~ s/^\Q$ENV{LOCALTOP}\L//;
1387     $ENV{THISDIR} =~ s/^\///;
1388     }
1389    
1390     sub LoadEnvFile
1391     {
1392     ###############################################################
1393     # LoadEnvFile() #
1394     ###############################################################
1395     # modified : Mon May 28 11:29:58 2001 / SFA #
1396     # params : #
1397     # : #
1398     # : #
1399     # : #
1400     # function : #
1401     # : #
1402     # : #
1403     ###############################################################
1404     _localarea()->copyenv(\%ENV);
1405     }
1406    
1407     sub env
1408     {
1409     ###############################################################
1410     # env() #
1411     ###############################################################
1412     # modified : Mon May 28 11:30:00 2001 / SFA #
1413     # params : #
1414     # : #
1415     # : #
1416     # : #
1417     # function : #
1418     # : #
1419     # : #
1420     ###############################################################
1421 hpw 1.1 print "Sorry - Not yet\n";
1422 sashby 1.2 }
1423 hpw 1.1
1424 sashby 1.2 sub devint
1425     {
1426     ###############################################################
1427     # devint() #
1428     ###############################################################
1429     # modified : Mon May 28 11:30:03 2001 / SFA #
1430     # params : #
1431     # : #
1432     # : #
1433     # : #
1434     # function : #
1435     # : #
1436     # : #
1437     ###############################################################
1438     my $class=shift @ARGV;
1439     scrambasics()->scramobjectinterface($class);
1440     }
1441    
1442     sub devtest
1443     {
1444     ###############################################################
1445     # devtest() #
1446     ###############################################################
1447     # modified : Mon May 28 11:30:06 2001 / SFA #
1448     # params : #
1449     # : #
1450     # : #
1451     # : #
1452     # function : #
1453     # : #
1454     # : #
1455     ###############################################################
1456     require Utilities::TestClass;
1457     my $class=shift @ARGV;
1458    
1459     my $tester;
1460     my $path;
1461    
1462     #_initproject();
1463     if ( $class =~ /::/ )
1464     {
1465     ($path=$class) =~ s/(.*)::.*/$1/;
1466     }
1467     $tester=Utilities::TestClass->new($class,
1468     "$ENV{SCRAM_HOME}/src/$path/test/testdata");
1469     $tester->dotest(@_);
1470     }
1471 hpw 1.1
1472     #
1473     # Create a lookup tag in the site database
1474     #
1475 sashby 1.2 sub install
1476     {
1477     ###############################################################
1478     # install() #
1479     ###############################################################
1480     # modified : Mon May 28 11:30:09 2001 / SFA #
1481     # params : #
1482     # : #
1483     # : #
1484     # : #
1485     # function : Install a project. Updates project.lookup #
1486     # : files found in /scramdb. #
1487     # : #
1488     ###############################################################
1489     localtop();
1490    
1491     scrambasics()->addareatoDB(_localarea(),@ARGV);
1492     _localarea()->align();
1493     }
1494    
1495     sub help_install()
1496     {
1497     ###############################################################
1498     # help_install() #
1499     ###############################################################
1500     # modified : Mon May 28 11:30:12 2001 / SFA #
1501     # params : #
1502     # : #
1503     # : #
1504     # : #
1505     # function : Show help for the install command. #
1506     # : #
1507     # : #
1508     ###############################################################
1509     print <<ENDTEXT;
1510 hpw 1.1 Associates a label with the current release in the SCRAM database.
1511     This allows other users to refer to a centrally installed project by
1512     this label rather than a remote url reference.
1513    
1514     Usage:
1515    
1516     $bold scram install $normal [project_tag [version_tag]]
1517    
1518     porject_tag : override default label (the project name of the current release)
1519     version_tag : the version tag of the current release. If version is not
1520     specified the base release version will be taken by default.
1521    
1522     ENDTEXT
1523 sashby 1.2 }
1524 hpw 1.1
1525 sashby 1.2 sub helpheader ($label)
1526     {
1527     ###############################################################
1528     # helpheader(label) #
1529     ###############################################################
1530     # modified : Mon May 28 11:30:17 2001 / SFA #
1531     # params : label for the header. #
1532     # : #
1533     # : #
1534     # : #
1535     # function : Prints a header for the help command of #
1536     # : scram command "label". #
1537     # : #
1538     ###############################################################
1539     my $label=shift;
1540    
1541     print <<ENDTEXT;
1542    
1543 hpw 1.1 *************************************************************************
1544 sashby 1.2 SCRAM HELP --------- $label
1545 hpw 1.1 *************************************************************************
1546 sashby 1.2
1547 hpw 1.1 ENDTEXT
1548 sashby 1.2 }
1549 hpw 1.1
1550 sashby 1.2 sub version
1551     {
1552     ###############################################################
1553     # version() #
1554     ###############################################################
1555     # modified : Mon May 28 11:30:24 2001 / SFA #
1556     # params : #
1557     # : #
1558     # : #
1559     # : #
1560     # function : Get the version of scram being used. #
1561     # : #
1562     # : #
1563     ###############################################################
1564     my $version=shift @ARGV;
1565     my $thisversion;
1566     my $scram_top;
1567     my $cvsobject;
1568    
1569     ($thisversion=$ENV{SCRAM_HOME}) =~ s/(.*)\///;
1570     $scram_top=$1;
1571     if ( $version eq "" )
1572     {
1573     print "$thisversion";
1574     # deal with links
1575     $version=readlink $ENV{SCRAM_HOME};
1576     if ( defined $version)
1577     {
1578     print " ---> $version";
1579     }
1580     print "\n";
1581     }
1582     else
1583     {
1584     if ( -d $scram_top."/".$version )
1585     {
1586     print "Version $version exists\n";
1587     }
1588     else
1589     {
1590     print "Version $version not available locally\n";
1591     print "Attempting download from the SCRAM repository\n";
1592     # set up and configure the cvs module for SCRAM
1593     require Utilities::CVSmodule;
1594     $cvsobject=Utilities::CVSmodule->new();
1595     $cvsobject->set_base(
1596     "cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
1597     $cvsobject->set_auth("pserver");
1598     $cvsobject->set_user("anonymous");
1599     $cvsobject->set_passkey("AA_:yZZ3e");
1600     # Now check it out in the right place
1601     chdir $scram_top or die "Unable to change to $scram_top $!\n";
1602     $cvsobject->invokecvs( ( split / /,
1603     "co -d $version -r $version SCRAM" ));
1604 hpw 1.1
1605 sashby 1.2 # Get rid of cvs object now weve finished
1606     $cvsobject=undef;
1607     print "\n";
1608     }
1609     }
1610     0;
1611     }
1612    
1613     sub list
1614     {
1615     ###############################################################
1616     # list() #
1617     ###############################################################
1618     # modified : Mon May 28 11:30:28 2001 / SFA #
1619     # params : #
1620     # : #
1621     # : #
1622     # : #
1623     # function : List available projects. #
1624     # : #
1625     # : #
1626     ###############################################################
1627     &environmentinit;
1628    
1629     my $linebold = "$bold"."$line"."$normal";
1630     my $pjname = "Project Name";
1631     my $pjversion = "Project Version";
1632     my $pjlocation = "Project Location";
1633 sashby 1.5 my $headstring = sprintf("| %-12s | %-24s | %-33s |",$pjname,$pjversion,$pjlocation);
1634 sashby 1.2
1635     if ( ! -f $ENV{SCRAM_LOOKUPDB} )
1636     {
1637     print "\n","No installation database available - perhaps no projects".
1638     " have been installed locally?\n";
1639     exit 1;
1640     }
1641 sashby 1.4 print "\n","Listing installed projects....","\n\n";
1642 sashby 1.2 print $linebold,"\n";
1643     print $headstring."\n";
1644     print $linebold,"\n\n";
1645     listDB(@ARGV);
1646     print "\n";
1647     }
1648    
1649    
1650     sub remove
1651     {
1652     ###############################################################
1653     # remove(project) #
1654     ###############################################################
1655     # modified : Mon May 28 11:30:31 2001 / SFA #
1656 sashby 1.5 # params : project name, project version #
1657 sashby 1.2 # : #
1658     # : #
1659     # : #
1660     # function : Remove the named project from the project.lookup #
1661     # : file (scram database). #
1662     # : #
1663 sashby 1.5 ###############################################################
1664     my $projectname=shift @ARGV;
1665     my $projectversion=shift @ARGV;
1666    
1667     # Check there were sufficient args:
1668     if ($projectname eq "" || $projectversion eq "")
1669     {
1670     error("\"scram remove help\" for usage info.");
1671     &help_remove;
1672     exit (0);
1673     }
1674     else
1675     {
1676     scrambasics()->removeareafromDB($projectname,$projectversion);
1677     }
1678     0;
1679 sashby 1.2 }
1680    
1681     sub db
1682     {
1683     ###############################################################
1684     # db() #
1685     ###############################################################
1686     # modified : Mon May 28 11:30:35 2001 / SFA #
1687 sashby 1.5 # params : "link", "unlink" or "show(links )" #
1688 sashby 1.2 # : #
1689     # : #
1690     # : #
1691     # function : Show project info stored in scramdb. Link/unlink #
1692     # : project database files, or show linked databases.#
1693     # : #
1694     ###############################################################
1695     my $subcmd=shift @ARGV;
1696    
1697     # Make sure we have an argument, or tell the user:
1698     if ( ! defined($subcmd))
1699     {
1700     &help_db;
1701     print "\n";
1702     exit (1);
1703     }
1704    
1705     &environmentinit;
1706    
1707     # First, check for a database area:
1708     if ( ! -f $ENV{SCRAM_LOOKUPDB} )
1709     {
1710     print "\n","No installation database available - perhaps no projects".
1711     "have been installed locally?\n";
1712     exit (1);
1713     }
1714     print "\n","Current scram database: ";
1715     print $bold."$ENV{SCRAM_LOOKUPDB}".$normal."\n\n";
1716    
1717     switch :
1718     {
1719     if ( $subcmd eq 'link' )
1720     {
1721     print "\n","Linked @ARGV to current scram database.","\n\n";
1722     scrambasics()->scramprojectdb()->link(@ARGV);
1723     last switch;
1724     }
1725     if ( $subcmd eq 'unlink' )
1726     {
1727     print "\n","Unlinked @ARGV from current scram database.","\n\n";
1728     scrambasics()->scramprojectdb()->unlink(@ARGV);
1729     last switch;
1730     }
1731     if ( $subcmd eq 'showlinks'
1732     || $subcmd eq 'showlink'
1733     || $subcmd eq 'show')
1734     {
1735     my @links=scrambasics()->scramprojectdb()->listlinks();
1736     # Are there any links defined?:
1737     if ( defined($links[0]) )
1738     {
1739     print "\n","The following scram databases are linked to the current scram database: ","\n\n";
1740     foreach $link ( @links )
1741     {
1742     print " ".$link."\n";
1743     }
1744     print "\n";
1745     }
1746     else
1747     {
1748     print "There are no databases linked.","\n\n";
1749     }
1750     last switch;
1751     }
1752     } # end switch
1753     }
1754 hpw 1.1
1755 sashby 1.2 sub listDB
1756     {
1757     ###############################################################
1758     # listDB() #
1759     ###############################################################
1760     # modified : Mon May 28 11:30:39 2001 / SFA #
1761     # params : Project name #
1762     # : #
1763 sashby 1.4 # function : List projects. Only those projects that were #
1764     # : installed on the user's current OS will be #
1765     # : displayed (slight anomaly here: some projects #
1766     # : were installed on SunOS_5.6 so won't appear if #
1767     # : the user's current platform is SunOS_5.7...). #
1768 sashby 1.2 # : #
1769     ###############################################################
1770     my $project="";
1771    
1772     if ( @_ )
1773     {
1774     $project=shift;
1775     }
1776 sashby 1.5
1777 sashby 1.2 my @prs=scrambasics()->scramprojectdb()->listall();
1778 sashby 1.5
1779     # Check to see if there are any projects:
1780     if ( ! defined @prs )
1781     {
1782     print "\t\t>>>> No locally installed projects! <<<<","\n";
1783     return (0);
1784     }
1785    
1786     # Iterate over the project list:
1787 sashby 1.2 foreach $pr ( @prs )
1788     {
1789     if ( $project eq "" || $project eq $$pr[0] )
1790     {
1791     my $url=scrambasics()->scramprojectdb()->
1792     getarea($$pr[0],$$pr[1])->location();
1793 sashby 1.4 # Check that there exists an installation for
1794     # our current architecture. Check for a bin and
1795     # a lib directory:
1796     if ( -d "$url/bin/$ENV{SCRAM_ARCH}"
1797     || -d "$url/lib/$ENV{SCRAM_ARCH}" )
1798     {
1799 sashby 1.12 # Check that the path to the project area is readable:
1800     if ( -d $url )
1801     {
1802     # Stagger the printed lines to allow easier
1803     # copying using the mouse:
1804     printf " %-15s %-25s \n",$$pr[0],$$pr[1];
1805     printf "%45s%-30s\n","--> ",$bold.$url.$normal;
1806     }
1807     else
1808     {
1809     # We have an area that is unreadable. Give a warning:
1810     printf ">> AREA MISSING: %-10s %-20s \n",$$pr[0],$$pr[1];
1811     }
1812 sashby 1.4 }
1813 sashby 1.2 }
1814     }
1815 sashby 1.4 print "\n\n","Projects available for platform >> ".$bold."$ENV{SCRAM_ARCH}".$normal." <<\n";
1816     print "\n";
1817 sashby 1.2 0;
1818     }
1819    
1820     sub arch
1821     {
1822     ###############################################################
1823     # arch() #
1824     ###############################################################
1825     # modified : Mon May 28 11:30:41 2001 / SFA #
1826     # params : #
1827     # : #
1828     # : #
1829     # : #
1830     # function : Show the information about current architecture. #
1831     # : #
1832     # : #
1833     ###############################################################
1834     &environmentinit();
1835 sashby 1.10
1836     print "$ENV{SCRAM_ARCH}\n";
1837 sashby 1.2 }
1838 hpw 1.1
1839    
1840     #
1841     # Setup a new tool
1842     #
1843    
1844 sashby 1.2 sub setup
1845     {
1846     ###############################################################
1847     # setup() #
1848     ###############################################################
1849     # modified : Mon May 28 11:30:45 2001 / SFA #
1850     # params : #
1851     # : #
1852     # : #
1853     # : #
1854     # function : Setup tools. #
1855     # : #
1856     # : #
1857     ###############################################################
1858     my $interactive=0;
1859    
1860     # process options
1861     while ( $ARGV[0] =~ "^-" )
1862     {
1863     if ( $ARGV[0] =~ /-i/ )
1864     {
1865     shift @ARGV;
1866     $interactive=1;
1867 hpw 1.1 }
1868 sashby 1.2 else
1869     {
1870     error("Unknown option $ARGV[0] to project command");
1871 hpw 1.1 }
1872 sashby 1.2 }
1873 hpw 1.1
1874 sashby 1.2 localtop();
1875    
1876     my $area=_localarea();
1877     my $toolname=shift @ARGV;
1878     my $insert=0;
1879     toolbox()->interactive($interactive);
1880    
1881     # If no toolname specified then its a full setup
1882     if ( $toolname eq "" )
1883     {
1884     # -- add architecture specific directories
1885     use Utilities::AddDir;
1886     AddDir::adddir($area->location()."/lib/$ENV{SCRAM_ARCH}");
1887     AddDir::adddir($area->location()."/bin/$ENV{SCRAM_ARCH}");
1888     # -- check the releasetop area
1889     # if the releasetop has the files copy them
1890     my $releaseobj=_releasearea();
1891     if ( $releaseobj->copysetup($ENV{LOCALTOP}) )
1892     {
1893     print "Doing Full Setup\n";
1894     scrambasics()->setuptoolsinarea($area);
1895     }
1896     }
1897     else
1898     {
1899     scrambasics()->setuptoolsinarea($area, $toolname,@ARGV);
1900     }
1901     }
1902 sashby 1.11
1903    
1904    
1905     ###########################
1906     ###########################
1907     ###########################
1908    
1909    
1910     sub autoset
1911     {
1912     ###############################################################
1913     # autoset #
1914     ###############################################################
1915     # modified : Wed Aug 22 15:06:01 2001 / SFA #
1916     # params : #
1917     # : #
1918     # : #
1919     # : #
1920     # function : Test routine for new set implementation #
1921     # : #
1922     # : #
1923     ###############################################################
1924     print "\n","*"x 80,"\n";
1925 sashby 1.12 print " This is a test routine for a new setup implementation \
1926     ==> not intended for release! <==\n";
1927 sashby 1.11 print "*"x 80,"\n\n";
1928    
1929 sashby 1.12 exit (0);
1930    
1931 sashby 1.11 ############################# Setup routine starts here #############
1932     my $interactive=0;
1933    
1934     # process options
1935     while ( $ARGV[0] =~ "^-" )
1936     {
1937     if ( $ARGV[0] =~ /-i/ )
1938     {
1939     shift @ARGV;
1940     $interactive=1;
1941     }
1942     else
1943     {
1944     error("Unknown option $ARGV[0] to project command");
1945     }
1946     }
1947    
1948     localtop();
1949    
1950     my $area=_localarea();
1951     my $toolname=shift @ARGV;
1952     my $insert=0;
1953     toolbox()->interactive($interactive);
1954    
1955     # If no toolname specified then its a full setup
1956     if ( $toolname eq "" )
1957     {
1958     # -- add architecture specific directories
1959     use Utilities::AddDir;
1960     AddDir::adddir($area->location()."/lib/$ENV{SCRAM_ARCH}");
1961     AddDir::adddir($area->location()."/bin/$ENV{SCRAM_ARCH}");
1962     # -- check the releasetop area
1963     # if the releasetop has the files copy them
1964     my $releaseobj=_releasearea();
1965     if ( $releaseobj->copysetup($ENV{LOCALTOP}) )
1966     {
1967     print "Doing Full Setup\n";
1968     scrambasics()->setuptoolsinarea($area);
1969     }
1970     }
1971     else
1972     {
1973     scrambasics()->setuptoolsinarea($area, $toolname,@ARGV);
1974     }
1975     ############################ Setup routine ends here #############
1976     }
1977    
1978    
1979 sashby 1.12 sub setroot
1980     {
1981     ###############################################################
1982     # setroot #
1983     ###############################################################
1984     # modified : Wed Nov 7 16:22:25 2001 / SFA #
1985     # params : #
1986     # : #
1987     # : #
1988     # : #
1989     # function : #
1990     # : #
1991     # : #
1992     # : #
1993     ###############################################################
1994     my $shell = shift @ARGV;
1995    
1996     # Check the shell argument...this must be supplied:
1997     if ($shell =~ "^-" )
1998     {
1999     # Remove the hyphen:
2000     $shell =~ s/-//;
2001     if ($shell ne "sh" && $shell ne "csh") {print "No shell given! Exitting.","\n"; exit(1);}
2002     }
2003     else
2004     {
2005     print "No shell given! Exitting.","\n";
2006     exit(1);
2007     }
2008    
2009     my $projectname=shift @ARGV;
2010     my $projectversion=shift @ARGV;
2011    
2012     # Check there were sufficient args:
2013     if ($projectname eq "" || $projectversion eq "")
2014     {
2015     error("\"scram setroot help\" for usage info.");
2016     &help_setroot;
2017     exit (0);
2018     }
2019     else
2020     {
2021 sashby 1.13 # Reset the LOCALTOP/RELEASETOP vars:
2022     $ENV{'LOCALTOP'}='';
2023     $ENV{'RELEASETOP'}='';
2024    
2025     # And on we go. Let's find a release area for this project/version:
2026 sashby 1.12 my $releasearea = scrambasics()->scramprojectdb()->getarea($projectname,$projectversion);
2027     print "No release area!!","\n" if ( ! defined ($releasearea));
2028 sashby 1.13
2029 sashby 1.12 # The info we need is stored in a hash and can be accessed using the key ENV.
2030     # Location info is accessed using keys LOCALTOP and RELEASETOP:
2031     foreach $key (keys %{${$releasearea}{'ENV'}})
2032     {
2033     if ( $key eq "LOCALTOP" || $key eq "RELEASETOP" )
2034     {
2035     printoutenv($shell,$key,${${$releasearea}{'ENV'}}{$key});
2036     }
2037     }
2038    
2039     # If LOCALTOP isn't defined, make it the same as RELEASETOP:
2040 sashby 1.13 if ( $ENV{'LOCALTOP'} eq '' )
2041 sashby 1.12 {
2042     printoutenv($shell,"LOCALTOP",${${$releasearea}{'ENV'}}{'RELEASETOP'});
2043     }
2044 sashby 1.13 0;
2045 sashby 1.12 }
2046     }
2047    
2048 sashby 1.11
2049     ###########################
2050     ###########################
2051     ###########################
2052    
2053 sashby 1.2
2054     sub _releasearea
2055     {
2056     ###############################################################
2057     # _releasearea() #
2058     ###############################################################
2059     # modified : Mon May 28 11:30:50 2001 / SFA #
2060     # params : #
2061     # : #
2062     # : #
2063     # : #
2064     # function : #
2065     # : #
2066     # : #
2067     ###############################################################
2068     if ( !defined $self->{releasearea} )
2069     {
2070     require Configuration::ConfigArea;
2071     $self->{releasearea}=Configuration::ConfigArea->new();
2072     $self->{releasearea}->bootstrapfromlocation($ENV{RELEASETOP});
2073     }
2074     return $self->{releasearea};
2075     }
2076 hpw 1.1
2077     # get a toolbox object for the local area
2078 sashby 1.2 sub toolbox
2079     {
2080     ###############################################################
2081     # toolbox() #
2082     ###############################################################
2083     # modified : Mon May 28 11:30:53 2001 / SFA #
2084     # params : #
2085     # : #
2086     # : #
2087     # : #
2088     # function : #
2089     # : #
2090     # : #
2091     ###############################################################
2092     if ( ! defined $toolbox )
2093     {
2094     localtop();
2095     my $area=_localarea();
2096     $toolbox=scrambasics()->areatoolbox($area);
2097     }
2098     return $toolbox;
2099     }
2100    
2101     sub help_db
2102     {
2103     ###############################################################
2104     # help_db() #
2105     ###############################################################
2106     # modified : Mon May 28 11:30:56 2001 / SFA #
2107     # params : #
2108     # : #
2109     # : #
2110     # : #
2111     # function : Show help for scram db command. #
2112     # : #
2113     # : #
2114     ###############################################################
2115     print <<ENDTEXT;
2116 hpw 1.1 scram database administration command.
2117    
2118     Usage:
2119    
2120     $bold scram db $normal subcommand
2121    
2122 sashby 1.2 Subcommands:
2123    
2124 hpw 1.1 link :
2125     Make available an additional database for
2126     project and list operations
2127    
2128     $bold scram db link $normal /a/directory/path/project.lookup
2129    
2130     unlink :
2131     Remove a database from the link list. Note this does
2132     not remove the database, just the link to it in scram.
2133    
2134     $bold scram db unlink $normal /a/directory/path/project.lookup
2135    
2136     showlinks :
2137     List the databases that are linked in
2138    
2139     ENDTEXT
2140 sashby 1.2 }
2141 hpw 1.1
2142 sashby 1.2 sub help_setup
2143     {
2144     ###############################################################
2145     # help_setup() #
2146     ###############################################################
2147     # modified : Mon May 28 11:31:02 2001 / SFA #
2148     # params : #
2149     # : #
2150     # : #
2151     # : #
2152     # function : Show help for scram setup command. #
2153     # : #
2154     # : #
2155     ###############################################################
2156     print <<ENDTEXT;
2157 hpw 1.1 Allows installation/re-installation of a new tool/external package into an
2158     already existing development area. If not toolname is specified,
2159     the complete installation process is initiated.
2160    
2161     Usage:
2162    
2163     $bold scram setup [-i]$normal [toolname] [[version] [url]]
2164    
2165     toolname : The name of the tool setup file required.
2166     version : where more than one version exists specify the version
2167     url : when setting up a completely new tool specify the url too
2168    
2169     The -i option turns off the automatic search mechanism allowing for more
2170     user interaction with the setup mechanism
2171     ENDTEXT
2172 sashby 1.2 }
2173 hpw 1.1
2174 sashby 1.2 sub help_list
2175     {
2176     ###############################################################
2177     # help_list() #
2178     ###############################################################
2179     # modified : Mon May 28 11:31:09 2001 / SFA #
2180     # params : #
2181     # : #
2182     # : #
2183     # : #
2184     # function : Show help for scram list command. #
2185     # : #
2186     # : #
2187     ###############################################################
2188     print <<ENDTEXT;
2189 hpw 1.1 List the available projects and versions installed in the local SCRAM database
2190     (see scram install help)
2191    
2192     Usage:
2193    
2194     $bold scram list $normal [ProjectName]
2195    
2196     ENDTEXT
2197 sashby 1.2 }
2198    
2199     sub help_remove
2200     {
2201     ###############################################################
2202     # help_remove() #
2203     ###############################################################
2204     # modified : Mon May 28 11:31:12 2001 / SFA #
2205     # params : #
2206     # : #
2207     # : #
2208     # : #
2209     # function : Show help for scram remove command. #
2210     # : #
2211     # : #
2212     ###############################################################
2213     print <<ENDTEXT;
2214 sashby 1.5 Remove a project entry from scram database file (\"project.lookup\").
2215 sashby 1.2
2216     Usage:
2217    
2218 sashby 1.5 $bold scram remove $normal [ProjectName] [Version]
2219 sashby 1.2
2220     ENDTEXT
2221     }
2222 hpw 1.1
2223 sashby 1.2 sub help_project
2224     {
2225     ###############################################################
2226     # help_project() #
2227     ###############################################################
2228     # modified : Mon May 28 11:31:16 2001 / SFA #
2229     # params : #
2230     # : #
2231     # : #
2232     # : #
2233     # function : Show help for scram project command. #
2234     # : #
2235     # : #
2236     ###############################################################
2237     print <<ENDTEXT;
2238 hpw 1.1 Setup a new project development area. The new area will appear in the current
2239     working directory.
2240     Usage:
2241    
2242     $bold scram project [-d install_area] [-n directory_name]$normal project_url [project_version]
2243    
2244     Options:
2245    
2246     project_url: The url of a scram bootstrap file.
2247     Currently supported types are:
2248     $bold Database label $normal
2249     Labels can be assigned to bootstrap files for easy
2250     access (See "scram install" command). If you
2251     specify a label you must also specify a project_version.
2252     e.g.
2253    
2254     scram project SCRAM V1_0
2255    
2256     scram project ORCA ORCA_1_1_1
2257    
2258     To see the list of installed projects use the
2259     "scram list" command.
2260    
2261     $bold file: $normal A regular file on an accessable file system
2262     e.g.
2263    
2264     file:~/myprojects/projecta/config/BootStrapFile
2265    
2266     project_version:
2267     Only for use with a database label
2268    
2269     -d install_area:
2270     Indicate a project installation area into which the new
2271     project area should appear. Default is the current working
2272     directory.
2273    
2274     -n directory_name:
2275     Specify the name of the SCRAM development area you wish to
2276     create.
2277    
2278     ENDTEXT
2279 sashby 1.2 }
2280 hpw 1.1
2281 sashby 1.2 sub help_version
2282     {
2283     ###############################################################
2284     # help_version() #
2285     ###############################################################
2286     # modified : Mon May 28 11:31:23 2001 / SFA #
2287     # params : #
2288     # : #
2289     # : #
2290     # : #
2291     # function : Show help for scram version command. #
2292     # : #
2293     # : #
2294     ###############################################################
2295     print <<ENDTEXT;
2296     With no $bold [version] $normal argument given, this command will simply
2297 hpw 1.1 print to standard output the current version number.
2298    
2299     Providing a version argument will cause that version to be downloaded and
2300     installed, if not already locally available.
2301    
2302    
2303     Usage:
2304     $bold scram version [version]$normal
2305    
2306     ENDTEXT
2307 sashby 1.2 }
2308 hpw 1.1
2309 sashby 1.2 sub help_arch
2310     {
2311     ###############################################################
2312     # help_arch() #
2313     ###############################################################
2314     # modified : Mon May 28 11:31:33 2001 / SFA #
2315     # params : #
2316     # : #
2317     # : #
2318     # : #
2319     # function : Show help for scram arch command. #
2320     # : #
2321     # : #
2322     ###############################################################
2323     print <<ENDTEXT;
2324 hpw 1.1 Print out the architecture flag for the current machine.
2325    
2326     Usage:
2327     $bold scram arch $normal
2328     ENDTEXT
2329 sashby 1.2 }
2330 hpw 1.1
2331 sashby 1.2 sub help_runtime
2332     {
2333     ###############################################################
2334     # help_runtime() #
2335     ###############################################################
2336     # modified : Mon May 28 11:31:37 2001 / SFA #
2337     # params : #
2338     # : #
2339     # : #
2340     # : #
2341     # function : Show help for scram runtime command. #
2342     # : #
2343     # : #
2344     ###############################################################
2345     print <<ENDTEXT;
2346 hpw 1.1 Echo to Standard Output the Runtime Environment for the current development area
2347     Output available in csh or sh flavours
2348    
2349     Usage:
2350     1) $bold scram runtime [-csh|-sh] $normal
2351     or
2352     2) $bold scram runtime [-csh|-sh] filename $normal
2353     or
2354     3) $bold scram runtime info filename [variable]$normal
2355    
2356     1) For the general configuration environment
2357     2) For environment described in filename or
2358     areatop/src/directory/BuildFile
2359     3) Display information concerning the environment in the given file
2360     (limited to variable if specified)
2361    
2362     The file for cases 2) and 3) are searched as follows :
2363     a) straightforward filename
2364     b) filename relative to local_area/src
2365     c) filename relative to release_area/src
2366     d) BuildFile relative to local_area/src
2367     e) BuildFile relative to release_area/src
2368    
2369     Examples:
2370    
2371     Setup the current environment to include the project Runtime Environment
2372     in a csh environment
2373    
2374     $bold eval `scram runtime -csh` $normal
2375    
2376     Setup the current environment to include the project Runtime Environment in a
2377     sh environment
2378    
2379     $bold eval `scram runtime -sh` $normal
2380    
2381 sashby 1.12 ENDTEXT
2382     }
2383    
2384    
2385     sub help_setroot
2386     {
2387     ###############################################################
2388     # help_setroot #
2389     ###############################################################
2390     # modified : Wed Nov 7 16:23:32 2001 / SFA #
2391     # params : #
2392     # : #
2393     # : #
2394     # : #
2395     # function : #
2396     # : #
2397     # : #
2398     # : #
2399     ###############################################################
2400     print <<ENDTEXT;
2401     Set a SCRAM-aware variable which points to a particular project area. This
2402     permits the setting of the runtime environment outside of the project area.
2403    
2404     Usage:
2405     $bold scram setroot $normal [ProjectName] [Version]
2406    
2407    
2408 hpw 1.1
2409     ENDTEXT
2410 sashby 1.2 }
2411 sashby 1.12