src/BuildSystem/ToolBox.pm

#
# ToolBox.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# tools and interface to access them 
#
# Interface
# ---------
# new(ConfigArea)       : A new toolbox object
# tools()       : return a list of tools (name,version) pairs
# defaultversion(tool) : return the default version of the specified tool
# gettool(name[,version]) : get the tool object with the given name
#                           returns the default version if version not spec.
#                           returns undef if no setup tool is available
# toolsetup(name,version[,doc]) : setup the named tool from the specified doc
#                                 if doc not specified try and use previous
#                                 document; returns 0=OK 1=no version 
# interactive(0|1)      : set the setup mode
# searcher(SearchObject) : Set the search object for matching tools during setup

package BuildSystem::ToolBox;
use FileHandle;
use BuildSystem::Tool;
use Utilities::Verbose;

@ISA=qw(Utilities::Verbose);
require 5.004;

sub new {
        my $class=shift;
        my $area=shift;
        $self={};
        bless $self, $class;
        $self->init($area);
        #$self->verbosity(1);
        return $self;
}

sub init {
        my $self=shift;
        my $area=shift;
        my $top=$area->location();
        my $config=$top."/".$area->configurationdir();
        $self->{area}=$area;
        $self->{urlcache}="$top/.SCRAM/ToolFiles";
        $self->{datastore}=$top."/.SCRAM/".$ENV{SCRAM_ARCH};
        AddDir::adddir($self->{urlcache});
        $self->_readdefaultsfile($config."/External_Dependencies");
}

sub interactive {
        my $self=shift;

        @_?$self->{interactive}=shift
          :((defined $self->{interactive})?$self->{interactive}:0);
}

sub tools {
        my $self=shift;
        return @{$self->{toollist}};
}

sub toolsetup {
        my $self=shift;
        my $name=shift;

        AddDir::adddir($self->{datastore});
        $name=~tr[A-Z][a-z];
        my $rv=0;
        # -- get version
        my $version;
        if ( @_ ) {
          $version=shift;
        }
        else {
          $version=$self->defaultversion($name);
          if ( ! defined $version ) { $rv=1; return $rv; }
        }

        my $url;

        # -- get a tool object
        my ($tool)=$self->_toolobject($name,$version);

        # -- get the url
        if ( @_ ) {
          $url=shift;
        }
        else {
          # no url specified - try to get it from the tool
          $url=$tool->url();
          if ( ! defined $url ) {
            $self->error("Unable to determine document for tool ".
                                $name." ".$version);
          }
        }
        $url=$self->_download($url);

        # -- the tool setup 
        $tool->url($url);
        print "\n ----------- Setting Up $name $version ---------------\n";
        require BuildSystem::ToolDoc;
        my $doc=BuildSystem::ToolDoc->new();
        $doc->tool($tool);
        if ( defined $self->searcher() ) {
          $doc->toolsearcher($self->searcher());
        }
        $doc->interactive($self->interactive());
        $tool->reset();
        if ( ! $doc->setup($self->{urlcache}."/".$url,$name,$version) ) {
          $tool->store($self->_toolfile($name,$version));
        }
        else {
          $self->error("Unable to find $name $version in $url");
        }
        undef $doc;

        return $rv;
}

sub searcher {
        my $self=shift;

        if ( @_ ) {
            $self->{toolboxsearcher}=shift;
        }
        return $self->{toolboxsearcher};
}

sub gettool {
        my $self=shift;
        my $product=shift;
        my $version;

        $product=~tr[A-Z][a-z];
        if ( @_ ) { $version=shift; }
        else {
          # lookup the default version
          $version=$self->defaultversion($product);
          return undef, if ( ! defined $version );
        }
        my ($tool,$rv)=$self->_toolobject($product,$version); 
        return ( $rv==0?$tool:undef ); # only return if already set up
}

sub defaultversion {
        my $self=shift;
        my $product=shift;

        return $self->{defaults}{$product};
}

sub _toolfile {
        my $self=shift;
        my $name=shift;
        my $version=shift;

        $name=~tr[A-Z][a-z];
        return $self->{datastore}."/".$name."_$version.dat";
}

sub _download {
        my $self=shift;
        my $url=shift;

        my $name;
        # -- make sure we have a copy of the file
        if ( ! -f $self->{urlcache}."/".$url ) {
                if ( $url!~/:/ ) {
                   $name=$url;
                   $url="file:$ENV{SCRAM_HOME}/toolbox/".$url;
                }
                else {
                   ($name=$url)=~s/.*\/(.*)/$1/;
                }
                $self->verbose("Attempting Download of $url");
                &urlhandler::urlhandler($url,
                        , $self->{urlcache}."/$name") ;
                $url=$name;
        }
        return $url;
}

sub _readdefaultsfile {
        my $self=shift;
        my $file=shift;

        # -- Get defaults from the RequirementsDoc
        my $req=$self->_requirements();
        my $tool;
        my $toollower;
        foreach $tool ( $req->tools()) {
           ($toollower=$tool)=~tr[A-Z][a-z];
           push @{$self->{toollist}}, [ ($toollower, $req->version($tool)) ];
           if ( ! defined $self->{defaults}{$toollower} ) {
             $self->{defaults}{$toollower}=$req->version($tool);
           }
        }

        # -- Read the default override file
        my $fh=FileHandle->new();
        $fh->open("<".$file); 
        while ( <$fh> ) {
          chomp;
          next if /^#/;
          next if /^\s*$/;
          ($product, $version)=split /:/;
          $product=~tr[A-Z][a-z];
          $self->{defaults}{$product}=$version;
        }
        undef $fh;
}

sub _requirements {
        my $self=shift;
        if ( ! defined $self->{reqsobj} ) {
          $self->{reqsobj}=$self->{area}->requirementsdoc();
        }
        return $self->{reqsobj};
}

sub _toolobject {
        my $self=shift;
        my $product=shift;
        my $version=shift;

        my $rv=0;

        if ( ! exists $self->{tools}{$product}{$version} ) {
           $self->verbose("$product $version being Intitialised");
           $self->{tools}{$product}{$version}=BuildSystem::Tool->new();
           my $file=$self->_toolfile($product,$version);
           if ( -f $file ) { # restore it from disk
             $self->verbose("Recovering $product $version from $file");
             $self->{tools}{$product}{$version}->restore($file);
           }
           else {
                $rv=1;
                $self->{tools}{$product}{$version}->name($product);
                $self->{tools}{$product}{$version}->version($version);
                $self->verbose("Tool $product $version needs set up");
                #push @{$self->{toollist}}, [$product, $version];
           }
        }
        return ($self->{tools}{$product}{$version}, $rv);
}

sub runtime {
        my $self=shift;
        my $hashref=shift;

        $self->verbose("ToolBox Runtime Setting");
        foreach $tool ( $self->_toolobjs() ) {
           $self->verbose("Setting runtime on ".$tool->name());
           $tool->runtime($hashref);
        }
}

sub _toolobjs {
        my $self=shift;

        my @tools=();
        foreach $toolpair ( $self->tools() ) { 
           my $tool=$self->gettool($$toolpair[0]); #only defaults
           if ( defined $tool ) { 
                push @tools, $tool;
           }
        }
        return @tools;
}
Revision:	1.1.2.27
Committed:	Fri Jun 23 15:35:09 2000 UTC (24 years, 10 months ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_13_3, V0_13_2, V0_13_1
Changes since 1.1.2.26:	+3 -6 lines
Log Message:	sort out requirements object problems
#	User	Rev	Content
1	williamc	1.1.2.1	#
2			# ToolBox.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8	williamc	1.1.2.9	# tools and interface to access them
9	williamc	1.1.2.1	#
10			# Interface
11			# ---------
12	williamc	1.1.2.27	# new(ConfigArea) : A new toolbox object
13	williamc	1.1.2.1	# tools() : return a list of tools (name,version) pairs
14			# defaultversion(tool) : return the default version of the specified tool
15			# gettool(name[,version]) : get the tool object with the given name
16			# returns the default version if version not spec.
17	williamc	1.1.2.3	# returns undef if no setup tool is available
18			# toolsetup(name,version[,doc]) : setup the named tool from the specified doc
19			# if doc not specified try and use previous
20	williamc	1.1.2.7	# document; returns 0=OK 1=no version
21	williamc	1.1.2.8	# interactive(0\|1) : set the setup mode
22	williamc	1.1.2.14	# searcher(SearchObject) : Set the search object for matching tools during setup
23	williamc	1.1.2.1
24			package BuildSystem::ToolBox;
25			use FileHandle;
26			use BuildSystem::Tool;
27	williamc	1.1.2.3	use Utilities::Verbose;
28
29			@ISA=qw(Utilities::Verbose);
30	williamc	1.1.2.1	require 5.004;
31
32			sub new {
33			my $class=shift;
34	williamc	1.1.2.15	my $area=shift;
35	williamc	1.1.2.1	$self={};
36			bless $self, $class;
37	williamc	1.1.2.15	$self->init($area);
38	williamc	1.1.2.18	#$self->verbosity(1);
39	williamc	1.1.2.1	return $self;
40			}
41
42			sub init {
43			my $self=shift;
44	williamc	1.1.2.15	my $area=shift;
45			my $top=$area->location();
46			my $config=$top."/".$area->configurationdir();
47	williamc	1.1.2.27	$self->{area}=$area;
48	williamc	1.1.2.15	$self->{urlcache}="$top/.SCRAM/ToolFiles";
49			$self->{datastore}=$top."/.SCRAM/".$ENV{SCRAM_ARCH};
50	williamc	1.1.2.3	AddDir::adddir($self->{urlcache});
51	williamc	1.1.2.15	$self->_readdefaultsfile($config."/External_Dependencies");
52	williamc	1.1.2.1	}
53
54	williamc	1.1.2.8	sub interactive {
55			my $self=shift;
56
57			@_?$self->{interactive}=shift
58			:((defined $self->{interactive})?$self->{interactive}:0);
59			}
60
61	williamc	1.1.2.1	sub tools {
62			my $self=shift;
63			return @{$self->{toollist}};
64			}
65
66	williamc	1.1.2.3	sub toolsetup {
67			my $self=shift;
68			my $name=shift;
69
70	williamc	1.1.2.20	AddDir::adddir($self->{datastore});
71	williamc	1.1.2.18	$name=~tr[A-Z][a-z];
72	williamc	1.1.2.3	my $rv=0;
73			# -- get version
74			my $version;
75			if ( @_ ) {
76			$version=shift;
77			}
78			else {
79			$version=$self->defaultversion($name);
80			if ( ! defined $version ) { $rv=1; return $rv; }
81			}
82
83			my $url;
84
85			# -- get a tool object
86			my ($tool)=$self->_toolobject($name,$version);
87
88			# -- get the url
89			if ( @_ ) {
90			$url=shift;
91			}
92			else {
93			# no url specified - try to get it from the tool
94			$url=$tool->url();
95			if ( ! defined $url ) {
96			$self->error("Unable to determine document for tool ".
97			$name." ".$version);
98			}
99			}
100			$url=$self->_download($url);
101
102	williamc	1.1.2.14	# -- the tool setup
103	williamc	1.1.2.19	$tool->url($url);
104	williamc	1.1.2.10	print "\n ----------- Setting Up $name $version ---------------\n";
105	williamc	1.1.2.25	require BuildSystem::ToolDoc;
106			my $doc=BuildSystem::ToolDoc->new();
107			$doc->tool($tool);
108	williamc	1.1.2.26	if ( defined $self->searcher() ) {
109			$doc->toolsearcher($self->searcher());
110			}
111	williamc	1.1.2.25	$doc->interactive($self->interactive());
112			$tool->reset();
113			if ( ! $doc->setup($self->{urlcache}."/".$url,$name,$version) ) {
114			$tool->store($self->_toolfile($name,$version));
115	williamc	1.1.2.3	}
116	williamc	1.1.2.25	else {
117			$self->error("Unable to find $name $version in $url");
118			}
119			undef $doc;
120
121	williamc	1.1.2.3	return $rv;
122			}
123
124	williamc	1.1.2.14	sub searcher {
125			my $self=shift;
126
127			if ( @_ ) {
128			$self->{toolboxsearcher}=shift;
129			}
130			return $self->{toolboxsearcher};
131			}
132	williamc	1.1.2.3
133	williamc	1.1.2.1	sub gettool {
134			my $self=shift;
135			my $product=shift;
136			my $version;
137
138	williamc	1.1.2.17	$product=~tr[A-Z][a-z];
139	williamc	1.1.2.1	if ( @_ ) { $version=shift; }
140			else {
141			# lookup the default version
142			$version=$self->defaultversion($product);
143			return undef, if ( ! defined $version );
144			}
145	williamc	1.1.2.3	my ($tool,$rv)=$self->_toolobject($product,$version);
146			return ( $rv==0?$tool:undef ); # only return if already set up
147	williamc	1.1.2.1	}
148
149			sub defaultversion {
150			my $self=shift;
151			my $product=shift;
152
153			return $self->{defaults}{$product};
154	williamc	1.1.2.13	}
155
156	williamc	1.1.2.3	sub _toolfile {
157			my $self=shift;
158			my $name=shift;
159			my $version=shift;
160
161	williamc	1.1.2.12	$name=~tr[A-Z][a-z];
162	williamc	1.1.2.11	return $self->{datastore}."/".$name."_$version.dat";
163	williamc	1.1.2.3	}
164
165			sub _download {
166			my $self=shift;
167			my $url=shift;
168
169	williamc	1.1.2.22	my $name;
170	williamc	1.1.2.3	# -- make sure we have a copy of the file
171	williamc	1.1.2.22	if ( ! -f $self->{urlcache}."/".$url ) {
172			if ( $url!~/:/ ) {
173			$name=$url;
174			$url="file:$ENV{SCRAM_HOME}/toolbox/".$url;
175			}
176			else {
177			($name=$url)=~s/.\/(.)/$1/;
178			}
179			$self->verbose("Attempting Download of $url");
180			&urlhandler::urlhandler($url,
181			, $self->{urlcache}."/$name") ;
182	williamc	1.1.2.23	$url=$name;
183	williamc	1.1.2.3	}
184	williamc	1.1.2.15	return $url;
185	williamc	1.1.2.3	}
186
187	williamc	1.1.2.1	sub _readdefaultsfile {
188			my $self=shift;
189			my $file=shift;
190
191	williamc	1.1.2.9	# -- Get defaults from the RequirementsDoc
192			my $req=$self->_requirements();
193			my $tool;
194	williamc	1.1.2.17	my $toollower;
195	williamc	1.1.2.9	foreach $tool ( $req->tools()) {
196	williamc	1.1.2.17	($toollower=$tool)=~tr[A-Z][a-z];
197			push @{$self->{toollist}}, [ ($toollower, $req->version($tool)) ];
198			if ( ! defined $self->{defaults}{$toollower} ) {
199			$self->{defaults}{$toollower}=$req->version($tool);
200	williamc	1.1.2.9	}
201			}
202
203			# -- Read the default override file
204	williamc	1.1.2.1	my $fh=FileHandle->new();
205	williamc	1.1.2.9	$fh->open("<".$file);
206	williamc	1.1.2.1	while ( <$fh> ) {
207			chomp;
208			next if /^#/;
209			next if /^\s*$/;
210			($product, $version)=split /:/;
211			$product=~tr[A-Z][a-z];
212			$self->{defaults}{$product}=$version;
213			}
214			undef $fh;
215			}
216
217	williamc	1.1.2.9	sub _requirements {
218	williamc	1.1.2.15	my $self=shift;
219			if ( ! defined $self->{reqsobj} ) {
220	williamc	1.1.2.27	$self->{reqsobj}=$self->{area}->requirementsdoc();
221	williamc	1.1.2.9	}
222	williamc	1.1.2.15	return $self->{reqsobj};
223	williamc	1.1.2.9	}
224	williamc	1.1.2.3
225	williamc	1.1.2.1	sub _toolobject {
226			my $self=shift;
227			my $product=shift;
228			my $version=shift;
229
230	williamc	1.1.2.5	my $rv=0;
231	williamc	1.1.2.3
232	williamc	1.1.2.1	if ( ! exists $self->{tools}{$product}{$version} ) {
233	williamc	1.1.2.3	$self->verbose("$product $version being Intitialised");
234	williamc	1.1.2.1	$self->{tools}{$product}{$version}=BuildSystem::Tool->new();
235	williamc	1.1.2.3	my $file=$self->_toolfile($product,$version);
236			if ( -f $file ) { # restore it from disk
237			$self->verbose("Recovering $product $version from $file");
238			$self->{tools}{$product}{$version}->restore($file);
239			}
240			else {
241	williamc	1.1.2.5	$rv=1;
242	williamc	1.1.2.19	$self->{tools}{$product}{$version}->name($product);
243			$self->{tools}{$product}{$version}->version($version);
244	williamc	1.1.2.3	$self->verbose("Tool $product $version needs set up");
245	williamc	1.1.2.26	#push @{$self->{toollist}}, [$product, $version];
246	williamc	1.1.2.3	}
247	williamc	1.1.2.1	}
248	williamc	1.1.2.3	return ($self->{tools}{$product}{$version}, $rv);
249	williamc	1.1.2.26	}
250
251			sub runtime {
252			my $self=shift;
253			my $hashref=shift;
254
255			$self->verbose("ToolBox Runtime Setting");
256			foreach $tool ( $self->_toolobjs() ) {
257			$self->verbose("Setting runtime on ".$tool->name());
258			$tool->runtime($hashref);
259			}
260			}
261
262			sub _toolobjs {
263			my $self=shift;
264
265			my @tools=();
266			foreach $toolpair ( $self->tools() ) {
267			my $tool=$self->gettool($$toolpair[0]); #only defaults
268			if ( defined $tool ) {
269			push @tools, $tool;
270			}
271			}
272			return @tools;
273	williamc	1.1.2.1	}