79 my %rootmap = &rootMap($path,$sysdef); |
79 my %rootmap = &rootMap($path,$sysdef); |
80 my %nsmap; |
80 my %nsmap; |
81 my %urimap; |
81 my %urimap; |
82 |
82 |
83 my $parser = new XML::DOM::Parser; |
83 my $parser = new XML::DOM::Parser; |
84 my $sysdefdoc = $parser->parsefile ($sysdef); |
84 my $sysdefdoc; |
|
85 eval { |
|
86 $sysdefdoc = $parser->parsefile ($sysdef); |
|
87 }; |
|
88 if(!$sysdefdoc) { |
|
89 die "ERROR: could not open $sysdef\n"; |
|
90 } |
|
91 |
85 |
92 |
86 |
93 |
87 my $maxschema = $sysdefdoc->getDocumentElement()->getAttribute('schema'); # don't check value, just store it. |
94 my $maxschema = $sysdefdoc->getDocumentElement()->getAttribute('schema'); # don't check value, just store it. |
88 |
95 |
89 my $docroot = $sysdefdoc->getDocumentElement; |
96 my $docroot = $sysdefdoc->getDocumentElement; |
229 } |
237 } |
230 if(!$ok) |
238 if(!$ok) |
231 { |
239 { |
232 foreach my $a (keys %unitmap) { |
240 foreach my $a (keys %unitmap) { |
233 if($a eq substr($link,0,length($a))) { |
241 if($a eq substr($link,0,length($a))) { |
234 my $trylink = $unitmap{$a}.substr($link,length($a)); |
242 $trylink = $unitmap{$a}.substr($link,length($a)); |
235 if(-e "$trylink$ext") { |
243 if(-e "$trylink$ext") { |
236 $ok=1; |
244 $ok=1; |
237 $link = $trylink; |
245 $link = $trylink; |
238 last; |
246 last; |
239 } |
247 } |
240 } |
248 } |
241 } |
249 } |
242 } |
250 } |
243 if(!$ok) |
251 if(!$ok) |
244 { |
252 { |
245 print "Error: $atr not found in $link$filter\n"; |
253 print "Error: $atr not found in ",($trylink ne '') ? $trylink : $link,"$filter\n"; |
246 } |
254 } |
247 } |
255 } |
248 } |
256 } |
249 } |
257 } |
250 elsif($tag eq 'meta') |
258 elsif($tag eq 'meta') |
308 # combine data from linked sysdef fragment w/ equivalent element in parent document |
316 # combine data from linked sysdef fragment w/ equivalent element in parent document |
309 my $node = shift; |
317 my $node = shift; |
310 my $file = shift; |
318 my $file = shift; |
311 my $getfromfile = &localfile($file); |
319 my $getfromfile = &localfile($file); |
312 $getfromfile eq '' && return; # already raised warning, no need to repeat |
320 $getfromfile eq '' && return; # already raised warning, no need to repeat |
313 my $doc = $parser->parsefile ($getfromfile); |
321 my $doc; |
|
322 eval { |
|
323 $doc = $parser->parsefile ($getfromfile); |
|
324 }; |
|
325 if(!$doc) { |
|
326 print "ERROR: could not open $getfromfile\n"; |
|
327 return; |
|
328 } |
314 my $item =&firstElement($doc->getDocumentElement); |
329 my $item =&firstElement($doc->getDocumentElement); |
315 $item || die "badly formatted $file"; |
330 $item || die "badly formatted $file"; |
316 &fixIDs($item); |
331 my @upid = &getNamespaceAndValue($node,'id'); |
317 my %up = &atts($node); |
332 my @downid = &getNamespaceAndValue($item,'id'); |
318 my %down = &atts($item); |
333 (($upid[0] eq $downid[0]) && ($upid[1] eq $downid[1])) || die "$upid[1] ($upid[0]) differs from $downid[1] ($downid[0]) "; # make sure the link is valid |
319 $up{'id'} eq $down{'id'} || die "$up{id} differs from $down{id}"; |
334 &walk($getfromfile,$item); |
320 $node->removeAttribute('href'); |
|
321 foreach my $v (keys %up) {delete $down{$v}} |
|
322 foreach my $v (keys %down) |
|
323 { |
|
324 $node->setAttribute($v,$down{$v}) |
|
325 } |
|
326 foreach my $child (@{$item->getChildNodes}) |
|
327 { |
|
328 ©Into($node,$child); |
|
329 } |
|
330 &walk($file,$node); |
|
331 } |
335 } |
332 |
336 |
333 |
337 |
334 sub copyInto |
338 sub copyInto |
335 { |
339 { |
339 my $doc = $parent->getOwnerDocument; |
343 my $doc = $parent->getOwnerDocument; |
340 my $type = $item->getNodeType; |
344 my $type = $item->getNodeType; |
341 my $new; |
345 my $new; |
342 if($type==1) |
346 if($type==1) |
343 { |
347 { |
344 &fixIDs($item); |
|
345 $new = $doc->createElement($item->getTagName); |
348 $new = $doc->createElement($item->getTagName); |
346 my %down = &atts($item); |
349 my %down = &atts($item); |
347 foreach my $ordered ('id','name','bldFile','mrp','level','levels','introduced','deprecated','filter') |
350 foreach my $ordered ('id','name','bldFile','mrp','level','levels','introduced','deprecated','filter') |
348 { |
351 { |
349 if($down{$ordered}) |
352 if($down{$ordered}) |
373 { |
376 { |
374 $parent->appendChild($new); |
377 $parent->appendChild($new); |
375 } |
378 } |
376 } |
379 } |
377 |
380 |
378 sub getNs |
381 |
379 { |
382 sub getNamespaceAndValue |
380 # find the namespace URI that applies to the specified prefix. |
383 { |
381 my $node = shift; |
|
382 my $pre = shift; |
|
383 my $uri = $node->getAttribute("xmlns:$pre"); |
|
384 if($uri) {return $uri} |
|
385 my $parent = $node->getParentNode; |
|
386 if($parent && $parent->getNodeType==1) |
|
387 { |
|
388 return getNs($parent,$pre); |
|
389 } |
|
390 } |
|
391 |
|
392 |
|
393 sub fixIDs |
|
394 { |
|
395 # translate the ID to use the root doc's namespaces |
|
396 my $node = shift; |
|
397 foreach my $id ('id','before') |
|
398 { |
|
399 &fixID($node,$id); |
|
400 } |
|
401 } |
|
402 |
|
403 sub fixID |
|
404 { |
|
405 # translate the ID to use the root doc's namespaces |
|
406 my $node = shift; |
384 my $node = shift; |
407 my $attr = shift || 'id'; |
385 my $attr = shift || 'id'; |
408 my $id = $node->getAttribute($attr); |
386 my $id = $node->getAttribute($attr); |
409 if($id eq '') {return} |
387 if($id eq '') {return} |
410 my $ns; |
388 my $ns; |
411 if($id=~s/^(.*)://) |
389 if($id=~s/^(.*)://) |
412 { # it's got a ns, find out what it is |
390 { # it's got a ns, find out what it is |
413 my $pre = $1; |
391 $ns=&getNs($node,$1); |
414 $ns=&getNs($node,$pre); |
|
415 } |
392 } |
416 else |
393 else |
417 { |
394 { |
418 $ns = $node->getOwnerDocument->getDocumentElement->getAttribute("id-namespace") || |
395 $ns = $node->getOwnerDocument->getDocumentElement->getAttribute("id-namespace") || |
419 $defaultns; |
396 $defaultns; |
420 } |
397 } |
421 $ns = $urimap{$ns}; |
398 return ($ns,$id);; |
422 $id = ($ns eq '') ? $id : "$ns:$id"; |
399 } |
423 return $node->setAttribute($attr,$id); |
400 |
424 } |
401 sub getNs |
|
402 { |
|
403 # find the namespace URI that applies to the specified prefix. |
|
404 my $node = shift; |
|
405 my $pre = shift; |
|
406 my $uri = $node->getAttribute("xmlns:$pre"); |
|
407 if($uri) {return $uri} |
|
408 my $parent = $node->getParentNode; |
|
409 if($parent && $parent->getNodeType==1) |
|
410 { |
|
411 return getNs($parent,$pre); |
|
412 } |
|
413 } |
|
414 |
|
415 |
425 |
416 |
426 sub firstElement { |
417 sub firstElement { |
427 # return the first element in this node |
418 # return the first element in this node |
428 my $node = shift; |
419 my $node = shift; |
429 foreach my $item (@{$node->getChildNodes}) { |
420 foreach my $item (@{$node->getChildNodes}) { |