|
1 #!/usr/bin/perl |
|
2 |
|
3 # Copyright (c) 2009 Symbian Foundation Ltd |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of the License "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Symbian Foundation Ltd - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # Map the SFL license to the EULA license, keeping a copy of the original file |
|
16 # in a parallel tree for creation of a "repair" kit to reinstate the SFL |
|
17 |
|
18 use strict; |
|
19 use File::Copy; |
|
20 use File::Path; |
|
21 |
|
22 my $debug = 0; |
|
23 |
|
24 sub map_eula($$$) |
|
25 { |
|
26 my ($file,$shadowdir,$name) = @_; |
|
27 |
|
28 open FILE, "<$file" or print "ERROR: Cannot open $file: $!\n" and return "Cannot open"; |
|
29 my @lines = <FILE>; |
|
30 close FILE; |
|
31 |
|
32 my $updated = 0; |
|
33 my @newlines = (); |
|
34 while (my $line = shift @lines) |
|
35 { |
|
36 # under the terms of the License "Symbian Foundation License v1.0" |
|
37 # which accompanies this distribution, and is available |
|
38 # at the URL "http://www.symbianfoundation.org/legal/sfl-v10.html". |
|
39 if ($line =~ /terms of the License "Symbian Foundation License v1.0"/) |
|
40 { |
|
41 my $midline = shift @lines; |
|
42 my $nextline = shift @lines; |
|
43 if ($nextline =~ /the URL "http:\/\/www.symbianfoundation.org\/legal\/sfl-v10.html"/) |
|
44 { |
|
45 # Found it - assume that there's only one instance |
|
46 $line =~ s/Symbian Foundation License v1.0/Symbian End User License v1.0/; |
|
47 $nextline =~ s/legal\/sfl-v10.html/legal\/eula-v10.html/; |
|
48 push @newlines, $line, $midline, $nextline, @lines; |
|
49 $updated = 1; |
|
50 last; |
|
51 } |
|
52 else |
|
53 { |
|
54 print STDERR "Problem in $file: incorrectly formatted >\n$line$nextline\n"; |
|
55 last; |
|
56 } |
|
57 } |
|
58 push @newlines, $line; |
|
59 } |
|
60 |
|
61 return if (!$updated); |
|
62 |
|
63 mkpath($shadowdir, {verbose=>0}); |
|
64 move($file, "$shadowdir/$name") or die("Cannot move $file to $shadowdir/$name: $!\n"); |
|
65 open NEWFILE, ">$file" or die("Cannot overwrite $file: $!\n"); |
|
66 print NEWFILE @newlines; |
|
67 close NEWFILE or die("Failed to update $file: $!\n"); |
|
68 print "* updated $file\n"; |
|
69 } |
|
70 |
|
71 # Process tree |
|
72 |
|
73 sub scan_directory($$) |
|
74 { |
|
75 my ($path, $shadow) = @_; |
|
76 |
|
77 opendir DIR, $path; |
|
78 my @files = grep !/^\.\.?$/, readdir DIR; |
|
79 closedir DIR; |
|
80 |
|
81 foreach my $file (@files) |
|
82 { |
|
83 my $newpath = "$path/$file"; |
|
84 my $newshadow = "$shadow/$file"; |
|
85 |
|
86 if (-d $newpath) |
|
87 { |
|
88 scan_directory($newpath, $newshadow); |
|
89 next; |
|
90 } |
|
91 next if (-B $newpath); # ignore binary files |
|
92 |
|
93 map_eula($newpath, $shadow, $file); |
|
94 } |
|
95 } |
|
96 |
|
97 scan_directory("/epoc32", "/sfl_epoc32"); |