OLD | NEW |
| (Empty) |
1 # | |
2 # KDOM IDL parser | |
3 # | |
4 # Copyright (C) 2005 Nikolas Zimmermann <wildfox@kde.org> | |
5 # Copyright (C) 2006 Samuel Weinig <sam.weinig@gmail.com> | |
6 # | |
7 # This file is part of the KDE project | |
8 # | |
9 # This library is free software; you can redistribute it and/or | |
10 # modify it under the terms of the GNU Library General Public | |
11 # License as published by the Free Software Foundation; either | |
12 # version 2 of the License, or (at your option) any later version. | |
13 # | |
14 # This library is distributed in the hope that it will be useful, | |
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
17 # Library General Public License for more details. | |
18 # | |
19 # You should have received a copy of the GNU Library General Public License | |
20 # aint with this library; see the file COPYING.LIB. If not, write to | |
21 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 # Boston, MA 02111-1307, USA. | |
23 # | |
24 | |
25 package CodeGenerator; | |
26 | |
27 my $useDocument = ""; | |
28 my $useGenerator = ""; | |
29 my $useOutputDir = ""; | |
30 my $useDirectories = ""; | |
31 my $useLayerOnTop = 0; | |
32 my $preprocessor; | |
33 | |
34 my $codeGenerator = 0; | |
35 | |
36 my $verbose = 0; | |
37 | |
38 my %primitiveTypeHash = ("int" => 1, "short" => 1, "long" => 1, "long long" => 1
, | |
39 "unsigned int" => 1, "unsigned short" => 1, | |
40 "unsigned long" => 1, "float" => 1, | |
41 "unsigned long long" => 1, | |
42 "double" => 1, "boolean" => 1, "void" => 1); | |
43 | |
44 my %podTypeHash = ("SVGNumber" => 1, "SVGTransform" => 1); | |
45 my %podTypeWithWriteablePropertiesHash = ("SVGLength" => 1, "SVGMatrix" => 1, "S
VGPoint" => 1, "SVGRect" => 1); | |
46 my %stringTypeHash = ("DOMString" => 1, "AtomicString" => 1); | |
47 | |
48 my %nonPointerTypeHash = ("DOMTimeStamp" => 1, "CompareHow" => 1, "SVGPaintType"
=> 1); | |
49 | |
50 my %svgAnimatedTypeHash = ("SVGAnimatedAngle" => 1, "SVGAnimatedBoolean" => 1, | |
51 "SVGAnimatedEnumeration" => 1, "SVGAnimatedInteger" =
> 1, | |
52 "SVGAnimatedLength" => 1, "SVGAnimatedLengthList" =>
1, | |
53 "SVGAnimatedNumber" => 1, "SVGAnimatedNumberList" =>
1, | |
54 "SVGAnimatedPreserveAspectRatio" => 1, | |
55 "SVGAnimatedRect" => 1, "SVGAnimatedString" => 1, | |
56 "SVGAnimatedTransformList" => 1); | |
57 | |
58 # Helpers for 'ScanDirectory' | |
59 my $endCondition = 0; | |
60 my $foundFilename = ""; | |
61 my @foundFilenames = (); | |
62 my $ignoreParent = 1; | |
63 my $defines = ""; | |
64 | |
65 # Default constructor | |
66 sub new | |
67 { | |
68 my $object = shift; | |
69 my $reference = { }; | |
70 | |
71 $useDirectories = shift; | |
72 $useGenerator = shift; | |
73 $useOutputDir = shift; | |
74 $useLayerOnTop = shift; | |
75 $preprocessor = shift; | |
76 | |
77 bless($reference, $object); | |
78 return $reference; | |
79 } | |
80 | |
81 sub StripModule($) | |
82 { | |
83 my $object = shift; | |
84 my $name = shift; | |
85 $name =~ s/[a-zA-Z0-9]*:://; | |
86 return $name; | |
87 } | |
88 | |
89 sub ProcessDocument | |
90 { | |
91 my $object = shift; | |
92 $useDocument = shift; | |
93 $defines = shift; | |
94 | |
95 my $ifaceName = "CodeGenerator" . $useGenerator; | |
96 | |
97 # Dynamically load external code generation perl module | |
98 require $ifaceName . ".pm"; | |
99 $codeGenerator = $ifaceName->new($object, $useOutputDir, $useLayerOnTop, $pr
eprocessor); | |
100 unless (defined($codeGenerator)) { | |
101 my $classes = $useDocument->classes; | |
102 foreach my $class (@$classes) { | |
103 print "Skipping $useGenerator code generation for IDL interface \""
. $class->name . "\".\n" if $verbose; | |
104 } | |
105 return; | |
106 } | |
107 | |
108 # Start the actual code generation! | |
109 $codeGenerator->GenerateModule($useDocument, $defines); | |
110 | |
111 my $classes = $useDocument->classes; | |
112 foreach my $class (@$classes) { | |
113 print "Generating $useGenerator bindings code for IDL interface \"" . $c
lass->name . "\"...\n" if $verbose; | |
114 $codeGenerator->GenerateInterface($class, $defines); | |
115 $codeGenerator->finish(); | |
116 } | |
117 } | |
118 | |
119 | |
120 sub FindParentsRecursively | |
121 { | |
122 my $object = shift; | |
123 my $dataNode = shift; | |
124 my @parents = ($dataNode->name); | |
125 foreach (@{$dataNode->parents}) { | |
126 my $interface = $object->StripModule($_); | |
127 | |
128 $endCondition = 0; | |
129 $foundFilename = ""; | |
130 foreach (@{$useDirectories}) { | |
131 $object->ScanDirectory("$interface.idl", $_, $_, 0) if ($foundFilename eq
""); | |
132 } | |
133 | |
134 if ($foundFilename ne "") { | |
135 print " | |> Parsing parent IDL \"$foundFilename\" for interface \"$int
erface\"\n" if $verbose; | |
136 | |
137 # Step #2: Parse the found IDL file (in quiet mode). | |
138 my $parser = IDLParser->new(1); | |
139 my $document = $parser->ParseInheritance($foundFilename, $defines, $prepro
cessor); | |
140 | |
141 foreach my $class (@{$document->classes}) { | |
142 @parents = (@parents, FindParentsRecursively($object, $class)); | |
143 } | |
144 } else { | |
145 die("Could NOT find specified parent interface \"$interface\"!\n") | |
146 } | |
147 } | |
148 return @parents; | |
149 } | |
150 | |
151 | |
152 sub AddMethodsConstantsAndAttributesFromParentClasses | |
153 { | |
154 # For the passed interface, recursively parse all parent | |
155 # IDLs in order to find out all inherited properties/methods. | |
156 | |
157 my $object = shift; | |
158 my $dataNode = shift; | |
159 | |
160 my @parents = @{$dataNode->parents}; | |
161 my $parentsMax = @{$dataNode->parents}; | |
162 | |
163 my $constantsRef = $dataNode->constants; | |
164 my $functionsRef = $dataNode->functions; | |
165 my $attributesRef = $dataNode->attributes; | |
166 | |
167 # Exception: For the DOM 'Node' is our topmost baseclass, not EventTargetNod
e. | |
168 foreach (@{$dataNode->parents}) { | |
169 my $interface = $object->StripModule($_); | |
170 | |
171 # Don't ignore the first class EventTarget | |
172 if ($interface ne "EventTarget" && $ignoreParent) { | |
173 # Ignore first parent class, already handled by the generation itsel
f. | |
174 $ignoreParent = 0; | |
175 next; | |
176 } | |
177 | |
178 # Step #1: Find the IDL file associated with 'interface' | |
179 $endCondition = 0; | |
180 $foundFilename = ""; | |
181 | |
182 foreach (@{$useDirectories}) { | |
183 $object->ScanDirectory("$interface.idl", $_, $_, 0) if ($foundFilena
me eq ""); | |
184 } | |
185 | |
186 if ($foundFilename ne "") { | |
187 print " | |> Parsing parent IDL \"$foundFilename\" for interface
\"$interface\"\n" if $verbose; | |
188 | |
189 # Step #2: Parse the found IDL file (in quiet mode). | |
190 my $parser = IDLParser->new(1); | |
191 my $document = $parser->Parse($foundFilename, $defines, $preprocesso
r); | |
192 | |
193 foreach my $class (@{$document->classes}) { | |
194 # Step #3: Enter recursive parent search | |
195 AddMethodsConstantsAndAttributesFromParentClasses($object, $clas
s); | |
196 | |
197 # Step #4: Collect constants & functions & attributes of this pa
rent-class | |
198 my $constantsMax = @{$class->constants}; | |
199 my $functionsMax = @{$class->functions}; | |
200 my $attributesMax = @{$class->attributes}; | |
201 | |
202 print " | |> -> Inheriting $constantsMax constants, $function
sMax functions, $attributesMax attributes...\n | |>\n" if $verbose; | |
203 | |
204 # Step #5: Concatenate data | |
205 push(@$constantsRef, $_) foreach (@{$class->constants}); | |
206 push(@$functionsRef, $_) foreach (@{$class->functions}); | |
207 push(@$attributesRef, $_) foreach (@{$class->attributes}); | |
208 } | |
209 } else { | |
210 die("Could NOT find specified parent interface \"$interface\"!\n"); | |
211 } | |
212 } | |
213 } | |
214 | |
215 # Append an attribute to an array if its name does not exist in the array. | |
216 sub AppendAttribute | |
217 { | |
218 my $attributes = shift; | |
219 my $newAttr = shift; | |
220 foreach (@$attributes) { | |
221 if ($_->signature->name eq $newAttr->signature->name) { | |
222 print " | |> -> $newAttr->signature->name is overridden.\n | |>
\n" if $verbose; | |
223 return; | |
224 } | |
225 } | |
226 push(@$attributes, $newAttr); | |
227 } | |
228 | |
229 # Helpers for all CodeGenerator***.pm modules | |
230 sub IsPodType | |
231 { | |
232 my $object = shift; | |
233 my $type = shift; | |
234 | |
235 return 1 if $podTypeHash{$type}; | |
236 return 1 if $podTypeWithWriteablePropertiesHash{$type}; | |
237 return 0; | |
238 } | |
239 | |
240 sub IsPodTypeWithWriteableProperties | |
241 { | |
242 my $object = shift; | |
243 my $type = shift; | |
244 | |
245 return 1 if $podTypeWithWriteablePropertiesHash{$type}; | |
246 return 0; | |
247 } | |
248 | |
249 sub IsPrimitiveType | |
250 { | |
251 my $object = shift; | |
252 my $type = shift; | |
253 | |
254 return 1 if $primitiveTypeHash{$type}; | |
255 return 0; | |
256 } | |
257 | |
258 sub IsStringType | |
259 { | |
260 my $object = shift; | |
261 my $type = shift; | |
262 | |
263 return 1 if $stringTypeHash{$type}; | |
264 return 0; | |
265 } | |
266 | |
267 sub IsNonPointerType | |
268 { | |
269 my $object = shift; | |
270 my $type = shift; | |
271 | |
272 return 1 if $nonPointerTypeHash{$type} or $primitiveTypeHash{$type}; | |
273 return 0; | |
274 } | |
275 | |
276 sub IsSVGAnimatedType | |
277 { | |
278 my $object = shift; | |
279 my $type = shift; | |
280 | |
281 return 1 if $svgAnimatedTypeHash{$type}; | |
282 return 0; | |
283 } | |
284 | |
285 # Internal Helper | |
286 sub ScanDirectory | |
287 { | |
288 my $object = shift; | |
289 | |
290 my $interface = shift; | |
291 my $directory = shift; | |
292 my $useDirectory = shift; | |
293 my $reportAllFiles = shift; | |
294 | |
295 print "Scanning interface " . $interface . " in " . $directory . "\n" if $ve
rbose; | |
296 | |
297 return if ($endCondition eq 1) and ($reportAllFiles eq 0); | |
298 | |
299 my $sourceRoot = $ENV{SOURCE_ROOT}; | |
300 my $thisDir = $sourceRoot ? "$sourceRoot/$directory" : $directory; | |
301 | |
302 opendir(DIR, $thisDir) or die "[ERROR] Can't open directory $thisDir: \"$!\"
\n"; | |
303 | |
304 my @names = readdir(DIR) or die "[ERROR] Cant't read directory $thisDir \"$!
\"\n"; | |
305 closedir(DIR); | |
306 | |
307 foreach my $name (@names) { | |
308 # Skip if we already found the right file or | |
309 # if we encounter 'exotic' stuff (ie. '.', '..', '.svn') | |
310 next if ($endCondition eq 1) or ($name =~ /^\./); | |
311 | |
312 # Recurisvely enter directory | |
313 if (-d "$thisDir/$name") { | |
314 $object->ScanDirectory($interface, "$directory/$name", $useDirectory
, $reportAllFiles); | |
315 next; | |
316 } | |
317 | |
318 # Check wheter we found the desired file | |
319 my $condition = ($name eq $interface); | |
320 $condition = 1 if ($interface eq "allidls") and ($name =~ /\.idl$/); | |
321 | |
322 if ($condition) { | |
323 $foundFilename = "$thisDir/$name"; | |
324 | |
325 if ($reportAllFiles eq 0) { | |
326 $endCondition = 1; | |
327 } else { | |
328 push(@foundFilenames, $foundFilename); | |
329 } | |
330 } | |
331 } | |
332 } | |
333 | |
334 1; | |
OLD | NEW |