ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.40
Committed: Fri Apr 26 14:12:42 2002 UTC (23 years ago) by sashby
Branch: MAIN
Changes since 1.39: +125 -8 lines
Log Message: 
*** empty log message ***

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