10 # |
10 # |
11 # Contributors: |
11 # Contributors: |
12 # |
12 # |
13 # Description: |
13 # Description: |
14 # Script to validate the unit links in a system definition or package definition XML file |
14 # Script to validate the unit links in a system definition or package definition XML file |
|
15 #!/usr/bin/perl |
15 |
16 |
16 use strict; |
17 use strict; |
17 |
18 |
18 if (! scalar @ARGV) {&help()} |
19 |
19 |
20 use FindBin; # for FindBin::Bin |
20 |
21 use lib $FindBin::Bin; |
21 my $debug = 0; |
22 use lib "$FindBin::Bin/lib"; |
22 my $skipfilter; # skip anything with a named filter |
23 |
23 my $xslt = "../../../buildtools/bldsystemtools/buildsystemtools/joinsysdef.xsl"; |
24 use Cwd; |
24 my $xalan = "../../../buildtools/devlib/devlibhelp/tools/doc_tree/lib/apache/xalan.jar"; |
25 use Cwd 'abs_path'; |
25 my $sysdef = shift; |
26 use Getopt::Long; |
26 while($sysdef=~/^-/) { #arguments |
27 use File::Basename; |
27 if($sysdef eq '-nofilter') {$skipfilter = shift} |
28 use File::Spec; |
28 elsif($sysdef eq '-v') {$debug = 1} |
29 use XML::DOM; |
29 else { &help("Invalid command line option $sysdef")} |
30 |
30 $sysdef = shift; |
31 my $output; |
|
32 my $path; |
|
33 my %defineParams; |
|
34 my %defines; |
|
35 my $defaultns = 'http://www.symbian.org/system-definition'; # needed if no DTD |
|
36 my $realloc; |
|
37 |
|
38 # need to add options for controlling which metas are filtered out and which are included inline |
|
39 GetOptions |
|
40 ( |
|
41 'path=s' => $path, |
|
42 'effective-sysdef=s' => \$realloc |
|
43 ); |
|
44 |
|
45 # -path specifies the full system-model path to the file which is being processed. |
|
46 # This must be an absolute path if you're processing a root sysdef. |
|
47 # If processing a pkgdef file, you can use "./package_definition.xml" to leave all links relative. Though I can't really see the use case for this. |
|
48 |
|
49 |
|
50 # if config is not set, no confguration will be done. |
|
51 # If it is set, all configuration metadata will be processed and stripped from the output, even if the confguration data is empty |
|
52 |
|
53 if($path eq '') {$path = '/os/deviceplatformrelease/foundation_system/system_model/system_definition.xml'} |
|
54 |
|
55 ($#ARGV == -1 ) && &help(); |
|
56 my $sysdef = &abspath(shift); # resolve the location of the root sysdef |
|
57 |
|
58 $realloc = $realloc || $sysdef; |
|
59 |
|
60 my %unitmap; |
|
61 my @p1=reverse(split(/[\\\/]/,$path)); |
|
62 my @p2=reverse(split(/[\\\/]/,$realloc)); |
|
63 |
|
64 shift(@p1);shift(@p2); # don't care abt file name |
|
65 while(lc($p1[0]) eq lc($p2[0])) {shift(@p1);shift(@p2)} |
|
66 |
|
67 $unitmap{join('/',reverse(@p1))} = join("/",reverse(@p2)); |
|
68 |
|
69 my @p1=reverse(split(/[\\\/]/,$sysdef)); |
|
70 my @p2=reverse(split(/[\\\/]/,$realloc)); |
|
71 |
|
72 shift(@p1);shift(@p2); # don't care abt file name |
|
73 while(lc($p1[0]) eq lc($p2[0])) {shift(@p1);shift(@p2)} |
|
74 |
|
75 $unitmap{join('/',reverse(@p1))} = join("/",reverse(@p2)); |
|
76 |
|
77 |
|
78 # rootmap is a mapping from the filesystem to the paths in the doc |
|
79 my %rootmap = &rootMap($path,$sysdef); |
|
80 my %nsmap; |
|
81 my %urimap; |
|
82 |
|
83 my $parser = new XML::DOM::Parser; |
|
84 my $sysdefdoc = $parser->parsefile ($sysdef); |
|
85 |
|
86 |
|
87 my $maxschema = $sysdefdoc->getDocumentElement()->getAttribute('schema'); # don't check value, just store it. |
|
88 |
|
89 my $docroot = $sysdefdoc->getDocumentElement; |
|
90 |
|
91 my $ns = $docroot->getAttribute('id-namespace'); |
|
92 if(!$ns && $nsmap{''}) |
|
93 { |
|
94 $docroot->setAttribute('id-namespace',$nsmap{''}); |
|
95 } |
|
96 |
|
97 $docroot->setAttribute('schema',$maxschema); # output has the largest syntax version of all includes |
|
98 |
|
99 |
|
100 while(my($pre,$uri) = each(%nsmap)) |
|
101 { |
|
102 $pre ne '' || next ; |
|
103 $docroot->setAttribute("xmlns:$pre",$uri); |
|
104 } |
|
105 |
|
106 &walk($sysdef,$docroot); # process the XML |
|
107 |
|
108 |
|
109 sub abspath |
|
110 { # normalize the path into an absolute one |
|
111 my ($name,$path) = fileparse($_[0]); |
|
112 $path=~tr,\\,/,; |
|
113 if( -e $path) |
|
114 { |
|
115 return abs_path($path)."/$name"; |
|
116 } |
|
117 my @dir = split('/',$_[0]); |
|
118 my @new; |
|
119 foreach my $d (@dir) |
|
120 { |
|
121 if($d eq '.') {next} |
|
122 if($d eq '..') |
|
123 { |
|
124 pop(@new); |
|
125 next; |
|
126 } |
|
127 push(@new,$d) |
|
128 } |
|
129 return join('/',@new); |
|
130 } |
|
131 |
|
132 sub rootMap { |
|
133 my @pathdirs = split(/\//,$_[0]); |
|
134 my @rootdirs = split(/\//,$_[1]); |
|
135 |
|
136 while(lc($rootdirs[$#rootdirs]) eq lc($pathdirs[$#pathdirs]) ) |
|
137 { |
|
138 pop(@rootdirs); |
|
139 pop(@pathdirs); |
|
140 } |
|
141 return (join('/',@rootdirs) => join('/',@pathdirs) ); |
|
142 } |
|
143 |
|
144 sub rootMapMeta { |
|
145 # find all the explict path mapping from the link-mapping metadata |
|
146 my $node = shift; |
|
147 foreach my $child (@{$node->getChildNodes}) |
|
148 { |
|
149 if ($child->getNodeType==1 && $child->getTagName eq 'map-prefix') |
|
150 { |
|
151 my $from = $child->getAttribute('link'); |
|
152 my $to = $child->getAttribute('to'); # optional, but blank if not set |
|
153 $rootmap{$from} = $to; |
|
154 } |
|
155 } |
|
156 # once this is processed we have no more need for it. Remove from output |
|
157 $node->getParentNode->removeChild($node); |
|
158 } |
|
159 |
|
160 |
|
161 sub walk |
|
162 { # walk through the doc, resolving all links |
|
163 my $file = shift; |
|
164 my $node = shift; |
|
165 my $type = $node->getNodeType; |
|
166 if($type!=1) {return} |
|
167 my $tag = $node->getTagName; |
|
168 if($tag=~/^(layer|package|collection|component)$/ ) |
|
169 { |
|
170 my $link= $node->getAttribute('href'); |
|
171 if($link) |
|
172 { |
|
173 my $file = &resolvePath($file,$link); |
|
174 if(-e $file) |
|
175 { |
|
176 &combineLink($node,$file); |
|
177 } |
|
178 else |
|
179 { |
|
180 print "Note: $file not found\n"; |
|
181 $node->removeAttribute('href'); |
|
182 } |
|
183 return; |
|
184 } |
|
185 } |
|
186 elsif($tag=~/^(SystemDefinition|systemModel)$/ ) |
|
187 { |
|
188 } |
|
189 elsif($tag eq 'unit') |
|
190 { |
|
191 my %at = &atts($node); |
|
192 my $pro; |
|
193 foreach my $o (keys(%at)) |
|
194 { |
|
195 if($o eq 'proFile' || $o=~/:proFile$/) |
|
196 { |
|
197 $pro = $at{$o}; |
|
198 last; |
|
199 } |
|
200 } |
|
201 my $filter=$node->getParentNode()->getAttribute('filter'); |
|
202 if($filter ne '' && $at{'filter'}) {$filter.=','.$at{'filter'}} |
|
203 elsif($at{'filter'}) {$filter=$at{'filter'}} |
|
204 if($filter ne '') {$filter="\t($filter)"} |
|
205 foreach my $atr ('bldFile','mrp','base') |
|
206 { |
|
207 my $ext; |
|
208 my $link= $at{$atr}; |
|
209 if($atr eq 'bldFile') { |
|
210 $ext = ($pro ne '') ? "/$pro" : '/bld.inf' |
|
211 } |
|
212 if($link ne '') |
|
213 { |
|
214 my $ok = 0; |
|
215 my $trylink; |
|
216 if($link && !($link=~/^\//)) |
|
217 { |
|
218 $link= &abspath(File::Basename::dirname($file)."/$link"); |
|
219 $ok = (-e "$link$ext"); |
|
220 if(!$ok) |
|
221 { |
|
222 foreach my $a (keys %rootmap) |
|
223 { |
|
224 $link=~s,^$a,$rootmap{$a},ie; |
|
225 # remove leading ./ which is used to indicate that paths should remain relative |
|
226 $link=~s,^\./([^/]),$1,; |
|
227 } |
|
228 |
|
229 } |
|
230 } |
|
231 if(!$ok) |
|
232 { |
|
233 foreach my $a (keys %unitmap) { |
|
234 if($a eq substr($link,0,length($a))) { |
|
235 $trylink = $unitmap{$a}.substr($link,length($a)); |
|
236 if(-e "$trylink$ext") { |
|
237 $ok=1; |
|
238 $link = $trylink; |
|
239 last; |
|
240 } |
|
241 } |
|
242 } |
|
243 } |
|
244 if(!$ok) |
|
245 { |
|
246 print "Error: $atr not found in ",($trylink ne '') ? $trylink : $link,"$filter\n"; |
|
247 } |
|
248 } |
|
249 } |
|
250 } |
|
251 elsif($tag eq 'meta') |
|
252 { |
|
253 my $rel= $node->getAttribute('rel') || 'Generic'; |
|
254 my $link= $node->getAttribute('href'); |
|
255 $link=~s,^file://(/([a-z]:/))?,$2,; # convert file URI to absolute path |
|
256 if ($link ne '' ) |
|
257 { |
|
258 if($link=~/^[\/]+:/) |
|
259 { |
|
260 print "Note: Remote URL $link not validated\n"; |
|
261 next; # do not alter children |
|
262 } |
|
263 if(! ($link=~/^\//)) |
|
264 { |
|
265 $link= &abspath(File::Basename::dirname($file)."/$link"); |
|
266 } |
|
267 if(! -e $link) |
|
268 { |
|
269 if(! -e &realPath($link)) { |
|
270 print "Warning: Local metadata file not found: $link\n"; |
|
271 } |
|
272 next; # do not alter children |
|
273 } |
|
274 } |
|
275 if($node->getAttribute('rel') eq 'link-mapping') |
|
276 {# need to process this now |
|
277 &rootMapMeta($node); |
|
278 } |
|
279 return; |
|
280 } |
|
281 else {return} |
|
282 my $checkversion=0; |
|
283 foreach my $item (@{$node->getChildNodes}) |
|
284 { |
|
285 #print $item->getNodeType,"\n"; |
|
286 &walk($file,$item); |
|
287 } |
|
288 |
|
289 |
|
290 |
|
291 } |
|
292 |
|
293 |
|
294 sub realPath |
|
295 { |
|
296 my $link = shift; |
|
297 foreach my $a (keys %unitmap) |
|
298 { |
|
299 if($a eq substr($link,0,length($a))) |
|
300 { |
|
301 my $trylink = $unitmap{$a}.substr($link,length($a)); |
|
302 if(-e $trylink) {return $trylink} |
|
303 } |
|
304 } |
|
305 } |
|
306 |
|
307 sub combineLink |
|
308 { |
|
309 # combine data from linked sysdef fragment w/ equivalent element in parent document |
|
310 my $node = shift; |
|
311 my $file = shift; |
|
312 my $getfromfile = &localfile($file); |
|
313 $getfromfile eq '' && return; # already raised warning, no need to repeat |
|
314 my $doc = $parser->parsefile ($getfromfile); |
|
315 my $item =&firstElement($doc->getDocumentElement); |
|
316 $item || die "badly formatted $file"; |
|
317 &fixIDs($item); |
|
318 my %up = &atts($node); |
|
319 my %down = &atts($item); |
|
320 $up{'id'} eq $down{'id'} || die "$up{id} differs from $down{id}"; |
|
321 $node->removeAttribute('href'); |
|
322 foreach my $v (keys %up) {delete $down{$v}} |
|
323 foreach my $v (keys %down) |
|
324 { |
|
325 $node->setAttribute($v,$down{$v}) |
|
326 } |
|
327 foreach my $child (@{$item->getChildNodes}) |
|
328 { |
|
329 ©Into($node,$child); |
|
330 } |
|
331 &walk($file,$node); |
|
332 } |
|
333 |
|
334 |
|
335 sub copyInto |
|
336 { |
|
337 # make a deep copy the node (2nd arg) into the element (1st arg) |
|
338 my $parent=shift; |
|
339 my $item = shift; |
|
340 my $doc = $parent->getOwnerDocument; |
|
341 my $type = $item->getNodeType; |
|
342 my $new; |
|
343 if($type==1) |
|
344 { |
|
345 &fixIDs($item); |
|
346 $new = $doc->createElement($item->getTagName); |
|
347 my %down = &atts($item); |
|
348 foreach my $ordered ('id','name','bldFile','mrp','level','levels','introduced','deprecated','filter') |
|
349 { |
|
350 if($down{$ordered}) |
|
351 { |
|
352 $new->setAttribute($ordered,$down{$ordered}); |
|
353 delete $down{$ordered} |
|
354 } |
|
355 } |
|
356 while(my($a,$b) = each(%down)) |
|
357 { |
|
358 $new->setAttribute($a,$b); |
|
359 } |
|
360 foreach my $child (@{$item->getChildNodes}) |
|
361 { |
|
362 ©Into($new,$child); |
|
363 } |
|
364 } |
|
365 elsif($type==3) |
|
366 { |
|
367 $new = $doc->createTextNode ($item->getData); |
|
368 } |
|
369 elsif($type==8) |
|
370 { |
|
371 $new = $doc->createComment ($item->getData); |
|
372 } |
|
373 if($new) |
|
374 { |
|
375 $parent->appendChild($new); |
|
376 } |
|
377 } |
|
378 |
|
379 sub getNs |
|
380 { |
|
381 # find the namespace URI that applies to the specified prefix. |
|
382 my $node = shift; |
|
383 my $pre = shift; |
|
384 my $uri = $node->getAttribute("xmlns:$pre"); |
|
385 if($uri) {return $uri} |
|
386 my $parent = $node->getParentNode; |
|
387 if($parent && $parent->getNodeType==1) |
|
388 { |
|
389 return getNs($parent,$pre); |
|
390 } |
|
391 } |
|
392 |
|
393 |
|
394 sub fixIDs |
|
395 { |
|
396 # translate the ID to use the root doc's namespaces |
|
397 my $node = shift; |
|
398 foreach my $id ('id','before') |
|
399 { |
|
400 &fixID($node,$id); |
|
401 } |
31 } |
402 } |
32 my $dir = $sysdef; |
403 |
33 $dir =~ s,[^\\/]+$,,; |
404 sub fixID |
34 my $root="../../../.."; |
405 { |
35 my $full; |
406 # translate the ID to use the root doc's namespaces |
36 |
407 my $node = shift; |
37 if($sysdef=~/system_definition\.xml/) { # if running on a sysdef, ensure it's joined before continuing |
408 my $attr = shift || 'id'; |
38 ($full = `java -jar $dir$xalan -in $sysdef -xsl $dir$xslt`) || die "bad XML syntax"; |
409 my $id = $node->getAttribute($attr); |
39 }else { # assume any other file has no hrefs to include (valid by convention) |
410 if($id eq '') {return} |
40 $root=''; |
411 my $ns; |
41 open S, $sysdef; |
412 if($id=~s/^(.*)://) |
42 $full=join('',<S>); |
413 { # it's got a ns, find out what it is |
43 close S; |
414 my $pre = $1; |
|
415 $ns=&getNs($node,$pre); |
|
416 } |
|
417 else |
|
418 { |
|
419 $ns = $node->getOwnerDocument->getDocumentElement->getAttribute("id-namespace") || |
|
420 $defaultns; |
|
421 } |
|
422 $ns = $urimap{$ns}; |
|
423 $id = ($ns eq '') ? $id : "$ns:$id"; |
|
424 return $node->setAttribute($attr,$id); |
44 } |
425 } |
45 $full=~s/<!--.*?-->//sg; # remove all comments; |
426 |
46 my $count=1; |
427 sub firstElement { |
47 |
428 # return the first element in this node |
48 my $filter = ''; |
429 my $node = shift; |
49 foreach (split(/</,$full)) { # loop through all elements |
430 foreach my $item (@{$node->getChildNodes}) { |
50 my $found = 0; |
431 if($item->getNodeType==1) {return $item} |
51 if(/^component/) { # save the current filter so we know if we need to skip the named filter |
432 } |
52 $filter=''; |
|
53 if(/filter="([^"]+)"/) {$filter=$1} |
|
54 } |
|
55 elsif(s/^unit//) { |
|
56 my $f=",$filter,"; # commas are the separators - safe to have extra ones for testing |
|
57 if(/filter="([^"]+)"/) {$f.=",$1,"} |
|
58 if($skipfilter ne '' && $f=~/,$filter,/) {next} # don't test anything with s60 filter |
|
59 if(/\smrp="(.*?)"/) { |
|
60 my $file = &fileLocation($1); |
|
61 if($debug) {print "MRP ",-s $file," $file\n"} # debug code |
|
62 if(!(-s $file)){ |
|
63 print STDERR "$count: Cannot find MRP file $file\n"; |
|
64 $found=1; |
|
65 } |
|
66 } |
|
67 if(/\sbldFile="(.*?)"/) { |
|
68 my $file = &fileLocation("$1/bld.inf"); |
|
69 if($debug) {print "Bld ",-s $file ," $file\n"} # debug code |
|
70 if(!(-s $file) ){ |
|
71 print STDERR "$count: Cannot find bld.inf file $file\n"; |
|
72 $found=1; |
|
73 } |
|
74 } |
|
75 if(/\sbase="(.*?)"/) { |
|
76 my $file = &fileLocation($1); |
|
77 if($debug) {print "Base $file\n"} # debug code |
|
78 if(!(-d $file) ){ |
|
79 print STDERR "$count: Cannot find base dir $file\n"; |
|
80 $found=1; |
|
81 } |
|
82 } |
|
83 } |
|
84 $count+=$found; |
|
85 } |
433 } |
86 |
434 |
87 exit $count; |
435 |
88 |
436 sub atts { |
89 sub fileLocation { |
437 # return a hash of all attribtues defined for this element |
90 my $file = "$dir$root$_[0]"; |
438 my $node = shift; |
91 $file=~tr/\//\\/; |
439 my %at = $node->getAttributes; |
92 while($file=~s/\\[^\\.]+\\\.\.\\/\\/){} |
440 my %list; |
93 return $file; |
441 foreach my $a (keys %{$node->getAttributes}) |
|
442 { |
|
443 if($a ne '') |
|
444 { |
|
445 $list{$a} = $node->getAttribute ($a); |
|
446 } |
|
447 } |
|
448 return %list; |
94 } |
449 } |
95 sub help { |
450 |
96 print "$0: ",($_[0] eq '' ? "syntax" : $_[0]); |
451 |
97 print "\nSyntax: [-v] [-nofilter filter] system_definition.xml |
452 sub ns |
98 Validate the unit links in a system definition or package definition XML |
453 { |
99 file. This only prints errors in the files. If it exits silently, the links |
454 # return a hash of ns prefix and uri -- the xmlns: part is stripped off |
100 are all valid. |
455 my $node = shift; |
101 Call with -nos60 filter to skip checking presence of fitler=\"s60\" units |
456 my %list; |
102 Requires system definition files to be in the standard location |
457 foreach my $a (keys %{$node->getAttributes}) |
103 in deviceplatformrelease, |
458 { |
104 and the presence of joinsysdef.xsl and xalan.jar in their expected |
459 my $pre = $a; |
105 locations. |
460 if($pre=~s/^xmlns://) |
106 Package definition files can be anywhere."; |
461 { |
107 exit 1; |
462 $list{$pre} = $node->getAttribute ($a); |
108 } |
463 } |
|
464 } |
|
465 return %list; |
|
466 } |
|
467 |
|
468 |
|
469 sub resolvePath |
|
470 { |
|
471 # return full path to 2nd arg relative to first (path or absolute URI) |
|
472 my $base = shift; |
|
473 my $path = shift; |
|
474 if($path=~m,^/,) {return $path } # path is absolute, but has no drive. Let OS deal with it. |
|
475 if($path=~s,^file:///([a-zA-Z]:/),$1,) {return $path } # file URI with drive letter |
|
476 if($path=~m,^file://,) {return $path } # file URI with no drive letter (unit-style). Just pass on as is with leading / and let OS deal with it |
|
477 if($path=~m,^[a-z0-9][a-z0-9]+:,i) {return $path } # absolute URI -- no idea how to handle, so just return |
|
478 return &abspath(File::Basename::dirname($base)."/$path"); |
|
479 } |
|
480 |
|
481 |
|
482 sub resolveURI |
|
483 { |
|
484 # return full path to 2nd arg relative to first (path or absolute URI) |
|
485 my $base = shift; |
|
486 my $path = shift; |
|
487 if($path=~m,[a-z0-9][a-z0-9]+:,i) {return $path } # absolute URI -- just return |
|
488 if($path=~m,^/,) {return $path } # path is absolute, but has no drive. Let OS deal with it. |
|
489 return &abspath(File::Basename::dirname($base)."/$path"); |
|
490 } |
|
491 |
|
492 sub localfile |
|
493 { |
|
494 my $file = shift; |
|
495 if($file=~s,file:///([a-zA-Z]:/),$1,) {return $file } # file URI with drive letter |
|
496 if($file=~m,file://,) {return $file } # file URI with no drive letter (unit-style). Just pass on as is with leading / and let OS deal with it |
|
497 if($file=~m,^([a-z0-9][a-z0-9]+):,i) |
|
498 { |
|
499 print "ERROR: $1 scheme not supported\n"; |
|
500 return; # return empty string if not supported. |
|
501 } |
|
502 return $file |
|
503 } |
|
504 |
|
505 |
|
506 |
|
507 |
|
508 |
|
509 sub help |
|
510 { |
|
511 my $name= $0; $name=~s,^.*[\\/],,; |
|
512 my $text; |
|
513 format STDERR = |
|
514 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
|
515 $text, |
|
516 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ |
|
517 $text |
|
518 . |
|
519 print STDERR "usage: $name [options...] sysdef\n valid options are:\n\n"; |
|
520 foreach ( |
|
521 "-path [sm-path]\tspecifies the full system-model path to the file which is being processed. By default this is \"/os/deviceplatformrelease/foundation_system/system_model/system_definition.xml\"", |
|
522 " This must be an absolute path if you're processing a root sysdef.", |
|
523 " If processing a pkgdef file, you can use \"./package_definition.xml\" to leave all links relative.", |
|
524 "effective-sysdef [local-file]\tspecifies another local filesystem location the sysdef should be considered when resolving linked metas and unit paths, but not system model item hrefs. This is mainly used for testing system-wide changes to pkgdefs since it allows the pkgdefs to exist in a separate location to the rest of the codeline" |
|
525 ) { |
|
526 $text = $_; |
|
527 write STDERR; |
|
528 print STDERR "\n"; |
|
529 } |
|
530 |
|
531 exit(1); |
|
532 } |
|
533 |
|
534 |
|
535 |