ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.27
Committed: Mon Jan 21 12:43:58 2002 UTC (23 years, 4 months ago) by sashby
Branch: MAIN
Changes since 1.26: +35 -0 lines
Log Message:
Adding verbose for main

File Contents

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