|
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 EPL license, keeping a copy of the original file |
|
16 # in a parallel tree |
|
17 |
|
18 use strict; |
|
19 use File::Copy; |
|
20 use File::Path; |
|
21 |
|
22 if (scalar @ARGV != 2) |
|
23 { |
|
24 print <<'EOF'; |
|
25 Incorrect number of arguments |
|
26 |
|
27 Usage: perl convert_to_epl.pl workdir savedir |
|
28 |
|
29 Recursively processes workdir to examine all of the text files and convert |
|
30 all perfectly formed instances of the SFL copyright notice into EPL notices. |
|
31 |
|
32 If a file is modified, the original is first copied to the corresponding place |
|
33 under savedir. |
|
34 |
|
35 It is safe to rerun this script if it stopped for any reason, as no converted |
|
36 SFL notice will ever match on the second run through. |
|
37 EOF |
|
38 exit 1; |
|
39 } |
|
40 |
|
41 my $work_root = $ARGV[0]; |
|
42 my $saved_root = $ARGV[1]; |
|
43 |
|
44 $work_root =~ s/\\/\//g; # convert to Unix separators please |
|
45 $saved_root =~ s/\\/\//g; |
|
46 |
|
47 print "* Processing $work_root, leaving the original of any modified file in $saved_root\n"; |
|
48 |
|
49 my $debug = 0; |
|
50 |
|
51 my @oldtext = ( |
|
52 'terms of the License "Symbian Foundation License v1.0"', |
|
53 'the URL "http://www.symbianfoundation.org/legal/sfl-v10.html"' |
|
54 ); |
|
55 my @newtext = ( |
|
56 'terms of the License "Eclipse Public License v1.0"', |
|
57 'the URL "http://www.eclipse.org/legal/epl-v10.html"' |
|
58 ); |
|
59 |
|
60 my @errorfiles = (); |
|
61 my @multinoticefiles = (); |
|
62 |
|
63 sub map_epl($$$) |
|
64 { |
|
65 my ($file,$shadowdir,$name) = @_; |
|
66 |
|
67 open FILE, "<$file" or print "ERROR: Cannot open $file: $!\n" and return "Cannot open"; |
|
68 my @lines = <FILE>; |
|
69 close FILE; |
|
70 |
|
71 my $updated = 0; |
|
72 my @newlines = (); |
|
73 while (my $line = shift @lines) |
|
74 { |
|
75 # under the terms of the License "Symbian Foundation License v1.0" |
|
76 # which accompanies this distribution, and is available |
|
77 # at the URL "http://www.symbianfoundation.org/legal/sfl-v10.html". |
|
78 my $pos1 = index $line, $oldtext[0]; |
|
79 if ($pos1 >= 0) |
|
80 { |
|
81 # be careful - oldtext is a prefix of newtext! |
|
82 if (index($line, $newtext[0]) >= 0) |
|
83 { |
|
84 # line already converted - nothing to do |
|
85 push @newlines, $line; |
|
86 next; |
|
87 } |
|
88 my $midline = shift @lines; |
|
89 my $urlline = shift @lines; |
|
90 my $pos2 = index $urlline, $oldtext[1]; |
|
91 if ($pos2 >= 0) |
|
92 { |
|
93 # Found it - assume that there's only one instance |
|
94 substr $line, $pos1, length($oldtext[0]), $newtext[0]; |
|
95 substr $urlline, $pos2, length($oldtext[1]), $newtext[1]; |
|
96 push @newlines, $line, $midline, $urlline; |
|
97 $updated += 1; |
|
98 next; |
|
99 } |
|
100 else |
|
101 { |
|
102 if(!$updated) |
|
103 { |
|
104 my $lineno = 1 + (scalar @newlines); |
|
105 print STDERR "Problem in $file at $lineno: incorrectly formatted >\n$line$midline$urlline\n"; |
|
106 push @errorfiles, $file; |
|
107 } |
|
108 last; |
|
109 } |
|
110 } |
|
111 push @newlines, $line; |
|
112 } |
|
113 |
|
114 return if (!$updated); |
|
115 |
|
116 if ($updated > 1) |
|
117 { |
|
118 push @multinoticefiles, $file; |
|
119 print "! found $updated SFL notices in $file\n"; |
|
120 } |
|
121 |
|
122 mkpath($shadowdir, {verbose=>0}); |
|
123 move($file, "$shadowdir/$name") or die("Cannot move $file to $shadowdir/$name: $!\n"); |
|
124 open NEWFILE, ">$file" or die("Cannot overwrite $file: $!\n"); |
|
125 print NEWFILE @newlines, @lines; |
|
126 close NEWFILE or die("Failed to update $file: $!\n"); |
|
127 print "* updated $file\n"; |
|
128 } |
|
129 |
|
130 # Process tree |
|
131 |
|
132 sub scan_directory($$) |
|
133 { |
|
134 my ($path, $shadow) = @_; |
|
135 |
|
136 opendir DIR, $path; |
|
137 my @files = grep !/^\.\.?$/, readdir DIR; |
|
138 closedir DIR; |
|
139 |
|
140 foreach my $file (@files) |
|
141 { |
|
142 my $newpath = "$path/$file"; |
|
143 my $newshadow = "$shadow/$file"; |
|
144 |
|
145 if (-d $newpath) |
|
146 { |
|
147 scan_directory($newpath, $newshadow); |
|
148 next; |
|
149 } |
|
150 next if (-B $newpath); # ignore binary files |
|
151 |
|
152 map_epl($newpath, $shadow, $file); |
|
153 } |
|
154 } |
|
155 |
|
156 scan_directory($work_root, $saved_root); |
|
157 |
|
158 printf "%d problem files\n", scalar @errorfiles; |
|
159 print "\t", join("\n\t", @errorfiles), "\n"; |
|
160 |
|
161 printf "%d files with multiple notices\n", scalar @multinoticefiles; |
|
162 print "\t", join("\n\t", @multinoticefiles), "\n"; |
|
163 |