ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.14
Committed: Fri Nov 9 14:15:14 2001 UTC (23 years, 6 months ago) by sashby
Branch: MAIN
Changes since 1.13: +46 -18 lines
Log Message: 
Improved list command and area-checking.

File Contents

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