ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.26
Committed: Wed Jan 16 10:22:40 2002 UTC (23 years, 4 months ago) by sashby
Branch: MAIN
Changes since 1.25: +1 -0 lines
Log Message:
Couple of fixes to wrapper scripts.

File Contents

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