21 |
|
require 5.004; |
22 |
|
@ISA=qw(Utilities::Verbose); |
23 |
|
|
24 |
< |
sub new { |
25 |
< |
my $class=shift; |
26 |
< |
my $self={}; |
27 |
< |
bless $self, $class; |
28 |
< |
$self->{dbstore}=shift; |
29 |
< |
$self->{file}=shift; |
30 |
< |
$self->{cache}=$self->{dbstore}->cache(); |
31 |
< |
if ( @_ ) { |
32 |
< |
$self->arch(shift); |
33 |
< |
} |
34 |
< |
$self->{mydocversion}="2.0"; |
35 |
< |
$self->{Arch}=1; |
36 |
< |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
37 |
< |
$self->init($self->{file}); |
38 |
< |
return $self; |
39 |
< |
} |
40 |
< |
|
41 |
< |
sub url { |
42 |
< |
my $self=shift; |
43 |
< |
if ( @_ ) { |
44 |
< |
$self->{file}=shift; |
45 |
< |
} |
46 |
< |
return $self->{file} |
47 |
< |
} |
48 |
< |
|
49 |
< |
sub setup { |
50 |
< |
my $self=shift; |
51 |
< |
my $toolbox=shift; |
52 |
< |
|
53 |
< |
my $tool; |
54 |
< |
foreach $tool ( $self->selectedtools() ) { |
55 |
< |
$self->verbose("Setting Up Tool $tool"); |
56 |
< |
$toolbox->toolsetup($tool, $self->version($tool), $self->toolurl($tool)); |
57 |
< |
} |
58 |
< |
} |
59 |
< |
|
60 |
< |
sub tools { |
61 |
< |
my $self=shift; |
62 |
< |
return @{$self->{tools}}; |
63 |
< |
} |
64 |
< |
|
65 |
< |
sub selectedtools { |
66 |
< |
my $self=shift; |
67 |
< |
my @toollist=(); |
68 |
< |
foreach $tool ( @{$self->{tools}} ) { |
69 |
< |
if ( $self->{selected}{$tool} == 1 ) { |
70 |
< |
push @toollist, $tool; |
71 |
< |
} |
72 |
< |
} |
73 |
< |
return @toollist; |
74 |
< |
} |
75 |
< |
|
76 |
< |
sub toolcomment { |
77 |
< |
my $self=shift; |
78 |
< |
my $tool=shift; |
79 |
< |
my $version=shift; |
80 |
< |
|
81 |
< |
return $self->{reqtext}{$tool}{$version}; |
82 |
< |
} |
83 |
< |
|
84 |
< |
sub distributionurl { |
85 |
< |
my $self=shift; |
86 |
< |
my $tool=shift; |
87 |
< |
my $version=shift; |
88 |
< |
|
89 |
< |
return ( defined $self->{dist}{$tool}{$version})? |
90 |
< |
$self->{dist}{$tool}{$version}:undef; |
91 |
< |
} |
92 |
< |
|
93 |
< |
sub version { |
94 |
< |
my $self=shift; |
95 |
< |
my $tool=shift; |
96 |
< |
return $self->{'version'}{$tool}; |
97 |
< |
} |
98 |
< |
|
99 |
< |
sub toolurl { |
100 |
< |
my $self=shift; |
101 |
< |
my $tool=shift; |
102 |
< |
return $self->{'url'}{$tool}; |
103 |
< |
} |
104 |
< |
|
105 |
< |
sub init { |
106 |
< |
my $self=shift; |
107 |
< |
my $url=shift; |
108 |
< |
|
109 |
< |
my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore}); |
110 |
< |
$switch->verbosity($self->verbosity()); |
111 |
< |
$switch->url($url); |
112 |
< |
$switch->newparse("ordering"); |
113 |
< |
$switch->addbasetags("ordering"); |
114 |
< |
$switch->addtag("ordering","Architecture", |
115 |
< |
\&Arch_Start,$self, |
116 |
< |
"", $self, |
117 |
< |
\&Arch_End, $self); |
118 |
< |
$switch->addtag("ordering","Restrict", |
119 |
< |
\&Restrict_start,$self, |
120 |
< |
"", $self, |
121 |
< |
\&Restrict_end, $self); |
122 |
< |
$switch->addtag("ordering","deselect", |
123 |
< |
\&deselect_start,$self, |
124 |
< |
"", $self, |
125 |
< |
"", $self); |
126 |
< |
$switch->addtag("ordering","select", |
127 |
< |
\&select_start,$self, |
128 |
< |
"", $self, |
129 |
< |
"", $self); |
130 |
< |
$switch->addtag("ordering","distribution", |
131 |
< |
\&disttag,$self); |
132 |
< |
$switch->grouptag("Architecture","ordering"); |
133 |
< |
$switch->addtag("ordering","require", |
134 |
< |
\&require_start,$self, |
135 |
< |
\&require_text, $self, |
136 |
< |
\&require_end, $self); |
137 |
< |
|
138 |
< |
$self->{reqcontext}=0; |
139 |
< |
$self->{switch}=$switch; |
140 |
< |
undef $self->{restrictstack}; |
141 |
< |
@{$self->{tools}}=(); |
142 |
< |
|
143 |
< |
my($doctype,$docversion)=$switch->doctype(); |
144 |
< |
# -- for backwards compatability only parse if we have a docversion |
145 |
< |
# defined |
146 |
< |
if ( defined $docversion ) { |
147 |
< |
if ( $docversion eq $self->{mydocversion} ) { |
148 |
< |
@{$self->{ArchStack}}=(); |
149 |
< |
$self->{switch}->parse("ordering"); |
150 |
< |
} |
151 |
< |
} |
152 |
< |
else { |
153 |
< |
#print "wrong doc version - not parsing\n"; |
154 |
< |
} |
155 |
< |
} |
156 |
< |
|
157 |
< |
sub arch { |
158 |
< |
my $self=shift; |
159 |
< |
if ( @_ ) { |
160 |
< |
$self->{arch}=shift |
161 |
< |
} |
162 |
< |
else { |
163 |
< |
if ( ! defined $self->{arch} ) { |
164 |
< |
$self->{arch}=""; |
165 |
< |
} |
166 |
< |
} |
167 |
< |
return $self->{arch}; |
168 |
< |
} |
169 |
< |
|
170 |
< |
sub archlist { |
171 |
< |
my $self=shift; |
172 |
< |
return @{$self->{ArchStack}}; |
173 |
< |
} |
174 |
< |
|
175 |
< |
sub getreqforarch { |
176 |
< |
my $self=shift; |
177 |
< |
my $arch=shift; |
178 |
< |
|
179 |
< |
if ( ! defined $self->{reqsforarch}{$arch} ) { |
180 |
< |
$self->{reqsforarch}{$arch}= |
181 |
< |
BuildSystem::Requirements->new($self->{dbstore},$self->{file}, |
182 |
< |
$arch); |
183 |
< |
} |
184 |
< |
return $self->{reqsforarch}{$arch}; |
185 |
< |
} |
186 |
< |
|
187 |
< |
|
188 |
< |
sub download { |
189 |
< |
my $self=shift; |
190 |
< |
|
191 |
< |
my $tool; |
192 |
< |
foreach $tool ( $self->tools() ) { |
193 |
< |
$self->verbose("Downloading ".$self->toolurl($tool)); |
194 |
< |
# get into the cache |
195 |
< |
$self->{switch}->urlget($self->toolurl($tool)); |
196 |
< |
} |
197 |
< |
} |
198 |
< |
|
199 |
< |
sub _autoselect { |
200 |
< |
my $self=shift; |
201 |
< |
if ( @_ ) { |
202 |
< |
$self->{autoselect}=shift; |
203 |
< |
} |
204 |
< |
# -- default is true |
205 |
< |
return ((defined $self->{autoselect})?$self->{autoselect}:1); |
206 |
< |
} |
207 |
< |
|
208 |
< |
# ---- Tag routines |
209 |
< |
|
210 |
< |
sub Restrict_start { |
211 |
< |
my $self=shift; |
212 |
< |
my $name=shift; |
213 |
< |
my $hashref=shift; |
214 |
< |
|
215 |
< |
$self->{switch}->checktag( $name, $hashref, 'autoselect'); |
216 |
< |
if ( $self->{Arch} ) { |
217 |
< |
# -- create selection state stack |
218 |
< |
push @{$self->{restrictstack}}, $self->_autoselect(); |
219 |
< |
$self->_autoselect( |
220 |
< |
(($$hashref{'autoselect'}=~/true/i)?1:0)); |
221 |
< |
} |
222 |
< |
} |
223 |
< |
|
224 |
< |
sub Restrict_end { |
225 |
< |
my $self=shift; |
226 |
< |
my $name=shift; |
227 |
< |
|
228 |
< |
if ( $self->{Arch} ) { |
229 |
< |
if ( $#{$self->{restrictstack}} >= 0 ) { |
230 |
< |
$self->_autoselect(pop @{$self->{restrictstack}}); |
231 |
< |
} |
232 |
< |
else { |
233 |
< |
$self->{switch}->parseerror("Unmatched </$name>"); |
234 |
< |
} |
235 |
< |
} |
236 |
< |
} |
237 |
< |
|
238 |
< |
sub require_start { |
239 |
< |
my $self=shift; |
240 |
< |
my $name=shift; |
241 |
< |
my $hashref=shift; |
242 |
< |
|
243 |
< |
$self->{switch}->checktag( $name, $hashref, 'version'); |
244 |
< |
$self->{switch}->checktag( $name, $hashref, 'name'); |
245 |
< |
$self->{switch}->checktag( $name, $hashref, 'url'); |
246 |
< |
|
247 |
< |
if ( $self->{reqcontext} == 1 ) { |
248 |
< |
$self->{switch}->parseerror( |
249 |
< |
"Open new $name conext without previous </$name>"); |
250 |
< |
} |
251 |
< |
$self->{reqcontext}=1; |
252 |
< |
$$hashref{'name'}=~tr[A-Z][a-z]; |
253 |
< |
push @{$self->{tools}}, $$hashref{'name'}; |
254 |
< |
$self->{version}{$$hashref{'name'}}=$$hashref{'version'}; |
255 |
< |
# -- make sure the full url is taken |
256 |
< |
my $urlobj=$self->{switch}->expandurl($$hashref{'url'}); |
257 |
< |
$self->{url}{$$hashref{'name'}}=$urlobj->url(); |
258 |
< |
|
259 |
< |
# -- selection |
260 |
< |
if ( $self->{Arch} ) { |
261 |
< |
if ( $self->_autoselect() ) { |
262 |
< |
$self->{selected}{$$hashref{'name'}}=1; |
263 |
< |
} |
264 |
< |
else { |
265 |
< |
$self->{selected}{$$hashref{'name'}}=0; |
266 |
< |
} |
267 |
< |
} |
268 |
< |
$self->{creqtool}=$$hashref{'name'}; |
269 |
< |
$self->{creqversion}=$$hashref{'version'}; |
270 |
< |
$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=""; |
271 |
< |
} |
272 |
< |
|
273 |
< |
sub require_text { |
274 |
< |
my $self=shift; |
275 |
< |
my $name=shift; |
276 |
< |
my $string=shift; |
277 |
< |
|
278 |
< |
chomp $string; |
279 |
< |
$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}= |
280 |
< |
$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}. |
281 |
< |
$string; |
282 |
< |
|
283 |
< |
} |
284 |
< |
|
285 |
< |
sub require_end { |
286 |
< |
my $self=shift; |
287 |
< |
my $name=shift; |
288 |
< |
|
289 |
< |
if ( $self->{reqcontext} != 1 ) { |
290 |
< |
$self->{switch}->parseerror("No matching tag for </$name>"); |
291 |
< |
} |
292 |
< |
else { |
293 |
< |
$self->{reqcontext}=0; |
294 |
< |
} |
295 |
< |
} |
296 |
< |
|
297 |
< |
sub select_start { |
298 |
< |
my $self=shift; |
299 |
< |
my $name=shift; |
300 |
< |
my $hashref=shift; |
301 |
< |
|
302 |
< |
$self->{switch}->checktag( $name, $hashref, 'name'); |
303 |
< |
$$hashref{'name'}=~tr[A-Z][a-z]; |
304 |
< |
if ( $self->{Arch} ) { |
305 |
< |
$self->verbose("Selecting ".$$hashref{'name'}); |
306 |
< |
$self->{selected}{$$hashref{'name'}}=1; |
307 |
< |
} |
308 |
< |
} |
309 |
< |
|
310 |
< |
sub deselect_start { |
311 |
< |
my $self=shift; |
312 |
< |
my $name=shift; |
313 |
< |
my $hashref=shift; |
314 |
< |
|
315 |
< |
$self->{switch}->checktag( $name, $hashref, 'name'); |
316 |
< |
$$hashref{'name'}=~tr[A-Z][a-z]; |
317 |
< |
if ( $self->{Arch} ) { |
318 |
< |
$self->verbose("Deselecting ".$$hashref{'name'}); |
319 |
< |
$self->{selected}{$$hashref{'name'}}=0; |
320 |
< |
} |
321 |
< |
} |
322 |
< |
|
323 |
< |
sub Arch_Start { |
324 |
< |
my $self=shift; |
325 |
< |
my $name=shift; |
326 |
< |
my $hashref=shift; |
327 |
< |
|
328 |
< |
$self->{switch}->checktag($name, $hashref,'name'); |
329 |
< |
|
330 |
< |
( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1) |
331 |
< |
: ($self->{Arch}=0); |
332 |
< |
$self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name}); |
333 |
< |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
334 |
< |
push @{$self->{ArchStack}}, $$hashref{'name'}; |
335 |
< |
} |
336 |
< |
|
337 |
< |
sub Arch_End { |
338 |
< |
my $self=shift; |
339 |
< |
my $name=shift; |
340 |
< |
|
341 |
< |
pop @{$self->{ARCHBLOCK}}; |
342 |
< |
$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}]; |
343 |
< |
} |
344 |
< |
|
345 |
< |
sub disttag { |
346 |
< |
my $self=shift; |
347 |
< |
my $name=shift; |
348 |
< |
my $hashref=shift; |
349 |
< |
|
350 |
< |
if ( exists $$hashref{'url'} ) { |
351 |
< |
$self->{dist}{$self->{creqtool}}{$self->{creqversion}}= |
352 |
< |
$$hashref{'url'}; |
353 |
< |
} |
354 |
< |
} |
24 |
> |
sub new |
25 |
> |
{ |
26 |
> |
my $class=shift; |
27 |
> |
my $self={}; |
28 |
> |
bless $self, $class; |
29 |
> |
$self->{dbstore}=shift; |
30 |
> |
$self->{file}=shift; |
31 |
> |
$self->{cache}=$self->{dbstore}->cache(); |
32 |
> |
|
33 |
> |
if ( @_ ) |
34 |
> |
{ |
35 |
> |
$self->arch(shift); |
36 |
> |
} |
37 |
> |
$self->verbose("Initialising a new Requirements Doc"); |
38 |
> |
$self->{mydocversion}="2.0"; |
39 |
> |
# Counter for downloaded tools: zero it here. It will |
40 |
> |
# be auto-incremented as each tool is selected: |
41 |
> |
$self->{selectcounter}=0; |
42 |
> |
|
43 |
> |
$self->{Arch}=1; |
44 |
> |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
45 |
> |
$self->init($self->{file}); |
46 |
> |
return $self; |
47 |
> |
} |
48 |
> |
|
49 |
> |
sub toolmanager |
50 |
> |
{ |
51 |
> |
my $self=shift; |
52 |
> |
|
53 |
> |
@_ ? $self->{toolmanagerobject} = shift |
54 |
> |
: $self->{toolmanagerobject}; |
55 |
> |
|
56 |
> |
} |
57 |
> |
|
58 |
> |
sub configversion |
59 |
> |
{ |
60 |
> |
my $self=shift; |
61 |
> |
@_ ? $self->{configversion} = shift |
62 |
> |
: $self->{configversion}; |
63 |
> |
} |
64 |
> |
|
65 |
> |
sub url |
66 |
> |
{ |
67 |
> |
my $self=shift; |
68 |
> |
|
69 |
> |
if ( @_ ) |
70 |
> |
{ |
71 |
> |
$self->{file}=shift; |
72 |
> |
} |
73 |
> |
return $self->{file}; |
74 |
> |
} |
75 |
> |
|
76 |
> |
sub tools |
77 |
> |
{ |
78 |
> |
my $self=shift; |
79 |
> |
return @{$self->{tools}}; |
80 |
> |
} |
81 |
> |
|
82 |
> |
sub toolcomment |
83 |
> |
{ |
84 |
> |
my $self=shift; |
85 |
> |
my $tool=shift; |
86 |
> |
my $version=shift; |
87 |
> |
|
88 |
> |
return $self->{reqtext}{$tool}{$version}; |
89 |
> |
} |
90 |
> |
|
91 |
> |
sub distributionurl |
92 |
> |
{ |
93 |
> |
my $self=shift; |
94 |
> |
my $tool=shift; |
95 |
> |
my $version=shift; |
96 |
> |
|
97 |
> |
return ( defined $self->{dist}{$tool}{$version})? |
98 |
> |
$self->{dist}{$tool}{$version}:undef; |
99 |
> |
} |
100 |
> |
|
101 |
> |
sub version |
102 |
> |
{ |
103 |
> |
my $self=shift; |
104 |
> |
my $tool=shift; |
105 |
> |
return $self->{'version'}{$tool}; |
106 |
> |
} |
107 |
> |
|
108 |
> |
sub toolurl |
109 |
> |
{ |
110 |
> |
my $self=shift; |
111 |
> |
my $tool=shift; |
112 |
> |
return $self->{'url'}{$tool}; |
113 |
> |
} |
114 |
> |
|
115 |
> |
sub init |
116 |
> |
{ |
117 |
> |
my $self=shift; |
118 |
> |
my $url=shift; |
119 |
> |
|
120 |
> |
my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore}); |
121 |
> |
$switch->verbosity($self->verbosity()); |
122 |
> |
$switch->url($url); |
123 |
> |
$switch->newparse("ordering"); |
124 |
> |
$switch->addbasetags("ordering"); |
125 |
> |
|
126 |
> |
$switch->addtag("ordering","Architecture", |
127 |
> |
\&Arch_Start,$self, |
128 |
> |
"", $self, |
129 |
> |
\&Arch_End, $self); |
130 |
> |
$switch->addtag("ordering","select", |
131 |
> |
\&select_start,$self, |
132 |
> |
"", $self, |
133 |
> |
"", $self); |
134 |
> |
$switch->grouptag("Architecture","ordering"); |
135 |
> |
$switch->addtag("ordering","require", |
136 |
> |
\&require_start,$self, |
137 |
> |
\&require_text, $self, |
138 |
> |
\&require_end, $self); |
139 |
> |
|
140 |
> |
$self->{reqcontext}=0; |
141 |
> |
$self->{switch}=$switch; |
142 |
> |
undef $self->{restrictstack}; |
143 |
> |
@{$self->{tools}}=(); |
144 |
> |
|
145 |
> |
my($doctype,$docversion)=$switch->doctype(); |
146 |
> |
# -- for backwards compatability only parse if we have a docversion |
147 |
> |
# defined: |
148 |
> |
if ( defined $docversion ) |
149 |
> |
{ |
150 |
> |
if ($docversion eq $self->{mydocversion}) |
151 |
> |
{ |
152 |
> |
@{$self->{ArchStack}}=(); |
153 |
> |
$self->verbose("Initial Document Parse"); |
154 |
> |
$self->{switch}->parse("ordering"); |
155 |
> |
# Set the config version. If there isn't a version, it means that we |
156 |
> |
# have a stand-alone repository for the toolbox, rather than a CVS |
157 |
> |
# one. Hence, no CVS tag (== version): |
158 |
> |
($switch->{configurl}->param('version') eq '') ? |
159 |
> |
$self->configversion("STANDALONE") : |
160 |
> |
$self->configversion($switch->{configurl}->param('version')); |
161 |
> |
} |
162 |
> |
else |
163 |
> |
{ |
164 |
> |
$self->verbose("wrong doc version - not parsing"); |
165 |
> |
} |
166 |
> |
} |
167 |
> |
else |
168 |
> |
{ |
169 |
> |
$self->verbose("wrong doc type - not parsing"); |
170 |
> |
} |
171 |
> |
} |
172 |
> |
|
173 |
> |
sub arch |
174 |
> |
{ |
175 |
> |
my $self=shift; |
176 |
> |
# $self->arch is the SCRAM_ARCH value: |
177 |
> |
if ( @_ ) |
178 |
> |
{ |
179 |
> |
$self->{arch}=shift; |
180 |
> |
} |
181 |
> |
else |
182 |
> |
{ |
183 |
> |
if ( ! defined $self->{arch} ) |
184 |
> |
{ |
185 |
> |
$self->{arch}=""; |
186 |
> |
} |
187 |
> |
} |
188 |
> |
return $self->{arch}; |
189 |
> |
} |
190 |
> |
|
191 |
> |
sub archlist |
192 |
> |
{ |
193 |
> |
my $self=shift; |
194 |
> |
return @{$self->{ArchStack}}; |
195 |
> |
} |
196 |
> |
|
197 |
> |
sub getreqforarch |
198 |
> |
{ |
199 |
> |
my $self=shift; |
200 |
> |
my $arch=shift; |
201 |
> |
|
202 |
> |
if ( ! defined $self->{reqsforarch}{$arch} ) |
203 |
> |
{ |
204 |
> |
$self->{reqsforarch}{$arch}= |
205 |
> |
BuildSystem::Requirements->new($self->{dbstore},$self->{file}, |
206 |
> |
$arch); |
207 |
> |
} |
208 |
> |
return $self->{reqsforarch}{$arch}; |
209 |
> |
} |
210 |
> |
|
211 |
> |
sub download |
212 |
> |
{ |
213 |
> |
my $self=shift; |
214 |
> |
my $tool; |
215 |
> |
$| = 1; # Unbuffer the output |
216 |
> |
|
217 |
> |
print "Downloading tool descriptions....","\n"; |
218 |
> |
print " "; |
219 |
> |
foreach $tool ( $self->tools() ) |
220 |
> |
{ |
221 |
> |
print "#"; |
222 |
> |
$self->verbose("Downloading ".$self->toolurl($tool)); |
223 |
> |
# get into the cache: |
224 |
> |
$self->{switch}->urlget($self->toolurl($tool)); |
225 |
> |
} |
226 |
> |
print "\nDone.","\n"; |
227 |
> |
# So now add the list of downloaded tools, and which were |
228 |
> |
# selected, to tool cache: |
229 |
> |
print "Tool info cached locally.","\n","\n"; |
230 |
> |
|
231 |
> |
# Now copy required info from this object to ToolManager (ToolCache): |
232 |
> |
$self->toolmanager()->downloadedtools($self->{tools}); |
233 |
> |
$self->toolmanager()->defaultversions($self->{version}); |
234 |
> |
$self->toolmanager()->toolurls($self->{url}); |
235 |
> |
$self->toolmanager()->selected($self->{selected}); |
236 |
> |
} |
237 |
> |
|
238 |
> |
sub _autoselect |
239 |
> |
{ |
240 |
> |
my $self=shift; |
241 |
> |
if ( @_ ) |
242 |
> |
{ |
243 |
> |
$self->{autoselect}=shift; |
244 |
> |
} |
245 |
> |
# -- default is true |
246 |
> |
return ((defined $self->{autoselect})?$self->{autoselect}:1); |
247 |
> |
} |
248 |
> |
|
249 |
> |
sub require_start |
250 |
> |
{ |
251 |
> |
my $self=shift; |
252 |
> |
my $name=shift; |
253 |
> |
my $hashref=shift; |
254 |
> |
|
255 |
> |
$self->{switch}->checktag( $name, $hashref, 'version'); |
256 |
> |
$self->{switch}->checktag( $name, $hashref, 'name'); |
257 |
> |
$self->{switch}->checktag( $name, $hashref, 'url'); |
258 |
> |
|
259 |
> |
if ( $self->{reqcontext} == 1 ) |
260 |
> |
{ |
261 |
> |
$self->{switch}->parseerror( |
262 |
> |
"Open new $name context without previous </$name>"); |
263 |
> |
} |
264 |
> |
$self->{reqcontext}=1; |
265 |
> |
$$hashref{'name'}=~tr[A-Z][a-z]; |
266 |
> |
|
267 |
> |
# Add protection so that architecture tags are obeyed during download: |
268 |
> |
if ( $self->{Arch} ) |
269 |
> |
{ |
270 |
> |
# Add tool to the tool array: |
271 |
> |
push @{$self->{tools}}, $$hashref{'name'}; |
272 |
> |
|
273 |
> |
# If the tool already has an entry, modify the version string to |
274 |
> |
# include both versions. The versions can later be separated and |
275 |
> |
# parsed as normal: |
276 |
> |
if (defined $self->{version}{$$hashref{'name'}}) |
277 |
> |
{ |
278 |
> |
# Don't need an extra entry for this tool onto tool array: |
279 |
> |
pop @{$self->{tools}}, $$hashref{'name'}; |
280 |
> |
# Modify the version string to append the other tool version. |
281 |
> |
# Separate using a colon: |
282 |
> |
my $newversion=$self->{version}{$$hashref{'name'}}.":".$$hashref{'version'}; |
283 |
> |
$self->{version}{$$hashref{'name'}}=$newversion; |
284 |
> |
} |
285 |
> |
else |
286 |
> |
{ |
287 |
> |
$self->{version}{$$hashref{'name'}}=$$hashref{'version'}; |
288 |
> |
} |
289 |
> |
# -- make sure the full url is taken |
290 |
> |
my $urlobj=$self->{switch}->expandurl($$hashref{'url'}); |
291 |
> |
|
292 |
> |
$self->{url}{$$hashref{'name'}}=$urlobj->url(); |
293 |
> |
|
294 |
> |
$self->{creqtool}=$$hashref{'name'}; |
295 |
> |
$self->{creqversion}=$$hashref{'version'}; |
296 |
> |
$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=""; |
297 |
> |
} |
298 |
> |
} |
299 |
> |
|
300 |
> |
sub require_text |
301 |
> |
{ |
302 |
> |
my $self=shift; |
303 |
> |
my $name=shift; |
304 |
> |
my $string=shift; |
305 |
> |
|
306 |
> |
chomp $string; |
307 |
> |
$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}= |
308 |
> |
$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}. |
309 |
> |
$string; |
310 |
> |
} |
311 |
> |
|
312 |
> |
sub require_end |
313 |
> |
{ |
314 |
> |
my $self=shift; |
315 |
> |
my $name=shift; |
316 |
> |
|
317 |
> |
if ( $self->{reqcontext} != 1 ) |
318 |
> |
{ |
319 |
> |
$self->{switch}->parseerror("No matching tag for </$name>"); |
320 |
> |
} |
321 |
> |
else |
322 |
> |
{ |
323 |
> |
$self->{reqcontext}=0; |
324 |
> |
} |
325 |
> |
} |
326 |
> |
|
327 |
> |
sub select_start |
328 |
> |
{ |
329 |
> |
my $self=shift; |
330 |
> |
my $name=shift; |
331 |
> |
my $hashref=shift; |
332 |
> |
|
333 |
> |
$self->{switch}->checktag( $name, $hashref, 'name'); |
334 |
> |
$$hashref{'name'}=~tr[A-Z][a-z]; |
335 |
> |
if ( $self->{Arch} ) |
336 |
> |
{ |
337 |
> |
$self->verbose("Selecting ".$$hashref{'name'}); |
338 |
> |
# Increment counter: |
339 |
> |
$self->{selectcounter}++; |
340 |
> |
$self->{selected}{$$hashref{'name'}}=$self->{selectcounter}; |
341 |
> |
} |
342 |
> |
} |
343 |
> |
|
344 |
> |
sub Arch_Start |
345 |
> |
{ |
346 |
> |
my $self=shift; |
347 |
> |
my $name=shift; |
348 |
> |
my $hashref=shift; |
349 |
> |
|
350 |
> |
# Check the architecture tag: |
351 |
> |
$self->{switch}->checktag($name, $hashref,'name'); |
352 |
> |
( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1) |
353 |
> |
: ($self->{Arch}=0); |
354 |
> |
|
355 |
> |
$self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name}); |
356 |
> |
push @{$self->{ARCHBLOCK}}, $self->{Arch}; |
357 |
> |
push @{$self->{ArchStack}}, $$hashref{'name'}; |
358 |
> |
} |
359 |
> |
|
360 |
> |
sub Arch_End |
361 |
> |
{ |
362 |
> |
my $self=shift; |
363 |
> |
my $name=shift; |
364 |
> |
pop @{$self->{ARCHBLOCK}}; |
365 |
> |
$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}]; |
366 |
> |
} |
367 |
> |
|
368 |
> |
sub disttag |
369 |
> |
{ |
370 |
> |
my $self=shift; |
371 |
> |
my $name=shift; |
372 |
> |
my $hashref=shift; |
373 |
> |
|
374 |
> |
if ( exists $$hashref{'url'} ) |
375 |
> |
{ |
376 |
> |
$self->{dist}{$self->{creqtool}}{$self->{creqversion}}= |
377 |
> |
$$hashref{'url'}; |
378 |
> |
} |
379 |
> |
} |