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.3 by williamc, Wed Aug 30 09:31:31 2000 UTC vs.
Revision 1.14 by sashby, Wed Jul 11 15:48:17 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 68 | Line 86 | sub setuptoolsinarea {
86          my $self=shift;
87          my $area=shift;
88  
89 <        # -- initialise
89 >        # -- initialise
90 >        print "Initialising setup procedure......","\n";
91          $self->_allprojectinitsearcher();
92  
93          # -- create a new toolbox object
94          my $toolbox=$self->areatoolbox($area);
95 <        $toolbox->searcher($self->_projsearcher());
95 >        $toolbox->searcher($self->_allprojectinitsearcher());
96  
97          if ( @_ ) {
98              # -- specific tool specified
# Line 98 | Line 117 | sub satellite {
117          my $version=shift;
118          my $installarea=shift;
119  
120 <        my $areaname="";
120 >        my $areaname=undef;
121          if ( @_ ) {
122            $areaname=shift;
123          }
# Line 109 | Line 128 | sub satellite {
128            $self->error("Unable to Find Project $name $version");
129          }
130  
131 +        # -- fix for old broken areas
132 +        if ( (! defined $relarea->version()) || ($relarea->version() eq "") ) {
133 +           $relarea->version($version);
134 +        }
135 +
136          # -- create satellite
137          my $area=$relarea->satellite($installarea,$areaname);
138          $area->archname($self->arch());
# Line 137 | Line 161 | sub satellite {
161          return $area;
162   }
163  
164 + sub toolruntime {
165 +        my $self=shift;
166 +        my $area=shift;
167 +
168 +        my $name=$area->location();
169 +        if ( ! defined $self->{toolruntime}{$name} ) {
170 +         require Runtime;
171 +         my $toolbox=$self->areatoolbox($area);
172 +         $self->{toolruntime}{$name}=Runtime->new();
173 +
174 +         # -- add scram area specific runtimes
175 +         $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
176 +                $area->location()."/lib/".$self->arch(),"path");
177 +         $self->{toolruntime}{$name}->addvar("PATH",
178 +                $area->location()."/bin/".$self->arch(),"path");
179 +         if ( defined $area->linkarea() ) {
180 +          my $reltop=$area->linkarea()->location();
181 +          $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
182 +                $reltop."/lib/".$self->arch(),"path");
183 +          $self->{toolruntime}{$name}->addvar("PATH",
184 +                $reltop."/bin/".$self->arch(),"path");
185 +         }
186 +
187 +         # -- get the runtime environment from all the tools
188 +         my $tool;
189 +         foreach $toolname ( $toolbox->tools() ) {
190 +          $tool=$toolbox->gettool($toolname);
191 +          if ( defined $tool ) {
192 +            # -- get runtime paths
193 +            foreach $f ( $tool->listtype("runtime_path")) {
194 +             foreach $val ( $tool->getfeature($f) ) {
195 +              $self->{toolruntime}{$name}->addvar($f,$val,"path");
196 +             }
197 +            }
198 +            # -- get runtime vars
199 +            foreach $f ( $tool->listtype("runtime")) {
200 +             foreach $val ( $tool->getfeature($f) ) {
201 +              $self->{toolruntime}{$name}->addvar($f,$val);
202 +             }
203 +            }
204 +          }
205 +         }
206 +
207 +         # -- Get the project level environment
208 +         my $runtimefile=$area->location()."/".$area->configurationdir()
209 +                                                                ."/Runtime";
210 +         if ( -f $runtimefile ) {
211 +          $self->{toolruntime}{$name}->file($runtimefile);
212 +         }
213 +        }
214 +        return $self->{toolruntime}{$name};
215 + }
216 +
217 + sub webget {
218 +        my $self=shift;
219 +        my $area=shift;
220 +        my $url=shift;
221 +
222 +        require URL::URLhandler;
223 +        my $handler=URL::URLhandler->new($area->cache());
224 +        return ($handler->download($url));
225 + }
226 +
227   sub addareatoDB {
228          my $self=shift;
229          my $area=shift;
# Line 155 | Line 242 | sub addareatoDB {
242          $self->scramprojectdb()->addarea($tagname,$version,$area);
243   }
244  
245 +
246 + sub removeareafromDB
247 +   {
248 +   ###############################################################
249 +   # removearefromDB()                                           #
250 +   ###############################################################
251 +   # modified : Thu Jun 14 10:46:22 2001 / SFA                   #
252 +   # params   : projectname, projectversion                      #
253 +   #          :                                                  #
254 +   #          :                                                  #
255 +   #          :                                                  #
256 +   # function : Remove project <projectname> from DB file.       #
257 +   #          :                                                  #
258 +   #          :                                                  #
259 +   ###############################################################
260 +   my $self=shift;
261 +   my $projname=shift;
262 +   my $version=shift;
263 +  
264 +   # -- Remove from the DB:
265 +   $self->scramprojectdb()->removearea($projname,$version);
266 +   }
267 +
268 +
269 + sub spawnversion
270 +   {
271 +   my $self=shift;
272 +   my $version=shift;
273 +   my $rv=0;
274 +  
275 +   my $thisversion=$self->getversion();
276 +
277 +   if ( defined $version )
278 +      {
279 +      if ( $version ne $thisversion )
280 +         {
281 +         # first try to use the correct version
282 +         if ( -d $self->{scram_top}."/".$version )
283 +            {
284 +            $ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
285 +            $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
286 +            $self->verbose("Spawning SCRAM version $version");
287 +            my $rv=system("scram", @_)/256;
288 +            exit $rv;
289 +            }
290 +         else
291 +            { # if not then simply warn
292 +            print "******* Warning : scram version inconsistent ********\n";
293 +            print "This version: $thisversion; Required version: $version\n";
294 +            print "*****************************************************\n";
295 +            print "\n";
296 +            }
297 +         }
298 +      }
299 +   else
300 +      {
301 +      $self->error("Undefined value for version requested");
302 +      $rv=1;
303 +      }
304 +   return $rv;
305 +   }
306 +
307   sub globalcache {
308          my $self=shift;
309          if ( @_ ) {
# Line 180 | Line 329 | sub scramprojectdb {
329          }
330          return $self->{scramprojectsdb};
331   }
332 +
333 + sub getversion {
334 +        my $self=shift;
335 +        
336 +        my $thisversion;
337 +        ($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
338 +        my $scram_top=$1;
339 +        my $scram_version=$thisversion;
340 +        # deal with links
341 +        my $version=readlink $ENV{SCRAM_HOME};
342 +        if ( defined $version)  {
343 +          $scram_version=$version;
344 +        }
345 +        return $scram_version;
346 + }
347  
348   sub areatoolbox {
349          my $self=shift;
# Line 189 | Line 353 | sub areatoolbox {
353          if ( ! defined $self->{toolboxes}{$name} ) {
354            # -- create a new toolbox object
355            require BuildSystem::ToolBox;
356 <          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
356 >          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
357 >                                                        $self->arch());
358            $self->{toolboxes}{$name}->verbosity($self->verbosity());
359          }
360          return $self->{toolboxes}{$name};
# Line 228 | Line 393 | sub arch {
393            :$self->{arch};
394   }
395  
396 + sub scramobjectinterface {
397 +        my $self=shift;
398 +        my $class=shift;
399 +
400 +        my $file;
401 +        ($file=$class."\.pm")=~s/::/\//g;
402 +        $file=$ENV{TOOL_HOME}."/".$file;
403 +
404 +        if ( ! -f $file ) {
405 +          $self->error("Unable to find $class in ".$ENV{TOOL_HOME});
406 +        }
407 +        print "--------------------- $class ------------------\n";
408 +        my $fh=FileHandle->new();
409 +        $fh->open("<$file");
410 +        while ( <$fh> ) {
411 +           if ( $_=~/#\s*Interface/g ) {
412 +                $intregion=1;
413 +                next;
414 +           }
415 +           if ( $intregion ) { # if we are in the interface documentation
416 +            if ( ( $_!~/^#/ ) || ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
417 +                $intregion=0;
418 +                next;
419 +            }
420 +            print $_;
421 +            if ( $_=~/^#\s*(.*)\((.*)\)?:(.*)/ ) {
422 +             $interface=$1;
423 +             $args=$2;
424 +             $rest=$3;
425 +             next if ($interface eq "");
426 +             push @interfaces,$interface;
427 +             $interfaceargs{$interface}=$args;
428 +            }
429 +           }
430 +        }
431 +        print "\n";
432 +        undef $fh;
433 + }
434 +
435   # -------------- Support Routines ------------------------------
436  
437  
# Line 238 | Line 442 | sub _allprojectinitsearcher {
442             $search->addproject($$proj[0],$$proj[1]);
443            }
444          }
445 +        return $self->{projsearcher};
446   }
447  
448   sub _projsearcher {

Diff Legend

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