ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.49
Committed: Wed Aug 14 13:50:03 2002 UTC (22 years, 9 months ago) by sashby
Branch: MAIN
Changes since 1.48: +3 -3 lines
Log Message: 
Reverted to old build system.

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