src/Scram/ScramFunctions.pm

#
# ScramFunctions.pm
#
# Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new()         : A new ScramCommands object
# project(urlstring,dir[,areaname]): Create a project from the given url file
#                                       return the area
# satellite(name,version,installdirectory[,areaname]): create a satellite 
#                                       project from the specified name version
# addareatoDB(ConfigArea[,name[,version]]) : add area to the db 
# globalcache([cachedirectory])) : return the global cache object/set at dir.
# scramprojectdb()              : return the scram project DB object
# areatoolbox(ConfigArea) : return the toolbox of the specified area
# setuptoolsinarea($area[,$toolname[,$toolversion[,toolfile]) : setup
# arch()                : get/set the architecture string
# scramobjectinterface(Class)  : print out the interface of a scram class
# webget(area,url)      : get the url into the cache of the specified area
# getversion()          : return the current scram version
# spawnversion(version,@args) : spawn the scram version with the given args
# classverbose(classstring,setting) : Set the class verbosity level
# toolruntime(ConfigArea): Get a runtime object withthe settings from 
#                          the specified toolbox

package Scram::ScramFunctions;
use URL::URLcache;
use Utilities::Verbose;
require 5.004;

@ISA=qw(Utilities::Verbose);

sub new
   {
   my $class=shift;
   $self={};
   bless $self, $class;
   # -- default settings
   $self->{cachedir}=$ENV{HOME}."/.scramrc/globalcache";
   $self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
   ($self->{scram_top})=( $ENV{SCRAM_HOME}=~/(.*)\//) ;
   
   return $self;
   }

sub classverbose {
        my $self=shift;
        my $class=shift;
        my $val=shift;

        $ENV{"VERBOSE_".$class}=$val;
}

sub project {
        my $self=shift;
        my $url=shift;
        my $installarea=shift;

        my $areaname="";
        if ( @_ ) {
          $areaname=shift;
        }
        require Configuration::BootStrapProject;
        my $bs=Configuration::BootStrapProject->
                        new($self->globalcache(),$installarea);
        $self->verbose("BootStrapping $url");
        my $area=$bs->boot($url,$areaname);
        if ( ! defined $area ) {
                $self->error("Unable to create project area");
        }
        $area->archname($self->arch());

        # -- download all tool description files
        my $req=$self->arearequirements($area);
        if ( defined $req ) {
          $req->download($self->areatoolbox($area));
        }  

        return $area;
}

sub setuptoolsinarea
   {
   my $self=shift;
   my $area=shift;
   
   # -- initialise
   print "Initialising setup procedure......","\n";
   $self->_allprojectinitsearcher();
   
   # -- create a new toolbox object
   my $toolbox=$self->areatoolbox($area);
   $toolbox->searcher($self->_allprojectinitsearcher());
   
   if ( @_ )
      {
      # -- specific tool specified
      if ( my $rv=$toolbox->toolsetup(@_) )
         {
         if ( $rv eq 1 )
            {
            print "Unknown tool $toolname @ARGV\n";
            exit 1;
            }
         }
      }
   else
      {
      # -- setup all tools specified in the requirements doc
      print "Going to set up all tools....","\n\n";
      my $reqs=$self->arearequirements($area);     
      $self->verbose("Setup ToolBox from Requirements doc ($reqs)");
      # reqs is a BuildSystem::Requirements object:
      $reqs->setup($toolbox);
      }
   }

sub satellite {
        my $self=shift;
        my $name=shift;
        my $version=shift;
        my $installarea=shift;

        my $areaname=undef;
        if ( @_ ) {
          $areaname=shift;
        }

        # -- look up scram database for location
        my $relarea=$self->_lookupareaindb($name,$version);
        if ( ! defined $relarea ) {
          $self->error("Unable to Find Project $name $version");
        }

        # -- fix for old broken areas
        if ( (! defined $relarea->version()) || ($relarea->version() eq "") ) {
           $relarea->version($version);
        }

        # -- create satellite
        my $area=$relarea->satellite($installarea,$areaname);
        $area->archname($self->arch());

        # -- copy toolbox
        my $rtb=$self->areatoolbox($relarea);
        my $tb=$self->areatoolbox($area);
        $rtb->copytools($tb);

        # -- copy configuration directory
        if ( ! -d $area->location()."/".$area->configurationdir() ) {
          use Utilities::AddDir;
          AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
                $area->location()."/".$area->configurationdir() );
        }

        # -- copy RequirementsDoc
        if ( ! -f $area->requirementsdoc() ) {
          use File::Copy;
          copy( $relarea->requirementsdoc() , $area->requirementsdoc());
        }

        return $area;
}

sub toolruntime {
        my $self=shift;
        my $area=shift;

        my $name=$area->location();
        if ( ! defined $self->{toolruntime}{$name} ) {
         require Runtime;
         my $toolbox=$self->areatoolbox($area);
         $self->{toolruntime}{$name}=Runtime->new();

         # -- add scram area specific runtimes
         $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
                $area->location()."/lib/".$self->arch(),"path");
         $self->{toolruntime}{$name}->addvar("PATH",
                $area->location()."/bin/".$self->arch(),"path");
         if ( defined $area->linkarea() ) {
          my $reltop=$area->linkarea()->location();
          $self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
                $reltop."/lib/".$self->arch(),"path");
          $self->{toolruntime}{$name}->addvar("PATH",
                $reltop."/bin/".$self->arch(),"path");
         }

         # -- get the runtime environment from all the tools
         my $tool;
         foreach $toolname ( $toolbox->tools() ) {
          $tool=$toolbox->gettool($toolname);
          if ( defined $tool ) {
            # -- get runtime paths
            foreach $f ( $tool->listtype("runtime_path")) {
             foreach $val ( $tool->getfeature($f) ) {
              $self->{toolruntime}{$name}->addvar($f,$val,"path");
             }
            }
            # -- get runtime vars
            foreach $f ( $tool->listtype("runtime")) {
             foreach $val ( $tool->getfeature($f) ) {
              $self->{toolruntime}{$name}->addvar($f,$val);
             }
            }
          }
         }

         # -- Get the project level environment
         my $runtimefile=$area->location()."/".$area->configurationdir()
                                                                ."/Runtime";
         if ( -f $runtimefile ) {
          $self->{toolruntime}{$name}->file($runtimefile);
         }
        }
        return $self->{toolruntime}{$name};
}

sub webget {
        my $self=shift;
        my $area=shift;
        my $url=shift;

        require URL::URLhandler;
        my $handler=URL::URLhandler->new($area->cache());
        return ($handler->download($url));
}

sub addareatoDB {
        my $self=shift;
        my $area=shift;
        my $tagname=shift;
        my $version=shift;

        # -- create defaults if necessary
        if ( (! defined $version)  || ( $version eq "") ) {
           $version=$area->version();
        }
        if ( (! defined $tagname)  || ( $tagname eq "") ) {
           $tagname=$area->name();
        }

        # -- Add to the DB
        $self->scramprojectdb()->addarea($tagname,$version,$area);
}


sub removeareafromDB
   {
   ###############################################################
   # removearefromDB()                                           #
   ###############################################################
   # modified : Thu Jun 14 10:46:22 2001 / SFA                   #
   # params   : projectname, projectversion                      #
   #          :                                                  #
   #          :                                                  #
   #          :                                                  #
   # function : Remove project <projectname> from DB file.       #
   #          :                                                  #
   #          :                                                  #
   ###############################################################
   my $self=shift;
   my $projname=shift;
   my $version=shift;
   
   # -- Remove from the DB:
   $self->scramprojectdb()->removearea($projname,$version);
   }


sub spawnversion
   {
   ###############################################################
   # spawnversion                                                #
   ###############################################################
   # modified : Fri Aug 10 15:42:08 2001 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   #          :                                                  #
   #          :                                                  #
   # function : Check for version of scram to run, and run it.   #
   #          :                                                  #
   #          :                                                  #
   ###############################################################

   my $self=shift;
   my $version=shift;
   my $rv=0;
   
   my $thisversion=$self->getversion();

   if ( defined $version )
      {
      if ( $version ne $thisversion )
         {
         # first try to use the correct version
         if ( -d $self->{scram_top}."/".$version )
            {
            $ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
            $ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
            $self->verbose("Spawning SCRAM version $version");
            my $rv=system("scram", @_)/256;
            exit $rv;
            }
         else
            {
            # if not then simply warn. Send output to STDERR:
            if ( -t STDERR )
               {
               print STDERR "******* Warning : scram version inconsistent ********\n";
               print STDERR "This version: $thisversion; Required version: $version\n";
               print STDERR "*****************************************************\n";
               print STDERR "\n";
               }    
            }
         }
      }
   else
      {
      $self->error("Undefined value for version requested");
      $rv=1;
      }
   return $rv;
   }

sub globalcache {
        my $self=shift;
        if ( @_ ) {
          $self->{cachedir}=shift;
        }
        if ( ! defined $self->{globalcache} ) {
          $self->{globalcache}=URL::URLcache->new($self->{cachedir});
        }
        return $self->{globalcache};
}


sub scramprojectdb {
        my $self=shift;
        if ( @_ ) {
          $self->{scramprojectsdbdir}=shift;
        }
        if ( ! defined $self->{scramprojectsdb} ) {
          require Scram::ScramProjectDB;
          $self->{scramprojectsdb}=Scram::ScramProjectDB->new(
                           $self->{scramprojectsdbdir} );
          $self->{scramprojectsdb}->verbosity($self->verbosity());
        }
        return $self->{scramprojectsdb};
}

sub getversion {
        my $self=shift;
        
        my $thisversion;
        ($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
        my $scram_top=$1;
        my $scram_version=$thisversion;
        # deal with links
        my $version=readlink $ENV{SCRAM_HOME};
        if ( defined $version)  {
          $scram_version=$version;
        }
        return $scram_version;
}
 
sub areatoolbox {
        my $self=shift;
        my $area=shift;

        my $name=$area->location();
        if ( ! defined $self->{toolboxes}{$name} ) {
          # -- create a new toolbox object
          require BuildSystem::ToolBox;
          $self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
                                                        $self->arch());
          $self->{toolboxes}{$name}->verbosity($self->verbosity());
        }
        return $self->{toolboxes}{$name};
}

sub arearequirements {
        my $self=shift;
        my $area=shift;

        my $name=$area->location();
        if ( ! defined $self->{requirements}{$name} ) {
          # -- create a new toolbox object
          require BuildSystem::Requirements;
          my $doc=$area->requirementsdoc();
          my $cache=$area->cache();
          my $db=$area->objectstore();
          require ActiveDoc::ActiveStore;
          my $astore=ActiveDoc::ActiveStore->new($db,$cache);
          $self->{requirements}{$name}=
                BuildSystem::Requirements->new($astore,"file:".$doc, 
                        $ENV{SCRAM_ARCH});
          $self->{requirements}{$name}->verbosity($self->verbosity());
          $self->verbose("Requirements Doc (".$self->{requirements}{$name}.
                                  ") for area :\n $name\n initiated from $doc");
        }
        else {
          $self->verbose("Requirements Doc (".$self->{requirements}{$name}.")");
        }
        return $self->{requirements}{$name};
}

sub arch {
        my $self=shift;

        @_?$self->{arch}=shift
          :$self->{arch};
}

sub scramobjectinterface {
        my $self=shift;
        my $class=shift;

        my $file;
        ($file=$class."\.pm")=~s/::/\//g;
        $file=$ENV{TOOL_HOME}."/".$file;

        if ( ! -f $file ) {
          $self->error("Unable to find $class in ".$ENV{TOOL_HOME});
        }
        print "--------------------- $class ------------------\n";
        my $fh=FileHandle->new();
        $fh->open("<$file");
        while ( <$fh> ) {
           if ( $_=~/#\s*Interface/g ) {
                $intregion=1;
                next;
           }
           if ( $intregion ) { # if we are in the interface documentation
            if ( ( $_!~/^#/ ) || ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
                $intregion=0;
                next;
            }
            print $_;
            if ( $_=~/^#\s*(.*)\((.*)\)?:(.*)/ ) {
             $interface=$1;
             $args=$2;
             $rest=$3;
             next if ($interface eq "");
             push @interfaces,$interface;
             $interfaceargs{$interface}=$args;
            }
           }
        }
        print "\n";
        undef $fh;
}

# -------------- Support Routines ------------------------------


sub _allprojectinitsearcher {
        if ( ! defined $self->{projsearcher} ) {
          my $search=_projsearcher();
          foreach $proj ( $self->scramprojectdb()->list() ) {
           $search->addproject($$proj[0],$$proj[1]);
          }
        }
        return $self->{projsearcher};
}

sub _projsearcher {
        if ( ! defined $self->{projsearcher} ) {
          require Scram::ProjectSearcher;
          $self->{projsearcher}=Scram::ProjectSearcher->new(
                        $self->scramprojectdb());
        }
        return $self->{projsearcher};
}


sub _lookupareaindb {
        my $self=shift;

        my $area=undef;
        # -- Look up the area in the databse
        my @areas=$self->scramprojectdb()->getarea(@_);
        if ( $#areas > 0 ) { #ambigous
                # could ask user - for now just error
          $self->error("Ambigous request - please be more specific");
        }
        elsif ( $#areas != 0 ) { #not found
          $self->error("The project requested has not been found");
        }
        else {
          $area=$areas[0];
        }
        return $area;
}
Revision:	1.21
Committed:	Tue May 21 10:57:34 2002 UTC (22 years, 11 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V0_19_7, V0_19_6, V0_19_6p1, V0_19_5, SFATEST, V0_19_4
Branch point for:	SCRAM_V1_BRANCH, V0_19_4_B
Changes since 1.20:	+9 -5 lines
Log Message:	Final commit.
#	User	Rev	Content
1	williamc	1.2	#
2			# ScramFunctions.pm
3			#
4			# Written by Christopher Williams
5			#
6			# Description
7			#
8			# Interface
9			# ---------
10			# new() : A new ScramCommands object
11			# project(urlstring,dir[,areaname]): Create a project from the given url file
12			# return the area
13			# satellite(name,version,installdirectory[,areaname]): create a satellite
14			# project from the specified name version
15			# addareatoDB(ConfigArea[,name[,version]]) : add area to the db
16			# globalcache([cachedirectory])) : return the global cache object/set at dir.
17			# scramprojectdb() : return the scram project DB object
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	williamc	1.6	# scramobjectinterface(Class) : print out the interface of a scram class
22	williamc	1.10	# webget(area,url) : get the url into the cache of the specified area
23	williamc	1.8	# getversion() : return the current scram version
24			# spawnversion(version,@args) : spawn the scram version with the given args
25	williamc	1.10	# classverbose(classstring,setting) : Set the class verbosity level
26			# toolruntime(ConfigArea): Get a runtime object withthe settings from
27			# the specified toolbox
28	williamc	1.2
29			package Scram::ScramFunctions;
30			use URL::URLcache;
31			use Utilities::Verbose;
32			require 5.004;
33
34			@ISA=qw(Utilities::Verbose);
35
36	sashby	1.11	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	williamc	1.2
49	williamc	1.10	sub classverbose {
50			my $self=shift;
51			my $class=shift;
52			my $val=shift;
53
54			$ENV{"VERBOSE_".$class}=$val;
55			}
56
57	williamc	1.2	sub project {
58			my $self=shift;
59			my $url=shift;
60			my $installarea=shift;
61
62			my $areaname="";
63			if ( @_ ) {
64			$areaname=shift;
65			}
66			require Configuration::BootStrapProject;
67			my $bs=Configuration::BootStrapProject->
68			new($self->globalcache(),$installarea);
69			$self->verbose("BootStrapping $url");
70			my $area=$bs->boot($url,$areaname);
71			if ( ! defined $area ) {
72			$self->error("Unable to create project area");
73			}
74			$area->archname($self->arch());
75
76			# -- download all tool description files
77			my $req=$self->arearequirements($area);
78			if ( defined $req ) {
79			$req->download($self->areatoolbox($area));
80			}
81
82			return $area;
83			}
84
85	sashby	1.18	sub setuptoolsinarea
86			{
87			my $self=shift;
88			my $area=shift;
89	sashby	1.19
90	sashby	1.18	# -- initialise
91			print "Initialising setup procedure......","\n";
92			$self->_allprojectinitsearcher();
93
94			# -- create a new toolbox object
95			my $toolbox=$self->areatoolbox($area);
96			$toolbox->searcher($self->_allprojectinitsearcher());
97
98			if ( @_ )
99			{
100			# -- specific tool specified
101			if ( my $rv=$toolbox->toolsetup(@_) )
102			{
103			if ( $rv eq 1 )
104			{
105			print "Unknown tool $toolname @ARGV\n";
106			exit 1;
107			}
108			}
109			}
110			else
111			{
112			# -- setup all tools specified in the requirements doc
113			print "Going to set up all tools....","\n\n";
114			my $reqs=$self->arearequirements($area);
115			$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
116			# reqs is a BuildSystem::Requirements object:
117			$reqs->setup($toolbox);
118			}
119			}
120	williamc	1.2
121			sub satellite {
122			my $self=shift;
123			my $name=shift;
124			my $version=shift;
125			my $installarea=shift;
126
127	williamc	1.4	my $areaname=undef;
128	williamc	1.2	if ( @_ ) {
129			$areaname=shift;
130			}
131
132			# -- look up scram database for location
133			my $relarea=$self->_lookupareaindb($name,$version);
134			if ( ! defined $relarea ) {
135			$self->error("Unable to Find Project $name $version");
136	williamc	1.4	}
137
138			# -- fix for old broken areas
139			if ( (! defined $relarea->version()) \|\| ($relarea->version() eq "") ) {
140			$relarea->version($version);
141	williamc	1.2	}
142
143			# -- create satellite
144			my $area=$relarea->satellite($installarea,$areaname);
145			$area->archname($self->arch());
146
147			# -- copy toolbox
148			my $rtb=$self->areatoolbox($relarea);
149			my $tb=$self->areatoolbox($area);
150			$rtb->copytools($tb);
151
152			# -- copy configuration directory
153			if ( ! -d $area->location()."/".$area->configurationdir() ) {
154			use Utilities::AddDir;
155			AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
156			$area->location()."/".$area->configurationdir() );
157			}
158
159			# -- copy RequirementsDoc
160			if ( ! -f $area->requirementsdoc() ) {
161	williamc	1.3	use File::Copy;
162	williamc	1.2	copy( $relarea->requirementsdoc() , $area->requirementsdoc());
163			}
164
165			return $area;
166	williamc	1.7	}
167
168	williamc	1.10	sub toolruntime {
169	williamc	1.7	my $self=shift;
170			my $area=shift;
171
172	williamc	1.10	my $name=$area->location();
173			if ( ! defined $self->{toolruntime}{$name} ) {
174			require Runtime;
175			my $toolbox=$self->areatoolbox($area);
176			$self->{toolruntime}{$name}=Runtime->new();
177
178			# -- add scram area specific runtimes
179			$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
180			$area->location()."/lib/".$self->arch(),"path");
181			$self->{toolruntime}{$name}->addvar("PATH",
182			$area->location()."/bin/".$self->arch(),"path");
183			if ( defined $area->linkarea() ) {
184			my $reltop=$area->linkarea()->location();
185			$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
186			$reltop."/lib/".$self->arch(),"path");
187			$self->{toolruntime}{$name}->addvar("PATH",
188			$reltop."/bin/".$self->arch(),"path");
189			}
190
191			# -- get the runtime environment from all the tools
192			my $tool;
193			foreach $toolname ( $toolbox->tools() ) {
194			$tool=$toolbox->gettool($toolname);
195			if ( defined $tool ) {
196			# -- get runtime paths
197			foreach $f ( $tool->listtype("runtime_path")) {
198			foreach $val ( $tool->getfeature($f) ) {
199			$self->{toolruntime}{$name}->addvar($f,$val,"path");
200			}
201			}
202			# -- get runtime vars
203			foreach $f ( $tool->listtype("runtime")) {
204			foreach $val ( $tool->getfeature($f) ) {
205			$self->{toolruntime}{$name}->addvar($f,$val);
206			}
207			}
208			}
209			}
210
211			# -- Get the project level environment
212			my $runtimefile=$area->location()."/".$area->configurationdir()
213			."/Runtime";
214			if ( -f $runtimefile ) {
215			$self->{toolruntime}{$name}->file($runtimefile);
216			}
217			}
218			return $self->{toolruntime}{$name};
219			}
220
221			sub webget {
222			my $self=shift;
223			my $area=shift;
224			my $url=shift;
225
226			require URL::URLhandler;
227			my $handler=URL::URLhandler->new($area->cache());
228			return ($handler->download($url));
229	williamc	1.2	}
230
231			sub addareatoDB {
232			my $self=shift;
233			my $area=shift;
234			my $tagname=shift;
235			my $version=shift;
236
237			# -- create defaults if necessary
238			if ( (! defined $version) \|\| ( $version eq "") ) {
239			$version=$area->version();
240			}
241			if ( (! defined $tagname) \|\| ( $tagname eq "") ) {
242			$tagname=$area->name();
243			}
244
245			# -- Add to the DB
246			$self->scramprojectdb()->addarea($tagname,$version,$area);
247			}
248
249	sashby	1.13
250			sub removeareafromDB
251			{
252			###############################################################
253			# removearefromDB() #
254			###############################################################
255			# modified : Thu Jun 14 10:46:22 2001 / SFA #
256			# params : projectname, projectversion #
257			# : #
258			# : #
259			# : #
260			# function : Remove project <projectname> from DB file. #
261			# : #
262			# : #
263			###############################################################
264			my $self=shift;
265			my $projname=shift;
266			my $version=shift;
267
268			# -- Remove from the DB:
269			$self->scramprojectdb()->removearea($projname,$version);
270			}
271
272
273	sashby	1.12	sub spawnversion
274			{
275	sashby	1.15	###############################################################
276			# spawnversion #
277			###############################################################
278			# modified : Fri Aug 10 15:42:08 2001 / SFA #
279			# params : #
280			# : #
281			# : #
282			# : #
283			# function : Check for version of scram to run, and run it. #
284			# : #
285			# : #
286			###############################################################
287
288	sashby	1.12	my $self=shift;
289			my $version=shift;
290			my $rv=0;
291
292			my $thisversion=$self->getversion();
293	williamc	1.8
294	sashby	1.12	if ( defined $version )
295			{
296			if ( $version ne $thisversion )
297			{
298			# first try to use the correct version
299			if ( -d $self->{scram_top}."/".$version )
300			{
301			$ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
302			$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
303			$self->verbose("Spawning SCRAM version $version");
304			my $rv=system("scram", @_)/256;
305			exit $rv;
306			}
307			else
308	sashby	1.21	{
309			# if not then simply warn. Send output to STDERR:
310			if ( -t STDERR )
311			{
312			print STDERR "***** Warning : scram version inconsistent ******\n";
313			print STDERR "This version: $thisversion; Required version: $version\n";
314			print STDERR "*****************************************************\n";
315			print STDERR "\n";
316			}
317	sashby	1.12	}
318			}
319			}
320			else
321			{
322			$self->error("Undefined value for version requested");
323			$rv=1;
324			}
325			return $rv;
326			}
327	williamc	1.8
328	williamc	1.2	sub globalcache {
329			my $self=shift;
330			if ( @_ ) {
331			$self->{cachedir}=shift;
332			}
333			if ( ! defined $self->{globalcache} ) {
334			$self->{globalcache}=URL::URLcache->new($self->{cachedir});
335			}
336			return $self->{globalcache};
337			}
338
339
340			sub scramprojectdb {
341			my $self=shift;
342			if ( @_ ) {
343			$self->{scramprojectsdbdir}=shift;
344			}
345			if ( ! defined $self->{scramprojectsdb} ) {
346			require Scram::ScramProjectDB;
347			$self->{scramprojectsdb}=Scram::ScramProjectDB->new(
348			$self->{scramprojectsdbdir} );
349			$self->{scramprojectsdb}->verbosity($self->verbosity());
350			}
351			return $self->{scramprojectsdb};
352			}
353	williamc	1.8
354			sub getversion {
355			my $self=shift;
356
357			my $thisversion;
358			($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
359			my $scram_top=$1;
360			my $scram_version=$thisversion;
361			# deal with links
362			my $version=readlink $ENV{SCRAM_HOME};
363			if ( defined $version) {
364			$scram_version=$version;
365			}
366			return $scram_version;
367			}
368	williamc	1.2
369			sub areatoolbox {
370			my $self=shift;
371			my $area=shift;
372
373			my $name=$area->location();
374			if ( ! defined $self->{toolboxes}{$name} ) {
375			# -- create a new toolbox object
376			require BuildSystem::ToolBox;
377	williamc	1.8	$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
378			$self->arch());
379	williamc	1.2	$self->{toolboxes}{$name}->verbosity($self->verbosity());
380			}
381			return $self->{toolboxes}{$name};
382			}
383
384			sub arearequirements {
385			my $self=shift;
386			my $area=shift;
387
388			my $name=$area->location();
389			if ( ! defined $self->{requirements}{$name} ) {
390			# -- create a new toolbox object
391			require BuildSystem::Requirements;
392			my $doc=$area->requirementsdoc();
393			my $cache=$area->cache();
394			my $db=$area->objectstore();
395			require ActiveDoc::ActiveStore;
396			my $astore=ActiveDoc::ActiveStore->new($db,$cache);
397			$self->{requirements}{$name}=
398			BuildSystem::Requirements->new($astore,"file:".$doc,
399			$ENV{SCRAM_ARCH});
400			$self->{requirements}{$name}->verbosity($self->verbosity());
401			$self->verbose("Requirements Doc (".$self->{requirements}{$name}.
402			") for area :\n $name\n initiated from $doc");
403			}
404			else {
405			$self->verbose("Requirements Doc (".$self->{requirements}{$name}.")");
406			}
407			return $self->{requirements}{$name};
408			}
409
410			sub arch {
411			my $self=shift;
412
413			@_?$self->{arch}=shift
414			:$self->{arch};
415	williamc	1.6	}
416
417			sub scramobjectinterface {
418	williamc	1.10	my $self=shift;
419			my $class=shift;
420	williamc	1.6
421	williamc	1.10	my $file;
422			($file=$class."\.pm")=~s/::/\//g;
423			$file=$ENV{TOOL_HOME}."/".$file;
424	williamc	1.6
425	williamc	1.10	if ( ! -f $file ) {
426			$self->error("Unable to find $class in ".$ENV{TOOL_HOME});
427			}
428			print "--------------------- $class ------------------\n";
429			my $fh=FileHandle->new();
430	williamc	1.6	$fh->open("<$file");
431			while ( <$fh> ) {
432			if ( $_=~/#\s*Interface/g ) {
433			$intregion=1;
434			next;
435			}
436			if ( $intregion ) { # if we are in the interface documentation
437			if ( ( $_!~/^#/ ) \|\| ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
438			$intregion=0;
439			next;
440			}
441			print $_;
442			if ( $_=~/^#\s(.)\((.)\)?:(.)/ ) {
443			$interface=$1;
444			$args=$2;
445			$rest=$3;
446			next if ($interface eq "");
447			push @interfaces,$interface;
448			$interfaceargs{$interface}=$args;
449			}
450			}
451			}
452			print "\n";
453	williamc	1.10	undef $fh;
454	williamc	1.2	}
455
456			# -------------- Support Routines ------------------------------
457
458
459			sub _allprojectinitsearcher {
460			if ( ! defined $self->{projsearcher} ) {
461			my $search=_projsearcher();
462			foreach $proj ( $self->scramprojectdb()->list() ) {
463			$search->addproject($$proj[0],$$proj[1]);
464			}
465			}
466	williamc	1.10	return $self->{projsearcher};
467	williamc	1.2	}
468
469			sub _projsearcher {
470			if ( ! defined $self->{projsearcher} ) {
471			require Scram::ProjectSearcher;
472			$self->{projsearcher}=Scram::ProjectSearcher->new(
473			$self->scramprojectdb());
474			}
475			return $self->{projsearcher};
476			}
477
478
479			sub _lookupareaindb {
480			my $self=shift;
481
482			my $area=undef;
483			# -- Look up the area in the databse
484			my @areas=$self->scramprojectdb()->getarea(@_);
485			if ( $#areas > 0 ) { #ambigous
486			# could ask user - for now just error
487			$self->error("Ambigous request - please be more specific");
488			}
489			elsif ( $#areas != 0 ) { #not found
490			$self->error("The project requested has not been found");
491			}
492			else {
493			$area=$areas[0];
494			}
495			return $area;
496			}