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 Apple Inc. All rights reserved. 7# Copyright (C) 2009 Cameron McCormack <cam@mcc.id.au> 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., 51 Franklin Street, Fifth Floor, 22# Boston, MA 02110-1301, USA. 23# 24 25package CodeGenerator; 26 27use File::Find; 28 29my $useDocument = ""; 30my $useGenerator = ""; 31my $useOutputDir = ""; 32my $useDirectories = ""; 33my $useLayerOnTop = 0; 34my $preprocessor; 35my $writeDependencies = 0; 36my $defines = ""; 37 38my $codeGenerator = 0; 39 40my $verbose = 0; 41 42my %primitiveTypeHash = ("int" => 1, "short" => 1, "long" => 1, "long long" => 1, 43 "unsigned int" => 1, "unsigned short" => 1, 44 "unsigned long" => 1, "unsigned long long" => 1, 45 "float" => 1, "double" => 1, 46 "boolean" => 1, "void" => 1, 47 "Date" => 1); 48 49my %podTypeHash = ("SVGNumber" => 1, "SVGTransform" => 1); 50my %podTypesWithWritablePropertiesHash = ("SVGAngle" => 1, "SVGLength" => 1, "SVGMatrix" => 1, "SVGPoint" => 1, "SVGPreserveAspectRatio" => 1, "SVGRect" => 1); 51my %stringTypeHash = ("DOMString" => 1, "AtomicString" => 1); 52 53my %nonPointerTypeHash = ("DOMTimeStamp" => 1, "CompareHow" => 1, "SVGPaintType" => 1); 54 55my %svgAnimatedTypeHash = ("SVGAnimatedAngle" => 1, "SVGAnimatedBoolean" => 1, 56 "SVGAnimatedEnumeration" => 1, "SVGAnimatedInteger" => 1, 57 "SVGAnimatedLength" => 1, "SVGAnimatedLengthList" => 1, 58 "SVGAnimatedNumber" => 1, "SVGAnimatedNumberList" => 1, 59 "SVGAnimatedPreserveAspectRatio" => 1, 60 "SVGAnimatedRect" => 1, "SVGAnimatedString" => 1, 61 "SVGAnimatedTransformList" => 1); 62 63my %svgAttributesInHTMLHash = ("class" => 1, "id" => 1, "onabort" => 1, "onclick" => 1, 64 "onerror" => 1, "onload" => 1, "onmousedown" => 1, 65 "onmousemove" => 1, "onmouseout" => 1, "onmouseover" => 1, 66 "onmouseup" => 1, "onresize" => 1, "onscroll" => 1, 67 "onunload" => 1); 68 69# Cache of IDL file pathnames. 70my $idlFiles; 71 72# Default constructor 73sub new 74{ 75 my $object = shift; 76 my $reference = { }; 77 78 $useDirectories = shift; 79 $useGenerator = shift; 80 $useOutputDir = shift; 81 $useLayerOnTop = shift; 82 $preprocessor = shift; 83 $writeDependencies = shift; 84 85 bless($reference, $object); 86 return $reference; 87} 88 89sub StripModule($) 90{ 91 my $object = shift; 92 my $name = shift; 93 $name =~ s/[a-zA-Z0-9]*:://; 94 return $name; 95} 96 97sub ProcessDocument 98{ 99 my $object = shift; 100 $useDocument = shift; 101 $defines = shift; 102 103 my $ifaceName = "CodeGenerator" . $useGenerator; 104 105 # Dynamically load external code generation perl module 106 require $ifaceName . ".pm"; 107 $codeGenerator = $ifaceName->new($object, $useOutputDir, $useLayerOnTop, $preprocessor, $writeDependencies); 108 unless (defined($codeGenerator)) { 109 my $classes = $useDocument->classes; 110 foreach my $class (@$classes) { 111 print "Skipping $useGenerator code generation for IDL interface \"" . $class->name . "\".\n" if $verbose; 112 } 113 return; 114 } 115 116 # Start the actual code generation! 117 $codeGenerator->GenerateModule($useDocument, $defines); 118 119 my $classes = $useDocument->classes; 120 foreach my $class (@$classes) { 121 print "Generating $useGenerator bindings code for IDL interface \"" . $class->name . "\"...\n" if $verbose; 122 $codeGenerator->GenerateInterface($class, $defines); 123 } 124 125 $codeGenerator->finish(); 126} 127 128sub ForAllParents 129{ 130 my $object = shift; 131 my $dataNode = shift; 132 my $beforeRecursion = shift; 133 my $afterRecursion = shift; 134 my $parentsOnly = shift; 135 136 my $recurse; 137 $recurse = sub { 138 my $interface = shift; 139 140 for (@{$interface->parents}) { 141 my $interfaceName = $object->StripModule($_); 142 my $parentInterface = $object->ParseInterface($interfaceName, $parentsOnly); 143 144 if ($beforeRecursion) { 145 &$beforeRecursion($parentInterface) eq 'prune' and next; 146 } 147 &$recurse($parentInterface); 148 &$afterRecursion($parentInterface) if $afterRecursion; 149 } 150 }; 151 152 &$recurse($dataNode); 153} 154 155sub AddMethodsConstantsAndAttributesFromParentClasses 156{ 157 # Add to $dataNode all of its inherited interface members, except for those 158 # inherited through $dataNode's first listed parent. If an array reference 159 # is passed in as $parents, the names of all ancestor interfaces visited 160 # will be appended to the array. If $collectDirectParents is true, then 161 # even the names of $dataNode's first listed parent and its ancestors will 162 # be appended to $parents. 163 164 my $object = shift; 165 my $dataNode = shift; 166 my $parents = shift; 167 my $collectDirectParents = shift; 168 169 my $first = 1; 170 171 $object->ForAllParents($dataNode, sub { 172 my $interface = shift; 173 174 if ($first) { 175 # Ignore first parent class, already handled by the generation itself. 176 $first = 0; 177 178 if ($collectDirectParents) { 179 # Just collect the names of the direct ancestor interfaces, 180 # if necessary. 181 push(@$parents, $interface->name); 182 $object->ForAllParents($interface, sub { 183 my $interface = shift; 184 push(@$parents, $interface->name); 185 }, undef, 1); 186 } 187 188 # Prune the recursion here. 189 return 'prune'; 190 } 191 192 # Collect the name of this additional parent. 193 push(@$parents, $interface->name) if $parents; 194 195 print " | |> -> Inheriting " 196 . @{$interface->constants} . " constants, " 197 . @{$interface->functions} . " functions, " 198 . @{$interface->attributes} . " attributes...\n | |>\n" if $verbose; 199 200 # Add this parent's members to $dataNode. 201 push(@{$dataNode->constants}, @{$interface->constants}); 202 push(@{$dataNode->functions}, @{$interface->functions}); 203 push(@{$dataNode->attributes}, @{$interface->attributes}); 204 }); 205} 206 207sub GetMethodsAndAttributesFromParentClasses 208{ 209 # For the passed interface, recursively parse all parent 210 # IDLs in order to find out all inherited properties/methods. 211 212 my $object = shift; 213 my $dataNode = shift; 214 215 my @parentList = (); 216 217 $object->ForAllParents($dataNode, undef, sub { 218 my $interface = shift; 219 220 my $hash = { 221 "name" => $interface->name, 222 "functions" => $interface->functions, 223 "attributes" => $interface->attributes 224 }; 225 226 unshift(@parentList, $hash); 227 }); 228 229 return @parentList; 230} 231 232sub IDLFileForInterface 233{ 234 my $object = shift; 235 my $interfaceName = shift; 236 237 unless ($idlFiles) { 238 my $sourceRoot = $ENV{SOURCE_ROOT}; 239 my @directories = map { $_ = "$sourceRoot/$_" if $sourceRoot && -d "$sourceRoot/$_"; $_ } @$useDirectories; 240 241 $idlFiles = { }; 242 243 my $wanted = sub { 244 $idlFiles->{$1} = $File::Find::name if /^([A-Z].*)\.idl$/; 245 $File::Find::prune = 1 if /^\../; 246 }; 247 find($wanted, @directories); 248 } 249 250 return $idlFiles->{$interfaceName}; 251} 252 253sub ParseInterface 254{ 255 my $object = shift; 256 my $interfaceName = shift; 257 my $parentsOnly = shift; 258 259 return undef if $interfaceName eq 'Object'; 260 261 # Step #1: Find the IDL file associated with 'interface' 262 my $filename = $object->IDLFileForInterface($interfaceName) 263 or die("Could NOT find IDL file for interface \"$interfaceName\"!\n"); 264 265 print " | |> Parsing parent IDL \"$filename\" for interface \"$interfaceName\"\n" if $verbose; 266 267 # Step #2: Parse the found IDL file (in quiet mode). 268 my $parser = IDLParser->new(1); 269 my $document = $parser->Parse($filename, $defines, $preprocessor, $parentsOnly); 270 271 foreach my $interface (@{$document->classes}) { 272 return $interface if $interface->name eq $interfaceName; 273 } 274 275 die("Could NOT find interface definition for $interface in $filename"); 276} 277 278# Helpers for all CodeGenerator***.pm modules 279sub IsPodType 280{ 281 my $object = shift; 282 my $type = shift; 283 284 return 1 if $podTypeHash{$type}; 285 return 1 if $podTypesWithWritablePropertiesHash{$type}; 286 return 0; 287} 288 289sub IsPodTypeWithWriteableProperties 290{ 291 my $object = shift; 292 my $type = shift; 293 294 return 1 if $podTypesWithWritablePropertiesHash{$type}; 295 return 0; 296} 297 298sub IsPrimitiveType 299{ 300 my $object = shift; 301 my $type = shift; 302 303 return 1 if $primitiveTypeHash{$type}; 304 return 0; 305} 306 307sub IsStringType 308{ 309 my $object = shift; 310 my $type = shift; 311 312 return 1 if $stringTypeHash{$type}; 313 return 0; 314} 315 316sub IsNonPointerType 317{ 318 my $object = shift; 319 my $type = shift; 320 321 return 1 if $nonPointerTypeHash{$type} or $primitiveTypeHash{$type}; 322 return 0; 323} 324 325sub IsSVGAnimatedType 326{ 327 my $object = shift; 328 my $type = shift; 329 330 return 1 if $svgAnimatedTypeHash{$type}; 331 return 0; 332} 333 334# Uppercase the first letter while respecting WebKit style guidelines. 335# E.g., xmlEncoding becomes XMLEncoding, but xmlllang becomes Xmllang. 336sub WK_ucfirst 337{ 338 my ($object, $param) = @_; 339 my $ret = ucfirst($param); 340 $ret =~ s/Xml/XML/ if $ret =~ /^Xml[^a-z]/; 341 return $ret; 342} 343 344# Lowercase the first letter while respecting WebKit style guidelines. 345# URL becomes url, but SetURL becomes setURL. 346sub WK_lcfirst 347{ 348 my ($object, $param) = @_; 349 my $ret = lcfirst($param); 350 $ret =~ s/hTML/html/ if $ret =~ /^hTML/; 351 $ret =~ s/uRL/url/ if $ret =~ /^uRL/; 352 $ret =~ s/jS/js/ if $ret =~ /^jS/; 353 $ret =~ s/xML/xml/ if $ret =~ /^xML/; 354 $ret =~ s/xSLT/xslt/ if $ret =~ /^xSLT/; 355 return $ret; 356} 357 358# Return the C++ namespace that a given attribute name string is defined in. 359sub NamespaceForAttributeName 360{ 361 my ($object, $interfaceName, $attributeName) = @_; 362 return "SVGNames" if $interfaceName =~ /^SVG/ && !$svgAttributesInHTMLHash{$attributeName}; 363 return "HTMLNames"; 364} 365 3661; 367