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# 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 CodeGenerator; 25 26my $useDocument = ""; 27my $useGenerator = ""; 28my $useOutputDir = ""; 29my $useDirectories = ""; 30my $useLayerOnTop = 0; 31my $preprocessor; 32 33my $codeGenerator = 0; 34 35my $verbose = 0; 36 37my %primitiveTypeHash = ("int" => 1, "short" => 1, "long" => 1, "long long" => 1, 38 "unsigned int" => 1, "unsigned short" => 1, 39 "unsigned long" => 1, "unsigned long long" => 1, 40 "float" => 1, "double" => 1, 41 "boolean" => 1, "void" => 1); 42 43my %podTypeHash = ("SVGNumber" => 1, "SVGTransform" => 1); 44my %podTypesWithWritablePropertiesHash = ("SVGLength" => 1, "SVGMatrix" => 1, "SVGPoint" => 1, "SVGRect" => 1); 45my %stringTypeHash = ("DOMString" => 1, "AtomicString" => 1); 46 47my %nonPointerTypeHash = ("DOMTimeStamp" => 1, "CompareHow" => 1, "SVGPaintType" => 1); 48 49my %svgAnimatedTypeHash = ("SVGAnimatedAngle" => 1, "SVGAnimatedBoolean" => 1, 50 "SVGAnimatedEnumeration" => 1, "SVGAnimatedInteger" => 1, 51 "SVGAnimatedLength" => 1, "SVGAnimatedLengthList" => 1, 52 "SVGAnimatedNumber" => 1, "SVGAnimatedNumberList" => 1, 53 "SVGAnimatedPreserveAspectRatio" => 1, 54 "SVGAnimatedRect" => 1, "SVGAnimatedString" => 1, 55 "SVGAnimatedTransformList" => 1); 56 57# Helpers for 'ScanDirectory' 58my $endCondition = 0; 59my $foundFilename = ""; 60my @foundFilenames = (); 61my $ignoreParent = 1; 62my $defines = ""; 63 64# Default constructor 65sub new 66{ 67 my $object = shift; 68 my $reference = { }; 69 70 $useDirectories = shift; 71 $useGenerator = shift; 72 $useOutputDir = shift; 73 $useLayerOnTop = shift; 74 $preprocessor = shift; 75 76 bless($reference, $object); 77 return $reference; 78} 79 80sub StripModule($) 81{ 82 my $object = shift; 83 my $name = shift; 84 $name =~ s/[a-zA-Z0-9]*:://; 85 return $name; 86} 87 88sub ProcessDocument 89{ 90 my $object = shift; 91 $useDocument = shift; 92 $defines = shift; 93 94 my $ifaceName = "CodeGenerator" . $useGenerator; 95 96 # Dynamically load external code generation perl module 97 require $ifaceName . ".pm"; 98 $codeGenerator = $ifaceName->new($object, $useOutputDir, $useLayerOnTop, $preprocessor); 99 unless (defined($codeGenerator)) { 100 my $classes = $useDocument->classes; 101 foreach my $class (@$classes) { 102 print "Skipping $useGenerator code generation for IDL interface \"" . $class->name . "\".\n" if $verbose; 103 } 104 return; 105 } 106 107 # Start the actual code generation! 108 $codeGenerator->GenerateModule($useDocument, $defines); 109 110 my $classes = $useDocument->classes; 111 foreach my $class (@$classes) { 112 print "Generating $useGenerator bindings code for IDL interface \"" . $class->name . "\"...\n" if $verbose; 113 $codeGenerator->GenerateInterface($class, $defines); 114 } 115 116 $codeGenerator->finish(); 117} 118 119# Necessary for V8 bindings to determine whether an interface is descendant from Node. 120# Node descendants are treated differently by DOMMap and this allows inferring the 121# type statically. See more at the original change: http://codereview.chromium.org/3195. 122# FIXME: Figure out a way to eliminate this JS bindings dichotomy. 123sub FindParentsRecursively 124{ 125 my $object = shift; 126 my $dataNode = shift; 127 my @parents = ($dataNode->name); 128 foreach (@{$dataNode->parents}) { 129 my $interface = $object->StripModule($_); 130 131 $endCondition = 0; 132 $foundFilename = ""; 133 foreach (@{$useDirectories}) { 134 $object->ScanDirectory("$interface.idl", $_, $_, 0) if ($foundFilename eq ""); 135 } 136 137 if ($foundFilename ne "") { 138 print " | |> Parsing parent IDL \"$foundFilename\" for interface \"$interface\"\n" if $verbose; 139 140 # Step #2: Parse the found IDL file (in quiet mode). 141 my $parser = IDLParser->new(1); 142 my $document = $parser->Parse($foundFilename, $defines, $preprocessor, 1); 143 144 foreach my $class (@{$document->classes}) { 145 @parents = (@parents, FindParentsRecursively($object, $class)); 146 } 147 } else { 148 die("Could NOT find specified parent interface \"$interface\"!\n") 149 } 150 } 151 return @parents; 152} 153 154sub AddMethodsConstantsAndAttributesFromParentClasses 155{ 156 # For the passed interface, recursively parse all parent 157 # IDLs in order to find out all inherited properties/methods. 158 159 my $object = shift; 160 my $dataNode = shift; 161 162 my @parents = @{$dataNode->parents}; 163 my $parentsMax = @{$dataNode->parents}; 164 165 my $constantsRef = $dataNode->constants; 166 my $functionsRef = $dataNode->functions; 167 my $attributesRef = $dataNode->attributes; 168 169 foreach (@{$dataNode->parents}) { 170 if ($ignoreParent) { 171 # Ignore first parent class, already handled by the generation itself. 172 $ignoreParent = 0; 173 next; 174 } 175 176 my $interface = $object->StripModule($_); 177 178 # Step #1: Find the IDL file associated with 'interface' 179 $endCondition = 0; 180 $foundFilename = ""; 181 182 foreach (@{$useDirectories}) { 183 $object->ScanDirectory("$interface.idl", $_, $_, 0) if ($foundFilename eq ""); 184 } 185 186 if ($foundFilename ne "") { 187 print " | |> Parsing parent IDL \"$foundFilename\" for interface \"$interface\"\n" if $verbose; 188 189 # Step #2: Parse the found IDL file (in quiet mode). 190 my $parser = IDLParser->new(1); 191 my $document = $parser->Parse($foundFilename, $defines, $preprocessor); 192 193 foreach my $class (@{$document->classes}) { 194 # Step #3: Enter recursive parent search 195 AddMethodsConstantsAndAttributesFromParentClasses($object, $class); 196 197 # Step #4: Collect constants & functions & attributes of this parent-class 198 my $constantsMax = @{$class->constants}; 199 my $functionsMax = @{$class->functions}; 200 my $attributesMax = @{$class->attributes}; 201 202 print " | |> -> Inheriting $constantsMax constants, $functionsMax functions, $attributesMax attributes...\n | |>\n" if $verbose; 203 204 # Step #5: Concatenate data 205 push(@$constantsRef, $_) foreach (@{$class->constants}); 206 push(@$functionsRef, $_) foreach (@{$class->functions}); 207 push(@$attributesRef, $_) foreach (@{$class->attributes}); 208 } 209 } else { 210 die("Could NOT find specified parent interface \"$interface\"!\n"); 211 } 212 } 213} 214 215sub GetMethodsAndAttributesFromParentClasses 216{ 217 # For the passed interface, recursively parse all parent 218 # IDLs in order to find out all inherited properties/methods. 219 220 my $object = shift; 221 my $dataNode = shift; 222 223 my @parents = @{$dataNode->parents}; 224 225 return if @{$dataNode->parents} == 0; 226 227 my @parentList = (); 228 229 foreach (@{$dataNode->parents}) { 230 my $interface = $object->StripModule($_); 231 232 # Step #1: Find the IDL file associated with 'interface' 233 $endCondition = 0; 234 $foundFilename = ""; 235 236 foreach (@{$useDirectories}) { 237 $object->ScanDirectory("${interface}.idl", $_, $_, 0) if $foundFilename eq ""; 238 } 239 240 die("Could NOT find specified parent interface \"$interface\"!\n") if $foundFilename eq ""; 241 242 print " | |> Parsing parent IDL \"$foundFilename\" for interface \"$interface\"\n" if $verbose; 243 244 # Step #2: Parse the found IDL file (in quiet mode). 245 my $parser = IDLParser->new(1); 246 my $document = $parser->Parse($foundFilename, $defines); 247 248 foreach my $class (@{$document->classes}) { 249 # Step #3: Enter recursive parent search 250 push(@parentList, GetMethodsAndAttributesFromParentClasses($object, $class)); 251 252 # Step #4: Collect constants & functions & attributes of this parent-class 253 254 # print " | |> -> Inheriting $functionsMax functions amd $attributesMax attributes...\n | |>\n" if $verbose; 255 my $hash = { 256 "name" => $class->name, 257 "functions" => $class->functions, 258 "attributes" => $class->attributes 259 }; 260 261 # Step #5: Concatenate data 262 unshift(@parentList, $hash); 263 } 264 } 265 266 return @parentList; 267} 268 269sub ParseInterface 270{ 271 my ($object, $interfaceName) = @_; 272 273 # Step #1: Find the IDL file associated with 'interface' 274 $endCondition = 0; 275 $foundFilename = ""; 276 277 foreach (@{$useDirectories}) { 278 $object->ScanDirectory("${interfaceName}.idl", $_, $_, 0) if $foundFilename eq ""; 279 } 280 die "Could NOT find specified parent interface \"$interfaceName\"!\n" if $foundFilename eq ""; 281 282 print " | |> Parsing parent IDL \"$foundFilename\" for interface \"$interfaceName\"\n" if $verbose; 283 284 # Step #2: Parse the found IDL file (in quiet mode). 285 my $parser = IDLParser->new(1); 286 my $document = $parser->Parse($foundFilename, $defines); 287 288 foreach my $interface (@{$document->classes}) { 289 return $interface if $interface->name eq $interfaceName; 290 } 291 292 die "Interface definition not found"; 293} 294 295# Helpers for all CodeGenerator***.pm modules 296sub IsPodType 297{ 298 my $object = shift; 299 my $type = shift; 300 301 return 1 if $podTypeHash{$type}; 302 return 1 if $podTypesWithWritablePropertiesHash{$type}; 303 return 0; 304} 305 306sub IsPodTypeWithWriteableProperties 307{ 308 my $object = shift; 309 my $type = shift; 310 311 return 1 if $podTypesWithWritablePropertiesHash{$type}; 312 return 0; 313} 314 315sub IsPrimitiveType 316{ 317 my $object = shift; 318 my $type = shift; 319 320 return 1 if $primitiveTypeHash{$type}; 321 return 0; 322} 323 324sub IsStringType 325{ 326 my $object = shift; 327 my $type = shift; 328 329 return 1 if $stringTypeHash{$type}; 330 return 0; 331} 332 333sub IsNonPointerType 334{ 335 my $object = shift; 336 my $type = shift; 337 338 return 1 if $nonPointerTypeHash{$type} or $primitiveTypeHash{$type}; 339 return 0; 340} 341 342sub IsSVGAnimatedType 343{ 344 my $object = shift; 345 my $type = shift; 346 347 return 1 if $svgAnimatedTypeHash{$type}; 348 return 0; 349} 350 351# Internal Helper 352sub ScanDirectory 353{ 354 my $object = shift; 355 356 my $interface = shift; 357 my $directory = shift; 358 my $useDirectory = shift; 359 my $reportAllFiles = shift; 360 361 return if ($endCondition eq 1) and ($reportAllFiles eq 0); 362 363 my $sourceRoot = $ENV{SOURCE_ROOT}; 364 my $thisDir = $sourceRoot ? "$sourceRoot/$directory" : $directory; 365 366 if (!opendir(DIR, $thisDir)) { 367 opendir(DIR, $directory) or die "[ERROR] Can't open directory $thisDir or $directory: \"$!\"\n"; 368 $thisDir = $directory; 369 } 370 371 my @names = readdir(DIR) or die "[ERROR] Cant't read directory $thisDir \"$!\"\n"; 372 closedir(DIR); 373 374 foreach my $name (@names) { 375 # Skip if we already found the right file or 376 # if we encounter 'exotic' stuff (ie. '.', '..', '.svn') 377 next if ($endCondition eq 1) or ($name =~ /^\./); 378 379 # Recurisvely enter directory 380 if (-d "$thisDir/$name") { 381 $object->ScanDirectory($interface, "$directory/$name", $useDirectory, $reportAllFiles); 382 next; 383 } 384 385 # Check wheter we found the desired file 386 my $condition = ($name eq $interface); 387 $condition = 1 if ($interface eq "allidls") and ($name =~ /\.idl$/); 388 389 if ($condition) { 390 $foundFilename = "$thisDir/$name"; 391 392 if ($reportAllFiles eq 0) { 393 $endCondition = 1; 394 } else { 395 push(@foundFilenames, $foundFilename); 396 } 397 } 398 } 399} 400 401# Uppercase the first letter while respecting WebKit style guidelines. 402# E.g., xmlEncoding becomes XMLEncoding, but xmlllang becomes Xmllang. 403sub WK_ucfirst 404{ 405 my ($object, $param) = @_; 406 my $ret = ucfirst($param); 407 $ret =~ s/Xml/XML/ if $ret =~ /^Xml[^a-z]/; 408 return $ret; 409} 410 411# Lowercase the first letter while respecting WebKit style guidelines. 412# URL becomes url, but SetURL becomes setURL. 413sub WK_lcfirst 414{ 415 my ($object, $param) = @_; 416 my $ret = lcfirst($param); 417 $ret =~ s/uRL/url/ if $ret =~ /^uRL/; 418 $ret =~ s/jS/js/ if $ret =~ /^jS/; 419 $ret =~ s/xML/xml/ if $ret =~ /^xML/; 420 $ret =~ s/xSLT/xslt/ if $ret =~ /^xSLT/; 421 return $ret; 422} 423 4241; 425