1#
2# WebKit IDL parser
3#
4# Copyright (C) 2005 Nikolas Zimmermann <wildfox@kde.org>
5# Copyright (C) 2006 Samuel Weinig <sam.weinig@gmail.com>
6# Copyright (C) 2007, 2008, 2009, 2010 Apple Inc. All rights reserved.
7# Copyright (C) 2009 Cameron McCormack <cam@mcc.id.au>
8# Copyright (C) Research In Motion Limited 2010. All rights reserved.
9#
10# This library is free software; you can redistribute it and/or
11# modify it under the terms of the GNU Library General Public
12# License as published by the Free Software Foundation; either
13# version 2 of the License, or (at your option) any later version.
14#
15# This library is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18# Library General Public License for more details.
19#
20# You should have received a copy of the GNU Library General Public License
21# along with this library; see the file COPYING.LIB.  If not, write to
22# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23# Boston, MA 02110-1301, USA.
24#
25
26package CodeGenerator;
27
28use strict;
29
30use File::Find;
31
32my $useDocument = "";
33my $useGenerator = "";
34my $useOutputDir = "";
35my $useOutputHeadersDir = "";
36my $useDirectories = "";
37my $useLayerOnTop = 0;
38my $preprocessor;
39my $writeDependencies = 0;
40my $defines = "";
41
42my $codeGenerator = 0;
43
44my $verbose = 0;
45
46my %numericTypeHash = ("int" => 1, "short" => 1, "long" => 1, "long long" => 1,
47                       "unsigned int" => 1, "unsigned short" => 1,
48                       "unsigned long" => 1, "unsigned long long" => 1,
49                       "float" => 1, "double" => 1);
50
51my %primitiveTypeHash = ( "boolean" => 1, "void" => 1, "Date" => 1);
52
53my %stringTypeHash = ("DOMString" => 1, "AtomicString" => 1);
54
55my %nonPointerTypeHash = ("DOMTimeStamp" => 1, "CompareHow" => 1);
56
57my %svgAnimatedTypeHash = ("SVGAnimatedAngle" => 1, "SVGAnimatedBoolean" => 1,
58                           "SVGAnimatedEnumeration" => 1, "SVGAnimatedInteger" => 1,
59                           "SVGAnimatedLength" => 1, "SVGAnimatedLengthList" => 1,
60                           "SVGAnimatedNumber" => 1, "SVGAnimatedNumberList" => 1,
61                           "SVGAnimatedPreserveAspectRatio" => 1,
62                           "SVGAnimatedRect" => 1, "SVGAnimatedString" => 1,
63                           "SVGAnimatedTransformList" => 1);
64
65my %svgAttributesInHTMLHash = ("class" => 1, "id" => 1, "onabort" => 1, "onclick" => 1,
66                               "onerror" => 1, "onload" => 1, "onmousedown" => 1,
67                               "onmousemove" => 1, "onmouseout" => 1, "onmouseover" => 1,
68                               "onmouseup" => 1, "onresize" => 1, "onscroll" => 1,
69                               "onunload" => 1);
70
71my %svgTypeNeedingTearOff = (
72    "SVGAngle" => "SVGPropertyTearOff<SVGAngle>",
73    "SVGLength" => "SVGPropertyTearOff<SVGLength>",
74    "SVGLengthList" => "SVGListPropertyTearOff<SVGLengthList>",
75    "SVGMatrix" => "SVGPropertyTearOff<SVGMatrix>",
76    "SVGNumber" => "SVGPropertyTearOff<float>",
77    "SVGNumberList" => "SVGListPropertyTearOff<SVGNumberList>",
78    "SVGPathSegList" => "SVGPathSegListPropertyTearOff",
79    "SVGPoint" => "SVGPropertyTearOff<FloatPoint>",
80    "SVGPointList" => "SVGListPropertyTearOff<SVGPointList>",
81    "SVGPreserveAspectRatio" => "SVGPropertyTearOff<SVGPreserveAspectRatio>",
82    "SVGRect" => "SVGPropertyTearOff<FloatRect>",
83    "SVGStringList" => "SVGStaticListPropertyTearOff<SVGStringList>",
84    "SVGTransform" => "SVGPropertyTearOff<SVGTransform>",
85    "SVGTransformList" => "SVGTransformListPropertyTearOff"
86);
87
88my %svgTypeWithWritablePropertiesNeedingTearOff = (
89    "SVGPoint" => 1,
90    "SVGMatrix" => 1
91);
92
93# Cache of IDL file pathnames.
94my $idlFiles;
95
96# Default constructor
97sub new
98{
99    my $object = shift;
100    my $reference = { };
101
102    $useDirectories = shift;
103    $useGenerator = shift;
104    $useOutputDir = shift;
105    $useOutputHeadersDir = shift;
106    $useLayerOnTop = shift;
107    $preprocessor = shift;
108    $writeDependencies = shift;
109    $verbose = shift;
110
111    bless($reference, $object);
112    return $reference;
113}
114
115sub StripModule($)
116{
117    my $object = shift;
118    my $name = shift;
119    $name =~ s/[a-zA-Z0-9]*:://;
120    return $name;
121}
122
123sub ProcessDocument
124{
125    my $object = shift;
126    $useDocument = shift;
127    $defines = shift;
128
129    my $ifaceName = "CodeGenerator" . $useGenerator;
130    require $ifaceName . ".pm";
131
132    # Dynamically load external code generation perl module
133    $codeGenerator = $ifaceName->new($object, $useOutputDir, $useOutputHeadersDir, $useLayerOnTop, $preprocessor, $writeDependencies, $verbose);
134    unless (defined($codeGenerator)) {
135        my $classes = $useDocument->classes;
136        foreach my $class (@$classes) {
137            print "Skipping $useGenerator code generation for IDL interface \"" . $class->name . "\".\n" if $verbose;
138        }
139        return;
140    }
141
142    # Start the actual code generation!
143    $codeGenerator->GenerateModule($useDocument, $defines);
144
145    my $classes = $useDocument->classes;
146    foreach my $class (@$classes) {
147        print "Generating $useGenerator bindings code for IDL interface \"" . $class->name . "\"...\n" if $verbose;
148        $codeGenerator->GenerateInterface($class, $defines);
149    }
150
151    $codeGenerator->finish();
152}
153
154sub ForAllParents
155{
156    my $object = shift;
157    my $dataNode = shift;
158    my $beforeRecursion = shift;
159    my $afterRecursion = shift;
160    my $parentsOnly = shift;
161
162    my $recurse;
163    $recurse = sub {
164        my $interface = shift;
165
166        for (@{$interface->parents}) {
167            my $interfaceName = $object->StripModule($_);
168            my $parentInterface = $object->ParseInterface($interfaceName, $parentsOnly);
169
170            if ($beforeRecursion) {
171                &$beforeRecursion($parentInterface) eq 'prune' and next;
172            }
173            &$recurse($parentInterface);
174            &$afterRecursion($parentInterface) if $afterRecursion;
175        }
176    };
177
178    &$recurse($dataNode);
179}
180
181sub AddMethodsConstantsAndAttributesFromParentClasses
182{
183    # Add to $dataNode all of its inherited interface members, except for those
184    # inherited through $dataNode's first listed parent.  If an array reference
185    # is passed in as $parents, the names of all ancestor interfaces visited
186    # will be appended to the array.  If $collectDirectParents is true, then
187    # even the names of $dataNode's first listed parent and its ancestors will
188    # be appended to $parents.
189
190    my $object = shift;
191    my $dataNode = shift;
192    my $parents = shift;
193    my $collectDirectParents = shift;
194
195    my $first = 1;
196
197    $object->ForAllParents($dataNode, sub {
198        my $interface = shift;
199
200        if ($first) {
201            # Ignore first parent class, already handled by the generation itself.
202            $first = 0;
203
204            if ($collectDirectParents) {
205                # Just collect the names of the direct ancestor interfaces,
206                # if necessary.
207                push(@$parents, $interface->name);
208                $object->ForAllParents($interface, sub {
209                    my $interface = shift;
210                    push(@$parents, $interface->name);
211                }, undef, 1);
212            }
213
214            # Prune the recursion here.
215            return 'prune';
216        }
217
218        # Collect the name of this additional parent.
219        push(@$parents, $interface->name) if $parents;
220
221        print "  |  |>  -> Inheriting "
222            . @{$interface->constants} . " constants, "
223            . @{$interface->functions} . " functions, "
224            . @{$interface->attributes} . " attributes...\n  |  |>\n" if $verbose;
225
226        # Add this parent's members to $dataNode.
227        push(@{$dataNode->constants}, @{$interface->constants});
228        push(@{$dataNode->functions}, @{$interface->functions});
229        push(@{$dataNode->attributes}, @{$interface->attributes});
230    });
231}
232
233sub GetMethodsAndAttributesFromParentClasses
234{
235    # For the passed interface, recursively parse all parent
236    # IDLs in order to find out all inherited properties/methods.
237
238    my $object = shift;
239    my $dataNode = shift;
240
241    my @parentList = ();
242
243    $object->ForAllParents($dataNode, undef, sub {
244        my $interface = shift;
245
246        my $hash = {
247            "name" => $interface->name,
248            "functions" => $interface->functions,
249            "attributes" => $interface->attributes
250        };
251
252        unshift(@parentList, $hash);
253    });
254
255    return @parentList;
256}
257
258sub IDLFileForInterface
259{
260    my $object = shift;
261    my $interfaceName = shift;
262
263    unless ($idlFiles) {
264        my $sourceRoot = $ENV{SOURCE_ROOT};
265        my @directories = map { $_ = "$sourceRoot/$_" if $sourceRoot && -d "$sourceRoot/$_"; $_ } @$useDirectories;
266
267        $idlFiles = { };
268
269        my $wanted = sub {
270            $idlFiles->{$1} = $File::Find::name if /^([A-Z].*)\.idl$/;
271            $File::Find::prune = 1 if /^\../;
272        };
273        find($wanted, @directories);
274    }
275
276    return $idlFiles->{$interfaceName};
277}
278
279sub ParseInterface
280{
281    my $object = shift;
282    my $interfaceName = shift;
283    my $parentsOnly = shift;
284
285    return undef if $interfaceName eq 'Object';
286
287    # Step #1: Find the IDL file associated with 'interface'
288    my $filename = $object->IDLFileForInterface($interfaceName)
289        or die("Could NOT find IDL file for interface \"$interfaceName\"!\n");
290
291    print "  |  |>  Parsing parent IDL \"$filename\" for interface \"$interfaceName\"\n" if $verbose;
292
293    # Step #2: Parse the found IDL file (in quiet mode).
294    my $parser = IDLParser->new(1);
295    my $document = $parser->Parse($filename, $defines, $preprocessor, $parentsOnly);
296
297    foreach my $interface (@{$document->classes}) {
298        return $interface if $interface->name eq $interfaceName;
299    }
300
301    die("Could NOT find interface definition for $interfaceName in $filename");
302}
303
304# Helpers for all CodeGenerator***.pm modules
305
306sub AvoidInclusionOfType
307{
308    my $object = shift;
309    my $type = shift;
310
311    # Special case: SVGPoint.h / SVGNumber.h do not exist.
312    return 1 if $type eq "SVGPoint" or $type eq "SVGNumber";
313    return 0;
314}
315
316sub IsNumericType
317{
318    my $object = shift;
319    my $type = shift;
320
321    return 1 if $numericTypeHash{$type};
322    return 0;
323}
324
325sub IsPrimitiveType
326{
327    my $object = shift;
328    my $type = shift;
329
330    return 1 if $primitiveTypeHash{$type};
331    return 1 if $numericTypeHash{$type};
332    return 0;
333}
334
335sub IsStringType
336{
337    my $object = shift;
338    my $type = shift;
339
340    return 1 if $stringTypeHash{$type};
341    return 0;
342}
343
344sub IsNonPointerType
345{
346    my $object = shift;
347    my $type = shift;
348
349    return 1 if $nonPointerTypeHash{$type} or $primitiveTypeHash{$type} or $numericTypeHash{$type};
350    return 0;
351}
352
353sub IsSVGTypeNeedingTearOff
354{
355    my $object = shift;
356    my $type = shift;
357
358    return 1 if exists $svgTypeNeedingTearOff{$type};
359    return 0;
360}
361
362sub IsSVGTypeWithWritablePropertiesNeedingTearOff
363{
364    my $object = shift;
365    my $type = shift;
366
367    return 1 if $svgTypeWithWritablePropertiesNeedingTearOff{$type};
368    return 0;
369}
370
371sub GetSVGTypeNeedingTearOff
372{
373    my $object = shift;
374    my $type = shift;
375
376    return $svgTypeNeedingTearOff{$type} if exists $svgTypeNeedingTearOff{$type};
377    return undef;
378}
379
380sub GetSVGWrappedTypeNeedingTearOff
381{
382    my $object = shift;
383    my $type = shift;
384
385    my $svgTypeNeedingTearOff = $object->GetSVGTypeNeedingTearOff($type);
386    return $svgTypeNeedingTearOff if not $svgTypeNeedingTearOff;
387
388    if ($svgTypeNeedingTearOff =~ /SVGPropertyTearOff/) {
389        $svgTypeNeedingTearOff =~ s/SVGPropertyTearOff<//;
390    } elsif ($svgTypeNeedingTearOff =~ /SVGListPropertyTearOff/) {
391        $svgTypeNeedingTearOff =~ s/SVGListPropertyTearOff<//;
392    } elsif ($svgTypeNeedingTearOff =~ /SVGStaticListPropertyTearOff/) {
393        $svgTypeNeedingTearOff =~ s/SVGStaticListPropertyTearOff<//;
394    }  elsif ($svgTypeNeedingTearOff =~ /SVGTransformListPropertyTearOff/) {
395        $svgTypeNeedingTearOff =~ s/SVGTransformListPropertyTearOff<//;
396    }
397
398    $svgTypeNeedingTearOff =~ s/>//;
399    return $svgTypeNeedingTearOff;
400}
401
402sub IsSVGAnimatedType
403{
404    my $object = shift;
405    my $type = shift;
406
407    return 1 if $svgAnimatedTypeHash{$type};
408    return 0;
409}
410
411# Uppercase the first letter while respecting WebKit style guidelines.
412# E.g., xmlEncoding becomes XMLEncoding, but xmlllang becomes Xmllang.
413sub WK_ucfirst
414{
415    my ($object, $param) = @_;
416    my $ret = ucfirst($param);
417    $ret =~ s/Xml/XML/ if $ret =~ /^Xml[^a-z]/;
418
419    return $ret;
420}
421
422# Lowercase the first letter while respecting WebKit style guidelines.
423# URL becomes url, but SetURL becomes setURL.
424sub WK_lcfirst
425{
426    my ($object, $param) = @_;
427    my $ret = lcfirst($param);
428    $ret =~ s/hTML/html/ if $ret =~ /^hTML/;
429    $ret =~ s/uRL/url/ if $ret =~ /^uRL/;
430    $ret =~ s/jS/js/ if $ret =~ /^jS/;
431    $ret =~ s/xML/xml/ if $ret =~ /^xML/;
432    $ret =~ s/xSLT/xslt/ if $ret =~ /^xSLT/;
433
434    # For HTML5 FileSystem API Flags attributes.
435    # (create is widely used to instantiate an object and must be avoided.)
436    $ret =~ s/^create/isCreate/ if $ret =~ /^create$/;
437    $ret =~ s/^exclusive/isExclusive/ if $ret =~ /^exclusive$/;
438
439    return $ret;
440}
441
442# Return the C++ namespace that a given attribute name string is defined in.
443sub NamespaceForAttributeName
444{
445    my ($object, $interfaceName, $attributeName) = @_;
446    return "SVGNames" if $interfaceName =~ /^SVG/ && !$svgAttributesInHTMLHash{$attributeName};
447    return "HTMLNames";
448}
449
450# Identifies overloaded functions and for each function adds an array with
451# links to its respective overloads (including itself).
452sub LinkOverloadedFunctions
453{
454    my ($object, $dataNode) = @_;
455
456    my %nameToFunctionsMap = ();
457    foreach my $function (@{$dataNode->functions}) {
458        my $name = $function->signature->name;
459        $nameToFunctionsMap{$name} = [] if !exists $nameToFunctionsMap{$name};
460        push(@{$nameToFunctionsMap{$name}}, $function);
461        $function->{overloads} = $nameToFunctionsMap{$name};
462        $function->{overloadIndex} = @{$nameToFunctionsMap{$name}};
463    }
464}
465
466sub AttributeNameForGetterAndSetter
467{
468    my ($generator, $attribute) = @_;
469
470    my $attributeName = $attribute->signature->name;
471    my $attributeType = $generator->StripModule($attribute->signature->type);
472
473    # Avoid clash with C++ keyword.
474    $attributeName = "_operator" if $attributeName eq "operator";
475
476    # SVGAElement defines a non-virtual "String& target() const" method which clashes with "virtual String target() const" in Element.
477    # To solve this issue the SVGAElement method was renamed to "svgTarget", take care of that when calling this method.
478    $attributeName = "svgTarget" if $attributeName eq "target" and $attributeType eq "SVGAnimatedString";
479
480    # SVG animated types need to use a special attribute name.
481    # The rest of the special casing for SVG animated types is handled in the language-specific code generators.
482    $attributeName .= "Animated" if $generator->IsSVGAnimatedType($attributeType);
483
484    return $attributeName;
485}
486
487sub ContentAttributeName
488{
489    my ($generator, $implIncludes, $interfaceName, $attribute) = @_;
490
491    my $contentAttributeName = $attribute->signature->extendedAttributes->{"Reflect"};
492    return undef if !$contentAttributeName;
493
494    $contentAttributeName = lc $generator->AttributeNameForGetterAndSetter($attribute) if $contentAttributeName eq "1";
495
496    my $namespace = $generator->NamespaceForAttributeName($interfaceName, $contentAttributeName);
497
498    $implIncludes->{"${namespace}.h"} = 1;
499    return "WebCore::${namespace}::${contentAttributeName}Attr";
500}
501
502sub GetterExpressionPrefix
503{
504    my ($generator, $implIncludes, $interfaceName, $attribute) = @_;
505
506    my $contentAttributeName = $generator->ContentAttributeName($implIncludes, $interfaceName, $attribute);
507
508    if (!$contentAttributeName) {
509        return $generator->WK_lcfirst($generator->AttributeNameForGetterAndSetter($attribute)) . "(";
510    }
511
512    my $functionName;
513    if ($attribute->signature->extendedAttributes->{"URL"}) {
514        if ($attribute->signature->extendedAttributes->{"NonEmpty"}) {
515            $functionName = "getNonEmptyURLAttribute";
516        } else {
517            $functionName = "getURLAttribute";
518        }
519    } elsif ($attribute->signature->type eq "boolean") {
520        $functionName = "hasAttribute";
521    } elsif ($attribute->signature->type eq "long") {
522        $functionName = "getIntegralAttribute";
523    } elsif ($attribute->signature->type eq "unsigned long") {
524        $functionName = "getUnsignedIntegralAttribute";
525    } else {
526        $functionName = "getAttribute";
527    }
528
529    return "$functionName($contentAttributeName"
530}
531
532sub SetterExpressionPrefix
533{
534    my ($generator, $implIncludes, $interfaceName, $attribute) = @_;
535
536    my $contentAttributeName = $generator->ContentAttributeName($implIncludes, $interfaceName, $attribute);
537
538    if (!$contentAttributeName) {
539        return "set" . $generator->WK_ucfirst($generator->AttributeNameForGetterAndSetter($attribute)) . "(";
540    }
541
542    my $functionName;
543    if ($attribute->signature->type eq "boolean") {
544        $functionName = "setBooleanAttribute";
545    } elsif ($attribute->signature->type eq "long") {
546        $functionName = "setIntegralAttribute";
547    } elsif ($attribute->signature->type eq "unsigned long") {
548        $functionName = "setUnsignedIntegralAttribute";
549    } else {
550        $functionName = "setAttribute";
551    }
552
553    return "$functionName($contentAttributeName, "
554}
555
556sub ShouldCheckEnums
557{
558    my $dataNode = shift;
559    return not $dataNode->extendedAttributes->{"DontCheckEnums"};
560}
561
562sub GenerateCompileTimeCheckForEnumsIfNeeded
563{
564    my ($object, $dataNode) = @_;
565    my $interfaceName = $dataNode->name;
566    my @checks = ();
567    # If necessary, check that all constants are available as enums with the same value.
568    if (ShouldCheckEnums($dataNode) && @{$dataNode->constants}) {
569        push(@checks, "\n");
570        foreach my $constant (@{$dataNode->constants}) {
571            my $name = $constant->name;
572            my $value = $constant->value;
573            push(@checks, "COMPILE_ASSERT($value == ${interfaceName}::$name, ${interfaceName}Enum${name}IsWrongUseDontCheckEnums);\n");
574        }
575        push(@checks, "\n");
576    }
577    return @checks;
578}
579
5801;
581