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