1 # 2 # WebKit IDL parser 3 # 4 # Copyright (C) 2005 Nikolas Zimmermann <wildfox (at] kde.org> 5 # Copyright (C) 2006 Samuel Weinig <sam.weinig (at] gmail.com> 6 # Copyright (C) 2007 Apple Inc. All rights reserved. 7 # Copyright (C) 2009 Cameron McCormack <cam (at] 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 25 package CodeGenerator; 26 27 use File::Find; 28 29 my $useDocument = ""; 30 my $useGenerator = ""; 31 my $useOutputDir = ""; 32 my $useDirectories = ""; 33 my $useLayerOnTop = 0; 34 my $preprocessor; 35 my $writeDependencies = 0; 36 my $defines = ""; 37 38 my $codeGenerator = 0; 39 40 my $verbose = 0; 41 42 my %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 49 my %podTypeHash = ("SVGNumber" => 1, "SVGTransform" => 1); 50 my %podTypesWithWritablePropertiesHash = ("SVGAngle" => 1, "SVGLength" => 1, "SVGMatrix" => 1, "SVGPoint" => 1, "SVGPreserveAspectRatio" => 1, "SVGRect" => 1); 51 my %stringTypeHash = ("DOMString" => 1, "AtomicString" => 1); 52 53 my %nonPointerTypeHash = ("DOMTimeStamp" => 1, "CompareHow" => 1, "SVGPaintType" => 1); 54 55 my %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 63 my %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. 70 my $idlFiles; 71 72 # Default constructor 73 sub 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 89 sub StripModule($) 90 { 91 my $object = shift; 92 my $name = shift; 93 $name =~ s/[a-zA-Z0-9]*:://; 94 return $name; 95 } 96 97 sub 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 128 sub 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 155 sub 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 207 sub 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 232 sub 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 253 sub 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 279 sub 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 289 sub IsPodTypeWithWriteableProperties 290 { 291 my $object = shift; 292 my $type = shift; 293 294 return 1 if $podTypesWithWritablePropertiesHash{$type}; 295 return 0; 296 } 297 298 sub IsPrimitiveType 299 { 300 my $object = shift; 301 my $type = shift; 302 303 return 1 if $primitiveTypeHash{$type}; 304 return 0; 305 } 306 307 sub IsStringType 308 { 309 my $object = shift; 310 my $type = shift; 311 312 return 1 if $stringTypeHash{$type}; 313 return 0; 314 } 315 316 sub 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 325 sub 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. 336 sub 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. 346 sub 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. 359 sub NamespaceForAttributeName 360 { 361 my ($object, $interfaceName, $attributeName) = @_; 362 return "SVGNames" if $interfaceName =~ /^SVG/ && !$svgAttributesInHTMLHash{$attributeName}; 363 return "HTMLNames"; 364 } 365 366 1; 367
