11 |
|
# --------- |
12 |
|
# new() : A new ToolDoc object |
13 |
|
# tool(toolobj) : set the tool object for the class |
14 |
+ |
# toolsearcher(searcher) : set the searcher for finding reference tools |
15 |
|
# setup(file,$name,$version) : setup a tool object from the specified file |
16 |
|
# return 0 for OK 1 for cancel |
17 |
|
# interactive([0|1]) : set the interactive node 0=off 1=on |
19 |
|
package BuildSystem::ToolDoc; |
20 |
|
require 5.004; |
21 |
|
use ActiveDoc::SimpleDoc; |
22 |
+ |
use Utilities::Verbose; |
23 |
+ |
@ISA=qw(Utilities::Verbose); |
24 |
|
|
25 |
|
sub new { |
26 |
|
my $class=shift; |
56 |
|
"", $self, |
57 |
|
\&Arch_End,$self); |
58 |
|
$self->{Arch}=1; |
59 |
< |
push @{$self->{ARCHBLOCK}}, $Arch; |
59 |
> |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
60 |
|
|
61 |
|
} |
62 |
|
|
72 |
|
$self->{tool}=shift; |
73 |
|
} |
74 |
|
|
75 |
+ |
sub toolsearcher { |
76 |
+ |
my $self=shift; |
77 |
+ |
if ( @_ ) { |
78 |
+ |
my $searcher=shift; |
79 |
+ |
if ( ! defined $searcher ) { |
80 |
+ |
$self->error("Undefined Value passed as a Searcher". |
81 |
+ |
" in ToolDoc::toolsearcher"); |
82 |
+ |
} |
83 |
+ |
$self->{toolboxsearcher}=$searcher; |
84 |
+ |
} |
85 |
+ |
return $self->{toolboxsearcher}; |
86 |
+ |
} |
87 |
+ |
|
88 |
|
sub setup { |
89 |
|
my $self=shift; |
90 |
|
my $file=shift; |
98 |
|
$name=~tr[A-Z][a-z]; |
99 |
|
$self->{tool}->name($name); |
100 |
|
$self->{tool}->version($version); |
85 |
– |
$self->{tool}->url($file); |
101 |
|
$self->{switch}->filetoparse($file); |
102 |
|
$self->{toolfound}=1; |
103 |
|
$self->{switch}->parse("setup"); |
222 |
|
|
223 |
|
} |
224 |
|
|
225 |
+ |
# |
226 |
+ |
# Propgate through the searcher collecting matching tools |
227 |
+ |
# |
228 |
+ |
sub _searchtools { |
229 |
+ |
my $self=shift; |
230 |
+ |
my $tool=shift; |
231 |
+ |
|
232 |
+ |
my @tools=(); |
233 |
+ |
my $area; |
234 |
+ |
my $rtool; |
235 |
+ |
if ( defined $self->{toolboxsearcher} ) { |
236 |
+ |
my $it=$self->{toolboxsearcher}->newiterator(); |
237 |
+ |
while ( ! $it->last() ) { |
238 |
+ |
$area=$it->next(); |
239 |
+ |
if ( defined $area ) { |
240 |
+ |
$self->verbose("Searching for ".$tool->name()." ". |
241 |
+ |
$tool->version()." in ".$area->location()); |
242 |
+ |
$rtool=$area->toolbox()->gettool($tool->name(),$tool->version()); |
243 |
+ |
if ( (defined $rtool) && $rtool->equals($tool) ) { |
244 |
+ |
push @tools,$rtool; |
245 |
+ |
} |
246 |
+ |
} |
247 |
+ |
} |
248 |
+ |
} |
249 |
+ |
return @tools; |
250 |
+ |
} |
251 |
+ |
|
252 |
+ |
# search toolboxes for a nice list |
253 |
+ |
# |
254 |
+ |
sub _toolparamcopy { |
255 |
+ |
my $self=shift; |
256 |
+ |
my $tool=shift; |
257 |
+ |
my $param=shift; |
258 |
+ |
|
259 |
+ |
my $rv=0; |
260 |
+ |
my @params=(); |
261 |
+ |
$self->verbose("Check Other Projects for tool"); |
262 |
+ |
my @validtools=$self->_searchtools($tool); |
263 |
+ |
if ( ! $self->interactive() ) { |
264 |
+ |
if ( $#validtools >=0 ) { |
265 |
+ |
@params=$validtools[0]->getfeature($param); |
266 |
+ |
if ( $#params >=0 ) { |
267 |
+ |
$self->verbose("Extracting Feature $param from tool". |
268 |
+ |
" (= @params )\n"); |
269 |
+ |
#$tool->setfeature($param,@params); |
270 |
+ |
$rv=1; |
271 |
+ |
} |
272 |
+ |
} |
273 |
+ |
} |
274 |
+ |
return ($rv,@params); |
275 |
+ |
} |
276 |
+ |
|
277 |
|
# -- Tag Routines |
278 |
|
|
279 |
|
sub Client_start { |
341 |
|
$self->{currentenvtext}=""; |
342 |
|
$self->{EnvContext}=$$hashref{'name'}; |
343 |
|
undef $self->{Envvalue}; |
344 |
< |
if ( exists $$hahsref{'type'} ) { |
345 |
< |
$self->{tool}->type($$hashref{'name'},$$hahsref{'type'}); |
344 |
> |
if ( exists $$hashref{'type'} ) { |
345 |
> |
$$hashref{'type'}=~tr[A-Z][a-z]; |
346 |
> |
$self->{tool}->type($$hashref{'name'},$$hashref{'type'}); |
347 |
|
} |
348 |
|
if ( exists $$hashref{'value'}) { |
349 |
|
$self->{Envvalue}=$$hashref{'value'}; |
350 |
|
} |
351 |
|
elsif ( ! $self->interactive() ) { |
352 |
< |
if ( $self->_checkdefault($hashref) ) { |
353 |
< |
$self->{Envvalue}=$$hashref{'default'}; |
352 |
> |
# check other installed copies of the tool |
353 |
> |
my ($rv,@params)= |
354 |
> |
$self->_toolparamcopy($self->{tool},$$hashref{'name'}); |
355 |
> |
if ( $rv && ($#params == 0)) { #dont use multivalued params! |
356 |
> |
$self->{Envvalue}=$params[0]; # single val parameter |
357 |
> |
} |
358 |
> |
elsif ( defined $ENV{$$hashref{'name'}} ) { |
359 |
> |
# check the environment |
360 |
> |
$self->{Envvalue}=$ENV{$$hashref{'name'}}; |
361 |
> |
} |
362 |
> |
elsif ( $self->_checkdefault($hashref) ) { |
363 |
> |
$self->{Envvalue}=$$hashref{'default'}; |
364 |
|
} |
365 |
|
} |
366 |
|
} |
382 |
|
|
383 |
|
if ( $self->{Arch} ) { |
384 |
|
if ( ! defined $self->{EnvContext} ) { |
385 |
< |
$self->parseerror("</\$name> without an opening context"); |
385 |
> |
$self->{switch}->parseerror("</$name> without an opening context"); |
386 |
|
} |
387 |
|
# - set the help text |
388 |
|
$self->featuretext($self->{EnvContext},$self->{currentenvtext}); |
425 |
|
my $name=shift; |
426 |
|
my $hashref=shift; |
427 |
|
|
428 |
< |
$toolswitch->checktag($name, $hashref,'name'); |
428 |
> |
$self->{switch}->checktag($name, $hashref,'name'); |
429 |
|
( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1) |
430 |
|
: ($self->{Arch}=0); |
431 |
|
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |