src/BuildSystem/ToolBox.pm

#
# ToolBox.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# tools and interface to access them 
#
# Interface
# ---------
# new()         : 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->{urlcache}="$top/.SCRAM/ToolFiles";
        $self->{datastore}=$top."/.SCRAM/".$ENV{SCRAM_ARCH};
        $self->{reqdoc}=$area->requirementsdoc();
        AddDir::adddir($self->{datastore});
        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;

        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 
        print "\n ----------- Setting Up $name $version ---------------\n";
        if ( ($self->interactive()) || (! $self->_copymatchingtool($tool)) ) {
          require BuildSystem::ToolDoc;
          my $doc=BuildSystem::ToolDoc->new();
          $doc->tool($tool);
          $doc->interactive($self->interactive());
          $tool->reset();
          if ( ! $doc->setup($self->{urlcache}."/".$url,$name,$version) ) {
            $tool->url($url);
            $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;

        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 _copymatchingtool {
        my $self=shift;
        my $tool=shift;

        my $rv=0;
        my @validtools=$self->_gettools($tool);
        
        # -- for now we just take the first one
        if ( ! $self->interactive() ) {
          if ( $#validtools >= 0 ) {
           $self->verbose("Found Settings in another tool");
           my $file=$self->_toolfile($validtool[0]->name(),
                                        $validtool[0]->version());
           $validtools[0]->store($file);
           $tool->restore($file);
           $rv=1;
          }
        }
        return $rv;
}

#
# return list of matching tools
sub _gettools {
        my $self=shift;
        my $tool=shift;

        my @tools=();
        my $area;
        my $rtool;
        if ( defined $self->{toolboxsearcher} ) {
           my $it=$self->{toolboxsearcher}->newiterator();
           while ( ! $it->last()  ) {
             $area=$it->next();
             $self->verbose("Searching for ".$tool->name()." ".
                 $tool->version()." in ".$area->location());
             $rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
             if ( (defined $rtool) && $rtool->equals($tool) ) {
                push @tools,$rtool;
             }
           }
        }
        return @tools;
}

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;

        # -- make sure we have a copy of the file
        if ( ! -e $self->{urlcache}."/".$url ) {
                $self->verbose("Attemting Download of $url");
                &urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
                        .$url, $self->{urlcache}."/$url") ;
        }
        return $url;
}

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

        # -- Get defaults from the RequirementsDoc
        my $req=$self->_requirements();
        my $tool;
        foreach $tool ( $req->tools()) {
           push @{$self->{toollist}}, [ ($tool, $req->version($tool)) ];
           if ( ! defined $self->{defaults}{$tool} ) {
             $self->{defaults}{$tool}=$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} ) {
          require BuildSystem::Requirements;
          $self->{reqsobj}=
                BuildSystem::Requirements->new($ENV{SCRAM_ProjReqsDoc});
        }
        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->verbose("Tool $product $version needs set up");
           }
        #   push @{$self->{toollist}}, [$product, $version];
        }
        return ($self->{tools}{$product}{$version}, $rv);
}
Revision:	1.1.2.15
Committed:	Thu May 4 07:53:04 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
Changes since 1.1.2.14:	+30 -15 lines
Log Message:	ToolBox Searching added + url bugfixes
#	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			# new() : A new toolbox object
13			# 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			#$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			$self->{urlcache}="$top/.SCRAM/ToolFiles";
48			$self->{datastore}=$top."/.SCRAM/".$ENV{SCRAM_ARCH};
49			$self->{reqdoc}=$area->requirementsdoc();
50	williamc	1.1.2.3	AddDir::adddir($self->{datastore});
51			AddDir::adddir($self->{urlcache});
52	williamc	1.1.2.15	$self->_readdefaultsfile($config."/External_Dependencies");
53	williamc	1.1.2.1	}
54
55	williamc	1.1.2.8	sub interactive {
56			my $self=shift;
57
58			@_?$self->{interactive}=shift
59			:((defined $self->{interactive})?$self->{interactive}:0);
60			}
61
62	williamc	1.1.2.1	sub tools {
63			my $self=shift;
64			return @{$self->{toollist}};
65			}
66
67	williamc	1.1.2.3	sub toolsetup {
68			my $self=shift;
69			my $name=shift;
70
71			my $rv=0;
72			# -- get version
73			my $version;
74			if ( @_ ) {
75			$version=shift;
76			}
77			else {
78			$version=$self->defaultversion($name);
79			if ( ! defined $version ) { $rv=1; return $rv; }
80			}
81
82			my $url;
83
84			# -- get a tool object
85			my ($tool)=$self->_toolobject($name,$version);
86
87			# -- get the url
88			if ( @_ ) {
89			$url=shift;
90			}
91			else {
92			# no url specified - try to get it from the tool
93			$url=$tool->url();
94			if ( ! defined $url ) {
95			$self->error("Unable to determine document for tool ".
96			$name." ".$version);
97			}
98			}
99			$url=$self->_download($url);
100
101	williamc	1.1.2.14	# -- the tool setup
102	williamc	1.1.2.10	print "\n ----------- Setting Up $name $version ---------------\n";
103	williamc	1.1.2.15	if ( ($self->interactive()) \|\| (! $self->_copymatchingtool($tool)) ) {
104	williamc	1.1.2.14	require BuildSystem::ToolDoc;
105			my $doc=BuildSystem::ToolDoc->new();
106			$doc->tool($tool);
107			$doc->interactive($self->interactive());
108			$tool->reset();
109	williamc	1.1.2.15	if ( ! $doc->setup($self->{urlcache}."/".$url,$name,$version) ) {
110			$tool->url($url);
111	williamc	1.1.2.14	$tool->store($self->_toolfile($name,$version));
112			}
113			else {
114			$self->error("Unable to find $name $version in $url");
115			}
116			undef $doc;
117	williamc	1.1.2.3	}
118			return $rv;
119			}
120
121	williamc	1.1.2.14	sub searcher {
122			my $self=shift;
123
124			if ( @_ ) {
125			$self->{toolboxsearcher}=shift;
126			}
127			return $self->{toolboxsearcher};
128			}
129	williamc	1.1.2.3
130	williamc	1.1.2.1	sub gettool {
131			my $self=shift;
132			my $product=shift;
133			my $version;
134
135			if ( @_ ) { $version=shift; }
136			else {
137			# lookup the default version
138			$version=$self->defaultversion($product);
139			return undef, if ( ! defined $version );
140			}
141	williamc	1.1.2.3	my ($tool,$rv)=$self->_toolobject($product,$version);
142			return ( $rv==0?$tool:undef ); # only return if already set up
143	williamc	1.1.2.1	}
144
145			sub defaultversion {
146			my $self=shift;
147			my $product=shift;
148
149			return $self->{defaults}{$product};
150	williamc	1.1.2.14	}
151
152			sub _copymatchingtool {
153			my $self=shift;
154			my $tool=shift;
155
156			my $rv=0;
157			my @validtools=$self->_gettools($tool);
158
159			# -- for now we just take the first one
160			if ( ! $self->interactive() ) {
161			if ( $#validtools >= 0 ) {
162	williamc	1.1.2.15	$self->verbose("Found Settings in another tool");
163	williamc	1.1.2.14	my $file=$self->_toolfile($validtool[0]->name(),
164			$validtool[0]->version());
165			$validtools[0]->store($file);
166			$tool->restore($file);
167			$rv=1;
168			}
169			}
170			return $rv;
171	williamc	1.1.2.1	}
172
173	williamc	1.1.2.13	#
174			# return list of matching tools
175			sub _gettools {
176			my $self=shift;
177			my $tool=shift;
178
179			my @tools=();
180	williamc	1.1.2.15	my $area;
181			my $rtool;
182	williamc	1.1.2.13	if ( defined $self->{toolboxsearcher} ) {
183			my $it=$self->{toolboxsearcher}->newiterator();
184			while ( ! $it->last() ) {
185	williamc	1.1.2.15	$area=$it->next();
186			$self->verbose("Searching for ".$tool->name()." ".
187			$tool->version()." in ".$area->location());
188			$rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
189			if ( (defined $rtool) && $rtool->equals($tool) ) {
190	williamc	1.1.2.13	push @tools,$rtool;
191			}
192			}
193			}
194			return @tools;
195			}
196
197	williamc	1.1.2.3	sub _toolfile {
198			my $self=shift;
199			my $name=shift;
200			my $version=shift;
201
202	williamc	1.1.2.12	$name=~tr[A-Z][a-z];
203	williamc	1.1.2.11	return $self->{datastore}."/".$name."_$version.dat";
204	williamc	1.1.2.3	}
205
206			sub _download {
207			my $self=shift;
208			my $url=shift;
209
210			# -- make sure we have a copy of the file
211			if ( ! -e $self->{urlcache}."/".$url ) {
212	williamc	1.1.2.15	$self->verbose("Attemting Download of $url");
213	williamc	1.1.2.3	&urlhandler::urlhandler("file:$ENV{SCRAM_HOME}/toolbox/"
214			.$url, $self->{urlcache}."/$url") ;
215			}
216	williamc	1.1.2.15	return $url;
217	williamc	1.1.2.3	}
218
219	williamc	1.1.2.1	sub _readdefaultsfile {
220			my $self=shift;
221			my $file=shift;
222
223	williamc	1.1.2.9	# -- Get defaults from the RequirementsDoc
224			my $req=$self->_requirements();
225			my $tool;
226			foreach $tool ( $req->tools()) {
227	williamc	1.1.2.15	push @{$self->{toollist}}, [ ($tool, $req->version($tool)) ];
228	williamc	1.1.2.9	if ( ! defined $self->{defaults}{$tool} ) {
229			$self->{defaults}{$tool}=$req->version($tool);
230			}
231			}
232
233			# -- Read the default override file
234	williamc	1.1.2.1	my $fh=FileHandle->new();
235	williamc	1.1.2.9	$fh->open("<".$file);
236	williamc	1.1.2.1	while ( <$fh> ) {
237			chomp;
238			next if /^#/;
239			next if /^\s*$/;
240			($product, $version)=split /:/;
241			$product=~tr[A-Z][a-z];
242			$self->{defaults}{$product}=$version;
243			}
244			undef $fh;
245			}
246
247	williamc	1.1.2.9	sub _requirements {
248	williamc	1.1.2.15	my $self=shift;
249			if ( ! defined $self->{reqsobj} ) {
250	williamc	1.1.2.9	require BuildSystem::Requirements;
251	williamc	1.1.2.15	$self->{reqsobj}=
252			BuildSystem::Requirements->new($ENV{SCRAM_ProjReqsDoc});
253	williamc	1.1.2.9	}
254	williamc	1.1.2.15	return $self->{reqsobj};
255	williamc	1.1.2.9	}
256	williamc	1.1.2.3
257	williamc	1.1.2.1	sub _toolobject {
258			my $self=shift;
259			my $product=shift;
260			my $version=shift;
261
262	williamc	1.1.2.5	my $rv=0;
263	williamc	1.1.2.3
264	williamc	1.1.2.1	if ( ! exists $self->{tools}{$product}{$version} ) {
265	williamc	1.1.2.3	$self->verbose("$product $version being Intitialised");
266	williamc	1.1.2.1	$self->{tools}{$product}{$version}=BuildSystem::Tool->new();
267	williamc	1.1.2.3	my $file=$self->_toolfile($product,$version);
268			if ( -f $file ) { # restore it from disk
269			$self->verbose("Recovering $product $version from $file");
270			$self->{tools}{$product}{$version}->restore($file);
271			}
272			else {
273	williamc	1.1.2.5	$rv=1;
274	williamc	1.1.2.3	$self->verbose("Tool $product $version needs set up");
275			}
276	williamc	1.1.2.15	# push @{$self->{toollist}}, [$product, $version];
277	williamc	1.1.2.1	}
278	williamc	1.1.2.3	return ($self->{tools}{$product}{$version}, $rv);
279	williamc	1.1.2.1	}