ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/scram
(Generate patch)

Comparing COMP/SCRAM/src/scram (file contents):
Revision 1.1 by williamc, Mon Mar 1 10:37:54 1999 UTC vs.
Revision 1.35.2.1 by williamc, Thu Sep 21 12:45:49 2000 UTC

# Line 1 | Line 1
1 < #!/usr/local/bin/perl5 -I/afs/cern.ch/user/w/williamc/public/ConfigMan/toolbox/objects/schema1
1 > #!/usr/local/bin/perl5
2 > # ^^^^^^^^^^^^^^^^^^^^
3 > # we dont need this anymore to invoke perl but options placed here will be
4 > # used.
5   #
6   # User Interface
7   #
8 + # Make sure were running the right version
9 +
10 + versioncheck();
11  
12   $inputcmd=shift;
13   $found='false';
14 < @allowed_commands=qw(project build env install version list arch);
15 <
16 < foreach $command ( @allowed_commands ) {
17 <         do { &$command; $found='true'; last;} if ( $inputcmd=~/^$command\Z/i);
14 > $bold  = "\033[1m";
15 > $rv=0;
16 > $normal = "\033[0m";
17 > $self={};
18 >
19 > @allowed_commands=qw(project build install version list arch setup runtime db tool);
20 > @dev_cmds=qw(devtest align);
21 >
22 > if ( $inputcmd ne "" ) {
23 > foreach $command ( (@allowed_commands,@dev_cmds) ) {
24 >         if ( $command=~/^$inputcmd/i) {
25 >                # Deal with a help request
26 >                do{     helpheader($command);
27 >                        &{"help_".$command}; exit; } if $ARGV[0]=~/help/i;
28 >                $rv=&$command; $found='true';
29 >                last;
30 >         }
31 > }
32   }
33  
34   if ( ! ( $found=~/true/ ) ) {
35 <        print "scram help\n--------\n";
16 <        print "Recognised Commands: \n";
35 >        helpheader('Recognised Commands');
36          foreach $command ( @allowed_commands ) {
37 <        print "       ".$command."\n";  
37 >        print "      $bold scram ".$command.$normal."\n";      
38          }
39 +        print "\n";
40 +        print "Help on individual commands available through\n\n";
41 +        print "$bold       scram".$normal." command$bold help $normal\n\n";
42 + }
43 + exit $rv;
44 +
45 + sub error {
46 +        my $string=shift;
47 +        print "scram : ".$string."\n";
48 +        exit 1;
49 + }
50 +
51 + sub versioncheck {
52 +        my $version;
53 +
54 +        if ( @_ ) {
55 +           $version=shift;
56 +        }
57 +        else {
58 +         # -- get version from local area
59 +         if ( ! localtop_find() ) {
60 +         LoadEnvFile();
61 +         my $versionfile=$ENV{LOCALTOP}."/$ENV{projconfigdir}/scram_version";
62 +          if ( -f $versionfile ) {
63 +           open (VERSION, "<".$versionfile);
64 +            $version=<VERSION>;
65 +            chomp $version;
66 +          }
67 +         }
68 +        }
69 +        if ( defined $version ) {
70 +          scrambasics()->spawnversion($version,@ARGV);
71 +        }
72 + }
73 +
74 + sub _processcmds {
75 +        my $optionhandler=shift;
76 +        my $allowed_commands=shift;
77 +        my $cmds=shift;
78 +        my @subs=@_;
79 +
80 +        my $found='false';
81 +        # make a string from the subcommand levels
82 +        my $substring="";
83 +        if ( @subs ) {
84 +           $substring= join '_', @subs;
85 +           $substring=$substring."_";
86 +        }
87 +
88 +        # Process options
89 +        if ( defined ${$cmds}[0] ) {
90 +        while ( ${$cmds}[0]=~/^-/) {
91 +           &{$optionhandler}( ${$cmds}[0],$cmds);
92 +        }
93 +
94 +        my $inputcmd=shift @{$cmds};
95 +        if ( $inputcmd ne "" ) {
96 +         foreach $command ( @{$allowed_commands} ) {
97 +           if ( $command=~/^$inputcmd/i) {
98 +                # Deal with a help request
99 +                if ( ( defined $$cmds[0]) && $$cmds[0]=~/help/i ) {
100 +                   &helpheader($command,@subs);
101 +                   &{"help_".$substring.$command}; exit;
102 +                }
103 +                else {
104 +        #print "calling $substring".$command."(@{$cmds})\n";
105 +                   &{$substring.$command}(@{$cmds}); $found='true';
106 +                   last;
107 +                }
108 +           }
109 +         }
110 +        }
111 +        }
112 +        return $found;
113 + }
114 +
115 +
116 + sub help_build {
117 +        &build;
118 + }
119 +
120 + sub align {
121 +        _localarea()->align();
122   }
123  
124   sub build {
125          # is this a based or free release?
126          FullEnvInit();
127 <        use BuildSetup;
128 <        BuildSetup($ENV{THISDIR},@ARGV);
129 < #       system("$ENV{TOOL_HOME}/BuildSetup",$ENV{THISDIR},@ARGV);
127 >        use BuildSystem::BuildSetup;
128 >        $ENV{MAKETARGETS}=join ' ',@ARGV;
129 >        my $bs=BuildSystem::BuildSetup->new(toolbox());
130 >        $rv=$bs->BuildSetup($ENV{THISDIR},@ARGV);
131 >        $rv;
132   }
133  
134   sub project {
135 <        my $project=shift @ARGV;
136 <        my $version=shift @ARGV;
137 <        environmentinit();
138 <        use File::Copy;
139 <        use AddDir;
135 >        my @args=@ARGV;
136 >
137 >        my $devareaname="";
138 >        use Cwd;
139 >        my $installarea=cwd();
140 >
141 >        # process options
142 >        while ( $args[0]=~"^-" ) {
143 >         if ( $args[0]=~/-n/ ) {
144 >           shift @args;
145 >           $devareaname=shift @args;
146 >         }
147 >         elsif ( $args[0]=~/-d/ ) {  #installation area directory
148 >          shift @args;
149 >          $installarea=$args[0];
150 >          if ( ! -d $installarea ) {
151 >                error("$installarea does not exist");
152 >          }
153 >          shift @args;
154 >         }
155 >         else {
156 >          error("unknown option $args[0] to project command");
157 >         }
158 >        }
159 >
160 >        # -- check what arguments have been passed
161 >        if ( $#args <0 || $#args>1 ) {
162 >          error("\"scram project help\" for usage info");
163 >        }
164 >        my $area; #somewhere to store the area object when we have it
165 >
166 >        if ( ( $#args==0 ) && ($args[0]=~/:/) ) {
167 >          # -- must be a url to bootstrap from
168 >          $area=scrambasics()->project($args[0], $installarea,
169 >                                                $devareaname);
170 >          scrambasics()->setuptoolsinarea($area);
171 >        }
172 >        elsif ( $#args >0 ) {
173 >          # -- need to create a satellite area
174 >          $area=scrambasics()->satellite(@args,$installarea, $devareaname);
175 >        }
176 >        else {
177 >          error("\"scram project help\" for usage info");
178 >        }
179          
180 <           print "Warning : - you are entering a development zone.".
181 <                " Don't complain if it don't work\n";
182 <           use BootStrapProject;
183 <           # get the bootstrap files downloaded
184 <           BootStrapProject("$project\?\?$version");
185 <           # Go setup the rest of the environement, now we can
186 <           chdir $ENV{LOCALTOP};
187 <           &localtop;
188 <           LoadEnvFile();
189 <           #
190 <           # Now create the directories specified in the interface
191 <           #
192 <           foreach $key ( keys %ENV ) {
193 <                if ( $key=~/^INT/ ) {
194 <                        adddir($ENV{$key});
195 <                }
180 >        #
181 >        # Now create the directories specified in the interface
182 >        # There should be some better mechanism - TODO
183 >        #
184 >        chdir $area->location();
185 >        foreach $key ( keys %ENV ) {
186 >         if ( $key=~/^INT/ ) {
187 >                AddDir::adddir($ENV{$key});
188 >         }
189 >        }
190 >
191 >        print "\nInstallation Procedure Complete. \n".
192 >                "Installation Located at:\n".$area->location()."\n";
193 > }
194 >
195 > sub scrambasics {
196 >        require Scram::ScramFunctions;
197 >        if ( ! defined $scramobj ) {
198 >           environmentinit();
199 >           $scramobj=Scram::ScramFunctions->new();
200 >           $scramobj->arch($ENV{SCRAM_ARCH});
201 >           #$scramobj->verbosity(1);
202 >        }
203 >        return $scramobj;
204 > }
205 >
206 > # ------------ tool command --------------------------------------------
207 > sub tool {
208 >        @_=@ARGV;
209 >        localtop();
210 >        environmentinit();
211 >        my @allowed_cmds=qw(info list default setup);
212 >        _processcmds("_tooloptions", \@allowed_cmds, \@_, ("tool"));    
213 > }
214 >
215 > sub tool_default {
216 >        if ( $#_ != 1 ) {
217 >          error("\"scram tool default help\" for usage information");
218 >        }
219 >        my $tool=shift;
220 >        my $version=shift;
221 >        print "Setting default version of $tool to $version\n";
222 >        # -- adjust the toolbox
223 >        toolbox()->setdefault($tool,$version);
224 >
225 > }
226 >
227 > sub tool_list {
228 >        my $area=_localarea();
229 >        print "Tool List for "; #.$area->name()." ".$area->version()."\n";
230 >        print "Location : ".$area->location()."\n";
231 >        print "+"x60;
232 >        print "\n";
233 >        foreach $t ( toolbox()->tools() ) {
234 >          my $vers=join / /, toolbox()->versions($t);
235 >          print $t." ".$vers." (default=".toolbox()->defaultversion($t).")\n";
236 >        }
237 > }
238 >
239 > sub tool_info {
240 >        my $project=shift;
241 >        my $area=_localarea();
242 >        print "Tool Info as configured in ";
243 >                        #.$area->name()." ".$area->version()."\n";
244 >        print "Location : ".$area->location()."\n";
245 >        print "+"x60;
246 >        print "\n";
247 >
248 >        my @tools=toolbox()->gettool($project,@_);
249 >        foreach $t ( @tools ) {
250 >          if ( defined $t ) {
251 >           print "Name : ".$t->name();
252 >           print "\n";
253 >           print "Version : ".$t->version();
254 >           print "\n";
255 >           print "Docfile : ".$t->url();
256 >           print "\n";
257 >           print "+"x20;
258 >           print "\n";
259 >           @features=$t->features();
260 >           foreach $ft ( @features ) {
261 >             @vals=$t->getfeature($ft);
262 >             foreach $v ( @vals ) {
263 >               print $ft. "=$v\n";
264 >             }
265 >           }
266 >          }
267 >        }
268 > }
269 >
270 > sub tool_setup {
271 >        print "Please use scram setup command\n";
272 > }
273 >
274 > sub _tooloptions {
275 >        error("No Options defined for tool subcommand");
276 > }
277 >
278 > sub help_tool {
279 > print <<ENDTEXT;
280 > Manage the tools in the scram area that define the areas environment.
281 > tool subcommands :
282 >        list
283 >        info tool_name
284 >        default tool_name tool_version
285 >
286 > ENDTEXT
287 > }
288 >
289 > sub help_tool_info {
290 > print <<ENDTEXT;
291 > Description:
292 >        Print out information on the specified tool in the current area
293 >        configuration.
294 > Usage :
295 >        scram tool info tool_name [tool_version]
296 >
297 > ENDTEXT
298 > }
299 >
300 > sub help_tool_list {
301 > print <<ENDTEXT;
302 > Description:
303 >        List of currently configured tools available in ther current scram
304 >        area
305 > Usage :
306 >        scram tool list
307 >
308 > ENDTEXT
309 > }
310 >
311 > sub help_tool_default {
312 > print <<ENDTEXT;
313 > Description:
314 >        Change the default version of a tool to be used in the area
315 > Usage :
316 >        scram tool default tool_name tool_version
317 >
318 > ENDTEXT
319 > }
320 >
321 > # ----------------------------------------------------------------------
322 > sub _requirements {
323 >        if ( ! defined $reqsobj ) {
324 >          localtop();
325 >          my $area=_localarea();
326 >          scrambasics()->arearequirements($area)
327 >        }
328 >        return $reqsobj;
329 > }
330 >
331 > sub _allprojectinitsearcher {
332 >        my $search=_projsearcher();
333 >        foreach $proj ( _scramprojdb()->list() ) {
334 >           $search->addproject($$proj[0],$$proj[1]);
335 >        }
336 > }
337 >
338 > sub _projsearcher {
339 >        if ( ! defined $self->{projsearcher} ) {
340 >          require Scram::ProjectSearcher;
341 >          $self->{projsearcher}=Scram::ProjectSearcher->new(_scramprojdb());
342 >        }
343 >        return $self->{projsearcher};
344 > }
345 >
346 > sub _scramprojdb {
347 >        return scrambasics()->scramprojectdb();
348 > }
349 >
350 > sub runtime {
351 >        my $shell;
352 >        require Runtime;
353 >
354 >        # process options
355 >        while ( $ARGV[0]=~"^-" ) {
356 >         if ( $ARGV[0]=~/-sh/ ) {
357 >           shift @ARGV;
358 >           $shell="sh";
359 >           next;
360 >         }
361 >         if ( $ARGV[0]=~/-csh/ ) {  #installation area directory
362 >          shift @ARGV;
363 >          $shell="csh";
364 >          next;
365 >         }
366 >         print "Unknown Option $ARGV[0]\n";
367 >         exit 1;
368 >        }
369 >
370 >        FullEnvInit();
371 >        if ( @ARGV ) {
372 >           my $runtime=Runtime->new();
373 >           my $arg=shift @ARGV;
374 >
375 >           my $info=0;
376 >           if ( $arg eq "info" ) {
377 >              $arg=shift @ARGV;
378 >              $info=1;
379 >           }
380 >
381 >           # --- determine filename
382 >           my $filename;
383 >           if ( -f $arg ) { # Is it a file?
384 >              $filename=$arg;
385             }
386 <           use clientfile;
387 <           BuildClientFile( $ENV{SCRAM_ProjReqsDoc} );
386 >           else {
387 >               # -- lets see if its a BuildFile location
388 >               $filename=_testfile($ENV{LOCALTOP}."/src/".$arg,
389 >                                $ENV{RELEASETOP}."/src/".$arg,
390 >                                $ENV{LOCALTOP}."/src/".$arg."/BuildFile",
391 >                                $ENV{RELEASETOP}."/src/".$arg."/BuildFile");
392 >               if ( $filename eq "" ) {
393 >                   print "Unable to find a file (or BuildFile) relating to ".
394 >                        $arg."\n";
395 >                   exit 1;
396 >               }
397 >           }
398 >           $runtime->file($filename);
399 >           if ( ! $info ) {
400 >             $runtime->printenv($shell);
401 >           }
402 >           else {
403 >             if ( @ARGV ) { #do we have a specific variable request?
404 >                  _printvardoc($runtime,shift @ARGV);
405 >             }
406 >             else {
407 >                foreach $var ( $runtime->list() ) {
408 >                  _printvardoc($runtime,$var);
409 >                }
410 >             }
411 >           }
412 >           undef $runtime;
413 >        }
414 >        else {
415 >        FullEnvInit();
416 >        # We have to clean up from the last runtime cmd - use env history
417 >        foreach $variable ( %ENV ) {
418 >          if ( $variable=~/^SCRAMRT_(.*)/ ) { #SCRAMRT are history retaining
419 >            my $var=$1;
420 >            $ENV{$var}=~s/\Q$ENV{$variable}\E//g;
421 >            $ENV{$var}=~s/^:*//;  # Deal with any Path variables
422 >            #print "$variable : $ENV{$variable} \n$var : $ENV{$var}\n";
423 >            delete $ENV{$variable};
424 >          }
425 >        }
426 >
427 >        # -- Set SCRAM release area paths
428 >        addpath("LD_LIBRARY_PATH","$ENV{LOCALTOP}/lib/$ENV{SCRAM_ARCH}");
429 >        addpath("LD_LIBRARY_PATH","$ENV{RELEASETOP}/lib/$ENV{SCRAM_ARCH}");
430 >
431 >        # -- get the tool runtime environments
432 >        my $toolbox=toolbox();
433 >        foreach $tool ( $toolbox->tools() ) {
434 >          $tool=$toolbox->gettool($tool);
435 >          
436 >          if ( defined $tool ) {
437 >           # -- get runtime paths
438 >           foreach $f ( $tool->listtype("runtime_path")) {
439 >            foreach $val ( $tool->getfeature($f) ) {
440 >              addpath($f,$val);
441 >            }
442 >           }
443 >           # -- get runtime vars
444 >           foreach $f ( $tool->listtype("runtime")) {
445 >            foreach $val ( $tool->getfeature($f) ) {
446 >              $EnvRuntime{$f}=$val;
447 >            }
448 >           }
449 >          }
450 >        }
451 >
452 >        addpath("PATH","$ENV{LOCALTOP}/bin/$ENV{SCRAM_ARCH}");
453 >        addpath("PATH","$ENV{RELEASETOP}/bin/$ENV{SCRAM_ARCH}");
454 >
455 >        # Now get the general project environment
456 >        open ( SCRAMENV, "<$ENV{LOCALTOP}/$ENV{projconfigdir}/Runtime" );
457 >        while ( <SCRAMENV> ) {
458 >           chomp;
459 >           next if /^#/;
460 >           next if /^\s*$/;
461 >           ($name, $value)=split /=/;
462 >           addvar($name, (eval $value)," ");
463 >        }
464 >        close SCRAMENV;
465 >
466 >        # create new SCRAMRT history vars.
467 >        foreach $variable ( keys %EnvRuntime ) {
468 >          printoutenv($shell,"SCRAMRT_$variable",$EnvRuntime{$variable});
469 >          #addvar("SCRAMRT_$variable", $EnvRuntime{$variable}, "");
470 >        }
471 >        # Now adapt as necessary - include base environment as well
472 >        if ( exists $ENV{LD_LIBRARY_PATH} ) {
473 >           addpath("LD_LIBRARY_PATH","$ENV{LD_LIBRARY_PATH}");
474 >        }
475 >        if ( exists $ENV{MANPATH} ) {
476 >           addpath("MANPATH","$ENV{MANPATH}");
477 >        }
478 >        addpath("PATH","$ENV{PATH}");
479 >        # Print out as reqd
480 >        foreach $variable ( keys %EnvRuntime ) {
481 >          printoutenv($shell,$variable,$EnvRuntime{$variable});
482 >        }
483 >        }
484 > }
485 >
486 > # Support rt for runtime
487 >
488 > sub _testfile {
489 >        my @files=@_;
490 >
491 >        my $filename="";
492 >        foreach $file ( @files ) {
493 >          if ( -f $file ) {
494 >                $filename=$file;
495 >                last;
496 >          }
497 >        }
498 >        return $filename;
499 > }
500 >
501 > sub _printvardoc {
502 >        my $runtime=shift;
503 >        my $var=shift;
504 >
505 >        print $var." :\n";
506 >        print $runtime->doc($var);
507 >        print "\n";
508 > }
509 >
510 > sub printoutenv {
511 >        my $shell=shift;
512 >        my $variable=shift;
513 >        my $value=shift;
514 >
515 >        if ( $shell eq "csh" ) {
516 >          print "setenv $variable \"$value\";\n";
517 >        }
518 >        elsif ( $shell eq "sh" ) {
519 >          print "$variable=\"$value\";\n";
520 >          print "export $variable;\n";
521 >        }
522 > }
523 >
524 > sub addpath {
525 >        my $name=shift;
526 >        my $val=shift;
527 >
528 >        my $n;
529 >        my @env;
530 >        @env=split /:/, $EnvRuntime{$name};
531 >        foreach $n ( (split /:/, $val ) ){
532 >         if (  ! grep /^\Q$n\E$/, @env ) {
533 >          addvar($name,$n,":");
534 >         }
535 >        }
536 > }
537 >
538 > sub addvar {
539 >        my $name=shift;
540 >        my $val=shift;
541 >        my $sep=shift;
542 >
543 >        if ( $val ne "" ) {
544 >        if ( defined $EnvRuntime{$name} ) {
545 >         $EnvRuntime{$name}=$EnvRuntime{$name}.$sep.$val;
546 >        }
547 >        else {  
548 >         $EnvRuntime{$name}=$val;
549 >        }
550 >        }
551   }
552 +
553   sub FullEnvInit {
554      environmentinit();
555      localtop();
# Line 61 | Line 557 | sub FullEnvInit {
557   }
558  
559   sub environmentinit {
560 <        use setarchitecture;
560 >        use Utilities::setarchitecture;
561          my $name;
562          my $value;
563  
564          $ENV{LatestBuildFile}=""; # stop recursive behaviour in make
565 <        setarch();
565 >        setarchitecture::setarch();
566          $ENV{INTwork}="tmp/$ENV{SCRAM_ARCH}";
567          $ENV{INTlib}="lib/$ENV{SCRAM_ARCH}";
568          $ENV{INTsrc}="src";
569          $ENV{INTbin}="bin/$ENV{SCRAM_ARCH}";
570          $ENV{INTlog}="logs";
571  
572 <        if ( ! ( exists $ENV{SCRAM_HOME}) ){
573 <         $ENV{SCRAM_HOME}="/afs/cern.ch/user/w/williamc/public/ConfigMan";
574 <         print "Warning : Environment Variable SCRAM_HOME not set.\n";
79 <         print "Defaulting to $ENV{SCRAM_HOME}\n";
572 >        ($ENV{SCRAM_BASEDIR}=$ENV{SCRAM_HOME})=~s/(.*)\/.*/$1/;
573 >        if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){
574 >                $ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/configuration";
575          }
576 <         if ( ! ( exists $ENV{SCRAM_CONFIG} ) ){
577 <                $ENV{SCRAM_CONFIG}="$ENV{SCRAM_HOME}/Configuration";
576 >        $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
577 >        if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) ){
578 >                if ( -d "$ENV{SCRAM_BASEDIR}/scramdb/" ) {
579 >                  $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_BASEDIR}/scramdb/project.lookup";
580 >                }
581 >                else {
582 >                  $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
583 >                }
584          }
585 <        if ( ! ( exists $ENV{TOOL_HOME} ) ){
586 <                $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/toolbox";
585 >        $ENV{SCRAM_AVAILDIRS}="";
586 >        $ENV{SCRAM_AVAILFILES}="";
587 > }
588 >
589 > sub _localarea {
590 >        if ( ! defined $self->{localarea} ) {
591 >          require Configuration::ConfigArea;
592 >          $self->{localarea}=Configuration::ConfigArea->new();
593 >          if ( ! defined $ENV{LOCALTOP} ) {
594 >           if ( $self->{localarea}->bootstrapfromlocation() ) {
595 >            # Were not in a local area
596 >            undef $self->{localarea};
597 >           }
598 >           else {
599 >             $self->{localarea}->archname(scrambasics()->arch());
600 >           }
601 >          }
602 >          else {
603 >            $self->{localarea}->bootstrapfromlocation($ENV{LOCALTOP});
604 >          }
605          }
606 <        if ( ! ( exists $ENV{SCRAM_LOOKUPDB} ) ){
607 <                $ENV{SCRAM_LOOKUPDB}="$ENV{SCRAM_CONFIG}/project.lookup";
606 >        return $self->{localarea};
607 > }
608 >
609 > sub localtop_find {
610 >        my $rv=1;
611 >        if ( defined _localarea()) {
612 >          $rv=0;
613 >          $ENV{LOCALTOP}=_localarea()->location();
614          }
615 +        return $rv;
616   }
617  
618   sub localtop {
619 <        # find localtop
94 <        use Cwd;
95 <        my $thispath=cwd;
96 <        block: {
97 <        do {
98 <          if ( -e "$thispath/.SCRAM" ) {
99 <                $ENV{LOCALTOP}=$thispath;
100 <                last block;
101 <          }
102 <        } while ( ( $thispath=~s/(.*)\/.*/$1/ )=~/./  );
619 >        localtop_find();
620          if ( ! (defined $ENV{LOCALTOP}) ) {
621           print "Unable to locate the top of local release. Exiting\n";
622 <         exit 1
622 >         exit 1;
623          }
624 <        } #end block
108 <        ($ENV{THISDIR}=cwd)=~s/^$ENV{LOCALTOP}//;
624 >        ($ENV{THISDIR}=cwd)=~s/^\Q$ENV{LOCALTOP}\L//;
625          $ENV{THISDIR}=~s/^\///;
110        $ENV{SCRAM_WORKDIR}="$ENV{LOCALTOP}/.SCRAM";
626   }
627  
628   sub LoadEnvFile {
629 <        open ( SCRAMENV, "<$ENV{SCRAM_WORKDIR}/Environment" ) ||
115 <                die "Cant find Environment file $!\n";
116 <        while ( <SCRAMENV> ) {
117 <           chomp;
118 <           next if /^#/;
119 <           next if /^\s*$/ ;
120 <           ($name, $value)=split /=/;
121 <           eval "\$ENV{${name}}=\"$value\"";
122 <        }
123 <        close SCRAMENV;
629 >        _localarea()->copyenv(\%ENV);
630   }
631  
632   sub env {
633     print "Sorry - Not yet\n";
634   }
635  
636 + sub devtest {
637 +        require Utilities::TestClass;
638 +        my $class=shift @ARGV;
639 +
640 +        my $tester;
641 +        my $path;
642 +
643 +        #_initproject();
644 +        if ( $class=~/::/ ) {
645 +           ($path=$class)=~s/(.*)::.*/$1/;
646 +        }
647 +        $tester=Utilities::TestClass->new($class,
648 +                "$ENV{SCRAM_HOME}/src/$path/test/testdata");
649 +        $tester->dotest(@_);
650 + }
651 +
652   #
653   # Create a lookup tag in the site database
654   #
655 < sub install ( $tagname, $version ) {
656 <        my $tagname=shift @ARGV;
657 <        my $version=shift @ARGV;
658 <
137 <        # create database entry
138 <        do { &help_install; } if $tagname=~/help/i;
139 <        &FullEnvInit;
140 <        if ( $version eq "" ) {
141 <           $version=$ENV{SCRAM_PROJVERSION};
142 <        }
143 <        if ( $tagname eq "" ) {
144 <           $tagname=$ENV{SCRAM_PROJECTNAME};
145 <        }
146 <        my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
147 <        my $outfile="$ENV{SCRAM_CONFIG}/project.lookup.tmp";
148 <        open ( LOCALLOOKUPDB, "<$filename" );
149 <        open ( OUTFILE , ">$outfile" );
150 <        while ( <LOCALLOOKUPDB> ) {
151 <            if ( /^$tagname/ ) {
152 <                print "Related tag :".$_."\n";
153 <                if ( /$version/) {
154 <                  print "$tagname $version already exists. Overwrite (y/n)\n";
155 <                  if ( ! (<STDIN>=~/y/i ) ) {
156 <                        print "Aborting install ...\n";
157 <                        close OUTFILE;
158 <                        close LOCALLOOKUPDB;
159 <                        exit 1;
160 <                  }
161 <                }
162 <                else {
163 <                        print OUTFILE $_;
164 <                }
165 <            }
166 <            else {
167 <                print OUTFILE $_;
168 <            }
169 <        }
170 <        print OUTFILE "$tagname:$version:file:$ENV{LOCALTOP}".
171 <                "/.SCRAM/InstallFile\n";
172 <        close OUTFILE;
173 <        close LOCALLOOKUPDB;
174 <        copy ( "$outfile", "$filename" )
175 <                || die "Unable to copy $! \n";
176 <
655 > sub install {
656 >        localtop();
657 >        scrambasics()->addareatoDB(_localarea(),@ARGV);
658 >        _localarea()->align();
659   }
660  
661   sub help_install()  {
662  
181 helpheader("install");
663   print <<ENDTEXT;
664   Associates a label with the current release in the SCRAM database.
665   This allows other users to refer to a centrally installed project by
# Line 186 | Line 667 | this label rather than a remote url refe
667  
668   Usage:
669  
670 <                 scram install [[label] [version]]
670 >        $bold   scram install $normal [project_tag [version_tag]]
671  
672 < label   : override default label (the project name of the current release)
673 < version : the version tag of the current release. If version is not
672 > porject_tag : override default label (the project name of the current release)
673 > version_tag : the version tag of the current release. If version is not
674            specified the base release version will be taken by default.
675  
676   ENDTEXT
196 exit;
677   }
678  
679   sub helpheader ($label) {
# Line 206 | Line 686 | ENDTEXT
686   }
687  
688   sub version {
689 <        print "Scram version : prototype\n";
689 >        my $version=shift @ARGV;
690 >        my $thisversion;
691 >        my $scram_top;
692 >        my $cvsobject;
693 >
694 >        ($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
695 >        $scram_top=$1;
696 >        if ( $version eq "" ) {
697 >          print "$thisversion";
698 >          # deal with links
699 >          $version=readlink $ENV{SCRAM_HOME};
700 >          if ( defined $version)  {
701 >                print " ---> $version";
702 >          }
703 >          print "\n";
704 >        }
705 >        else {
706 >          if ( -d $scram_top."/".$version ) {
707 >                print "Version $version exists\n";
708 >          }
709 >          else {
710 >              print "Version $version not available locally\n";
711 >              print "Attempting download from the SCRAM repository\n";
712 >              # set up and configure the cvs module for SCRAM
713 >              require Utilities::CVSmodule;
714 >              $cvsobject=Utilities::CVSmodule->new();
715 >              $cvsobject->set_base(
716 >                "cmscvs.cern.ch:/cvs_server/repositories/SCRAM");
717 >              $cvsobject->set_auth("pserver");
718 >              $cvsobject->set_user("anonymous");
719 >              $cvsobject->set_passkey("AA_:yZZ3e");
720 >              # Now check it out in the right place
721 >              chdir $scram_top or die "Unable to change to $scram_top $!\n";
722 >              $cvsobject->invokecvs( ( split / /,
723 >                        "co -d $version -r $version SCRAM" ));
724 >                
725 >              # Get rid of cvs object now weve finished
726 >              $cvsobject=undef;
727 >              print "\n";
728 >          }
729 >        }
730 >        0;
731   }
732  
733   sub list {
734          &environmentinit;
735 <        my $filename="$ENV{SCRAM_CONFIG}/project.lookup";
736 <        open ( LOCALLOOKUPDB, "<$filename" );
735 >        my $filename="$ENV{SCRAM_LOOKUPDB}";
736 >        if ( ! -f $ENV{SCRAM_LOOKUPDB} ) {
737 >          print "No installation database available - perhaps no projects".
738 >                " have been installed locally\n";
739 >          exit 1;
740 >        }
741          print "Installed Projects\n";
742          print "------------------\n";
743          print "|Project Name  | Project Version |\n";
744          print "----------------------------------\n";
745 <        while ( <LOCALLOOKUPDB> ) {
746 <          ( $name, $version, $type, $url ) = split ":", $_;
745 >        listdb($filename);
746 > }
747 >
748 > sub db {
749 >        my $subcmd=shift @ARGV;
750 >        &environmentinit;
751 >
752 >        switch : {
753 >        if ( $subcmd eq 'link' ) {
754 >          dblink($ENV{SCRAM_LOOKUPDB},@ARGV);
755 >          last switch;
756 >        }
757 >        if ( ! -f $ENV{SCRAM_LOOKUPDB} ) {
758 >          print "No installation database available - perhaps no projects".
759 >                "have been installed locally\n";
760 >          exit 1;
761 >        }
762 >        if ( $subcmd eq 'unlink' ) {
763 >          dbunlink($ENV{SCRAM_LOOKUPDB},@ARGV);
764 >          last switch;
765 >        }
766 >        if ( $subcmd eq 'showlinks' ) {
767 >          dblinklist($ENV{SCRAM_LOOKUPDB});
768 >          last switch;
769 >        }
770 >        } # end switch
771 >        
772 > }
773 >
774 > sub dblinklist {
775 >        my $filename=shift;
776 >        open (LOCALLOOKUPDB, "<$filename")  or
777 >                die "Unable to open local database $!";
778 >        while (<LOCALLOOKUPDB>) {
779 >          if ( $_=~/\!DB (.*)/) {
780 >            print $1,"\n";
781 >          }
782 >        }
783 >        close LOCALLOOKUPDB;
784 > }
785 >
786 > sub dblink {
787 >        my $filename=shift;
788 >        my $newdbfilename=shift;
789 >        my $exists=0;
790 >
791 >        if ( -e $filename ) {
792 >         if ( -e $newdbfilename ) {
793 >         # Check if its already there
794 >          open (LOCALLOOKUPDB, "<$filename")  or
795 >                die "Unable to open local database $!";
796 >           while (<LOCALLOOKUPDB>) {
797 >            if ( $_=~/\!DB $newdbfilename/ ) {
798 >                $exists=1;
799 >                last;
800 >            }
801 >           }
802 >          close LOCALLOOKUPDB;
803 >          # Add it
804 >          if ( ! $exists ) {
805 >            open (LOCALLOOKUPDB, ">>$filename")  or
806 >                die "Unable to open local database $!";
807 >            print LOCALLOOKUPDB "\!DB $newdbfilename\n";
808 >            close LOCALLOOKUPDB;
809 >          }
810 >         }
811 >         else {
812 >          print "Unknown file $newdbfilename\n";
813 >          exit 1;
814 >         }
815 >        }
816 >        else {
817 >          print "Unknown file $filename $!\n";
818 >          exit 1;
819 >        }
820 >        
821 > }
822 >
823 > sub dbunlink {
824 >        my $filename=shift;
825 >        my $dbfilename=shift;
826 >        if ( -e $filename ) {
827 >         # Check if its already there
828 >         open (LOCALLOOKUPDB, "<$filename")  or
829 >                die "Unable to open local database $!";
830 >         open (DBOUTFILE, ">$filename.tmp") or
831 >                die "Unable to open working file $!";
832 >         while (<LOCALLOOKUPDB>) {
833 >            if ( $_!~/\!DB $dbfilename/ ) {
834 >                print DBOUTFILE $_;
835 >            }
836 >           }
837 >         close LOCALLOOKUPDB;
838 >         close DBOUTFILE;
839 >         use File::Copy;
840 >         rename "$filename.tmp", $filename;
841 >        }
842 > }
843 >
844 > sub listdb {
845 >        my $filename=shift;
846 >        my $map;
847 >
848 >        use FileHandle;
849 >        my $fh=FileHandle->new();
850 >        open ( $fh, "<$filename" );
851 >        while ( $map=<$fh> ) {
852 >          if ( $map=~/^\!DB (.*)/ ) { # Check for other DB files
853 >                my $db=$1;
854 >                if ( -f $db ) {
855 >                  listdb($db);
856 >                }
857 >                next;
858 >          }
859 >          ( $name, $version, $type, $url ) = split ":", $map;
860            printf "%1s",$name;
861            printf "%25s\n",$version;
862            printf "--> %25s\n",$type.":".$url;
863          }
864 <        close LOCALLOOKUPDB;
864 >        close $fh;
865 >        0;
866   }
867  
868   sub arch {
869          &environmentinit();
870          print "$ENV{SCRAM_ARCH}\n";
871   }
872 +
873 +
874 + #
875 + # Setup a new tool
876 + #
877 +
878 + sub setup {
879 +        my $interactive=0;
880 +
881 +        # process options
882 +        while ( $ARGV[0]=~"^-" ) {
883 +         if ( $ARGV[0]=~/-i/ ) {
884 +           shift @ARGV;
885 +           $interactive=1;
886 +         }
887 +         else {
888 +          error("scram: unknown option $ARGV[0] to project command");
889 +         }
890 +        }
891 +
892 +        localtop();
893 +        my $area=_localarea();
894 +        my $toolname=shift @ARGV;
895 +        my $insert=0;
896 +        toolbox()->interactive($interactive);
897 +
898 +        # If no toolname specified then its a full setup
899 +        if ( $toolname eq "" ) {
900 +           # -- add architecture specific directories
901 +           use Utilities::AddDir;
902 +           AddDir::adddir($area->location()."/lib/$ENV{SCRAM_ARCH}");
903 +           AddDir::adddir($area->location()."/bin/$ENV{SCRAM_ARCH}");
904 +        
905 +           # -- check the releasetop area
906 +           # if the releasetop has the files copy them
907 +           my $releaseobj=_releasearea();
908 +           if ( $releaseobj->copysetup($ENV{LOCALTOP}) ) {
909 +              print "Doing Full Setup\n";
910 +              scrambasics()->setuptoolsinarea($area);
911 +           }
912 +        }
913 +        else {
914 +            scrambasics()->setuptoolsinarea($area, $toolname,@ARGV);
915 +        }
916 + }
917 +
918 + sub _releasearea {
919 +        if ( !defined $self->{releasearea} ) {
920 +           require Configuration::ConfigArea;
921 +           $self->{releasearea}=Configuration::ConfigArea->new();
922 +           $self->{releasearea}->bootstrapfromlocation($ENV{RELEASETOP});
923 +        }
924 +        return $self->{releasearea};
925 + }
926 +
927 + # get a toolbox object for the local area
928 + sub toolbox {
929 +        if ( ! defined $toolbox ) {
930 +           localtop();
931 +           my $area=_localarea();
932 +           $toolbox=scrambasics()->areatoolbox($area);
933 +        }
934 +        return $toolbox;
935 + }
936 +
937 + sub help_db {
938 + print <<ENDTEXT;
939 + scram database administration command.
940 +
941 + Usage:
942 +
943 +                 $bold scram db $normal subcommand
944 +
945 + subcommands:
946 +        link :
947 +                Make available an additional database for
948 +                project and list operations
949 +
950 +                $bold scram db link $normal /a/directory/path/project.lookup
951 +
952 +        unlink :
953 +                Remove a database from the link list. Note this does
954 +                not remove the database, just the link to it in scram.
955 +
956 +                $bold scram db unlink $normal /a/directory/path/project.lookup
957 +
958 +        showlinks :
959 +                List the databases that are linked in
960 +
961 + ENDTEXT
962 + }
963 +
964 + sub help_setup {
965 +
966 + print <<ENDTEXT;
967 + Allows installation/re-installation of a new tool/external package into an
968 + already existing development area. If not toolname is specified,
969 + the complete installation process is initiated.
970 +
971 + Usage:
972 +
973 +                 $bold scram setup [-i]$normal [toolname] [[version] [url]]
974 +
975 + toolname : The name of the tool setup file required.
976 + version  : where more than one version exists specify the version
977 + url      : when setting up a completely new tool specify the url too
978 +
979 + The -i option turns off the automatic search mechanism allowing for more
980 + user interaction with the setup mechanism
981 + ENDTEXT
982 + }
983 +
984 + sub help_list {
985 + print <<ENDTEXT;
986 + List the available projects and versions installed in the local SCRAM database
987 + (see scram install help)
988 +
989 + Usage:
990 +
991 +        $bold   scram list $normal
992 +
993 + ENDTEXT
994 + }
995 +
996 + sub help_project {
997 + print <<ENDTEXT;
998 + Setup a new project development area. The new area will appear in the current
999 + working directory.
1000 + Usage:
1001 +
1002 +        $bold scram project [-d install_area] [-n directory_name]$normal project_url [project_version]
1003 +
1004 + Options:
1005 +
1006 + project_url: The url of a scram bootstrap file.
1007 +             Currently supported types are:
1008 +                $bold Database label $normal
1009 +                        Labels can be assigned to bootstrap files for easy
1010 +                        access (See "scram install" command). If you
1011 +                        specify a label you must also specify a project_version.
1012 +                        e.g.
1013 +
1014 +                           scram project SCRAM V1_0
1015 +                                
1016 +                           scram project ORCA ORCA_1_1_1
1017 +
1018 +                        To see the list of installed projects use the
1019 +                        "scram list" command.
1020 +
1021 +                $bold file: $normal A regular file on an accessable file system
1022 +                        e.g.
1023 +
1024 +                           file:~/myprojects/projecta/config/BootStrapFile
1025 +
1026 + project_version:
1027 +                 Only for use with a database label
1028 +
1029 + -d install_area:
1030 +                 Indicate a project installation area into which the new
1031 +                 project area should appear. Default is the current working
1032 +                 directory.
1033 +
1034 + -n directory_name:
1035 +                 Specify the name of the SCRAM development area you wish to
1036 +                 create.
1037 +        
1038 + ENDTEXT
1039 + }
1040 +
1041 + sub help_version {
1042 + print <<ENDTEXT;
1043 + With now $bold [version] $normal argument given, this command will simply
1044 + print to standard output the current version number.
1045 +
1046 + Providing a version argument will cause that version to be downloaded and
1047 + installed, if not already locally available.
1048 +
1049 +
1050 + Usage:
1051 +                $bold scram version [version]$normal
1052 +
1053 + ENDTEXT
1054 + }
1055 +
1056 + sub help_arch {
1057 + print <<ENDTEXT;
1058 + Print out the architecture flag for the current machine.
1059 +
1060 + Usage:
1061 +        $bold   scram arch $normal
1062 + ENDTEXT
1063 + }
1064 +
1065 + sub help_runtime {
1066 + print <<ENDTEXT;
1067 + Echo to Standard Output the Runtime Environment for the current development area
1068 + Output available in csh or sh flavours
1069 +
1070 + Usage:
1071 +        1) $bold   scram runtime [-csh|-sh] $normal
1072 + or
1073 +        2) $bold   scram runtime [-csh|-sh] filename $normal
1074 + or
1075 +        3) $bold   scram runtime info filename [variable]$normal
1076 +
1077 + 1) For the general configuration environment
1078 + 2) For environment described in filename or
1079 +                                areatop/src/directory/BuildFile
1080 + 3) Display information concerning the environment in the given file
1081 +   (limited to variable if specified)
1082 +
1083 + The file for cases 2) and 3) are searched as follows :
1084 + a) straightforward filename
1085 + b) filename relative to local_area/src
1086 + c) filename relative to release_area/src
1087 + d) BuildFile relative to local_area/src
1088 + e) BuildFile relative to release_area/src
1089 +
1090 + Examples:
1091 +
1092 + Setup the current environment to include the project Runtime Environment
1093 + in a csh environment
1094 +
1095 +       $bold  eval `scram runtime -csh` $normal
1096 +
1097 + Setup the current environment to include the project Runtime Environment in a
1098 + sh environment
1099 +
1100 +       $bold  eval `scram runtime -sh` $normal
1101 +
1102 +
1103 + ENDTEXT
1104 + }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines