|
1 #!perl |
|
2 |
|
3 # ziplog2pkg.pm |
|
4 |
|
5 # Copyright (c) 1997-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
6 # All rights reserved. |
|
7 # This component and the accompanying materials are made available |
|
8 # under the terms of "Eclipse Public License v1.0" |
|
9 # which accompanies this distribution, and is available |
|
10 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
11 # |
|
12 # Initial Contributors: |
|
13 # Nokia Corporation - initial contribution. |
|
14 # |
|
15 # Contributors: |
|
16 # |
|
17 # Description: |
|
18 # |
|
19 |
|
20 use strict; |
|
21 |
|
22 |
|
23 package ZipLog2Pkg; |
|
24 |
|
25 use File::Path; |
|
26 use CProgressLog; |
|
27 use KitStandardLocations; |
|
28 |
|
29 my $log; |
|
30 my %stdVars = (); |
|
31 |
|
32 |
|
33 # --------------------------------- Start of ZipLog2Pkg() ---------------------------- |
|
34 sub ZipLog2Pkg($$) |
|
35 { |
|
36 my $cmdfile = shift; |
|
37 |
|
38 my $parameters = shift; |
|
39 my @options = grep(/^-/,$parameters); |
|
40 |
|
41 my $verbose = 1; |
|
42 foreach my $option (@options) |
|
43 { |
|
44 if ($option eq "-v") |
|
45 { |
|
46 $verbose = 2; |
|
47 } |
|
48 elsif (($option eq "-batch") || ($option eq "-b")) |
|
49 { |
|
50 $verbose = 0; |
|
51 } |
|
52 else |
|
53 { |
|
54 print "WARNING: Option '$option' not understood; ignoring\n"; |
|
55 } |
|
56 } |
|
57 |
|
58 # set up hash containing variables defined in KitStandardLocations.pm |
|
59 foreach my $var (@KitStandardLocations::EXPORT) |
|
60 { |
|
61 $var =~ s/\$//; |
|
62 eval{ |
|
63 no strict 'refs'; |
|
64 $stdVars{"%".$var."%"} = "$$var"; |
|
65 }; |
|
66 } |
|
67 |
|
68 my $PlatformProductToolsDir = $FindBin::Bin; |
|
69 $PlatformProductToolsDir =~ s/common/$KitStandardLocations::Platform/i; # change "common" to platform name in path to tools directory |
|
70 $stdVars{"%baseline%"} = "$PlatformProductToolsDir\\baseline"; |
|
71 |
|
72 $log = New CProgressLog($verbose); |
|
73 open (CMDFILE, "<$cmdfile") or print "Unable to open $cmdfile - $!\n" ; |
|
74 |
|
75 my $packages = {}; |
|
76 my @files; |
|
77 my @usedFiles; |
|
78 my $version; |
|
79 my @global_map; |
|
80 |
|
81 $global_map[0] = ""; # global map from |
|
82 $global_map[1] = "[emul]\\"; # global map to |
|
83 |
|
84 |
|
85 foreach my $line (<CMDFILE>) |
|
86 { |
|
87 chomp($line); |
|
88 |
|
89 if ($line =~ /^#/) |
|
90 { |
|
91 print "\n$line\n" # Printable comment |
|
92 } |
|
93 elsif (($line =~ /^\/\//) || ($line =~ /^\s*$/)) |
|
94 { |
|
95 # Nonprintable comment or blank line |
|
96 } |
|
97 else |
|
98 { |
|
99 # replace standard variables in @params |
|
100 if ($line =~ /%/) |
|
101 { |
|
102 $line = replaceStdVars ($line) |
|
103 } |
|
104 |
|
105 my @parms = split(" ", $line); |
|
106 # Recombine quoted entries |
|
107 for (my $index=0; $index < scalar(@parms); $index++) |
|
108 { |
|
109 if ($parms[$index] =~ /^\"/) |
|
110 { |
|
111 # If double quoted |
|
112 my $entry = $parms[$index]; |
|
113 |
|
114 while ( ($entry !~ /\"$/) && ( ($index+1) < scalar(@parms) ) ) |
|
115 { |
|
116 # If end quote not found, merge following entry |
|
117 $entry = $entry." ".$parms[$index+1]; |
|
118 |
|
119 splice @parms, $index+1, 1; |
|
120 } |
|
121 |
|
122 if ($entry !~ /\"$/) |
|
123 { |
|
124 if ($entry =~ /^\"[^\"]*$/) |
|
125 { |
|
126 die "'$line' invalid: Opening quote must have corresponding close quote\n"; |
|
127 } |
|
128 else |
|
129 { |
|
130 die "'$line' invalid: Close quote must come at end of parameter\n"; |
|
131 } |
|
132 } |
|
133 |
|
134 # Store combined quoted entries |
|
135 $entry =~ s/^\"//; |
|
136 $entry =~ s/\"$//; |
|
137 splice @parms, $index, 1, $entry; |
|
138 } |
|
139 elsif ($parms[$index] =~ /^'/) |
|
140 { |
|
141 # If single quoted |
|
142 my $entry = $parms[$index]; |
|
143 |
|
144 while ( ($entry !~ /'$/) && ( ($index+1) < scalar(@parms) ) ) |
|
145 { |
|
146 # If end quote not found, merge following entry |
|
147 $entry = $entry." ".$parms[$index+1]; |
|
148 |
|
149 splice @parms, $index+1, 1; |
|
150 } |
|
151 |
|
152 if ($entry !~ /'$/) |
|
153 { |
|
154 if ($entry =~ /^'[^']*$/) |
|
155 { |
|
156 die "'$line' invalid: Opening quote must have corresponding close quote\n"; |
|
157 } |
|
158 else |
|
159 { |
|
160 die "'$line' invalid: Close quote must come at end of parameter\n"; |
|
161 } |
|
162 } |
|
163 |
|
164 # Store combined quoted entries |
|
165 $entry =~ s/^'//; |
|
166 $entry =~ s/'$//; |
|
167 splice @parms, $index, 1, $entry; |
|
168 } |
|
169 } |
|
170 |
|
171 |
|
172 my $command = shift @parms; |
|
173 $command = lc($command); |
|
174 |
|
175 if (($command eq "load") or ($command eq "add")) |
|
176 { |
|
177 if ($command eq "load") |
|
178 { |
|
179 # Don't append this; clear first |
|
180 if (scalar(@files)>0) |
|
181 { |
|
182 $log->Warn("WARNING: ".scalar(@files)." files discarded."); |
|
183 } |
|
184 @files = (); |
|
185 } |
|
186 |
|
187 if (scalar(@parms) != 1) |
|
188 { |
|
189 die "'$line' invalid:\nExpected only one parameter (ziplog filename)\n"; |
|
190 } |
|
191 |
|
192 my @new; |
|
193 |
|
194 if ($parms[0] =~ /^#/) |
|
195 { |
|
196 my $file = $parms[0]; |
|
197 $file =~ s/^#//; |
|
198 @new = @{readFileList($file)}; |
|
199 } |
|
200 else |
|
201 { |
|
202 @new = @{readZiplog($parms[0])}; |
|
203 } |
|
204 |
|
205 $log->Progress(""); |
|
206 |
|
207 my $orig = scalar(@files); |
|
208 @files = (@files, @new); |
|
209 |
|
210 # Clear any additional duplicated items |
|
211 @files = @{removeDuplicates(\@files, 1)}; |
|
212 |
|
213 # Don't load in any lines that were previously loaded |
|
214 # (add in @usedFiles twice, remove all duplicates) |
|
215 @files = (@usedFiles, @usedFiles, @files); |
|
216 @files = @{removeDuplicates(\@files, 0)}; # Removes all |
|
217 # of the @used files added, plus any of those which |
|
218 # matched the original @files too |
|
219 |
|
220 $log->Progress("Loaded $parms[0]. ".scalar(@new)." files (".(scalar(@new)+$orig-scalar(@files))." duplicates)"); |
|
221 } |
|
222 elsif ($command eq "patch") |
|
223 { |
|
224 if (scalar(@parms) != 1) |
|
225 { |
|
226 die "'$line' invalid:\nExpected only one parameter (file list filename)\n"; |
|
227 } |
|
228 |
|
229 my $file = $parms[0]; |
|
230 if ($file =~ /^#/) |
|
231 { |
|
232 $file=~s/^#//; |
|
233 } |
|
234 else |
|
235 { |
|
236 $log->Error("ERROR: Patch file should be prefixed with a '#' to specify filelist.\nAttempting default of filelist."); |
|
237 } |
|
238 |
|
239 # Read file list in |
|
240 my @filelist = @{readFileList($file)}; |
|
241 |
|
242 # Add them back in to files to match |
|
243 my $orig = scalar(@files); |
|
244 @files = (@files, @filelist); |
|
245 @files = @{removeDuplicates(\@files, 1)}; |
|
246 |
|
247 # Take them out of files already matched |
|
248 # (so a load containing one of them won't eliminate it) |
|
249 @usedFiles = (@usedFiles, @filelist, @filelist); |
|
250 @usedFiles = @{removeDuplicates(\@usedFiles, 0)}; |
|
251 |
|
252 $log->Progress("Loaded $parms[0]. ".scalar(@filelist)." files (".(scalar(@filelist)+$orig-scalar(@files))." duplicates)"); |
|
253 } |
|
254 elsif ($command eq "create") |
|
255 { |
|
256 # Create package list |
|
257 if (scalar(@parms) < 2) |
|
258 { |
|
259 die "'$line' invalid:\nExpected at least 2 parameters (package name, device name, [dependencies ...])\n"; |
|
260 } |
|
261 |
|
262 # Parms: packagePath, device, dependencies... |
|
263 my $packagePath = shift @parms; |
|
264 my $device = shift @parms; |
|
265 |
|
266 my $packageName = $packagePath; |
|
267 $packageName =~ s/^.*[\/\\]//; |
|
268 $packagePath =~ s/[\/\\][^\/\\]+$/\\/ or $packagePath = ""; |
|
269 |
|
270 if ($packageName eq "null") |
|
271 { |
|
272 die "'$line' invalid:\nCannot create package named 'null'. This name is reserved for files not to be written\n"; |
|
273 } |
|
274 |
|
275 $packages->{$packageName} = [$packagePath, $device, [], \@parms, [], [], \@global_map, "", "", "", []]; |
|
276 } |
|
277 elsif ($command eq "path") |
|
278 { |
|
279 # Parms: packageName, path to add |
|
280 if (scalar(@parms) != 2) |
|
281 { |
|
282 die "'$line' invalid:\nExpected 2 parameters (package name, path to add)\n"; |
|
283 } |
|
284 my $packageName = shift @parms; |
|
285 my $path = shift @parms; |
|
286 |
|
287 my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
288 push @$paths, $path; |
|
289 |
|
290 $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags]; |
|
291 } |
|
292 elsif ($command eq "menu") |
|
293 { |
|
294 # Parms: package name, menu entry, description, working path, file path [arguments, icon path] |
|
295 if (scalar(@parms) < 5) |
|
296 { |
|
297 die "'$line' invalid:\nExpected at least 5 parameters (package name, menu entry, description, working path, file path, arguments, icon path)\n"; |
|
298 } |
|
299 my ($packageName,$entry,$desc,$path,$file,$args,$icon) = @parms; |
|
300 |
|
301 my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
302 push @$menu, [$entry, $desc, $path, $file, $args, $icon]; |
|
303 |
|
304 $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags]; |
|
305 } |
|
306 elsif ($command eq "map_global") |
|
307 { |
|
308 # Parms: global map from, global map to |
|
309 if (scalar(@parms) != 2) |
|
310 { |
|
311 die "'$line' invalid:\nExpected 2 parameters (global map from, global map to)\n"; |
|
312 } |
|
313 @global_map = @parms; |
|
314 } |
|
315 elsif ($command eq "map") |
|
316 { |
|
317 # Parms: packageName, map from, map to |
|
318 if (scalar(@parms) != 3) |
|
319 { |
|
320 die "'$line' invalid:\nExpected 3 parameters (package name, map from, map to)\n"; |
|
321 } |
|
322 my ($packageName, $from, $to) = @parms; |
|
323 |
|
324 my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
325 $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, [$from, $to], $category, $description, $licence, $tags]; |
|
326 } |
|
327 elsif ($command eq "category") |
|
328 { |
|
329 # Parms: packageName, category |
|
330 if (scalar(@parms) < 2) |
|
331 { |
|
332 die "'$line' invalid:\nExpected 2 parameters (package name, category)\n"; |
|
333 } |
|
334 my $packageName = shift @parms; |
|
335 my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
336 my $category = shift @parms; |
|
337 $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags]; |
|
338 } |
|
339 elsif ($command eq "description") |
|
340 { |
|
341 # Parms: packageName, description |
|
342 if (scalar(@parms) < 2) |
|
343 { |
|
344 die "'$line' invalid:\nExpected 2 parameters (package name, description)\n"; |
|
345 } |
|
346 my $packageName = shift @parms; |
|
347 my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
348 my $description = shift @parms; |
|
349 $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags]; |
|
350 } |
|
351 elsif ($command eq "licence") |
|
352 { |
|
353 # Parms: packageName, licence file |
|
354 if (scalar(@parms) != 2) |
|
355 { |
|
356 die "'$line' invalid:\nExpected 2 parameters (package name, licence file)\n"; |
|
357 } |
|
358 my $packageName = shift @parms; |
|
359 my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
360 my $licence = shift @parms; |
|
361 $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags]; |
|
362 } |
|
363 elsif ($command eq "tag") |
|
364 { |
|
365 # Parms: packageName, tag name, tag value |
|
366 if (scalar(@parms) != 3) |
|
367 { |
|
368 die "'$line' invalid:\nExpected 3 parameters (package name, tag name, tag value)\n"; |
|
369 } |
|
370 my ($packageName, $tagName, $tagValue) = @parms; |
|
371 |
|
372 my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
373 $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, [$tagName, $tagValue]]; |
|
374 } |
|
375 elsif ($command eq "test") |
|
376 { |
|
377 # Warn if any files match |
|
378 if (scalar(@parms) < 1) |
|
379 { |
|
380 die "'$line' invalid:\nExpected >1 parameter (expressions to match)\n"; |
|
381 } |
|
382 |
|
383 my @files = @{ match(\@files, \@parms, [0], $cmdfile) }; |
|
384 |
|
385 foreach my $file (@files) |
|
386 { |
|
387 $log->Warn("WARNING: '$file' matched tests '".join(", ",@parms)."'"); |
|
388 } |
|
389 } |
|
390 elsif ($command eq "write") |
|
391 { |
|
392 # Write out to a package list |
|
393 my @options = grep(/^-/,@parms); |
|
394 my @parms = grep(!/^-/,@parms); |
|
395 |
|
396 if (scalar(@parms) < 2) |
|
397 { |
|
398 die "'$line' invalid:\nExpected >2 parameters (expressions..., package name)\n"; |
|
399 } |
|
400 |
|
401 my $warn = 1; |
|
402 foreach my $option (@options) |
|
403 { |
|
404 if ($option eq "-nowarn") |
|
405 { |
|
406 $warn = 0; |
|
407 } |
|
408 else |
|
409 { |
|
410 die "'$line' invalid:\nOption $option not understood\n"; |
|
411 } |
|
412 } |
|
413 |
|
414 my $packageName = pop @parms; |
|
415 |
|
416 # Perform the matching |
|
417 my @package = @{ match(\@files,\@parms, [$warn], $cmdfile) }; |
|
418 |
|
419 # Get list of the files that are still to be matched |
|
420 @files = (@files, @package, @package); |
|
421 @files = @{removeDuplicates(\@files,0)}; |
|
422 |
|
423 # Record the matched files as used |
|
424 @usedFiles = (@usedFiles, @package); |
|
425 |
|
426 $log->Progress("Matched ".scalar(@package)." files for $packageName"); |
|
427 |
|
428 if (defined($packages->{$packageName})) |
|
429 { |
|
430 my ($packagePath, $device, $merge, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}}; |
|
431 |
|
432 $merge = [@package, @$merge]; |
|
433 $packages->{$packageName} = [$packagePath, $device, $merge, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags]; |
|
434 } |
|
435 else |
|
436 { |
|
437 if ($packageName ne "null") |
|
438 { |
|
439 die "\nIn line '$line':\nAttempt to add to non-existent package '$packageName'.\nUse 'create $packageName [device name]' to create the package definition first\n"; |
|
440 } |
|
441 } |
|
442 } |
|
443 elsif ($command eq "version") |
|
444 { |
|
445 if (defined($version)) |
|
446 { |
|
447 die "\nIn line '$line':\nVersion has already been defined. One script can only have one version\n"; |
|
448 } |
|
449 else |
|
450 { |
|
451 if (scalar(@parms) > 1) |
|
452 { |
|
453 die "\nIn line '$line':\nExpected only one parameter (spaces must be quoted)\n"; |
|
454 } |
|
455 else |
|
456 { |
|
457 $version = shift @parms; |
|
458 } |
|
459 } |
|
460 } |
|
461 else |
|
462 { |
|
463 $log->Error("ERROR: Command not understood; ignoring: $line"); |
|
464 } |
|
465 } |
|
466 } |
|
467 close(CMDFILE); |
|
468 |
|
469 # Write out $packages |
|
470 my $device; |
|
471 my $files; |
|
472 my $dependencies; |
|
473 my $paths; |
|
474 my $menu; |
|
475 my $map; |
|
476 my $category; |
|
477 my $description; |
|
478 my $licence; |
|
479 my $tags; |
|
480 my $packagePath; |
|
481 foreach my $pkgName (keys(%$packages)) |
|
482 { |
|
483 ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$pkgName}}; |
|
484 writePkg($packagePath, $pkgName, $files, $device, $dependencies, $paths, $menu, $map, $version, $category, $description, $licence, $tags); |
|
485 } |
|
486 } |
|
487 |
|
488 sub readZiplog($) |
|
489 { |
|
490 my ($zipLog)=@_; |
|
491 my @package; |
|
492 |
|
493 # read in file |
|
494 open (FILE, "<$zipLog") or die "Couldn't open file $zipLog"; |
|
495 |
|
496 # parse for elements we want |
|
497 foreach my $line (<FILE>) |
|
498 { |
|
499 $line =~ s/^\s+// ; |
|
500 |
|
501 if ($line =~ m/^adding: (.*)$/ ) |
|
502 { |
|
503 # found line with file on - need to parse |
|
504 my $fileline = $1; |
|
505 |
|
506 # remove (deflated... or (stored... or ( anything bit at end |
|
507 |
|
508 $fileline=~s/ \(.*\)$//; |
|
509 |
|
510 $fileline =~ s/\s+$// ; |
|
511 |
|
512 # ignore lines ending in slash - probably a directory |
|
513 |
|
514 if ($fileline =~ /\/$/ ) |
|
515 { |
|
516 print "Directory?? - $fileline\n" ; |
|
517 } |
|
518 else |
|
519 { |
|
520 $fileline =~ s,/,\\,g; |
|
521 $fileline =~ s/^[\/\\]//; |
|
522 push (@package, $fileline); |
|
523 } |
|
524 } |
|
525 } |
|
526 |
|
527 close(FILE); |
|
528 |
|
529 return \@package; |
|
530 } |
|
531 |
|
532 sub readFileList($) |
|
533 { |
|
534 my ($file) = @_; |
|
535 |
|
536 my @filelist; |
|
537 |
|
538 # Read file list in |
|
539 open (FILELIST, $file) or die "File '$file' not found\n"; |
|
540 while (my $filename=<FILELIST>) |
|
541 { |
|
542 chomp($filename); |
|
543 $filename =~ s,/,\\,g ; |
|
544 $filename =~ s/^[\/\\]//; # remove initial slash |
|
545 push @filelist, $filename; |
|
546 } |
|
547 |
|
548 close(FILELIST); |
|
549 |
|
550 return \@filelist; |
|
551 } |
|
552 |
|
553 sub writePkg($$$$$$$$$$$$) |
|
554 { |
|
555 my ($pkgPath, $pkgName, $fileList, $device, $dependencies, $paths, $menu, $map, $version, $category, $description, $licence, $tags) = @_; |
|
556 my $from; |
|
557 my $to; |
|
558 |
|
559 if ($map != 0) |
|
560 { |
|
561 ($from, $to) = @$map; |
|
562 } |
|
563 if ($pkgPath ne "") |
|
564 { |
|
565 mkpath($pkgPath); |
|
566 |
|
567 if (-e $pkgPath) |
|
568 { |
|
569 if (!(-d $pkgPath)) |
|
570 { |
|
571 die "Couldn't open output dir $pkgPath (file of the same name already exists)\n"; |
|
572 } |
|
573 } |
|
574 else |
|
575 { |
|
576 die "Couldn't open output dir $pkgPath\n"; |
|
577 } |
|
578 } |
|
579 |
|
580 open (FILE, ">$pkgPath$pkgName.pkgdef") or die "Couldn't open output file $pkgPath$pkgName.pkgdef"; |
|
581 print (FILE "<?xml version=\"1.0\" encoding=\"ISO8859-1\"?>\n"); |
|
582 print (FILE "\n"); |
|
583 |
|
584 print (FILE "<packagedef version=\"1.0\">\n"); |
|
585 print (FILE " <package name=\"$pkgName\" major-version=\"0\" minor-version=\"0\">\n"); |
|
586 print (FILE " <supplier>Symbian Ltd</supplier>\n"); |
|
587 print (FILE " <sdk-version>$version</sdk-version>\n"); |
|
588 print (FILE " <category>$category</category>\n") if ($category ne ""); |
|
589 print (FILE " <description>$description</description>\n\n") if ($description ne ""); |
|
590 |
|
591 print (FILE " <licensing-agreement xml:lang=\"en_US\" document-root=\"".$licence."\" mime-type=\"text\/plain\"/>\n") if ($licence ne ""); |
|
592 print (FILE " <attributes>\n <device name=\"".$device."\"/>\n </attributes>\n") if ($device ne "device"); |
|
593 |
|
594 if (scalar(@$tags) > 0) |
|
595 { |
|
596 print (FILE " <install-path-tags>\n"); |
|
597 (my $tagName, my $tagValue) = @$tags; |
|
598 print (FILE " <tag tag=\"$tagName\">$tagValue</tag>\n"); |
|
599 print (FILE " </install-path-tags>\n"); |
|
600 } |
|
601 if (scalar(@$dependencies) > 0) |
|
602 { |
|
603 print (FILE " <dependencies>\n"); |
|
604 foreach my $dependency (@$dependencies) |
|
605 { |
|
606 print (FILE " <dependency name=\"$dependency\" major-version=\"0\" minor-version=\"0\" build-number=\"0\"/>\n"); |
|
607 } |
|
608 print (FILE " </dependencies>\n"); |
|
609 } |
|
610 if (scalar(@$paths) > 0) |
|
611 { |
|
612 print (FILE " <environment-changes>\n"); |
|
613 foreach my $path (@$paths) |
|
614 { |
|
615 print (FILE " <add-to-variable name=\"Path\" value=\"$path\" how=\"append\" separator=\";\"/>\n"); |
|
616 } |
|
617 print (FILE " </environment-changes>\n"); |
|
618 } |
|
619 if (scalar(@$menu) > 0) |
|
620 { |
|
621 print (FILE " <shortcuts>\n"); |
|
622 foreach my $entry (@$menu) |
|
623 { |
|
624 my ($name, $description, $workingDirectory, $filePath, $arguments, $iconPath) = @$entry; |
|
625 |
|
626 print (FILE " <shortcut shortcut-path=\"Symbian\" file-path=\"".$filePath."\""); |
|
627 print (FILE " description=\"".$description."\"") unless ($description eq ""); |
|
628 print (FILE " arguments=\'".$arguments."\'") unless ($arguments eq ""); |
|
629 print (FILE " working-directory=\"".$workingDirectory."\"") unless ($workingDirectory eq ""); |
|
630 print (FILE ">\n"); |
|
631 print (FILE " <shortcut-name xml:lang=\"en-US\" name=\"".$name."\"/>\n"); |
|
632 print (FILE " <shortcut-icon path=\"".$iconPath."\"/>\n") unless ($iconPath eq ""); |
|
633 print (FILE " </shortcut>\n"); |
|
634 } |
|
635 print (FILE " </shortcuts>\n"); |
|
636 } |
|
637 print (FILE " </package>\n"); |
|
638 print (FILE "\n"); |
|
639 print (FILE " <manifest>\n"); |
|
640 |
|
641 $fileList=[sort(@$fileList)]; |
|
642 $fileList=removeDuplicates($fileList,1); # Remove additional duplicates (may happen with 'patch'ed files) |
|
643 |
|
644 foreach my $line (@$fileList) |
|
645 { |
|
646 print FILE " <item src=\"\\$line\""; |
|
647 $line =~ s/^$from(.*)$/$1/i; |
|
648 print FILE " dest=\"$to$line\"/>\n"; |
|
649 } |
|
650 print FILE " <\/manifest>\n</packagedef>\n"; |
|
651 close(FILE); |
|
652 } |
|
653 |
|
654 sub removeDuplicates($$) |
|
655 { |
|
656 # NB: Case insensitive matching |
|
657 my ($aListRef, $aLeave) = @_; |
|
658 my @list = @$aListRef; |
|
659 |
|
660 if ($aLeave>1) |
|
661 { |
|
662 die "removeDuplicates(\$\$): Cannot leave more than 1 duplicate\n"; |
|
663 } |
|
664 |
|
665 my $prevEntry = undef; |
|
666 my $entry; |
|
667 |
|
668 my $index=0; |
|
669 |
|
670 @list=sort(@list); |
|
671 |
|
672 while ($index < scalar(@list)) |
|
673 { |
|
674 $entry = lc($list[$index]); |
|
675 |
|
676 if ($entry eq $prevEntry) |
|
677 { |
|
678 if ($aLeave == 0) |
|
679 { |
|
680 # Get rid of the prevEntry as well if we need |
|
681 splice(@list, $index-1, 1); |
|
682 $index--; |
|
683 } |
|
684 |
|
685 while ($entry eq $prevEntry) |
|
686 { |
|
687 # If there's a duplicate, remove the duplicate |
|
688 splice(@list, $index, 1); |
|
689 # then get the next entry to check |
|
690 $entry = lc($list[$index]); |
|
691 } |
|
692 } |
|
693 |
|
694 $prevEntry = $entry; |
|
695 |
|
696 $index++; |
|
697 } |
|
698 |
|
699 return \@list; |
|
700 } |
|
701 |
|
702 # Keep only duplicated entries - and then only keep one of them |
|
703 sub keepDuplicates($) |
|
704 { |
|
705 my ($listRef) = @_; |
|
706 |
|
707 my @list = sort(@$listRef); |
|
708 |
|
709 my $index=0; |
|
710 |
|
711 while ($index < scalar(@list)) |
|
712 { |
|
713 if (($index<(scalar(@list)-1)) && (lc($list[$index]) eq lc($list[$index+1]))) |
|
714 { |
|
715 # Remove all other duplicates except the last one |
|
716 while ((lc($list[$index]) eq lc($list[$index+1])) && $index < (scalar(@list)-1)) |
|
717 { |
|
718 splice(@list, $index, 1); |
|
719 } |
|
720 $index++; |
|
721 } |
|
722 else |
|
723 { |
|
724 # Not a duplicate; remove it |
|
725 splice(@list, $index, 1); |
|
726 } |
|
727 } |
|
728 |
|
729 return \@list; |
|
730 } |
|
731 |
|
732 sub match($$$$) |
|
733 { |
|
734 my @package = @{(shift)}; # Files available for matching |
|
735 my @patterns = @{(shift)}; # List of patterns to match |
|
736 my @options = @{(shift)}; # Options ($warn) |
|
737 my $filename = shift; # This is only used for error messages |
|
738 |
|
739 my ($warn) = @options; |
|
740 |
|
741 my @regexp = grep(/^\/.*\/$/, @patterns); |
|
742 my @leftpatterns = grep(!/^\/.*\/$/, @patterns); |
|
743 my @filelist = grep(/^#/, @leftpatterns); |
|
744 @leftpatterns = grep(!/^#/, @leftpatterns); |
|
745 |
|
746 if (scalar(@leftpatterns) > 0) |
|
747 { |
|
748 foreach my $expression (@leftpatterns) |
|
749 { |
|
750 $log->Error("ERROR: Expression '$expression' not understood (must be /regexp/ or #filename)"); |
|
751 } |
|
752 exit($log->getErrorCode()); |
|
753 } |
|
754 |
|
755 if (scalar(@filelist)>0) |
|
756 { |
|
757 # Prepare list of files to match |
|
758 my $file = shift @filelist; |
|
759 $file =~ s/^#//; |
|
760 my @tomatch = @{readFileList($file) }; |
|
761 |
|
762 @tomatch = @{removeDuplicates(\@tomatch, 1)}; # Remove extra duplicates |
|
763 |
|
764 foreach my $file (@filelist) |
|
765 { |
|
766 $file =~ s/^#//; |
|
767 my @list = @{readFileList($file)}; |
|
768 |
|
769 @list = @{removeDuplicates(\@list, 1)}; # Remove extra duplicates |
|
770 |
|
771 @tomatch = @tomatch, @list; |
|
772 @tomatch = @{keepDuplicates(\@tomatch)}; # Keep only matching files |
|
773 } |
|
774 |
|
775 foreach my $regexp (@regexp) |
|
776 { |
|
777 $regexp =~ s/^\/(.*)\/$/\1/; |
|
778 @tomatch = grep(/$regexp/i, @tomatch); # Filter list of files to match |
|
779 } |
|
780 |
|
781 # Match files |
|
782 my @match = (); |
|
783 my @nomatch = (); |
|
784 my $lcentry; |
|
785 |
|
786 foreach my $entry (@tomatch) |
|
787 { |
|
788 $lcentry = lc($entry); |
|
789 my @matches = grep((lc($_) eq $lcentry), @package); |
|
790 |
|
791 if (scalar(@matches) == 0) |
|
792 { |
|
793 push @nomatch, $entry; |
|
794 } |
|
795 elsif (scalar(@matches) == 1) |
|
796 { |
|
797 push @match, $matches[0]; |
|
798 } |
|
799 else |
|
800 { |
|
801 die "Fatal error: Failure to clear duplicates\n"; |
|
802 } |
|
803 } |
|
804 @package = @match; |
|
805 |
|
806 if ($warn) |
|
807 { |
|
808 if (scalar(@nomatch)>0) |
|
809 { |
|
810 my $object; |
|
811 |
|
812 if (scalar(@patterns) == 1) |
|
813 { |
|
814 $object="file"; |
|
815 } |
|
816 else |
|
817 { |
|
818 $object="rule"; |
|
819 } |
|
820 |
|
821 $log->Warn("WARNING: ".scalar(@nomatch)." files not matched from $object '".join(" ",@patterns)."'."); |
|
822 |
|
823 $log->ListMissing(@nomatch); |
|
824 } |
|
825 } |
|
826 |
|
827 if ((scalar(@package) == 0) && (scalar(@tomatch) > 0)) |
|
828 { |
|
829 if ($warn) |
|
830 { |
|
831 $log->Warn("WARNING: 0 files matched against rule '".join(" ",@patterns)."' [$filename:$.]"); |
|
832 } |
|
833 } |
|
834 } |
|
835 else |
|
836 { |
|
837 # Regexps only |
|
838 foreach my $regexp (@regexp) |
|
839 { |
|
840 $regexp =~ s/^\/(.*)\/$/\1/; |
|
841 @package = grep(/$regexp/i, @package ); |
|
842 |
|
843 if (scalar(@package) == 0) |
|
844 { |
|
845 last; |
|
846 } |
|
847 } |
|
848 if (scalar(@package) == 0) |
|
849 { |
|
850 if ($warn) |
|
851 { |
|
852 $log->Warn("WARNING: 0 files matched against rule '".join(" ",@patterns)."' [$filename:$.]"); |
|
853 } |
|
854 } |
|
855 } |
|
856 |
|
857 return \@package; |
|
858 } |
|
859 |
|
860 |
|
861 sub replaceStdVars($) |
|
862 { |
|
863 my $line = $_[0]; |
|
864 $line =~ s/(%[^%]*?%)/$stdVars{$1}/gi; |
|
865 return $line; |
|
866 } |
|
867 |
|
868 |
|
869 |
|
870 1; |