| OLD | NEW |
| (Empty) |
| 1 # | |
| 2 # KDOM IDL parser | |
| 3 # | |
| 4 # Copyright (C) 2005 Nikolas Zimmermann <wildfox@kde.org> | |
| 5 # Copyright (C) 2006 Samuel Weinig <sam.weinig@gmail.com> | |
| 6 # | |
| 7 # This file is part of the KDE project | |
| 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., 59 Temple Place - Suite 330, | |
| 22 # Boston, MA 02111-1307, USA. | |
| 23 # | |
| 24 | |
| 25 package CodeGenerator; | |
| 26 | |
| 27 my $useDocument = ""; | |
| 28 my $useGenerator = ""; | |
| 29 my $useOutputDir = ""; | |
| 30 my $useDirectories = ""; | |
| 31 my $useLayerOnTop = 0; | |
| 32 my $preprocessor; | |
| 33 | |
| 34 my $codeGenerator = 0; | |
| 35 | |
| 36 my $verbose = 0; | |
| 37 | |
| 38 my %primitiveTypeHash = ("int" => 1, "short" => 1, "long" => 1, "long long" => 1
, | |
| 39 "unsigned int" => 1, "unsigned short" => 1, | |
| 40 "unsigned long" => 1, "float" => 1, | |
| 41 "unsigned long long" => 1, | |
| 42 "double" => 1, "boolean" => 1, "void" => 1); | |
| 43 | |
| 44 my %podTypeHash = ("SVGNumber" => 1, "SVGTransform" => 1); | |
| 45 my %podTypeWithWriteablePropertiesHash = ("SVGLength" => 1, "SVGMatrix" => 1, "S
VGPoint" => 1, "SVGRect" => 1); | |
| 46 my %stringTypeHash = ("DOMString" => 1, "AtomicString" => 1); | |
| 47 | |
| 48 my %nonPointerTypeHash = ("DOMTimeStamp" => 1, "CompareHow" => 1, "SVGPaintType"
=> 1); | |
| 49 | |
| 50 my %svgAnimatedTypeHash = ("SVGAnimatedAngle" => 1, "SVGAnimatedBoolean" => 1, | |
| 51 "SVGAnimatedEnumeration" => 1, "SVGAnimatedInteger" =
> 1, | |
| 52 "SVGAnimatedLength" => 1, "SVGAnimatedLengthList" =>
1, | |
| 53 "SVGAnimatedNumber" => 1, "SVGAnimatedNumberList" =>
1, | |
| 54 "SVGAnimatedPreserveAspectRatio" => 1, | |
| 55 "SVGAnimatedRect" => 1, "SVGAnimatedString" => 1, | |
| 56 "SVGAnimatedTransformList" => 1); | |
| 57 | |
| 58 # Helpers for 'ScanDirectory' | |
| 59 my $endCondition = 0; | |
| 60 my $foundFilename = ""; | |
| 61 my @foundFilenames = (); | |
| 62 my $ignoreParent = 1; | |
| 63 my $defines = ""; | |
| 64 | |
| 65 # Default constructor | |
| 66 sub new | |
| 67 { | |
| 68 my $object = shift; | |
| 69 my $reference = { }; | |
| 70 | |
| 71 $useDirectories = shift; | |
| 72 $useGenerator = shift; | |
| 73 $useOutputDir = shift; | |
| 74 $useLayerOnTop = shift; | |
| 75 $preprocessor = shift; | |
| 76 | |
| 77 bless($reference, $object); | |
| 78 return $reference; | |
| 79 } | |
| 80 | |
| 81 sub StripModule($) | |
| 82 { | |
| 83 my $object = shift; | |
| 84 my $name = shift; | |
| 85 $name =~ s/[a-zA-Z0-9]*:://; | |
| 86 return $name; | |
| 87 } | |
| 88 | |
| 89 sub ProcessDocument | |
| 90 { | |
| 91 my $object = shift; | |
| 92 $useDocument = shift; | |
| 93 $defines = shift; | |
| 94 | |
| 95 my $ifaceName = "CodeGenerator" . $useGenerator; | |
| 96 | |
| 97 # Dynamically load external code generation perl module | |
| 98 require $ifaceName . ".pm"; | |
| 99 $codeGenerator = $ifaceName->new($object, $useOutputDir, $useLayerOnTop, $pr
eprocessor); | |
| 100 unless (defined($codeGenerator)) { | |
| 101 my $classes = $useDocument->classes; | |
| 102 foreach my $class (@$classes) { | |
| 103 print "Skipping $useGenerator code generation for IDL interface \""
. $class->name . "\".\n" if $verbose; | |
| 104 } | |
| 105 return; | |
| 106 } | |
| 107 | |
| 108 # Start the actual code generation! | |
| 109 $codeGenerator->GenerateModule($useDocument, $defines); | |
| 110 | |
| 111 my $classes = $useDocument->classes; | |
| 112 foreach my $class (@$classes) { | |
| 113 print "Generating $useGenerator bindings code for IDL interface \"" . $c
lass->name . "\"...\n" if $verbose; | |
| 114 $codeGenerator->GenerateInterface($class, $defines); | |
| 115 $codeGenerator->finish(); | |
| 116 } | |
| 117 } | |
| 118 | |
| 119 | |
| 120 sub FindParentsRecursively | |
| 121 { | |
| 122 my $object = shift; | |
| 123 my $dataNode = shift; | |
| 124 my @parents = ($dataNode->name); | |
| 125 foreach (@{$dataNode->parents}) { | |
| 126 my $interface = $object->StripModule($_); | |
| 127 | |
| 128 $endCondition = 0; | |
| 129 $foundFilename = ""; | |
| 130 foreach (@{$useDirectories}) { | |
| 131 $object->ScanDirectory("$interface.idl", $_, $_, 0) if ($foundFilename eq
""); | |
| 132 } | |
| 133 | |
| 134 if ($foundFilename ne "") { | |
| 135 print " | |> Parsing parent IDL \"$foundFilename\" for interface \"$int
erface\"\n" if $verbose; | |
| 136 | |
| 137 # Step #2: Parse the found IDL file (in quiet mode). | |
| 138 my $parser = IDLParser->new(1); | |
| 139 my $document = $parser->ParseInheritance($foundFilename, $defines, $prepro
cessor); | |
| 140 | |
| 141 foreach my $class (@{$document->classes}) { | |
| 142 @parents = (@parents, FindParentsRecursively($object, $class)); | |
| 143 } | |
| 144 } else { | |
| 145 die("Could NOT find specified parent interface \"$interface\"!\n") | |
| 146 } | |
| 147 } | |
| 148 return @parents; | |
| 149 } | |
| 150 | |
| 151 | |
| 152 sub AddMethodsConstantsAndAttributesFromParentClasses | |
| 153 { | |
| 154 # For the passed interface, recursively parse all parent | |
| 155 # IDLs in order to find out all inherited properties/methods. | |
| 156 | |
| 157 my $object = shift; | |
| 158 my $dataNode = shift; | |
| 159 | |
| 160 my @parents = @{$dataNode->parents}; | |
| 161 my $parentsMax = @{$dataNode->parents}; | |
| 162 | |
| 163 my $constantsRef = $dataNode->constants; | |
| 164 my $functionsRef = $dataNode->functions; | |
| 165 my $attributesRef = $dataNode->attributes; | |
| 166 | |
| 167 # Exception: For the DOM 'Node' is our topmost baseclass, not EventTargetNod
e. | |
| 168 foreach (@{$dataNode->parents}) { | |
| 169 my $interface = $object->StripModule($_); | |
| 170 | |
| 171 # Don't ignore the first class EventTarget | |
| 172 if ($interface ne "EventTarget" && $ignoreParent) { | |
| 173 # Ignore first parent class, already handled by the generation itsel
f. | |
| 174 $ignoreParent = 0; | |
| 175 next; | |
| 176 } | |
| 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 ($foundFilena
me 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, $preprocesso
r); | |
| 192 | |
| 193 foreach my $class (@{$document->classes}) { | |
| 194 # Step #3: Enter recursive parent search | |
| 195 AddMethodsConstantsAndAttributesFromParentClasses($object, $clas
s); | |
| 196 | |
| 197 # Step #4: Collect constants & functions & attributes of this pa
rent-class | |
| 198 my $constantsMax = @{$class->constants}; | |
| 199 my $functionsMax = @{$class->functions}; | |
| 200 my $attributesMax = @{$class->attributes}; | |
| 201 | |
| 202 print " | |> -> Inheriting $constantsMax constants, $function
sMax 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 | |
| 215 # Append an attribute to an array if its name does not exist in the array. | |
| 216 sub AppendAttribute | |
| 217 { | |
| 218 my $attributes = shift; | |
| 219 my $newAttr = shift; | |
| 220 foreach (@$attributes) { | |
| 221 if ($_->signature->name eq $newAttr->signature->name) { | |
| 222 print " | |> -> $newAttr->signature->name is overridden.\n | |>
\n" if $verbose; | |
| 223 return; | |
| 224 } | |
| 225 } | |
| 226 push(@$attributes, $newAttr); | |
| 227 } | |
| 228 | |
| 229 # Helpers for all CodeGenerator***.pm modules | |
| 230 sub IsPodType | |
| 231 { | |
| 232 my $object = shift; | |
| 233 my $type = shift; | |
| 234 | |
| 235 return 1 if $podTypeHash{$type}; | |
| 236 return 1 if $podTypeWithWriteablePropertiesHash{$type}; | |
| 237 return 0; | |
| 238 } | |
| 239 | |
| 240 sub IsPodTypeWithWriteableProperties | |
| 241 { | |
| 242 my $object = shift; | |
| 243 my $type = shift; | |
| 244 | |
| 245 return 1 if $podTypeWithWriteablePropertiesHash{$type}; | |
| 246 return 0; | |
| 247 } | |
| 248 | |
| 249 sub IsPrimitiveType | |
| 250 { | |
| 251 my $object = shift; | |
| 252 my $type = shift; | |
| 253 | |
| 254 return 1 if $primitiveTypeHash{$type}; | |
| 255 return 0; | |
| 256 } | |
| 257 | |
| 258 sub IsStringType | |
| 259 { | |
| 260 my $object = shift; | |
| 261 my $type = shift; | |
| 262 | |
| 263 return 1 if $stringTypeHash{$type}; | |
| 264 return 0; | |
| 265 } | |
| 266 | |
| 267 sub IsNonPointerType | |
| 268 { | |
| 269 my $object = shift; | |
| 270 my $type = shift; | |
| 271 | |
| 272 return 1 if $nonPointerTypeHash{$type} or $primitiveTypeHash{$type}; | |
| 273 return 0; | |
| 274 } | |
| 275 | |
| 276 sub IsSVGAnimatedType | |
| 277 { | |
| 278 my $object = shift; | |
| 279 my $type = shift; | |
| 280 | |
| 281 return 1 if $svgAnimatedTypeHash{$type}; | |
| 282 return 0; | |
| 283 } | |
| 284 | |
| 285 # Internal Helper | |
| 286 sub ScanDirectory | |
| 287 { | |
| 288 my $object = shift; | |
| 289 | |
| 290 my $interface = shift; | |
| 291 my $directory = shift; | |
| 292 my $useDirectory = shift; | |
| 293 my $reportAllFiles = shift; | |
| 294 | |
| 295 print "Scanning interface " . $interface . " in " . $directory . "\n" if $ve
rbose; | |
| 296 | |
| 297 return if ($endCondition eq 1) and ($reportAllFiles eq 0); | |
| 298 | |
| 299 my $sourceRoot = $ENV{SOURCE_ROOT}; | |
| 300 my $thisDir = $sourceRoot ? "$sourceRoot/$directory" : $directory; | |
| 301 | |
| 302 opendir(DIR, $thisDir) or die "[ERROR] Can't open directory $thisDir: \"$!\"
\n"; | |
| 303 | |
| 304 my @names = readdir(DIR) or die "[ERROR] Cant't read directory $thisDir \"$!
\"\n"; | |
| 305 closedir(DIR); | |
| 306 | |
| 307 foreach my $name (@names) { | |
| 308 # Skip if we already found the right file or | |
| 309 # if we encounter 'exotic' stuff (ie. '.', '..', '.svn') | |
| 310 next if ($endCondition eq 1) or ($name =~ /^\./); | |
| 311 | |
| 312 # Recurisvely enter directory | |
| 313 if (-d "$thisDir/$name") { | |
| 314 $object->ScanDirectory($interface, "$directory/$name", $useDirectory
, $reportAllFiles); | |
| 315 next; | |
| 316 } | |
| 317 | |
| 318 # Check wheter we found the desired file | |
| 319 my $condition = ($name eq $interface); | |
| 320 $condition = 1 if ($interface eq "allidls") and ($name =~ /\.idl$/); | |
| 321 | |
| 322 if ($condition) { | |
| 323 $foundFilename = "$thisDir/$name"; | |
| 324 | |
| 325 if ($reportAllFiles eq 0) { | |
| 326 $endCondition = 1; | |
| 327 } else { | |
| 328 push(@foundFilenames, $foundFilename); | |
| 329 } | |
| 330 } | |
| 331 } | |
| 332 } | |
| 333 | |
| 334 1; | |
| OLD | NEW |