ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/Requirements.pm
Revision: 1.19.2.2
Committed: Fri Feb 27 15:34:54 2004 UTC (21 years, 2 months ago) by sashby
Content type: text/plain
Branch: SCRAM_V1_BRANCH
CVS Tags: V1_pre0, SCRAM_V1, SCRAMV1_IMPORT
Branch point for: V1_pre1
Changes since 1.19.2.1: +84 -55 lines
Log Message:
First import of new SCRAM packages into CMS cvs repos.

File Contents

# Content
1 # Requirements Doc - just to get ordering info
2 #
3 # Interface
4 # ---------
5 # new(ActiveStore,url[,arch]) : new requirements doc
6 # setup(toolbox): set up the requirements into the specified toolbox object
7 # download(toolbox) : download description files (into toolbox cache)
8 # tools() : Return list of ALL requirements (ordered)
9 # selectedtools() : Return list of only those tools selected
10 # version(tool) : return the version of a given tool
11 # toolurl(tool) : return the url of a given tool
12 # getreqforarch(arch) : Return a RequirementsObject corresponding to the
13 # specified architecture
14 # toolcomment(tool,version) : return the comment string for the specified tool
15 # distributionurl(tool,version) : return the dist info url for the tool
16
17 package BuildSystem::Requirements;
18 use ActiveDoc::ActiveDoc;
19 use Utilities::Verbose;
20
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->verbose("Initialising a new Requirements Doc");
35 $self->{mydocversion}="2.0";
36 $self->{Arch}=1;
37 push @{$self->{ARCHBLOCK}}, $self->{Arch};
38 $self->init($self->{file});
39 return $self;
40 }
41
42 sub toolmanager
43 {
44 my $self=shift;
45
46 @_ ? $self->{toolmanagerobject} = shift #
47 : $self->{toolmanagerobject};
48
49 }
50
51 sub configversion
52 {
53 my $self=shift;
54 @_ ? $self->{configversion} = shift #
55 : $self->{configversion};
56 }
57
58 sub url {
59 my $self=shift;
60
61 if ( @_ ) {
62 $self->{file}=shift;
63 }
64 return $self->{file}
65 }
66
67 sub setup
68 {
69 my $self=shift;
70 my $toolbox=shift;
71 my $tool;
72
73 # Only for arch of interest:
74 if ($self->{Arch})
75 {
76 # Loop over selected tools:
77 foreach $tool ( $self->selectedtools() )
78 {
79 $self->verbose("Setting Up Tool $tool");
80 # Check to see if we have multiple versions of
81 # this tool (e.g. compilers)-just look for a colon
82 # which is used to separate the version entries:
83 if ( $self->version($tool) =~ /.*:.*$/)
84 {
85 # If so, extract versions:
86 my @versions=split /:/,$self->version($tool);
87 # Loop over versions of this tool and configure them:
88 foreach my $tversion (@versions)
89 {
90 $self->verbose(">> Treating multiple versions of tool $tool: $tversion <<");
91 $toolbox->toolsetup($tool, $tversion, $self->toolurl($tool));
92 }
93 }
94 else
95 {
96 $toolbox->toolsetup($tool, $self->version($tool), $self->toolurl($tool));
97 }
98 }
99 }
100 else
101 {
102 print "No tools defined for this arch.","\n";
103 return;
104 }
105 }
106
107 sub tools {
108 my $self=shift;
109 return @{$self->{tools}};
110 }
111
112 sub selectedtools
113 {
114 ###############################################################
115 # selectedtools() #
116 ###############################################################
117 # modified : Wed Dec 5 15:39:39 2001 / SFA #
118 # params : #
119 # : #
120 # : #
121 # : #
122 # function : New version of routine. Return a list of tools #
123 # : that were selected after parsing RequirementsDoc #
124 # : #
125 # : #
126 ###############################################################
127 my $self=shift;
128 my @toolarray = ();
129
130 # Grab the arrays of tools:
131 my ($toolref,$deseltoolref,$unseltoolref) = $self->grabtools();
132
133 my @tools = @{$toolref};
134 my @deseltools = @{$deseltoolref};
135 my @unseltools = @{$unseltoolref};
136
137 if ($#tools == -1)
138 {
139 $self->verbose(">> No tools SELECTED. Checking for DESELECTED tools");
140
141 # No tools "SELECTED". We return the tools that were "UNSELECTED"
142 # (these are the tools that remain after unwanted tools are deselected):
143 if ($#unseltools != -1)
144 {
145 $self->verbose(">> Using the tools remaining after DESELECTION ops");
146 # The array has elements:
147 return @unseltools;
148 }
149 else
150 {
151 $self->verbose(">> No UNSELECTED tools.....");
152 }
153 }
154 else
155 {
156 # We will return the selected tools but only after checking
157 # for subsequently deselected tools (unlikely but...):
158 foreach $selected (@tools)
159 {
160 # If the tool exists in the deselected tool array, pass.
161 if ( ! grep /$selected/, @deseltools)
162 {
163 push @toolarray, $selected;
164 }
165 else
166 {
167 $self->verbose(">> Tool $selected was subsequently deselected.");
168 }
169 }
170 }
171 return @toolarray;
172 }
173
174
175 sub grabtools
176 {
177 ###############################################################
178 # grabtools() #
179 ###############################################################
180 # modified : Wed Dec 5 14:41:56 2001 / SFA #
181 # params : #
182 # : #
183 # : #
184 # : #
185 # function : Loop over the tools read from RequirementsDoc #
186 # : and fill arrays for selected, deselected and #
187 # : unselected tools. #
188 # : #
189 ###############################################################
190 my $self=shift;
191 my @toollist=();
192 my @deseltoollist=();
193 my @unseltoollist=();
194
195 foreach $tool ( @{$self->{tools}} )
196 {
197 if ( $self->{selected}{$tool} eq "SELECTED" )
198 {
199 push @toollist, $tool;
200 }
201 elsif ( $self->{selected}{$tool} eq "DESELECTED" )
202 {
203 push @deseltoollist, $tool;
204 }
205 elsif ( $self->{selected}{$tool} eq "UNSELECTED" )
206 {
207 push @unseltoollist, $tool;
208 }
209 else
210 {
211 $self->verbose(">> Looks like an unknown sel flag for tool ".$tool." ");
212 }
213 }
214 return \(@toollist, @deseltoollist, @unseltoollist);
215 }
216
217
218 sub toolcomment {
219 my $self=shift;
220 my $tool=shift;
221 my $version=shift;
222
223 return $self->{reqtext}{$tool}{$version};
224 }
225
226 sub distributionurl {
227 my $self=shift;
228 my $tool=shift;
229 my $version=shift;
230
231 return ( defined $self->{dist}{$tool}{$version})?
232 $self->{dist}{$tool}{$version}:undef;
233 }
234
235 sub version {
236 my $self=shift;
237 my $tool=shift;
238 return $self->{'version'}{$tool};
239 }
240
241 sub toolurl {
242 my $self=shift;
243 my $tool=shift;
244 return $self->{'url'}{$tool};
245 }
246
247 sub init {
248 my $self=shift;
249 my $url=shift;
250
251 my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
252 $switch->verbosity($self->verbosity());
253 $switch->url($url);
254 $switch->newparse("ordering");
255 $switch->addbasetags("ordering");
256
257 $switch->addtag("ordering","Architecture",
258 \&Arch_Start,$self,
259 "", $self,
260 \&Arch_End, $self);
261 $switch->addtag("ordering","Restrict",
262 \&Restrict_start,$self,
263 "", $self,
264 \&Restrict_end, $self);
265 $switch->addtag("ordering","deselect",
266 \&deselect_start,$self,
267 "", $self,
268 "", $self);
269 $switch->addtag("ordering","select",
270 \&select_start,$self,
271 "", $self,
272 "", $self);
273 $switch->addtag("ordering","distribution",
274 \&disttag,$self);
275 $switch->grouptag("Architecture","ordering");
276 $switch->addtag("ordering","require",
277 \&require_start,$self,
278 \&require_text, $self,
279 \&require_end, $self);
280
281 $self->{reqcontext}=0;
282 $self->{switch}=$switch;
283 undef $self->{restrictstack};
284 @{$self->{tools}}=();
285
286 my($doctype,$docversion)=$switch->doctype();
287 # -- for backwards compatability only parse if we have a docversion
288 # defined
289 if ( defined $docversion ) {
290 if ( $docversion eq $self->{mydocversion} ) {
291 @{$self->{ArchStack}}=();
292 $self->verbose("Initial Document Parse");
293 $self->{switch}->parse("ordering");
294 $self->configversion($switch->{configurl}->param('version'));
295 }
296 else {
297 $self->verbose("wrong doc version - not parsing");
298 }
299 }
300 else {
301 $self->verbose("wrong doc type - not parsing");
302 }
303 }
304
305 sub arch {
306 my $self=shift;
307 # $self->arch is the SCRAM_ARCH value:
308 if ( @_ ) {
309 $self->{arch}=shift
310 }
311 else {
312 if ( ! defined $self->{arch} ) {
313 $self->{arch}="";
314 }
315 }
316 return $self->{arch};
317 }
318
319 sub archlist {
320 my $self=shift;
321 return @{$self->{ArchStack}};
322 }
323
324 sub getreqforarch {
325 my $self=shift;
326 my $arch=shift;
327
328 if ( ! defined $self->{reqsforarch}{$arch} ) {
329 $self->{reqsforarch}{$arch}=
330 BuildSystem::Requirements->new($self->{dbstore},$self->{file},
331 $arch);
332 }
333 return $self->{reqsforarch}{$arch};
334 }
335
336
337 sub download
338 {
339 my $self=shift;
340 my $tool;
341 $| = 1; # Unbuffer the output
342
343 print "Downloading tool descriptions....","\n";
344 print " ";
345 foreach $tool ( $self->tools() )
346 {
347 print "#";
348 $self->verbose("Downloading ".$self->toolurl($tool));
349 # get into the cache
350 $self->{switch}->urlget($self->toolurl($tool));
351 }
352 print "\nDone.","\n";
353 # So now add the list of downloaded tools, and which were
354 # selected, to tool cache:
355 print "Tool info cached locally.","\n","\n";
356
357 # Now copy required info from this object to ToolManager (ToolCache):
358 $self->toolmanager()->downloadedtools($self->{tools});
359 $self->toolmanager()->defaultversions($self->{version});
360 $self->toolmanager()->toolurls($self->{url});
361 $self->toolmanager()->selected($self->selectedtools());
362 }
363
364 sub _autoselect {
365 my $self=shift;
366 if ( @_ ) {
367 $self->{autoselect}=shift;
368 }
369 # -- default is true
370 return ((defined $self->{autoselect})?$self->{autoselect}:1);
371 }
372
373 # ---- Tag routines
374
375 sub Restrict_start {
376 my $self=shift;
377 my $name=shift;
378 my $hashref=shift;
379
380 $self->{switch}->checktag( $name, $hashref, 'autoselect');
381 if ( $self->{Arch} ) {
382 # -- create selection state stack
383 push @{$self->{restrictstack}}, $self->_autoselect();
384 $self->_autoselect(
385 (($$hashref{'autoselect'}=~/true/i)?1:0));
386 }
387 }
388
389 sub Restrict_end {
390 my $self=shift;
391 my $name=shift;
392
393 if ( $self->{Arch} ) {
394 if ( $#{$self->{restrictstack}} >= 0 ) {
395 $self->_autoselect(pop @{$self->{restrictstack}});
396 }
397 else {
398 $self->{switch}->parseerror("Unmatched </$name>");
399 }
400 }
401 }
402
403 sub require_start
404 {
405 my $self=shift;
406 my $name=shift;
407 my $hashref=shift;
408
409 $self->{switch}->checktag( $name, $hashref, 'version');
410 $self->{switch}->checktag( $name, $hashref, 'name');
411 $self->{switch}->checktag( $name, $hashref, 'url');
412
413 if ( $self->{reqcontext} == 1 )
414 {
415 $self->{switch}->parseerror(
416 "Open new $name context without previous </$name>");
417 }
418 $self->{reqcontext}=1;
419 $$hashref{'name'}=~tr[A-Z][a-z];
420 # Add protection so that architecture tags are obeyed during download:
421 if ( $self->{Arch} )
422 {
423 # Add tool to the tool array:
424 push @{$self->{tools}}, $$hashref{'name'};
425
426 # If the tool already has an entry, modify the version string to
427 # include both versions. The versions can later be separated and
428 # parsed as normal:
429 if (defined $self->{version}{$$hashref{'name'}})
430 {
431 # Don't need an extra entry for this tool onto tool array:
432 pop @{$self->{tools}}, $$hashref{'name'};
433 # Modify the version string to append the other tool version.
434 # Separate using a colon:
435 my $newversion=$self->{version}{$$hashref{'name'}}.":".$$hashref{'version'};
436 $self->{version}{$$hashref{'name'}}=$newversion;
437 }
438 else
439 {
440 $self->{version}{$$hashref{'name'}}=$$hashref{'version'};
441 }
442 # -- make sure the full url is taken
443 my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
444 $self->{url}{$$hashref{'name'}}=$urlobj->url();
445 $self->{selected}{$$hashref{'name'}}="UNSELECTED";
446
447 # Output the tool name here with the value
448 # of its' select flag:
449 $self->verbose(">> Tool name: ".$$hashref{'name'}." sel/desel flag value: ".
450 $self->{selected}{$$hashref{'name'}} ." ");
451
452 $self->{creqtool}=$$hashref{'name'};
453 $self->{creqversion}=$$hashref{'version'};
454 $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
455 }
456 }
457
458 sub require_text {
459 my $self=shift;
460 my $name=shift;
461 my $string=shift;
462
463 chomp $string;
464 $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
465 $self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
466 $string;
467
468 }
469
470 sub require_end {
471 my $self=shift;
472 my $name=shift;
473
474 if ( $self->{reqcontext} != 1 ) {
475 $self->{switch}->parseerror("No matching tag for </$name>");
476 }
477 else {
478 $self->{reqcontext}=0;
479 }
480 }
481
482 sub select_start
483 {
484 my $self=shift;
485 my $name=shift;
486 my $hashref=shift;
487
488 $self->{switch}->checktag( $name, $hashref, 'name');
489 $$hashref{'name'}=~tr[A-Z][a-z];
490 if ( $self->{Arch} )
491 {
492 $self->verbose("Selecting ".$$hashref{'name'});
493 $self->{selected}{$$hashref{'name'}} = "SELECTED";
494 $self->verbose(">> Tool select flag = ".$self->{selected}{$$hashref{'name'}}."\n");
495 }
496 }
497
498 sub deselect_start
499 {
500 my $self=shift;
501 my $name=shift;
502 my $hashref=shift;
503
504 $self->{switch}->checktag( $name, $hashref, 'name');
505 $$hashref{'name'}=~tr[A-Z][a-z];
506 if ( $self->{Arch} )
507 {
508 $self->verbose("Deselecting ".$$hashref{'name'});
509 $self->{selected}{$$hashref{'name'}} = "DESELECTED";
510 $self->verbose(">> Tool select flag = ".$self->{selected}{$$hashref{'name'}}."\n");
511 }
512 }
513
514 sub Arch_Start
515 {
516 my $self=shift;
517 my $name=shift;
518 my $hashref=shift;
519 # Check the architecture tag:
520 $self->{switch}->checktag($name, $hashref,'name');
521 # Look for a match between the architecture flag read
522 # from the RequirementsDoc ($$hashref{name}) and scram arch:
523 #
524 # ------ THIS DOES NOT WORK!!!! --------------
525 #
526 #if ($self->arch() =~ /$$hashref{name}$/)
527 # {
528 # $self->{Arch}=1;
529 # }
530 #else
531 # {
532 # $self->{Arch}=0;
533 # }
534
535 ( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
536 : ($self->{Arch}=0);
537
538 $self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name});
539 push @{$self->{ARCHBLOCK}}, $self->{Arch};
540 push @{$self->{ArchStack}}, $$hashref{'name'};
541 }
542
543 sub Arch_End {
544 my $self=shift;
545 my $name=shift;
546 pop @{$self->{ARCHBLOCK}};
547 $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
548 }
549
550 sub disttag {
551 my $self=shift;
552 my $name=shift;
553 my $hashref=shift;
554
555 if ( exists $$hashref{'url'} ) {
556 $self->{dist}{$self->{creqtool}}{$self->{creqversion}}=
557 $$hashref{'url'};
558 }
559 }