ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.24
Committed: Fri Dec 7 11:36:51 2001 UTC (23 years, 5 months ago) by sashby
Branch: MAIN
Changes since 1.23: +6 -5 lines
Log Message:
*** empty log message ***

File Contents

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