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 |
+ |
# setup(file,$name,$version) : setup a tool object from the specified file |
15 |
+ |
# return 0 for OK 1 for cancel |
16 |
+ |
# interactive([0|1]) : set the interactive node 0=off 1=on |
17 |
+ |
|
18 |
+ |
package BuildSystem::ToolDoc; |
19 |
+ |
require 5.004; |
20 |
+ |
use ActiveDoc::SimpleDoc; |
21 |
+ |
|
22 |
+ |
sub new { |
23 |
+ |
my $class=shift; |
24 |
+ |
$self={}; |
25 |
+ |
bless $self, $class; |
26 |
+ |
$self->init(); |
27 |
+ |
return $self; |
28 |
+ |
} |
29 |
+ |
|
30 |
+ |
sub init { |
31 |
+ |
my $self=shift; |
32 |
+ |
$self->{switch}=ActiveDoc::SimpleDoc->new(); |
33 |
+ |
$self->{switch}->newparse("setup"); |
34 |
+ |
$self->{switch}->addtag("setup","Tool",\&Tool_Start, $self, |
35 |
+ |
"", $self, |
36 |
+ |
\&Tool_End, $self); |
37 |
+ |
$self->{switch}->addtag("setup","Lib",\&Lib, $self, |
38 |
+ |
"", $self, |
39 |
+ |
"", $self); |
40 |
+ |
$self->{switch}->addtag("setup","External",\&External_Start, $self, |
41 |
+ |
"", $self, |
42 |
+ |
"", $self); |
43 |
+ |
$self->{switch}->addtag("setup","Client",\&Client_start, $self, |
44 |
+ |
"", $self, |
45 |
+ |
\&Client_end, $self); |
46 |
+ |
$self->{switch}->addtag("setup","Environment", |
47 |
+ |
\&Environment_Start, $self, |
48 |
+ |
\&Env_text, $self, |
49 |
+ |
\&Environment_End, $self); |
50 |
+ |
$self->{switch}->grouptag("Tool","setup"); |
51 |
+ |
$self->{switch}->addtag("setup","Architecture", |
52 |
+ |
\&Arch_Start,$self, |
53 |
+ |
"", $self, |
54 |
+ |
\&Arch_End,$self); |
55 |
+ |
$self->{Arch}=1; |
56 |
+ |
push @{$self->{ARCHBLOCK}}, $Arch; |
57 |
+ |
|
58 |
+ |
} |
59 |
+ |
|
60 |
+ |
sub interactive { |
61 |
+ |
my $self=shift; |
62 |
+ |
|
63 |
+ |
@_?$self->{interactive}=shift |
64 |
+ |
:((defined $self->{interactive})?$self->{interactive}:0); |
65 |
+ |
} |
66 |
+ |
|
67 |
+ |
sub tool { |
68 |
+ |
my $self=shift; |
69 |
+ |
$self->{tool}=shift; |
70 |
+ |
} |
71 |
+ |
|
72 |
+ |
sub setup { |
73 |
+ |
my $self=shift; |
74 |
+ |
my $file=shift; |
75 |
+ |
my $name=shift; |
76 |
+ |
my $version=shift; |
77 |
+ |
|
78 |
+ |
$self->{ToolEnv}{'SCRAMtoolname'}=$name; |
79 |
+ |
$self->{ToolEnv}{'SCRAMtoolversion'}=$version; |
80 |
+ |
$self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'}; |
81 |
+ |
|
82 |
+ |
$name=~tr[A-Z][a-z]; |
83 |
+ |
$self->{tool}->name($name); |
84 |
+ |
$self->{tool}->version($version); |
85 |
+ |
$self->{tool}->url($file); |
86 |
+ |
$self->{switch}->filetoparse($file); |
87 |
+ |
$self->{switch}->parse("setup"); |
88 |
+ |
return 0; |
89 |
+ |
} |
90 |
+ |
|
91 |
+ |
sub featuretext { |
92 |
+ |
my $self=shift; |
93 |
+ |
my $feature=shift; |
94 |
+ |
|
95 |
+ |
if ( @_ ) { |
96 |
+ |
$self->{featuretext}{$feature}=shift; |
97 |
+ |
} |
98 |
+ |
else { |
99 |
+ |
return ($self->{featuretext}{$feature}); |
100 |
+ |
} |
101 |
+ |
} |
102 |
+ |
|
103 |
+ |
sub _checkdefault { |
104 |
+ |
my $self=shift; |
105 |
+ |
my $hashref=shift; |
106 |
+ |
|
107 |
+ |
if ( defined $$hashref{'default'} ) { #check default |
108 |
+ |
my $default; |
109 |
+ |
foreach $default ( split /:/, $$hashref{'default'} ) { |
110 |
+ |
$default=~s/\"//; |
111 |
+ |
if ($self->_testlocation($default, |
112 |
+ |
[ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; } |
113 |
+ |
} |
114 |
+ |
} |
115 |
+ |
return 0; |
116 |
+ |
} |
117 |
+ |
|
118 |
+ |
sub _testlocation { |
119 |
+ |
my $self=shift; |
120 |
+ |
my $default=shift; |
121 |
+ |
my $testfiles=shift; |
122 |
+ |
my $OK='false'; |
123 |
+ |
my $file; |
124 |
+ |
|
125 |
+ |
chomp $default; |
126 |
+ |
$default=$self->_expandvars($default); |
127 |
+ |
print "Trying $default .... "; |
128 |
+ |
if ( -f $default ) { |
129 |
+ |
$OK="true"; |
130 |
+ |
} |
131 |
+ |
else { |
132 |
+ |
my $fh=FileHandle->new(); |
133 |
+ |
opendir $fh, $default or do { print "No \n"; return 0; }; |
134 |
+ |
($#{$testfiles}==-1) ? $OK='false' : $OK='true'; |
135 |
+ |
print "\n"; |
136 |
+ |
my @files=readdir $fh; |
137 |
+ |
undef $fh; |
138 |
+ |
foreach $file ( @$testfiles ) { |
139 |
+ |
print " Checking for $file .... "; |
140 |
+ |
# now check that the required files are actually there |
141 |
+ |
if ( ( $number = grep /\Q$file\L/, @files) == 0 ) { |
142 |
+ |
$OK='false'; |
143 |
+ |
print "not found\n"; |
144 |
+ |
last; |
145 |
+ |
} |
146 |
+ |
print "found\n"; |
147 |
+ |
} |
148 |
+ |
} |
149 |
+ |
if ( $OK eq 'true' ) { |
150 |
+ |
print "Directory Check Complete\n"; |
151 |
+ |
return 1 |
152 |
+ |
} |
153 |
+ |
return 0 |
154 |
+ |
} |
155 |
+ |
|
156 |
+ |
sub _expandvars { |
157 |
+ |
my $self=shift; |
158 |
+ |
my $string=shift; |
159 |
+ |
|
160 |
+ |
return "" , if ( ! defined $string ); |
161 |
+ |
$string=~s{ |
162 |
+ |
\$\((\w+)\) |
163 |
+ |
}{ |
164 |
+ |
if (defined $self->{ToolEnv}{$1}) { |
165 |
+ |
$self->_expandvars($self->{ToolEnv}{$1}); |
166 |
+ |
} else { |
167 |
+ |
"\$$1"; |
168 |
+ |
} |
169 |
+ |
}egx; |
170 |
+ |
$string=~s{ |
171 |
+ |
\$(\w+) |
172 |
+ |
}{ |
173 |
+ |
if (defined $self->{ToolEnv}{$1}) { |
174 |
+ |
$self->_expandvars($self->{ToolEnv}{$1}); |
175 |
+ |
} else { |
176 |
+ |
"\$$1"; |
177 |
+ |
} |
178 |
+ |
}egx; |
179 |
+ |
return $string; |
180 |
+ |
} |
181 |
+ |
|
182 |
+ |
|
183 |
+ |
sub _askuser { |
184 |
+ |
my $self=shift; |
185 |
+ |
my $querystring=shift; |
186 |
+ |
my $varname=shift; |
187 |
+ |
|
188 |
+ |
print $self->featuretext($self->{EnvContext}); |
189 |
+ |
for ( ;; ) { |
190 |
+ |
print "\n".$querystring." (RETURN to log as missing)\nset $varname = "; |
191 |
+ |
$path=<STDIN>; |
192 |
+ |
chomp $path; |
193 |
+ |
if ( $path ne "" ) { |
194 |
+ |
if ( defined $self->{'client'}) { # must be a location |
195 |
+ |
if ( $self->_testlocation($path , "H", $Envtype{$type} )) { |
196 |
+ |
return $path; |
197 |
+ |
} |
198 |
+ |
print "Error : ".$path." does not exist.\n"; |
199 |
+ |
next; |
200 |
+ |
} |
201 |
+ |
} |
202 |
+ |
else { |
203 |
+ |
return $path; |
204 |
+ |
} |
205 |
+ |
} #end for |
206 |
+ |
|
207 |
+ |
} |
208 |
+ |
|
209 |
+ |
# -- Tag Routines |
210 |
+ |
|
211 |
+ |
sub Client_start { |
212 |
+ |
my $self=shift; |
213 |
+ |
my $name=shift; |
214 |
+ |
my $hashref=shift; |
215 |
+ |
|
216 |
+ |
if ( $self->{Arch} ) { |
217 |
+ |
$self->{'client'}=1; |
218 |
+ |
} |
219 |
+ |
} |
220 |
+ |
|
221 |
+ |
sub Client_end { |
222 |
+ |
my $self=shift; |
223 |
+ |
if ( $self->{Arch} ) { |
224 |
+ |
undef $self->{'client'}; |
225 |
+ |
} |
226 |
+ |
} |
227 |
+ |
|
228 |
+ |
sub Tool_Start { |
229 |
+ |
my $self=shift; |
230 |
+ |
my $name=shift; |
231 |
+ |
my $hashref=shift; |
232 |
+ |
|
233 |
+ |
$self->{switch}->checktag($name, $hashref, 'name'); |
234 |
+ |
$self->{switch}->checktag($name, $hashref, 'version'); |
235 |
+ |
$self->{switch}->opengroup("Toolactive"); |
236 |
+ |
|
237 |
+ |
# lower case the name |
238 |
+ |
$$hashref{'name'}=~tr[A-Z][a-z]; |
239 |
+ |
# make sure we only pick up the tool requested |
240 |
+ |
if ( ( $self->{tool}->name() eq $$hashref{'name'} ) && |
241 |
+ |
($self->{tool}->version() eq $$hashref{'version'})) { |
242 |
+ |
$self->{switch}-> |
243 |
+ |
allowgroup("Toolactive",$self->{switch}->currentparsename()); |
244 |
+ |
$self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'}; |
245 |
+ |
$self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'}; |
246 |
+ |
} |
247 |
+ |
else { |
248 |
+ |
$self->{switch}->disallowgroup("Toolactive", |
249 |
+ |
$self->{switch}->currentparsename()); |
250 |
+ |
} |
251 |
+ |
} |
252 |
+ |
|
253 |
+ |
sub Tool_End { |
254 |
+ |
my $self=shift; |
255 |
+ |
my $name=shift; |
256 |
+ |
my $hashref=shift; |
257 |
+ |
|
258 |
+ |
$self->{switch}->closegroup("Toolactive"); |
259 |
+ |
} |
260 |
+ |
|
261 |
+ |
sub Environment_Start { |
262 |
+ |
my $self=shift; |
263 |
+ |
my $name=shift; |
264 |
+ |
my $hashref=shift; |
265 |
+ |
|
266 |
+ |
$self->{switch}->checktag($name, $hashref, 'name'); |
267 |
+ |
if ( $self->{Arch} ) { |
268 |
+ |
if ( defined $self->{EnvContext} ) { |
269 |
+ |
$self->parserror(" Attempted to open new <$name> context". |
270 |
+ |
" without closing the previous one"); |
271 |
+ |
} |
272 |
+ |
$self->{currentenvtext}=""; |
273 |
+ |
$self->{EnvContext}=$$hashref{'name'}; |
274 |
+ |
undef $self->{Envvalue}; |
275 |
+ |
if ( exists $$hahsref{'type'} ) { |
276 |
+ |
$self->{tool}->type($$hashref{'name'},$$hahsref{'type'}); |
277 |
+ |
} |
278 |
+ |
if ( exists $$hashref{'value'}) { |
279 |
+ |
$self->{Envvalue}=$$hashref{'value'}; |
280 |
+ |
} |
281 |
+ |
elsif ( ! $self->interactive() ) { |
282 |
+ |
if ( $self->_checkdefault($hashref) ) { |
283 |
+ |
$self->{Envvalue}=$$hashref{'default'}; |
284 |
+ |
} |
285 |
+ |
} |
286 |
+ |
} |
287 |
+ |
} |
288 |
+ |
|
289 |
+ |
sub Env_text { |
290 |
+ |
my $self=shift; |
291 |
+ |
my $name=shift; |
292 |
+ |
my $string=shift; |
293 |
+ |
|
294 |
+ |
if ( $self->{Arch} ) { |
295 |
+ |
$self->{currentenvtext}=$self->{currentenvtext}.$string; |
296 |
+ |
} |
297 |
+ |
} |
298 |
+ |
|
299 |
+ |
sub Environment_End { |
300 |
+ |
my $self=shift; |
301 |
+ |
my $name=shift; |
302 |
+ |
|
303 |
+ |
if ( $self->{Arch} ) { |
304 |
+ |
if ( ! defined $self->{EnvContext} ) { |
305 |
+ |
$self->parseerror("</\$name> without an opening context"); |
306 |
+ |
} |
307 |
+ |
# - set the help text |
308 |
+ |
$self->featuretext($self->{EnvContext},$self->{currentenvtext}); |
309 |
+ |
if ( ! defined $self->{Envvalue} ) { |
310 |
+ |
$self->{Envvalue}=$self->_askuser("Please Enter the Value Below:", |
311 |
+ |
$self->{EnvContext}); |
312 |
+ |
} |
313 |
+ |
$self->{Envvalue}=$self->_expandvars($self->{Envvalue}); |
314 |
+ |
$self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue}); |
315 |
+ |
$self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue}; |
316 |
+ |
undef $self->{EnvContext}; |
317 |
+ |
undef $self->{Envvalue}; |
318 |
+ |
} |
319 |
+ |
} |
320 |
+ |
|
321 |
+ |
sub Lib { |
322 |
+ |
my $self=shift; |
323 |
+ |
my $name=shift; |
324 |
+ |
my $hashref=shift; |
325 |
+ |
|
326 |
+ |
$self->{switch}->checktag($name, $hashref, 'name'); |
327 |
+ |
if ( $self->{Arch} ) { |
328 |
+ |
$self->{tool}->addfeature("lib",$$hashref{'name'}); |
329 |
+ |
} |
330 |
+ |
} |
331 |
+ |
|
332 |
+ |
sub External_Start { |
333 |
+ |
my $self=shift; |
334 |
+ |
my $name=shift; |
335 |
+ |
my $hashref=shift; |
336 |
+ |
|
337 |
+ |
$self->{switch}->checktag($name, $hashref,'ref'); |
338 |
+ |
if ( $self->{Arch} ) { |
339 |
+ |
$self->{tool}->addfeature("_externals",$$hashref{'ref'}); |
340 |
+ |
} |
341 |
+ |
} |
342 |
+ |
|
343 |
+ |
sub Arch_Start { |
344 |
+ |
my $self=shift; |
345 |
+ |
my $name=shift; |
346 |
+ |
my $hashref=shift; |
347 |
+ |
|
348 |
+ |
$toolswitch->checktag($name, $hashref,'name'); |
349 |
+ |
( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1) |
350 |
+ |
: ($self->{Arch}=0); |
351 |
+ |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
352 |
+ |
} |
353 |
+ |
|
354 |
+ |
sub Arch_End { |
355 |
+ |
my $self=shift; |
356 |
+ |
my $name=shift; |
357 |
+ |
|
358 |
+ |
pop @{$self->{ARCHBLOCK}}; |
359 |
+ |
$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}]; |
360 |
+ |
} |
361 |
+ |
|
362 |
+ |
|