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

Comparing COMP/SCRAM/src/Scram/ScramFunctions.pm (file contents):
Revision 1.4 by williamc, Wed Aug 30 09:47:39 2000 UTC vs.
Revision 1.11 by sashby, Wed May 30 12:47:01 2001 UTC

# Line 18 | Line 18
18   # areatoolbox(ConfigArea) : return the toolbox of the specified area
19   # setuptoolsinarea($area[,$toolname[,$toolversion[,toolfile]) : setup
20   # arch()                : get/set the architecture string
21 + # scramobjectinterface(Class)  : print out the interface of a scram class
22 + # webget(area,url)      : get the url into the cache of the specified area
23 + # getversion()          : return the current scram version
24 + # spawnversion(version,@args) : spawn the scram version with the given args
25 + # classverbose(classstring,setting) : Set the class verbosity level
26 + # toolruntime(ConfigArea): Get a runtime object withthe settings from
27 + #                          the specified toolbox
28  
29   package Scram::ScramFunctions;
30   use URL::URLcache;
# Line 26 | Line 33 | require 5.004;
33  
34   @ISA=qw(Utilities::Verbose);
35  
36 < sub new {
36 > sub new
37 >   {
38 >   my $class=shift;
39 >   $self={};
40 >   bless $self, $class;
41 >   # -- default settings
42 >   $self->{cachedir}=$ENV{HOME}."/.scramrc/globalcache";
43 >   $self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
44 >   ($self->{scram_top})=( $ENV{SCRAM_HOME}=~/(.*)\//) ;
45 >  
46 >   return $self;
47 >   }
48 >
49 > sub classverbose {
50 >        my $self=shift;
51          my $class=shift;
52 <        $self={};
53 <        bless $self, $class;
54 <        # -- default settings
34 <        $self->{cachedir}=$ENV{HOME}."/.SCRAM/globalcache";
35 <        $self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
36 <        return $self;
52 >        my $val=shift;
53 >
54 >        $ENV{"VERBOSE_".$class}=$val;
55   }
56  
57   sub project {
# Line 73 | Line 91 | sub setuptoolsinarea {
91  
92          # -- create a new toolbox object
93          my $toolbox=$self->areatoolbox($area);
94 <        $toolbox->searcher($self->_projsearcher());
94 >        $toolbox->searcher($self->_allprojectinitsearcher());
95  
96          if ( @_ ) {
97              # -- specific tool specified
# Line 142 | Line 160 | sub satellite {
160          return $area;
161   }
162  
163 + sub toolruntime {
164 +        my $self=shift;
165 +        my $area=shift;
166 +
167 +        my $name=$area->location();
168 +        if ( ! defined $self->{toolruntime}{$name} ) {
169 +         require Runtime;
170 +         my $toolbox=$self->areatoolbox($area);
171 +         $self->{toolruntime}{$name}=Runtime->new();
172 +
173 +         # -- add scram area specific runtimes
174 +         $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
175 +                $area->location()."/lib/".$self->arch(),"path");
176 +         $self->{toolruntime}{$name}->addvar("PATH",
177 +                $area->location()."/bin/".$self->arch(),"path");
178 +         if ( defined $area->linkarea() ) {
179 +          my $reltop=$area->linkarea()->location();
180 +          $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
181 +                $reltop."/lib/".$self->arch(),"path");
182 +          $self->{toolruntime}{$name}->addvar("PATH",
183 +                $reltop."/bin/".$self->arch(),"path");
184 +         }
185 +
186 +         # -- get the runtime environment from all the tools
187 +         my $tool;
188 +         foreach $toolname ( $toolbox->tools() ) {
189 +          $tool=$toolbox->gettool($toolname);
190 +          if ( defined $tool ) {
191 +            # -- get runtime paths
192 +            foreach $f ( $tool->listtype("runtime_path")) {
193 +             foreach $val ( $tool->getfeature($f) ) {
194 +              $self->{toolruntime}{$name}->addvar($f,$val,"path");
195 +             }
196 +            }
197 +            # -- get runtime vars
198 +            foreach $f ( $tool->listtype("runtime")) {
199 +             foreach $val ( $tool->getfeature($f) ) {
200 +              $self->{toolruntime}{$name}->addvar($f,$val);
201 +             }
202 +            }
203 +          }
204 +         }
205 +
206 +         # -- Get the project level environment
207 +         my $runtimefile=$area->location()."/".$area->configurationdir()
208 +                                                                ."/Runtime";
209 +         if ( -f $runtimefile ) {
210 +          $self->{toolruntime}{$name}->file($runtimefile);
211 +         }
212 +        }
213 +        return $self->{toolruntime}{$name};
214 + }
215 +
216 + sub webget {
217 +        my $self=shift;
218 +        my $area=shift;
219 +        my $url=shift;
220 +
221 +        require URL::URLhandler;
222 +        my $handler=URL::URLhandler->new($area->cache());
223 +        return ($handler->download($url));
224 + }
225 +
226   sub addareatoDB {
227          my $self=shift;
228          my $area=shift;
# Line 160 | Line 241 | sub addareatoDB {
241          $self->scramprojectdb()->addarea($tagname,$version,$area);
242   }
243  
244 + sub spawnversion {
245 +        my $self=shift;
246 +        my $version=shift;
247 +
248 +        my $rv=0;
249 +        my $thisversion=$self->getversion();
250 +        if ( defined $version ) {
251 +          if ( $version ne $thisversion ) {
252 +              # first try to use the correct version
253 +              if ( -d $self->{scram_top}."/".$version ) {
254 +                $ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
255 +                $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
256 +                $self->verbose("Spawning SCRAM version $version");
257 +                my $rv=system("scram", @_)/256;
258 +                exit $rv;
259 +              }
260 +              else { # if not then simply warn
261 +               print "******* Warning : scram version inconsistent ********\n";
262 +               print "This version: $thisversion; Required version: $version\n";
263 +               print "*****************************************************\n";
264 +               print "\n";
265 +              }
266 +           }
267 +        }
268 +        else {
269 +           $self->error("Undefined value for version requested");
270 +           $rv=1;
271 +        }
272 +        return $rv;
273 + }
274 +
275   sub globalcache {
276          my $self=shift;
277          if ( @_ ) {
# Line 185 | Line 297 | sub scramprojectdb {
297          }
298          return $self->{scramprojectsdb};
299   }
300 +
301 + sub getversion {
302 +        my $self=shift;
303 +        
304 +        my $thisversion;
305 +        ($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
306 +        my $scram_top=$1;
307 +        my $scram_version=$thisversion;
308 +        # deal with links
309 +        my $version=readlink $ENV{SCRAM_HOME};
310 +        if ( defined $version)  {
311 +          $scram_version=$version;
312 +        }
313 +        return $scram_version;
314 + }
315  
316   sub areatoolbox {
317          my $self=shift;
# Line 194 | Line 321 | sub areatoolbox {
321          if ( ! defined $self->{toolboxes}{$name} ) {
322            # -- create a new toolbox object
323            require BuildSystem::ToolBox;
324 <          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
324 >          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
325 >                                                        $self->arch());
326            $self->{toolboxes}{$name}->verbosity($self->verbosity());
327          }
328          return $self->{toolboxes}{$name};
# Line 233 | Line 361 | sub arch {
361            :$self->{arch};
362   }
363  
364 + sub scramobjectinterface {
365 +        my $self=shift;
366 +        my $class=shift;
367 +
368 +        my $file;
369 +        ($file=$class."\.pm")=~s/::/\//g;
370 +        $file=$ENV{TOOL_HOME}."/".$file;
371 +
372 +        if ( ! -f $file ) {
373 +          $self->error("Unable to find $class in ".$ENV{TOOL_HOME});
374 +        }
375 +        print "--------------------- $class ------------------\n";
376 +        my $fh=FileHandle->new();
377 +        $fh->open("<$file");
378 +        while ( <$fh> ) {
379 +           if ( $_=~/#\s*Interface/g ) {
380 +                $intregion=1;
381 +                next;
382 +           }
383 +           if ( $intregion ) { # if we are in the interface documentation
384 +            if ( ( $_!~/^#/ ) || ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
385 +                $intregion=0;
386 +                next;
387 +            }
388 +            print $_;
389 +            if ( $_=~/^#\s*(.*)\((.*)\)?:(.*)/ ) {
390 +             $interface=$1;
391 +             $args=$2;
392 +             $rest=$3;
393 +             next if ($interface eq "");
394 +             push @interfaces,$interface;
395 +             $interfaceargs{$interface}=$args;
396 +            }
397 +           }
398 +        }
399 +        print "\n";
400 +        undef $fh;
401 + }
402 +
403   # -------------- Support Routines ------------------------------
404  
405  
# Line 243 | Line 410 | sub _allprojectinitsearcher {
410             $search->addproject($$proj[0],$$proj[1]);
411            }
412          }
413 +        return $self->{projsearcher};
414   }
415  
416   sub _projsearcher {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines