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 
        $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
            my $reqs=$self->arearequirements($area);
            $self->verbose("Setup ToolBox from Requirements doc ($reqs)");
            $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 setup info - deprecated by toolbox copy method
        #$relarea->copysetup($area->location());

        # -- 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 spawnversion {
        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
               print "******* Warning : scram version inconsistent ********\n";
               print "This version: $thisversion; Required version: $version\n";
               print "*****************************************************\n";
               print "\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.10
Committed:	Wed Nov 15 10:08:27 2000 UTC (24 years, 6 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V0_18_2, V0_18_1
Changes since 1.9:	+83 -18 lines
Log Message:	Import from V0_18_0
#	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			sub new {
37			my $class=shift;
38			$self={};
39			bless $self, $class;
40			# -- default settings
41	williamc	1.5	$self->{cachedir}=$ENV{HOME}."/.scramrc/globalcache";
42	williamc	1.2	$self->{scramprojectsdbdir}=$ENV{SCRAM_LOOKUPDB};
43	williamc	1.8	($self->{scram_top})=( $ENV{SCRAM_HOME}=~/(.*)\//) ;
44
45	williamc	1.2	return $self;
46			}
47
48	williamc	1.10	sub classverbose {
49			my $self=shift;
50			my $class=shift;
51			my $val=shift;
52
53			$ENV{"VERBOSE_".$class}=$val;
54			}
55
56	williamc	1.2	sub project {
57			my $self=shift;
58			my $url=shift;
59			my $installarea=shift;
60
61			my $areaname="";
62			if ( @_ ) {
63			$areaname=shift;
64			}
65			require Configuration::BootStrapProject;
66			my $bs=Configuration::BootStrapProject->
67			new($self->globalcache(),$installarea);
68			$self->verbose("BootStrapping $url");
69			my $area=$bs->boot($url,$areaname);
70			if ( ! defined $area ) {
71			$self->error("Unable to create project area");
72			}
73			$area->archname($self->arch());
74
75			# -- download all tool description files
76			my $req=$self->arearequirements($area);
77			if ( defined $req ) {
78			$req->download($self->areatoolbox($area));
79			}
80
81			return $area;
82			}
83
84			sub setuptoolsinarea {
85			my $self=shift;
86			my $area=shift;
87
88			# -- initialise
89			$self->_allprojectinitsearcher();
90
91			# -- create a new toolbox object
92			my $toolbox=$self->areatoolbox($area);
93	williamc	1.10	$toolbox->searcher($self->_allprojectinitsearcher());
94	williamc	1.2
95			if ( @_ ) {
96			# -- specific tool specified
97			if ( my $rv=$toolbox->toolsetup(@_) ) {
98			if ( $rv eq 1 ) {
99			print "Unknown tool $toolname @ARGV\n";
100			exit 1;
101			}
102			}
103			}
104			else {
105			# -- setup all tools specified in the requirements doc
106			my $reqs=$self->arearequirements($area);
107			$self->verbose("Setup ToolBox from Requirements doc ($reqs)");
108			$reqs->setup($toolbox);
109			}
110			}
111
112			sub satellite {
113			my $self=shift;
114			my $name=shift;
115			my $version=shift;
116			my $installarea=shift;
117
118	williamc	1.4	my $areaname=undef;
119	williamc	1.2	if ( @_ ) {
120			$areaname=shift;
121			}
122
123			# -- look up scram database for location
124			my $relarea=$self->_lookupareaindb($name,$version);
125			if ( ! defined $relarea ) {
126			$self->error("Unable to Find Project $name $version");
127	williamc	1.4	}
128
129			# -- fix for old broken areas
130			if ( (! defined $relarea->version()) \|\| ($relarea->version() eq "") ) {
131			$relarea->version($version);
132	williamc	1.2	}
133
134			# -- create satellite
135			my $area=$relarea->satellite($installarea,$areaname);
136			$area->archname($self->arch());
137
138			# -- copy setup info - deprecated by toolbox copy method
139			#$relarea->copysetup($area->location());
140
141			# -- copy toolbox
142			my $rtb=$self->areatoolbox($relarea);
143			my $tb=$self->areatoolbox($area);
144			$rtb->copytools($tb);
145
146			# -- copy configuration directory
147			if ( ! -d $area->location()."/".$area->configurationdir() ) {
148			use Utilities::AddDir;
149			AddDir::copydir($relarea->location()."/".$relarea->configurationdir(),
150			$area->location()."/".$area->configurationdir() );
151			}
152
153			# -- copy RequirementsDoc
154			if ( ! -f $area->requirementsdoc() ) {
155	williamc	1.3	use File::Copy;
156	williamc	1.2	copy( $relarea->requirementsdoc() , $area->requirementsdoc());
157			}
158
159			return $area;
160	williamc	1.7	}
161
162	williamc	1.10	sub toolruntime {
163	williamc	1.7	my $self=shift;
164			my $area=shift;
165
166	williamc	1.10	my $name=$area->location();
167			if ( ! defined $self->{toolruntime}{$name} ) {
168			require Runtime;
169			my $toolbox=$self->areatoolbox($area);
170			$self->{toolruntime}{$name}=Runtime->new();
171
172			# -- add scram area specific runtimes
173			$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
174			$area->location()."/lib/".$self->arch(),"path");
175			$self->{toolruntime}{$name}->addvar("PATH",
176			$area->location()."/bin/".$self->arch(),"path");
177			if ( defined $area->linkarea() ) {
178			my $reltop=$area->linkarea()->location();
179			$self->{toolruntime}{$name}->addvar("LD_LIBRARY_PATH",
180			$reltop."/lib/".$self->arch(),"path");
181			$self->{toolruntime}{$name}->addvar("PATH",
182			$reltop."/bin/".$self->arch(),"path");
183			}
184
185			# -- get the runtime environment from all the tools
186			my $tool;
187			foreach $toolname ( $toolbox->tools() ) {
188			$tool=$toolbox->gettool($toolname);
189			if ( defined $tool ) {
190			# -- get runtime paths
191			foreach $f ( $tool->listtype("runtime_path")) {
192			foreach $val ( $tool->getfeature($f) ) {
193			$self->{toolruntime}{$name}->addvar($f,$val,"path");
194			}
195			}
196			# -- get runtime vars
197			foreach $f ( $tool->listtype("runtime")) {
198			foreach $val ( $tool->getfeature($f) ) {
199			$self->{toolruntime}{$name}->addvar($f,$val);
200			}
201			}
202			}
203			}
204
205			# -- Get the project level environment
206			my $runtimefile=$area->location()."/".$area->configurationdir()
207			."/Runtime";
208			if ( -f $runtimefile ) {
209			$self->{toolruntime}{$name}->file($runtimefile);
210			}
211			}
212			return $self->{toolruntime}{$name};
213			}
214
215			sub webget {
216			my $self=shift;
217			my $area=shift;
218			my $url=shift;
219
220			require URL::URLhandler;
221			my $handler=URL::URLhandler->new($area->cache());
222			return ($handler->download($url));
223	williamc	1.2	}
224
225			sub addareatoDB {
226			my $self=shift;
227			my $area=shift;
228			my $tagname=shift;
229			my $version=shift;
230
231			# -- create defaults if necessary
232			if ( (! defined $version) \|\| ( $version eq "") ) {
233			$version=$area->version();
234			}
235			if ( (! defined $tagname) \|\| ( $tagname eq "") ) {
236			$tagname=$area->name();
237			}
238
239			# -- Add to the DB
240			$self->scramprojectdb()->addarea($tagname,$version,$area);
241			}
242
243	williamc	1.8	sub spawnversion {
244			my $self=shift;
245			my $version=shift;
246
247			my $rv=0;
248			my $thisversion=$self->getversion();
249			if ( defined $version ) {
250			if ( $version ne $thisversion ) {
251			# first try to use the correct version
252			if ( -d $self->{scram_top}."/".$version ) {
253			$ENV{SCRAM_HOME}=$self->{scram_top}."/".$version;
254			$ENV{TOOL_HOME}="$ENV{SCRAM_HOME}/src";
255			$self->verbose("Spawning SCRAM version $version");
256			my $rv=system("scram", @_)/256;
257			exit $rv;
258			}
259			else { # if not then simply warn
260			print "***** Warning : scram version inconsistent ******\n";
261			print "This version: $thisversion; Required version: $version\n";
262			print "*****************************************************\n";
263			print "\n";
264			}
265			}
266			}
267			else {
268			$self->error("Undefined value for version requested");
269			$rv=1;
270			}
271			return $rv;
272			}
273
274	williamc	1.2	sub globalcache {
275			my $self=shift;
276			if ( @_ ) {
277			$self->{cachedir}=shift;
278			}
279			if ( ! defined $self->{globalcache} ) {
280			$self->{globalcache}=URL::URLcache->new($self->{cachedir});
281			}
282			return $self->{globalcache};
283			}
284
285
286			sub scramprojectdb {
287			my $self=shift;
288			if ( @_ ) {
289			$self->{scramprojectsdbdir}=shift;
290			}
291			if ( ! defined $self->{scramprojectsdb} ) {
292			require Scram::ScramProjectDB;
293			$self->{scramprojectsdb}=Scram::ScramProjectDB->new(
294			$self->{scramprojectsdbdir} );
295			$self->{scramprojectsdb}->verbosity($self->verbosity());
296			}
297			return $self->{scramprojectsdb};
298			}
299	williamc	1.8
300			sub getversion {
301			my $self=shift;
302
303			my $thisversion;
304			($thisversion=$ENV{SCRAM_HOME})=~s/(.*)\///;
305			my $scram_top=$1;
306			my $scram_version=$thisversion;
307			# deal with links
308			my $version=readlink $ENV{SCRAM_HOME};
309			if ( defined $version) {
310			$scram_version=$version;
311			}
312			return $scram_version;
313			}
314	williamc	1.2
315			sub areatoolbox {
316			my $self=shift;
317			my $area=shift;
318
319			my $name=$area->location();
320			if ( ! defined $self->{toolboxes}{$name} ) {
321			# -- create a new toolbox object
322			require BuildSystem::ToolBox;
323	williamc	1.8	$self->{toolboxes}{$name}=BuildSystem::ToolBox->new($area,
324			$self->arch());
325	williamc	1.2	$self->{toolboxes}{$name}->verbosity($self->verbosity());
326			}
327			return $self->{toolboxes}{$name};
328			}
329
330			sub arearequirements {
331			my $self=shift;
332			my $area=shift;
333
334			my $name=$area->location();
335			if ( ! defined $self->{requirements}{$name} ) {
336			# -- create a new toolbox object
337			require BuildSystem::Requirements;
338			my $doc=$area->requirementsdoc();
339			my $cache=$area->cache();
340			my $db=$area->objectstore();
341			require ActiveDoc::ActiveStore;
342			my $astore=ActiveDoc::ActiveStore->new($db,$cache);
343			$self->{requirements}{$name}=
344			BuildSystem::Requirements->new($astore,"file:".$doc,
345			$ENV{SCRAM_ARCH});
346			$self->{requirements}{$name}->verbosity($self->verbosity());
347			$self->verbose("Requirements Doc (".$self->{requirements}{$name}.
348			") for area :\n $name\n initiated from $doc");
349			}
350			else {
351			$self->verbose("Requirements Doc (".$self->{requirements}{$name}.")");
352			}
353			return $self->{requirements}{$name};
354			}
355
356			sub arch {
357			my $self=shift;
358
359			@_?$self->{arch}=shift
360			:$self->{arch};
361	williamc	1.6	}
362
363			sub scramobjectinterface {
364	williamc	1.10	my $self=shift;
365			my $class=shift;
366	williamc	1.6
367	williamc	1.10	my $file;
368			($file=$class."\.pm")=~s/::/\//g;
369			$file=$ENV{TOOL_HOME}."/".$file;
370	williamc	1.6
371	williamc	1.10	if ( ! -f $file ) {
372			$self->error("Unable to find $class in ".$ENV{TOOL_HOME});
373			}
374			print "--------------------- $class ------------------\n";
375			my $fh=FileHandle->new();
376	williamc	1.6	$fh->open("<$file");
377			while ( <$fh> ) {
378			if ( $_=~/#\s*Interface/g ) {
379			$intregion=1;
380			next;
381			}
382			if ( $intregion ) { # if we are in the interface documentation
383			if ( ( $_!~/^#/ ) \|\| ( $_=~/^#\s?-{40}/ ) ) { #moving out of Int doc
384			$intregion=0;
385			next;
386			}
387			print $_;
388			if ( $_=~/^#\s(.)\((.)\)?:(.)/ ) {
389			$interface=$1;
390			$args=$2;
391			$rest=$3;
392			next if ($interface eq "");
393			push @interfaces,$interface;
394			$interfaceargs{$interface}=$args;
395			}
396			}
397			}
398			print "\n";
399	williamc	1.10	undef $fh;
400	williamc	1.2	}
401
402			# -------------- Support Routines ------------------------------
403
404
405			sub _allprojectinitsearcher {
406			if ( ! defined $self->{projsearcher} ) {
407			my $search=_projsearcher();
408			foreach $proj ( $self->scramprojectdb()->list() ) {
409			$search->addproject($$proj[0],$$proj[1]);
410			}
411			}
412	williamc	1.10	return $self->{projsearcher};
413	williamc	1.2	}
414
415			sub _projsearcher {
416			if ( ! defined $self->{projsearcher} ) {
417			require Scram::ProjectSearcher;
418			$self->{projsearcher}=Scram::ProjectSearcher->new(
419			$self->scramprojectdb());
420			}
421			return $self->{projsearcher};
422			}
423
424
425			sub _lookupareaindb {
426			my $self=shift;
427
428			my $area=undef;
429			# -- Look up the area in the databse
430			my @areas=$self->scramprojectdb()->getarea(@_);
431			if ( $#areas > 0 ) { #ambigous
432			# could ask user - for now just error
433			$self->error("Ambigous request - please be more specific");
434			}
435			elsif ( $#areas != 0 ) { #not found
436			$self->error("The project requested has not been found");
437			}
438			else {
439			$area=$areas[0];
440			}
441			return $area;
442			}