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.16 by sashby, Wed Nov 7 19:49:38 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 118 | Line 137 | sub satellite {
137          my $area=$relarea->satellite($installarea,$areaname);
138          $area->archname($self->arch());
139  
121 –        # -- copy setup info - deprecated by toolbox copy method
122 –        #$relarea->copysetup($area->location());
123 –
140          # -- copy toolbox
141          my $rtb=$self->areatoolbox($relarea);
142          my $tb=$self->areatoolbox($area);
# Line 142 | Line 158 | sub satellite {
158          return $area;
159   }
160  
161 + sub toolruntime {
162 +        my $self=shift;
163 +        my $area=shift;
164 +
165 +        my $name=$area->location();
166 +        if ( ! defined $self->{toolruntime}{$name} ) {
167 +         require Runtime;
168 +         my $toolbox=$self->areatoolbox($area);
169 +         $self->{toolruntime}{$name}=Runtime->new();
170 +
171 +         # -- add scram area specific runtimes
172 +         $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
173 +                $area->location()."/lib/".$self->arch(),"path");
174 +         $self->{toolruntime}{$name}->addvar("PATH",
175 +                $area->location()."/bin/".$self->arch(),"path");
176 +         if ( defined $area->linkarea() ) {
177 +          my $reltop=$area->linkarea()->location();
178 +          $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
179 +                $reltop."/lib/".$self->arch(),"path");
180 +          $self->{toolruntime}{$name}->addvar("PATH",
181 +                $reltop."/bin/".$self->arch(),"path");
182 +         }
183 +
184 +         # -- get the runtime environment from all the tools
185 +         my $tool;
186 +         foreach $toolname ( $toolbox->tools() ) {
187 +          $tool=$toolbox->gettool($toolname);
188 +          if ( defined $tool ) {
189 +            # -- get runtime paths
190 +            foreach $f ( $tool->listtype("runtime_path")) {
191 +             foreach $val ( $tool->getfeature($f) ) {
192 +              $self->{toolruntime}{$name}->addvar($f,$val,"path");
193 +             }
194 +            }
195 +            # -- get runtime vars
196 +            foreach $f ( $tool->listtype("runtime")) {
197 +             foreach $val ( $tool->getfeature($f) ) {
198 +              $self->{toolruntime}{$name}->addvar($f,$val);
199 +             }
200 +            }
201 +          }
202 +         }
203 +
204 +         # -- Get the project level environment
205 +         my $runtimefile=$area->location()."/".$area->configurationdir()
206 +                                                                ."/Runtime";
207 +         if ( -f $runtimefile ) {
208 +          $self->{toolruntime}{$name}->file($runtimefile);
209 +         }
210 +        }
211 +        return $self->{toolruntime}{$name};
212 + }
213 +
214 + sub webget {
215 +        my $self=shift;
216 +        my $area=shift;
217 +        my $url=shift;
218 +
219 +        require URL::URLhandler;
220 +        my $handler=URL::URLhandler->new($area->cache());
221 +        return ($handler->download($url));
222 + }
223 +
224   sub addareatoDB {
225          my $self=shift;
226          my $area=shift;
# Line 160 | Line 239 | sub addareatoDB {
239          $self->scramprojectdb()->addarea($tagname,$version,$area);
240   }
241  
242 +
243 + sub removeareafromDB
244 +   {
245 +   ###############################################################
246 +   # removearefromDB()                                           #
247 +   ###############################################################
248 +   # modified : Thu Jun 14 10:46:22 2001 / SFA                   #
249 +   # params   : projectname, projectversion                      #
250 +   #          :                                                  #
251 +   #          :                                                  #
252 +   #          :                                                  #
253 +   # function : Remove project <projectname> from DB file.       #
254 +   #          :                                                  #
255 +   #          :                                                  #
256 +   ###############################################################
257 +   my $self=shift;
258 +   my $projname=shift;
259 +   my $version=shift;
260 +  
261 +   # -- Remove from the DB:
262 +   $self->scramprojectdb()->removearea($projname,$version);
263 +   }
264 +
265 +
266 + sub spawnversion
267 +   {
268 +   ###############################################################
269 +   # spawnversion                                                #
270 +   ###############################################################
271 +   # modified : Fri Aug 10 15:42:08 2001 / SFA                   #
272 +   # params   :                                                  #
273 +   #          :                                                  #
274 +   #          :                                                  #
275 +   #          :                                                  #
276 +   # function : Check for version of scram to run, and run it.   #
277 +   #          :                                                  #
278 +   #          :                                                  #
279 +   ###############################################################
280 +
281 +   my $self=shift;
282 +   my $version=shift;
283 +   my $rv=0;
284 +  
285 +   my $thisversion=$self->getversion();
286 +
287 +   if ( defined $version )
288 +      {
289 +      if ( $version ne $thisversion )
290 +         {
291 +         # first try to use the correct version
292 +         if ( -d $self->{scram_top}."/".$version )
293 +            {
294 +            $ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
295 +            $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
296 +            $self->verbose("Spawning SCRAM version $version");
297 +            #print "######### SCRAM version control: ";
298 +            #print "ARGS: ",@_,"\n\n";
299 +            my $rv=system("scram", @_)/256;
300 +            exit $rv;
301 +            }
302 +         else
303 +            { # if not then simply warn
304 +            print "******* Warning : scram version inconsistent ********\n";
305 +            print "This version: $thisversion; Required version: $version\n";
306 +            print "*****************************************************\n";
307 +            print "\n";
308 +            }
309 +         }
310 +      }
311 +   else
312 +      {
313 +      $self->error("Undefined value for version requested");
314 +      $rv=1;
315 +      }
316 +   return $rv;
317 +   }
318 +
319   sub globalcache {
320          my $self=shift;
321          if ( @_ ) {
# Line 185 | Line 341 | sub scramprojectdb {
341          }
342          return $self->{scramprojectsdb};
343   }
344 +
345 + sub getversion {
346 +        my $self=shift;
347 +        
348 +        my $thisversion;
349 +        ($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
350 +        my $scram_top=$1;
351 +        my $scram_version=$thisversion;
352 +        # deal with links
353 +        my $version=readlink $ENV{SCRAM_HOME};
354 +        if ( defined $version)  {
355 +          $scram_version=$version;
356 +        }
357 +        return $scram_version;
358 + }
359  
360   sub areatoolbox {
361          my $self=shift;
# Line 194 | Line 365 | sub areatoolbox {
365          if ( ! defined $self->{toolboxes}{$name} ) {
366            # -- create a new toolbox object
367            require BuildSystem::ToolBox;
368 <          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area);
368 >          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
369 >                                                        $self->arch());
370            $self->{toolboxes}{$name}->verbosity($self->verbosity());
371          }
372          return $self->{toolboxes}{$name};
# Line 233 | Line 405 | sub arch {
405            :$self->{arch};
406   }
407  
408 + sub scramobjectinterface {
409 +        my $self=shift;
410 +        my $class=shift;
411 +
412 +        my $file;
413 +        ($file=$class."\.pm")=~s/::/\//g;
414 +        $file=$ENV{TOOL_HOME}."/".$file;
415 +
416 +        if ( ! -f $file ) {
417 +          $self->error("Unable to find $class in ".$ENV{TOOL_HOME});
418 +        }
419 +        print "--------------------- $class ------------------\n";
420 +        my $fh=FileHandle->new();
421 +        $fh->open("<$file");
422 +        while ( <$fh> ) {
423 +           if ( $_=~/#\s*Interface/g ) {
424 +                $intregion=1;
425 +                next;
426 +           }
427 +           if ( $intregion ) { # if we are in the interface documentation
428 +            if ( ( $_!~/^#/ ) || ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
429 +                $intregion=0;
430 +                next;
431 +            }
432 +            print $_;
433 +            if ( $_=~/^#\s*(.*)\((.*)\)?:(.*)/ ) {
434 +             $interface=$1;
435 +             $args=$2;
436 +             $rest=$3;
437 +             next if ($interface eq "");
438 +             push @interfaces,$interface;
439 +             $interfaceargs{$interface}=$args;
440 +            }
441 +           }
442 +        }
443 +        print "\n";
444 +        undef $fh;
445 + }
446 +
447   # -------------- Support Routines ------------------------------
448  
449  
# Line 243 | Line 454 | sub _allprojectinitsearcher {
454             $search->addproject($$proj[0],$$proj[1]);
455            }
456          }
457 +        return $self->{projsearcher};
458   }
459  
460   sub _projsearcher {

Diff Legend

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