ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.66
Committed: Fri Dec 10 13:57:46 2004 UTC (20 years, 5 months ago) by sashby
Branch: MAIN
CVS Tags: HEAD
Changes since 1.65: +0 -0 lines
State: FILE REMOVED
Error occurred while calculating annotation data.
Log Message:
*** empty log message ***

File Contents

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