Reviewed by Tim Hatcher (earlier version).
[WebKit-https.git] / WebCore / bindings / scripts / IDLParser.pm
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 # Default Constructor
45 sub new
46 {
47   my $object = shift;
48   my $reference = { };
49
50   $document = 0;
51   $beQuiet = shift;
52
53   bless($reference, $object);
54   return $reference;
55 }
56
57 # Returns the parsed 'idlDocument'
58 sub Parse
59 {
60   my $object = shift;
61   my $fileName = shift;
62
63   print " | *** Starting to parse $fileName...\n |\n" if(!$beQuiet);
64   open FILE, "-|", "/usr/bin/gcc", "-E", "-P", "-x", "c++", $fileName or die "Could not open $fileName";
65   my @documentContent = <FILE>;
66   close FILE;
67
68   my $dataAvailable = 0;
69
70   # Simple IDL Parser (tm)
71   foreach(@documentContent) {
72     my $newParseMode = $object->DetermineParseMode($_);
73
74     if($newParseMode ne MODE_UNDEF) {
75       if($dataAvailable eq 0) {
76         $dataAvailable = 1; # Start node building...
77       } else {
78         $object->ProcessSection();
79       }
80     }
81
82     # Update detected data stream mode...
83     if($newParseMode ne MODE_UNDEF) {
84       $parseMode = $newParseMode;
85     }
86
87     push(@temporaryContent, $_);
88   }
89
90   # Check if there is anything remaining to parse...
91   if(($parseMode ne MODE_UNDEF) and ($#temporaryContent > 0)) {
92     $object->ProcessSection();
93   }
94
95   print " | *** Finished parsing!\n" if(!$beQuiet);
96   
97   $document->fileName($fileName);
98   
99   return $document;
100 }
101
102 sub ParseModule
103 {
104   my $object = shift;
105   my $dataNode = shift;
106
107   print " |- Trying to parse module...\n" if(!$beQuiet);
108
109   my $data = join("", @temporaryContent);
110   $data =~ /$IDLStructure::moduleSelector/;
111
112   my $moduleName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
113   $dataNode->module($moduleName);
114
115   print "  |----> Module; NAME \"$moduleName\"\n |-\n |\n" if(!$beQuiet);
116 }
117
118 sub dumpExtendedAttributes
119 {
120   my $padStr = shift;
121   my $attrs = shift;
122
123   if (!%{$attrs}) {
124     return "";
125   }
126
127   my @temp;
128   while (($name, $value) = each(%{$attrs})) {
129     push(@temp, "$name=$value");
130   }
131   
132   return $padStr . "[" . join(", ", @temp) . "]";
133 }
134
135 sub parseExtendedAttributes
136 {
137   my $str = shift;
138   $str =~ s/\[\s*(.*)\]/$1/g;
139   
140   my %attrs = ();
141   
142   foreach my $value (split(/\s*,\s*/, $str)) {
143     ($name,$value) = split(/\s*=\s*/,$value,2);
144
145     # Attributes with no value are set to be true
146     $value = 1 unless defined $value;
147     $attrs{$name} = $value;
148   }
149   
150   return \%attrs;
151 }
152
153 sub ParseInterface
154 {
155   my $object = shift;
156   my $dataNode = shift;
157   my $sectionName = shift;
158
159   my $data = join("", @temporaryContent);
160
161   # Look for end-of-interface mark
162   $data =~ /};/g;
163   $data = substr($data, index($data, $sectionName), pos($data) - length($data));
164
165   $data =~ s/[\n\r]//g;
166
167   # Beginning of the regexp parsing magic
168   if($sectionName eq "exception") {
169     print " |- Trying to parse exception...\n" if(!$beQuiet);
170
171     my $exceptionName = ""; my $exceptionData = "";
172     my $exceptionDataName = ""; my $exceptionDataType = "";
173   
174     # Match identifier of the exception, and enclosed data...
175     $data =~ /$IDLStructure::exceptionSelector/;
176     $exceptionName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
177     $exceptionData = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
178
179     ('' =~ /^/); # Reset variables needed for regexp matching
180
181     # ... parse enclosed data (get. name & type)
182     $exceptionData =~ /$IDLStructure::exceptionSubSelector/;
183     $exceptionDataType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
184     $exceptionDataName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
185
186     # Fill in domClass datastructure
187     $dataNode->name($exceptionName);
188
189     my $newDataNode = new domAttribute();
190     $newDataNode->type("readonly attribute");
191     $newDataNode->signature(new domSignature());
192
193     $newDataNode->signature->name($exceptionDataName);
194     $newDataNode->signature->type($exceptionDataType);
195     $newDataNode->signature->hasPtrFlag(0);
196
197     my $arrayRef = $dataNode->attributes;
198     push(@$arrayRef, $newDataNode);
199
200     print "  |----> Exception; NAME \"$exceptionName\" DATA TYPE \"$exceptionDataType\" DATA NAME \"$exceptionDataName\"\n |-\n |\n" if(!$beQuiet);
201   } elsif($sectionName eq "interface") {
202     print " |- Trying to parse interface...\n" if(!$beQuiet);
203
204     my $interfaceName = "";
205     my $interfaceData = "";
206     
207     # Match identifier of the interface, and enclosed data...
208     $data =~ /$IDLStructure::interfaceSelector/;
209     
210     $interfaceExtendedAttributes = (defined($1) ? $1 : " "); chop($interfaceExtendedAttributes);
211     $interfaceName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
212     $interfaceBase = (defined($3) ? $3 : "");
213     $interfaceData = (defined($4) ? $4 : die("Parsing error!\nSource:\n$data\n)"));
214
215     # Fill in known parts of the domClass datastructure now...
216     $dataNode->name($interfaceName);
217     $dataNode->extendedAttributes(parseExtendedAttributes($interfaceExtendedAttributes));
218
219     # Inheritance detection
220     my @interfaceParents = split(/,/, $interfaceBase);
221     foreach(@interfaceParents) {
222       my $line = $_;
223       $line =~ s/\s*//g;
224
225       my $arrayRef = $dataNode->parents;
226       push(@$arrayRef, $line);
227     }
228
229     $interfaceData =~ s/[\n\r]//g;
230     my @interfaceMethods = split(/;/, $interfaceData);
231
232     foreach(@interfaceMethods) {
233       my $line = $_;
234
235       if($line =~ /attribute/) {
236         $line =~ /$IDLStructure::interfaceAttributeSelector/;
237
238         my $attributeType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
239         my $attributeExtendedAttributes = (defined($2) ? $2 : " "); chop($attributeExtendedAttributes);
240         
241         my $attributeDataType = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
242         my $attributeDataName = (defined($4) ? $4 : die("Parsing error!\nSource:\n$line\n)"));
243           
244         ('' =~ /^/); # Reset variables needed for regexp matching
245         
246         $line =~ /$IDLStructure::getterRaisesSelector/;
247         my $getterException = (defined($1) ? $1 : "");
248       
249         $line =~ /$IDLStructure::setterRaisesSelector/;
250         my $setterException = (defined($1) ? $1 : "");
251       
252         my $newDataNode = new domAttribute();
253         $newDataNode->type($attributeType);
254         $newDataNode->signature(new domSignature());
255
256         $newDataNode->signature->name($attributeDataName);
257         $newDataNode->signature->type($attributeDataType);
258         $newDataNode->signature->extendedAttributes(parseExtendedAttributes($attributeExtendedAttributes));
259
260         my $arrayRef = $dataNode->attributes;
261         push(@$arrayRef, $newDataNode);
262
263         print "  |  |>  Attribute; TYPE \"$attributeType\" DATA NAME \"$attributeDataName\" DATA TYPE \"$attributeDataType\" GET EXCEPTION? \"$getterException\" SET EXCEPTION? \"$setterException\"" .
264               dumpExtendedAttributes("\n  |                 ", $newDataNode->signature->extendedAttributes) . "\n" if(!$beQuiet);
265
266         $getterException =~ s/\s+//g;
267         $setterException =~ s/\s+//g;
268         @{$newDataNode->getterExceptions} = split(/,/, $getterException);
269         @{$newDataNode->setterExceptions} = split(/,/, $setterException);
270       } elsif(($line !~ s/^\s*$//g) and ($line !~ /^\s+const/)) {
271         $line =~ /$IDLStructure::interfaceMethodSelector/ or die "Parsing error!\nSource:\n$line\n)";
272
273         my $methodExtendedAttributes = (defined($1) ? $1 : " "); chop($methodExtendedAttributes);
274         my $methodType = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
275         my $methodName = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
276         my $methodSignature = (defined($4) ? $4 : die("Parsing error!\nSource:\n$line\n)"));
277         
278         ('' =~ /^/); # Reset variables needed for regexp matching
279         
280         $line =~ /$IDLStructure::raisesSelector/;
281         my $methodException = (defined($1) ? $1 : "");
282
283         my $newDataNode = new domFunction();
284
285         $newDataNode->signature(new domSignature());
286         $newDataNode->signature->name($methodName);
287         $newDataNode->signature->type($methodType);
288         $newDataNode->signature->extendedAttributes(parseExtendedAttributes($methodExtendedAttributes));
289
290         print "  |  |-  Method; TYPE \"$methodType\" NAME \"$methodName\" EXCEPTION? \"$methodException\"" .
291           dumpExtendedAttributes("\n  |              ", $newDataNode->signature->extendedAttributes) . "\n" if(!$beQuiet);
292
293         $methodException =~ s/\s+//g;
294         @{$newDataNode->raisesExceptions} = split(/,/, $methodException);
295
296         my @params = split(/,/, $methodSignature);
297         foreach(@params) {
298           my $line = $_;
299
300           $line =~ /$IDLStructure::interfaceParameterSelector/;
301           my $paramExtendedAttributes = (defined($1) ? $1 : " "); chop($paramExtendedAttributes);
302           my $paramType = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
303           my $paramName = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
304
305           my $paramDataNode = new domSignature();
306           $paramDataNode->name($paramName);
307           $paramDataNode->type($paramType);
308           $paramDataNode->extendedAttributes(parseExtendedAttributes($paramExtendedAttributes));
309
310           my $arrayRef = $newDataNode->parameters;
311           push(@$arrayRef, $paramDataNode);
312
313           print "  |   |>  Param; TYPE \"$paramType\" NAME \"$paramName\"" . 
314             dumpExtendedAttributes("\n  |              ", $paramDataNode->extendedAttributes) . "\n" if(!$beQuiet);          
315         }
316
317         my $arrayRef = $dataNode->functions;
318         push(@$arrayRef, $newDataNode);
319       } elsif($line =~ /^\s+const/) {
320         $line =~ /$IDLStructure::constantSelector/;
321         my $constType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
322         my $constName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
323         my $constValue = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
324
325         my $newDataNode = new domConstant();
326         $newDataNode->name($constName);
327         $newDataNode->type($constType);
328         $newDataNode->value($constValue);
329
330         my $arrayRef = $dataNode->constants;
331         push(@$arrayRef, $newDataNode);
332
333         print "  |   |>  Constant; TYPE \"$constType\" NAME \"$constName\" VALUE \"$constValue\"\n" if(!$beQuiet);
334       }
335     }
336
337     print "  |----> Interface; NAME \"$interfaceName\"" .
338           dumpExtendedAttributes("\n  |                 ", $dataNode->extendedAttributes) . "\n |-\n |\n" if(!$beQuiet);
339   }
340 }
341
342 # Internal helper
343 sub DetermineParseMode
344 {
345   my $object = shift;  
346   my $line = shift;
347
348   my $mode = MODE_UNDEF;
349   if($_ =~ /module/) {
350     $mode = MODE_MODULE;
351   } elsif($_ =~ /interface/) {
352     $mode = MODE_INTERFACE;
353   } elsif($_ =~ /exception/) {
354     $mode = MODE_EXCEPTION;
355   } elsif($_ =~ /alias/) {
356     $mode = MODE_ALIAS;
357   }
358
359   return $mode;
360 }
361
362 # Internal helper
363 sub ProcessSection
364 {
365   my $object = shift;
366   
367   if($parseMode eq MODE_MODULE) {
368     die ("Two modules in one file! Fatal error!\n") if($document ne 0);
369     $document = new idlDocument();
370     $object->ParseModule($document);
371   } elsif($parseMode eq MODE_INTERFACE) {
372     my $node = new domClass();
373     $object->ParseInterface($node, "interface");
374     
375     die ("No module specified! Fatal Error!\n") if($document eq 0);
376     my $arrayRef = $document->classes;
377     push(@$arrayRef, $node);
378   } elsif($parseMode eq MODE_EXCEPTION) {
379     my $node = new domClass();
380     $object->ParseInterface($node, "exception");
381
382     die ("No module specified! Fatal Error!\n") if($document eq 0);
383     my $arrayRef = $document->classes;
384     push(@$arrayRef, $node);
385   } elsif($parseMode eq MODE_ALIAS) {
386     print " |- Trying to parse alias...\n" if(!$beQuiet);
387     
388     my $line = join("", @temporaryContent);
389     $line =~ /$IDLStructure::aliasSelector/;
390
391     my $interfaceName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
392     my $wrapperName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
393     
394     print "  |----> Alias; INTERFACE \"$interfaceName\" WRAPPER \"$wrapperName\"\n |-\n |\n" if(!$beQuiet);
395
396     # FIXME: Check if alias is already in aliases
397     my $aliases = $document->aliases;
398     $aliases->{$interfaceName} = $wrapperName;
399   }
400
401   @temporaryContent = "";
402 }
403
404 1;
405