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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines