ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.46
Committed: Tue May 21 10:57:34 2002 UTC (23 years ago) by sashby
Branch: MAIN
CVS Tags: V0_19_5, V0_19_4
Branch point for: V0_19_4_B
Changes since 1.45: +29 -102 lines
Log Message: 
Final commit.

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