khtml/bindings/scripts/CodeGenerator.pm

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