ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolDoc.pm
Revision: 1.1.2.12
Committed: Tue Jun 20 15:27:40 2000 UTC (24 years, 10 months ago) by williamc
Content type: text/plain
Branch: V0_9branch
Changes since 1.1.2.11: +6 -1 lines
Log Message:
inpiut checking for searcher setting

File Contents

# User Rev Content
1 williamc 1.1.2.1 #
2     # ToolDoc.pm
3     #
4     # Originally Written by Christopher Williams
5     #
6     # Description
7     # -----------
8     # SimpleDoc interface to initialise Tool objects
9     #
10     # Interface
11     # ---------
12     # new() : A new ToolDoc object
13     # tool(toolobj) : set the tool object for the class
14 williamc 1.1.2.11 # toolsearcher(searcher) : set the searcher for finding reference tools
15 williamc 1.1.2.1 # setup(file,$name,$version) : setup a tool object from the specified file
16 williamc 1.1.2.3 # return 0 for OK 1 for cancel
17 williamc 1.1.2.1 # interactive([0|1]) : set the interactive node 0=off 1=on
18    
19     package BuildSystem::ToolDoc;
20     require 5.004;
21     use ActiveDoc::SimpleDoc;
22 williamc 1.1.2.11 use Utilities::Verbose;
23     @ISA=qw(Utilities::Verbose);
24 williamc 1.1.2.1
25     sub new {
26     my $class=shift;
27     $self={};
28     bless $self, $class;
29     $self->init();
30     return $self;
31     }
32    
33     sub init {
34     my $self=shift;
35     $self->{switch}=ActiveDoc::SimpleDoc->new();
36     $self->{switch}->newparse("setup");
37     $self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,
38     "", $self,
39     \&Tool_End, $self);
40     $self->{switch}->addtag("setup","Lib",\&Lib, $self,
41     "", $self,
42     "", $self);
43     $self->{switch}->addtag("setup","External",\&External_Start, $self,
44     "", $self,
45     "", $self);
46     $self->{switch}->addtag("setup","Client",\&Client_start, $self,
47     "", $self,
48     \&Client_end, $self);
49     $self->{switch}->addtag("setup","Environment",
50     \&Environment_Start, $self,
51     \&Env_text, $self,
52     \&Environment_End, $self);
53     $self->{switch}->grouptag("Tool","setup");
54     $self->{switch}->addtag("setup","Architecture",
55     \&Arch_Start,$self,
56     "", $self,
57     \&Arch_End,$self);
58     $self->{Arch}=1;
59 williamc 1.1.2.6 push @{$self->{ARCHBLOCK}}, $self->{Arch};
60 williamc 1.1.2.1
61     }
62    
63     sub interactive {
64     my $self=shift;
65    
66     @_?$self->{interactive}=shift
67     :((defined $self->{interactive})?$self->{interactive}:0);
68     }
69    
70     sub tool {
71     my $self=shift;
72     $self->{tool}=shift;
73     }
74    
75 williamc 1.1.2.11 sub toolsearcher {
76     my $self=shift;
77     if ( @_ ) {
78 williamc 1.1.2.12 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 williamc 1.1.2.11 }
85     return $self->{toolboxsearcher};
86     }
87    
88 williamc 1.1.2.1 sub setup {
89     my $self=shift;
90     my $file=shift;
91     my $name=shift;
92     my $version=shift;
93    
94     $self->{ToolEnv}{'SCRAMtoolname'}=$name;
95     $self->{ToolEnv}{'SCRAMtoolversion'}=$version;
96     $self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'};
97    
98     $name=~tr[A-Z][a-z];
99     $self->{tool}->name($name);
100     $self->{tool}->version($version);
101     $self->{switch}->filetoparse($file);
102 williamc 1.1.2.4 $self->{toolfound}=1;
103 williamc 1.1.2.1 $self->{switch}->parse("setup");
104 williamc 1.1.2.4 return $self->{toolfound};
105 williamc 1.1.2.1 }
106    
107     sub featuretext {
108     my $self=shift;
109     my $feature=shift;
110    
111     if ( @_ ) {
112     $self->{featuretext}{$feature}=shift;
113     }
114     else {
115     return ($self->{featuretext}{$feature});
116     }
117     }
118    
119     sub _checkdefault {
120     my $self=shift;
121     my $hashref=shift;
122    
123     if ( defined $$hashref{'default'} ) { #check default
124     my $default;
125     foreach $default ( split /:/, $$hashref{'default'} ) {
126     $default=~s/\"//;
127     if ($self->_testlocation($default,
128     [ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; }
129     }
130     }
131     return 0;
132     }
133    
134     sub _testlocation {
135     my $self=shift;
136     my $default=shift;
137     my $testfiles=shift;
138     my $OK='false';
139     my $file;
140    
141     chomp $default;
142     $default=$self->_expandvars($default);
143     print "Trying $default .... ";
144     if ( -f $default ) {
145     $OK="true";
146     }
147     else {
148     my $fh=FileHandle->new();
149     opendir $fh, $default or do { print "No \n"; return 0; };
150     ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
151     print "\n";
152     my @files=readdir $fh;
153     undef $fh;
154     foreach $file ( @$testfiles ) {
155     print " Checking for $file .... ";
156     # now check that the required files are actually there
157     if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
158     $OK='false';
159     print "not found\n";
160     last;
161     }
162     print "found\n";
163     }
164     }
165     if ( $OK eq 'true' ) {
166     print "Directory Check Complete\n";
167     return 1
168     }
169     return 0
170     }
171    
172     sub _expandvars {
173     my $self=shift;
174     my $string=shift;
175    
176     return "" , if ( ! defined $string );
177     $string=~s{
178     \$\((\w+)\)
179     }{
180     if (defined $self->{ToolEnv}{$1}) {
181     $self->_expandvars($self->{ToolEnv}{$1});
182     } else {
183     "\$$1";
184     }
185     }egx;
186     $string=~s{
187     \$(\w+)
188     }{
189     if (defined $self->{ToolEnv}{$1}) {
190     $self->_expandvars($self->{ToolEnv}{$1});
191     } else {
192     "\$$1";
193     }
194     }egx;
195     return $string;
196     }
197    
198    
199     sub _askuser {
200     my $self=shift;
201     my $querystring=shift;
202     my $varname=shift;
203    
204     print $self->featuretext($self->{EnvContext});
205     for ( ;; ) {
206     print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
207     $path=<STDIN>;
208     chomp $path;
209     if ( $path ne "" ) {
210     if ( defined $self->{'client'}) { # must be a location
211     if ( $self->_testlocation($path , "H", $Envtype{$type} )) {
212     return $path;
213     }
214     print "Error : ".$path." does not exist.\n";
215     next;
216     }
217     }
218     else {
219     return $path;
220     }
221     } #end for
222    
223     }
224    
225 williamc 1.1.2.11 #
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     $self->verbose("Check Other Projects for tool");
261     my @validtools=$self->_searchtools($tool);
262     if ( ! $self->interactive() ) {
263     if ( $#validtools >=0 ) {
264     my @params=$validtools[0]->getfeature($param);
265     if ( $#params >=0 ) {
266     $self->verbose("Extracting Feature $param from tool".
267     " (= @params )\n");
268     $tool->setfeature($param,@params);
269     $rv=1;
270     }
271     }
272     }
273     return $rv;
274     }
275    
276 williamc 1.1.2.1 # -- Tag Routines
277    
278     sub Client_start {
279     my $self=shift;
280     my $name=shift;
281     my $hashref=shift;
282    
283     if ( $self->{Arch} ) {
284     $self->{'client'}=1;
285     }
286     }
287    
288     sub Client_end {
289     my $self=shift;
290     if ( $self->{Arch} ) {
291     undef $self->{'client'};
292     }
293     }
294    
295     sub Tool_Start {
296     my $self=shift;
297     my $name=shift;
298     my $hashref=shift;
299    
300     $self->{switch}->checktag($name, $hashref, 'name');
301     $self->{switch}->checktag($name, $hashref, 'version');
302     $self->{switch}->opengroup("Toolactive");
303    
304     # lower case the name
305     $$hashref{'name'}=~tr[A-Z][a-z];
306     # make sure we only pick up the tool requested
307     if ( ( $self->{tool}->name() eq $$hashref{'name'} ) &&
308     ($self->{tool}->version() eq $$hashref{'version'})) {
309     $self->{switch}->
310     allowgroup("Toolactive",$self->{switch}->currentparsename());
311     $self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
312     $self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
313 williamc 1.1.2.4 $self->{toolfound}=0;
314 williamc 1.1.2.1 }
315     else {
316     $self->{switch}->disallowgroup("Toolactive",
317     $self->{switch}->currentparsename());
318     }
319     }
320    
321     sub Tool_End {
322     my $self=shift;
323     my $name=shift;
324     my $hashref=shift;
325    
326     $self->{switch}->closegroup("Toolactive");
327     }
328    
329     sub Environment_Start {
330     my $self=shift;
331     my $name=shift;
332     my $hashref=shift;
333    
334     $self->{switch}->checktag($name, $hashref, 'name');
335     if ( $self->{Arch} ) {
336     if ( defined $self->{EnvContext} ) {
337     $self->parserror(" Attempted to open new <$name> context".
338     " without closing the previous one");
339     }
340     $self->{currentenvtext}="";
341     $self->{EnvContext}=$$hashref{'name'};
342     undef $self->{Envvalue};
343 williamc 1.1.2.10 if ( exists $$hashref{'type'} ) {
344     $$hashref{'type'}=~tr[A-Z][a-z];
345     $self->{tool}->type($$hashref{'name'},$$hashref{'type'});
346 williamc 1.1.2.1 }
347     if ( exists $$hashref{'value'}) {
348     $self->{Envvalue}=$$hashref{'value'};
349     }
350     elsif ( ! $self->interactive() ) {
351 williamc 1.1.2.11 # check other installed copies of the tool
352     if ( $self->_toolparamcopy($self->{tool},$$hashref{'name'}) ) {
353     my @tmp=$self->{tool}->getfeature($$hashref{'name'});
354     $self->{Envvalue}=$tmp[0]; # assume single val parameter!
355     }
356     elsif ( defined $ENV{$$hashref{'name'}} ) {
357     # check the environment
358     $self->{Envvalue}=$ENV{$$hashref{'name'}};
359 williamc 1.1.2.5 }
360     elsif ( $self->_checkdefault($hashref) ) {
361 williamc 1.1.2.11 $self->{Envvalue}=$$hashref{'default'};
362 williamc 1.1.2.1 }
363     }
364     }
365     }
366    
367     sub Env_text {
368     my $self=shift;
369     my $name=shift;
370     my $string=shift;
371    
372     if ( $self->{Arch} ) {
373     $self->{currentenvtext}=$self->{currentenvtext}.$string;
374     }
375     }
376    
377     sub Environment_End {
378     my $self=shift;
379     my $name=shift;
380    
381     if ( $self->{Arch} ) {
382     if ( ! defined $self->{EnvContext} ) {
383 williamc 1.1.2.8 $self->{switch}->parseerror("</$name> without an opening context");
384 williamc 1.1.2.1 }
385     # - set the help text
386     $self->featuretext($self->{EnvContext},$self->{currentenvtext});
387     if ( ! defined $self->{Envvalue} ) {
388     $self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
389     $self->{EnvContext});
390     }
391     $self->{Envvalue}=$self->_expandvars($self->{Envvalue});
392     $self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
393     $self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
394     undef $self->{EnvContext};
395     undef $self->{Envvalue};
396     }
397     }
398    
399     sub Lib {
400     my $self=shift;
401     my $name=shift;
402     my $hashref=shift;
403    
404     $self->{switch}->checktag($name, $hashref, 'name');
405     if ( $self->{Arch} ) {
406     $self->{tool}->addfeature("lib",$$hashref{'name'});
407     }
408     }
409    
410     sub External_Start {
411     my $self=shift;
412     my $name=shift;
413     my $hashref=shift;
414    
415     $self->{switch}->checktag($name, $hashref,'ref');
416     if ( $self->{Arch} ) {
417 williamc 1.1.2.2 $self->{tool}->addfeature("_externals",$$hashref{'ref'});
418 williamc 1.1.2.1 }
419     }
420    
421     sub Arch_Start {
422     my $self=shift;
423     my $name=shift;
424     my $hashref=shift;
425    
426 williamc 1.1.2.5 $self->{switch}->checktag($name, $hashref,'name');
427 williamc 1.1.2.1 ( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
428     : ($self->{Arch}=0);
429     push @{$self->{ARCHBLOCK}}, $self->{Arch};
430     }
431    
432     sub Arch_End {
433     my $self=shift;
434     my $name=shift;
435    
436     pop @{$self->{ARCHBLOCK}};
437     $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
438     }
439    
440