ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scramcli
Revision: 1.10
Committed: Wed Aug 22 12:40:13 2001 UTC (23 years, 9 months ago) by sashby
Branch: MAIN
Changes since 1.9: +7 -3 lines
Log Message:
Committing some minor changes. Disable bold feature for piping.

File Contents

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