OLD | NEW |
| (Empty) |
1 # | |
2 # KDOM IDL parser | |
3 # | |
4 # Copyright (C) 2005 Nikolas Zimmermann <wildfox@kde.org> | |
5 # | |
6 # This file is part of the KDE project | |
7 # | |
8 # This library is free software; you can redistribute it and/or | |
9 # modify it under the terms of the GNU Library General Public | |
10 # License as published by the Free Software Foundation; either | |
11 # version 2 of the License, or (at your option) any later version. | |
12 # | |
13 # This library is distributed in the hope that it will be useful, | |
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 # Library General Public License for more details. | |
17 # | |
18 # You should have received a copy of the GNU Library General Public License | |
19 # aint with this library; see the file COPYING.LIB. If not, write to | |
20 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 # Boston, MA 02111-1307, USA. | |
22 # | |
23 | |
24 package IDLParser; | |
25 | |
26 use IDLStructure; | |
27 | |
28 use constant MODE_UNDEF => 0; # Default mode. | |
29 | |
30 use constant MODE_MODULE => 10; # 'module' section | |
31 use constant MODE_INTERFACE => 11; # 'interface' section | |
32 use constant MODE_EXCEPTION => 12; # 'exception' section | |
33 use constant MODE_ALIAS => 13; # 'alias' section | |
34 | |
35 # Helper variables | |
36 my @temporaryContent = ""; | |
37 | |
38 my $parseMode = MODE_UNDEF; | |
39 my $preservedParseMode = MODE_UNDEF; | |
40 | |
41 my $beQuiet; # Should not display anything on STDOUT? | |
42 my $document = 0; # Will hold the resulting 'idlDocument' | |
43 | |
44 my $directive = ""; | |
45 | |
46 # Default Constructor | |
47 sub new | |
48 { | |
49 my $object = shift; | |
50 my $reference = { }; | |
51 | |
52 $document = 0; | |
53 $beQuiet = shift; | |
54 | |
55 bless($reference, $object); | |
56 return $reference; | |
57 } | |
58 | |
59 | |
60 sub ParseInheritance | |
61 { | |
62 my $object = shift; | |
63 my $fileName = shift; | |
64 my $defines = shift; | |
65 my $preprocessor = shift; | |
66 | |
67 $directive = "inheritance"; | |
68 return $object->ParseImpl($fileName, $defines, $preprocessor); | |
69 } | |
70 | |
71 # Returns the parsed 'idlDocument' | |
72 sub Parse | |
73 { | |
74 my $object = shift; | |
75 my $fileName = shift; | |
76 my $defines = shift; | |
77 my $preprocessor = shift; | |
78 | |
79 $directive = ""; | |
80 return $object->ParseImpl($fileName, $defines, $preprocessor); | |
81 } | |
82 | |
83 sub ParseImpl | |
84 { | |
85 my $object = shift; | |
86 my $fileName = shift; | |
87 my $defines = shift; | |
88 my $preprocessor = shift; | |
89 | |
90 if (!$preprocessor) { | |
91 $preprocessor = "/usr/bin/gcc -E -P -x c++"; | |
92 } | |
93 | |
94 if (!$defines) { | |
95 $defines = ""; | |
96 } | |
97 | |
98 print " | *** Starting to parse $fileName...\n |\n" unless $beQuiet; | |
99 | |
100 open FILE, $preprocessor . " " . join(" ", (map { "-D$_" } split(/ /, $defin
es))) . " ". $fileName . "|" or die "Could not open $fileName"; | |
101 my @documentContent = <FILE>; | |
102 close FILE; | |
103 | |
104 my $dataAvailable = 0; | |
105 | |
106 # Simple IDL Parser (tm) | |
107 foreach (@documentContent) { | |
108 my $newParseMode = $object->DetermineParseMode($_); | |
109 | |
110 if ($newParseMode ne MODE_UNDEF) { | |
111 if ($dataAvailable eq 0) { | |
112 $dataAvailable = 1; # Start node building... | |
113 } else { | |
114 $object->ProcessSection(); | |
115 } | |
116 } | |
117 | |
118 # Update detected data stream mode... | |
119 if ($newParseMode ne MODE_UNDEF) { | |
120 $parseMode = $newParseMode; | |
121 } | |
122 | |
123 push(@temporaryContent, $_); | |
124 } | |
125 | |
126 # Check if there is anything remaining to parse... | |
127 if (($parseMode ne MODE_UNDEF) and ($#temporaryContent > 0)) { | |
128 $object->ProcessSection(); | |
129 } | |
130 | |
131 print " | *** Finished parsing!\n" unless $beQuiet; | |
132 | |
133 $document->fileName($fileName); | |
134 | |
135 return $document; | |
136 } | |
137 | |
138 sub ParseModule | |
139 { | |
140 my $object = shift; | |
141 my $dataNode = shift; | |
142 | |
143 print " |- Trying to parse module...\n" unless $beQuiet; | |
144 | |
145 my $data = join("", @temporaryContent); | |
146 $data =~ /$IDLStructure::moduleSelector/; | |
147 | |
148 my $moduleName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"
)); | |
149 $dataNode->module($moduleName); | |
150 | |
151 print " |----> Module; NAME \"$moduleName\"\n |-\n |\n" unless $beQuiet; | |
152 } | |
153 | |
154 sub dumpExtendedAttributes | |
155 { | |
156 my $padStr = shift; | |
157 my $attrs = shift; | |
158 | |
159 if (!%{$attrs}) { | |
160 return ""; | |
161 } | |
162 | |
163 my @temp; | |
164 while (($name, $value) = each(%{$attrs})) { | |
165 push(@temp, "$name=$value"); | |
166 } | |
167 | |
168 return $padStr . "[" . join(", ", @temp) . "]"; | |
169 } | |
170 | |
171 sub parseExtendedAttributes | |
172 { | |
173 my $str = shift; | |
174 $str =~ s/\[\s*(.*)\]/$1/g; | |
175 | |
176 my %attrs = (); | |
177 | |
178 foreach my $value (split(/\s*,\s*/, $str)) { | |
179 ($name,$value) = split(/\s*=\s*/, $value, 2); | |
180 | |
181 # Attributes with no value are set to be true | |
182 $value = 1 unless defined $value; | |
183 $attrs{$name} = $value; | |
184 } | |
185 | |
186 return \%attrs; | |
187 } | |
188 | |
189 sub ParseInterface | |
190 { | |
191 my $object = shift; | |
192 my $dataNode = shift; | |
193 my $sectionName = shift; | |
194 | |
195 my $data = join("", @temporaryContent); | |
196 | |
197 # Look for end-of-interface mark | |
198 $data =~ /};/g; | |
199 $data = substr($data, index($data, $sectionName), pos($data) - length($data)
); | |
200 | |
201 $data =~ s/[\n\r]/ /g; | |
202 | |
203 # Beginning of the regexp parsing magic | |
204 if ($sectionName eq "exception") { | |
205 print " |- Trying to parse exception...\n" unless $beQuiet; | |
206 | |
207 my $exceptionName = ""; | |
208 my $exceptionData = ""; | |
209 my $exceptionDataName = ""; | |
210 my $exceptionDataType = ""; | |
211 | |
212 # Match identifier of the exception, and enclosed data... | |
213 $data =~ /$IDLStructure::exceptionSelector/; | |
214 $exceptionName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data
\n)")); | |
215 $exceptionData = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data
\n)")); | |
216 | |
217 ('' =~ /^/); # Reset variables needed for regexp matching | |
218 | |
219 # ... parse enclosed data (get. name & type) | |
220 $exceptionData =~ /$IDLStructure::exceptionSubSelector/; | |
221 $exceptionDataType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$
data\n)")); | |
222 $exceptionDataName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$
data\n)")); | |
223 | |
224 # Fill in domClass datastructure | |
225 $dataNode->name($exceptionName); | |
226 | |
227 my $newDataNode = new domAttribute(); | |
228 $newDataNode->type("readonly attribute"); | |
229 $newDataNode->signature(new domSignature()); | |
230 | |
231 $newDataNode->signature->name($exceptionDataName); | |
232 $newDataNode->signature->type($exceptionDataType); | |
233 | |
234 my $arrayRef = $dataNode->attributes; | |
235 push(@$arrayRef, $newDataNode); | |
236 | |
237 print " |----> Exception; NAME \"$exceptionName\" DATA TYPE \"$exceptio
nDataType\" DATA NAME \"$exceptionDataName\"\n |-\n |\n" unless $beQuiet; | |
238 } elsif ($sectionName eq "interface") { | |
239 print " |- Trying to parse interface...\n" unless $beQuiet; | |
240 | |
241 my $interfaceName = ""; | |
242 my $interfaceData = ""; | |
243 | |
244 # Match identifier of the interface, and enclosed data... | |
245 $data =~ /$IDLStructure::interfaceSelector/; | |
246 | |
247 $interfaceExtendedAttributes = (defined($1) ? $1 : " "); chop($interface
ExtendedAttributes); | |
248 $interfaceName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data
\n)")); | |
249 $interfaceBase = (defined($3) ? $3 : ""); | |
250 $interfaceData = (defined($4) ? $4 : die("Parsing error!\nSource:\n$data
\n)")); | |
251 | |
252 # Fill in known parts of the domClass datastructure now... | |
253 $dataNode->name($interfaceName); | |
254 $dataNode->extendedAttributes(parseExtendedAttributes($interfaceExtended
Attributes)); | |
255 | |
256 # Inheritance detection | |
257 my @interfaceParents = split(/,/, $interfaceBase); | |
258 foreach(@interfaceParents) { | |
259 my $line = $_; | |
260 $line =~ s/\s*//g; | |
261 | |
262 my $arrayRef = $dataNode->parents; | |
263 push(@$arrayRef, $line); | |
264 } | |
265 | |
266 return if ($directive eq "inheritance"); | |
267 | |
268 $interfaceData =~ s/[\n\r]/ /g; | |
269 my @interfaceMethods = split(/;/, $interfaceData); | |
270 | |
271 foreach my $line (@interfaceMethods) { | |
272 if ($line =~ /[ \t]attribute[ \t]/) { | |
273 $line =~ /$IDLStructure::interfaceAttributeSelector/; | |
274 | |
275 my $attributeType = (defined($1) ? $1 : die("Parsing error!\nSou
rce:\n$line\n)")); | |
276 my $attributeExtendedAttributes = (defined($2) ? $2 : " "); chop
($attributeExtendedAttributes); | |
277 | |
278 my $attributeDataType = (defined($3) ? $3 : die("Parsing error!\
nSource:\n$line\n)")); | |
279 my $attributeDataName = (defined($4) ? $4 : die("Parsing error!\
nSource:\n$line\n)")); | |
280 | |
281 ('' =~ /^/); # Reset variables needed for regexp matching | |
282 | |
283 $line =~ /$IDLStructure::getterRaisesSelector/; | |
284 my $getterException = (defined($1) ? $1 : ""); | |
285 | |
286 $line =~ /$IDLStructure::setterRaisesSelector/; | |
287 my $setterException = (defined($1) ? $1 : ""); | |
288 | |
289 my $newDataNode = new domAttribute(); | |
290 $newDataNode->type($attributeType); | |
291 $newDataNode->signature(new domSignature()); | |
292 | |
293 $newDataNode->signature->name($attributeDataName); | |
294 $newDataNode->signature->type($attributeDataType); | |
295 $newDataNode->signature->extendedAttributes(parseExtendedAttribu
tes($attributeExtendedAttributes)); | |
296 | |
297 my $arrayRef = $dataNode->attributes; | |
298 push(@$arrayRef, $newDataNode); | |
299 | |
300 print " | |> Attribute; TYPE \"$attributeType\" DATA NAME \"$
attributeDataName\" DATA TYPE \"$attributeDataType\" GET EXCEPTION? \"$getterExc
eption\" SET EXCEPTION? \"$setterException\"" . | |
301 dumpExtendedAttributes("\n | ", $newDataNod
e->signature->extendedAttributes) . "\n" unless $beQuiet; | |
302 | |
303 $getterException =~ s/\s+//g; | |
304 $setterException =~ s/\s+//g; | |
305 @{$newDataNode->getterExceptions} = split(/,/, $getterException)
; | |
306 @{$newDataNode->setterExceptions} = split(/,/, $setterException)
; | |
307 } elsif (($line !~ s/^\s*$//g) and ($line !~ /^\s*const/)) { | |
308 $line =~ /$IDLStructure::interfaceMethodSelector/ or die "Parsin
g error!\nSource:\n$line\n)"; | |
309 | |
310 my $methodExtendedAttributes = (defined($1) ? $1 : " "); chop($m
ethodExtendedAttributes); | |
311 my $methodType = (defined($2) ? $2 : die("Parsing error!\nSource
:\n$line\n)")); | |
312 my $methodName = (defined($3) ? $3 : die("Parsing error!\nSource
:\n$line\n)")); | |
313 my $methodSignature = (defined($4) ? $4 : die("Parsing error!\nS
ource:\n$line\n)")); | |
314 | |
315 ('' =~ /^/); # Reset variables needed for regexp matching | |
316 | |
317 $line =~ /$IDLStructure::raisesSelector/; | |
318 my $methodException = (defined($1) ? $1 : ""); | |
319 | |
320 my $newDataNode = new domFunction(); | |
321 | |
322 $newDataNode->signature(new domSignature()); | |
323 $newDataNode->signature->name($methodName); | |
324 $newDataNode->signature->type($methodType); | |
325 $newDataNode->signature->extendedAttributes(parseExtendedAttribu
tes($methodExtendedAttributes)); | |
326 | |
327 print " | |- Method; TYPE \"$methodType\" NAME \"$methodName\
" EXCEPTION? \"$methodException\"" . | |
328 dumpExtendedAttributes("\n | ", $newDataNode->
signature->extendedAttributes) . "\n" unless $beQuiet; | |
329 | |
330 $methodException =~ s/\s+//g; | |
331 @{$newDataNode->raisesExceptions} = split(/,/, $methodException)
; | |
332 | |
333 my @params = split(/,/, $methodSignature); | |
334 foreach(@params) { | |
335 my $line = $_; | |
336 | |
337 $line =~ /$IDLStructure::interfaceParameterSelector/; | |
338 my $paramExtendedAttributes = (defined($1) ? $1 : " "); chop
($paramExtendedAttributes); | |
339 my $paramType = (defined($2) ? $2 : die("Parsing error!\nSou
rce:\n$line\n)")); | |
340 my $paramName = (defined($3) ? $3 : die("Parsing error!\nSou
rce:\n$line\n)")); | |
341 | |
342 my $paramDataNode = new domSignature(); | |
343 $paramDataNode->name($paramName); | |
344 $paramDataNode->type($paramType); | |
345 $paramDataNode->extendedAttributes(parseExtendedAttributes($
paramExtendedAttributes)); | |
346 | |
347 my $arrayRef = $newDataNode->parameters; | |
348 push(@$arrayRef, $paramDataNode); | |
349 | |
350 print " | |> Param; TYPE \"$paramType\" NAME \"$paramNam
e\"" . | |
351 dumpExtendedAttributes("\n | ", $paramData
Node->extendedAttributes) . "\n" unless $beQuiet; | |
352 } | |
353 | |
354 my $arrayRef = $dataNode->functions; | |
355 push(@$arrayRef, $newDataNode); | |
356 } elsif ($line =~ /^\s*const/) { | |
357 $line =~ /$IDLStructure::constantSelector/; | |
358 my $constType = (defined($1) ? $1 : die("Parsing error!\nSource:
\n$line\n)")); | |
359 my $constName = (defined($2) ? $2 : die("Parsing error!\nSource:
\n$line\n)")); | |
360 my $constValue = (defined($3) ? $3 : die("Parsing error!\nSource
:\n$line\n)")); | |
361 | |
362 my $newDataNode = new domConstant(); | |
363 $newDataNode->name($constName); | |
364 $newDataNode->type($constType); | |
365 $newDataNode->value($constValue); | |
366 | |
367 my $arrayRef = $dataNode->constants; | |
368 push(@$arrayRef, $newDataNode); | |
369 | |
370 print " | |> Constant; TYPE \"$constType\" NAME \"$constName
\" VALUE \"$constValue\"\n" unless $beQuiet; | |
371 } | |
372 } | |
373 | |
374 print " |----> Interface; NAME \"$interfaceName\"" . | |
375 dumpExtendedAttributes("\n | ", $dataNode->extended
Attributes) . "\n |-\n |\n" unless $beQuiet; | |
376 } | |
377 } | |
378 | |
379 # Internal helper | |
380 sub DetermineParseMode | |
381 { | |
382 my $object = shift; | |
383 my $line = shift; | |
384 | |
385 my $mode = MODE_UNDEF; | |
386 if ($_ =~ /module/) { | |
387 $mode = MODE_MODULE; | |
388 } elsif ($_ =~ /interface/) { | |
389 $mode = MODE_INTERFACE; | |
390 } elsif ($_ =~ /exception/) { | |
391 $mode = MODE_EXCEPTION; | |
392 } elsif ($_ =~ /alias/) { | |
393 $mode = MODE_ALIAS; | |
394 } | |
395 | |
396 return $mode; | |
397 } | |
398 | |
399 # Internal helper | |
400 sub ProcessSection | |
401 { | |
402 my $object = shift; | |
403 | |
404 if ($parseMode eq MODE_MODULE) { | |
405 die ("Two modules in one file! Fatal error!\n") if ($document ne 0); | |
406 $document = new idlDocument(); | |
407 $object->ParseModule($document); | |
408 } elsif ($parseMode eq MODE_INTERFACE) { | |
409 my $node = new domClass(); | |
410 $object->ParseInterface($node, "interface"); | |
411 | |
412 die ("No module specified! Fatal Error!\n") if ($document eq 0); | |
413 my $arrayRef = $document->classes; | |
414 push(@$arrayRef, $node); | |
415 } elsif($parseMode eq MODE_EXCEPTION) { | |
416 my $node = new domClass(); | |
417 $object->ParseInterface($node, "exception"); | |
418 | |
419 die ("No module specified! Fatal Error!\n") if ($document eq 0); | |
420 my $arrayRef = $document->classes; | |
421 push(@$arrayRef, $node); | |
422 } elsif($parseMode eq MODE_ALIAS) { | |
423 print " |- Trying to parse alias...\n" unless $beQuiet; | |
424 | |
425 my $line = join("", @temporaryContent); | |
426 $line =~ /$IDLStructure::aliasSelector/; | |
427 | |
428 my $interfaceName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$l
ine\n)")); | |
429 my $wrapperName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$lin
e\n)")); | |
430 | |
431 print " |----> Alias; INTERFACE \"$interfaceName\" WRAPPER \"$wrapperNa
me\"\n |-\n |\n" unless $beQuiet; | |
432 | |
433 # FIXME: Check if alias is already in aliases | |
434 my $aliases = $document->aliases; | |
435 $aliases->{$interfaceName} = $wrapperName; | |
436 } | |
437 | |
438 @temporaryContent = ""; | |
439 } | |
440 | |
441 1; | |
OLD | NEW |