| OLD | NEW |
| (Empty) |
| 1 # | |
| 2 # KDOM IDL parser | |
| 3 # | |
| 4 # Copyright (C) 2005 Nikolas Zimmermann <wildfox@kde.org> | |
| 5 # | |
| 6 # This file is part of the KDE project | |
| 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., 59 Temple Place - Suite 330, | |
| 21 # Boston, MA 02111-1307, USA. | |
| 22 # | |
| 23 | |
| 24 package IDLParser; | |
| 25 | |
| 26 use IDLStructure; | |
| 27 | |
| 28 use constant MODE_UNDEF => 0; # Default mode. | |
| 29 | |
| 30 use constant MODE_MODULE => 10; # 'module' section | |
| 31 use constant MODE_INTERFACE => 11; # 'interface' section | |
| 32 use constant MODE_EXCEPTION => 12; # 'exception' section | |
| 33 use constant MODE_ALIAS => 13; # 'alias' section | |
| 34 | |
| 35 # Helper variables | |
| 36 my @temporaryContent = ""; | |
| 37 | |
| 38 my $parseMode = MODE_UNDEF; | |
| 39 my $preservedParseMode = MODE_UNDEF; | |
| 40 | |
| 41 my $beQuiet; # Should not display anything on STDOUT? | |
| 42 my $document = 0; # Will hold the resulting 'idlDocument' | |
| 43 | |
| 44 my $directive = ""; | |
| 45 | |
| 46 # Default Constructor | |
| 47 sub new | |
| 48 { | |
| 49 my $object = shift; | |
| 50 my $reference = { }; | |
| 51 | |
| 52 $document = 0; | |
| 53 $beQuiet = shift; | |
| 54 | |
| 55 bless($reference, $object); | |
| 56 return $reference; | |
| 57 } | |
| 58 | |
| 59 | |
| 60 sub ParseInheritance | |
| 61 { | |
| 62 my $object = shift; | |
| 63 my $fileName = shift; | |
| 64 my $defines = shift; | |
| 65 my $preprocessor = shift; | |
| 66 | |
| 67 $directive = "inheritance"; | |
| 68 return $object->ParseImpl($fileName, $defines, $preprocessor); | |
| 69 } | |
| 70 | |
| 71 # Returns the parsed 'idlDocument' | |
| 72 sub Parse | |
| 73 { | |
| 74 my $object = shift; | |
| 75 my $fileName = shift; | |
| 76 my $defines = shift; | |
| 77 my $preprocessor = shift; | |
| 78 | |
| 79 $directive = ""; | |
| 80 return $object->ParseImpl($fileName, $defines, $preprocessor); | |
| 81 } | |
| 82 | |
| 83 sub ParseImpl | |
| 84 { | |
| 85 my $object = shift; | |
| 86 my $fileName = shift; | |
| 87 my $defines = shift; | |
| 88 my $preprocessor = shift; | |
| 89 | |
| 90 if (!$preprocessor) { | |
| 91 $preprocessor = "/usr/bin/gcc -E -P -x c++"; | |
| 92 } | |
| 93 | |
| 94 if (!$defines) { | |
| 95 $defines = ""; | |
| 96 } | |
| 97 | |
| 98 print " | *** Starting to parse $fileName...\n |\n" unless $beQuiet; | |
| 99 | |
| 100 open FILE, $preprocessor . " " . join(" ", (map { "-D$_" } split(/ /, $defin
es))) . " ". $fileName . "|" or die "Could not open $fileName"; | |
| 101 my @documentContent = <FILE>; | |
| 102 close FILE; | |
| 103 | |
| 104 my $dataAvailable = 0; | |
| 105 | |
| 106 # Simple IDL Parser (tm) | |
| 107 foreach (@documentContent) { | |
| 108 my $newParseMode = $object->DetermineParseMode($_); | |
| 109 | |
| 110 if ($newParseMode ne MODE_UNDEF) { | |
| 111 if ($dataAvailable eq 0) { | |
| 112 $dataAvailable = 1; # Start node building... | |
| 113 } else { | |
| 114 $object->ProcessSection(); | |
| 115 } | |
| 116 } | |
| 117 | |
| 118 # Update detected data stream mode... | |
| 119 if ($newParseMode ne MODE_UNDEF) { | |
| 120 $parseMode = $newParseMode; | |
| 121 } | |
| 122 | |
| 123 push(@temporaryContent, $_); | |
| 124 } | |
| 125 | |
| 126 # Check if there is anything remaining to parse... | |
| 127 if (($parseMode ne MODE_UNDEF) and ($#temporaryContent > 0)) { | |
| 128 $object->ProcessSection(); | |
| 129 } | |
| 130 | |
| 131 print " | *** Finished parsing!\n" unless $beQuiet; | |
| 132 | |
| 133 $document->fileName($fileName); | |
| 134 | |
| 135 return $document; | |
| 136 } | |
| 137 | |
| 138 sub ParseModule | |
| 139 { | |
| 140 my $object = shift; | |
| 141 my $dataNode = shift; | |
| 142 | |
| 143 print " |- Trying to parse module...\n" unless $beQuiet; | |
| 144 | |
| 145 my $data = join("", @temporaryContent); | |
| 146 $data =~ /$IDLStructure::moduleSelector/; | |
| 147 | |
| 148 my $moduleName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"
)); | |
| 149 $dataNode->module($moduleName); | |
| 150 | |
| 151 print " |----> Module; NAME \"$moduleName\"\n |-\n |\n" unless $beQuiet; | |
| 152 } | |
| 153 | |
| 154 sub dumpExtendedAttributes | |
| 155 { | |
| 156 my $padStr = shift; | |
| 157 my $attrs = shift; | |
| 158 | |
| 159 if (!%{$attrs}) { | |
| 160 return ""; | |
| 161 } | |
| 162 | |
| 163 my @temp; | |
| 164 while (($name, $value) = each(%{$attrs})) { | |
| 165 push(@temp, "$name=$value"); | |
| 166 } | |
| 167 | |
| 168 return $padStr . "[" . join(", ", @temp) . "]"; | |
| 169 } | |
| 170 | |
| 171 sub parseExtendedAttributes | |
| 172 { | |
| 173 my $str = shift; | |
| 174 $str =~ s/\[\s*(.*)\]/$1/g; | |
| 175 | |
| 176 my %attrs = (); | |
| 177 | |
| 178 foreach my $value (split(/\s*,\s*/, $str)) { | |
| 179 ($name,$value) = split(/\s*=\s*/, $value, 2); | |
| 180 | |
| 181 # Attributes with no value are set to be true | |
| 182 $value = 1 unless defined $value; | |
| 183 $attrs{$name} = $value; | |
| 184 } | |
| 185 | |
| 186 return \%attrs; | |
| 187 } | |
| 188 | |
| 189 sub ParseInterface | |
| 190 { | |
| 191 my $object = shift; | |
| 192 my $dataNode = shift; | |
| 193 my $sectionName = shift; | |
| 194 | |
| 195 my $data = join("", @temporaryContent); | |
| 196 | |
| 197 # Look for end-of-interface mark | |
| 198 $data =~ /};/g; | |
| 199 $data = substr($data, index($data, $sectionName), pos($data) - length($data)
); | |
| 200 | |
| 201 $data =~ s/[\n\r]/ /g; | |
| 202 | |
| 203 # Beginning of the regexp parsing magic | |
| 204 if ($sectionName eq "exception") { | |
| 205 print " |- Trying to parse exception...\n" unless $beQuiet; | |
| 206 | |
| 207 my $exceptionName = ""; | |
| 208 my $exceptionData = ""; | |
| 209 my $exceptionDataName = ""; | |
| 210 my $exceptionDataType = ""; | |
| 211 | |
| 212 # Match identifier of the exception, and enclosed data... | |
| 213 $data =~ /$IDLStructure::exceptionSelector/; | |
| 214 $exceptionName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data
\n)")); | |
| 215 $exceptionData = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data
\n)")); | |
| 216 | |
| 217 ('' =~ /^/); # Reset variables needed for regexp matching | |
| 218 | |
| 219 # ... parse enclosed data (get. name & type) | |
| 220 $exceptionData =~ /$IDLStructure::exceptionSubSelector/; | |
| 221 $exceptionDataType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$
data\n)")); | |
| 222 $exceptionDataName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$
data\n)")); | |
| 223 | |
| 224 # Fill in domClass datastructure | |
| 225 $dataNode->name($exceptionName); | |
| 226 | |
| 227 my $newDataNode = new domAttribute(); | |
| 228 $newDataNode->type("readonly attribute"); | |
| 229 $newDataNode->signature(new domSignature()); | |
| 230 | |
| 231 $newDataNode->signature->name($exceptionDataName); | |
| 232 $newDataNode->signature->type($exceptionDataType); | |
| 233 | |
| 234 my $arrayRef = $dataNode->attributes; | |
| 235 push(@$arrayRef, $newDataNode); | |
| 236 | |
| 237 print " |----> Exception; NAME \"$exceptionName\" DATA TYPE \"$exceptio
nDataType\" DATA NAME \"$exceptionDataName\"\n |-\n |\n" unless $beQuiet; | |
| 238 } elsif ($sectionName eq "interface") { | |
| 239 print " |- Trying to parse interface...\n" unless $beQuiet; | |
| 240 | |
| 241 my $interfaceName = ""; | |
| 242 my $interfaceData = ""; | |
| 243 | |
| 244 # Match identifier of the interface, and enclosed data... | |
| 245 $data =~ /$IDLStructure::interfaceSelector/; | |
| 246 | |
| 247 $interfaceExtendedAttributes = (defined($1) ? $1 : " "); chop($interface
ExtendedAttributes); | |
| 248 $interfaceName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data
\n)")); | |
| 249 $interfaceBase = (defined($3) ? $3 : ""); | |
| 250 $interfaceData = (defined($4) ? $4 : die("Parsing error!\nSource:\n$data
\n)")); | |
| 251 | |
| 252 # Fill in known parts of the domClass datastructure now... | |
| 253 $dataNode->name($interfaceName); | |
| 254 $dataNode->extendedAttributes(parseExtendedAttributes($interfaceExtended
Attributes)); | |
| 255 | |
| 256 # Inheritance detection | |
| 257 my @interfaceParents = split(/,/, $interfaceBase); | |
| 258 foreach(@interfaceParents) { | |
| 259 my $line = $_; | |
| 260 $line =~ s/\s*//g; | |
| 261 | |
| 262 my $arrayRef = $dataNode->parents; | |
| 263 push(@$arrayRef, $line); | |
| 264 } | |
| 265 | |
| 266 return if ($directive eq "inheritance"); | |
| 267 | |
| 268 $interfaceData =~ s/[\n\r]/ /g; | |
| 269 my @interfaceMethods = split(/;/, $interfaceData); | |
| 270 | |
| 271 foreach my $line (@interfaceMethods) { | |
| 272 if ($line =~ /[ \t]attribute[ \t]/) { | |
| 273 $line =~ /$IDLStructure::interfaceAttributeSelector/; | |
| 274 | |
| 275 my $attributeType = (defined($1) ? $1 : die("Parsing error!\nSou
rce:\n$line\n)")); | |
| 276 my $attributeExtendedAttributes = (defined($2) ? $2 : " "); chop
($attributeExtendedAttributes); | |
| 277 | |
| 278 my $attributeDataType = (defined($3) ? $3 : die("Parsing error!\
nSource:\n$line\n)")); | |
| 279 my $attributeDataName = (defined($4) ? $4 : die("Parsing error!\
nSource:\n$line\n)")); | |
| 280 | |
| 281 ('' =~ /^/); # Reset variables needed for regexp matching | |
| 282 | |
| 283 $line =~ /$IDLStructure::getterRaisesSelector/; | |
| 284 my $getterException = (defined($1) ? $1 : ""); | |
| 285 | |
| 286 $line =~ /$IDLStructure::setterRaisesSelector/; | |
| 287 my $setterException = (defined($1) ? $1 : ""); | |
| 288 | |
| 289 my $newDataNode = new domAttribute(); | |
| 290 $newDataNode->type($attributeType); | |
| 291 $newDataNode->signature(new domSignature()); | |
| 292 | |
| 293 $newDataNode->signature->name($attributeDataName); | |
| 294 $newDataNode->signature->type($attributeDataType); | |
| 295 $newDataNode->signature->extendedAttributes(parseExtendedAttribu
tes($attributeExtendedAttributes)); | |
| 296 | |
| 297 my $arrayRef = $dataNode->attributes; | |
| 298 push(@$arrayRef, $newDataNode); | |
| 299 | |
| 300 print " | |> Attribute; TYPE \"$attributeType\" DATA NAME \"$
attributeDataName\" DATA TYPE \"$attributeDataType\" GET EXCEPTION? \"$getterExc
eption\" SET EXCEPTION? \"$setterException\"" . | |
| 301 dumpExtendedAttributes("\n | ", $newDataNod
e->signature->extendedAttributes) . "\n" unless $beQuiet; | |
| 302 | |
| 303 $getterException =~ s/\s+//g; | |
| 304 $setterException =~ s/\s+//g; | |
| 305 @{$newDataNode->getterExceptions} = split(/,/, $getterException)
; | |
| 306 @{$newDataNode->setterExceptions} = split(/,/, $setterException)
; | |
| 307 } elsif (($line !~ s/^\s*$//g) and ($line !~ /^\s*const/)) { | |
| 308 $line =~ /$IDLStructure::interfaceMethodSelector/ or die "Parsin
g error!\nSource:\n$line\n)"; | |
| 309 | |
| 310 my $methodExtendedAttributes = (defined($1) ? $1 : " "); chop($m
ethodExtendedAttributes); | |
| 311 my $methodType = (defined($2) ? $2 : die("Parsing error!\nSource
:\n$line\n)")); | |
| 312 my $methodName = (defined($3) ? $3 : die("Parsing error!\nSource
:\n$line\n)")); | |
| 313 my $methodSignature = (defined($4) ? $4 : die("Parsing error!\nS
ource:\n$line\n)")); | |
| 314 | |
| 315 ('' =~ /^/); # Reset variables needed for regexp matching | |
| 316 | |
| 317 $line =~ /$IDLStructure::raisesSelector/; | |
| 318 my $methodException = (defined($1) ? $1 : ""); | |
| 319 | |
| 320 my $newDataNode = new domFunction(); | |
| 321 | |
| 322 $newDataNode->signature(new domSignature()); | |
| 323 $newDataNode->signature->name($methodName); | |
| 324 $newDataNode->signature->type($methodType); | |
| 325 $newDataNode->signature->extendedAttributes(parseExtendedAttribu
tes($methodExtendedAttributes)); | |
| 326 | |
| 327 print " | |- Method; TYPE \"$methodType\" NAME \"$methodName\
" EXCEPTION? \"$methodException\"" . | |
| 328 dumpExtendedAttributes("\n | ", $newDataNode->
signature->extendedAttributes) . "\n" unless $beQuiet; | |
| 329 | |
| 330 $methodException =~ s/\s+//g; | |
| 331 @{$newDataNode->raisesExceptions} = split(/,/, $methodException)
; | |
| 332 | |
| 333 my @params = split(/,/, $methodSignature); | |
| 334 foreach(@params) { | |
| 335 my $line = $_; | |
| 336 | |
| 337 $line =~ /$IDLStructure::interfaceParameterSelector/; | |
| 338 my $paramExtendedAttributes = (defined($1) ? $1 : " "); chop
($paramExtendedAttributes); | |
| 339 my $paramType = (defined($2) ? $2 : die("Parsing error!\nSou
rce:\n$line\n)")); | |
| 340 my $paramName = (defined($3) ? $3 : die("Parsing error!\nSou
rce:\n$line\n)")); | |
| 341 | |
| 342 my $paramDataNode = new domSignature(); | |
| 343 $paramDataNode->name($paramName); | |
| 344 $paramDataNode->type($paramType); | |
| 345 $paramDataNode->extendedAttributes(parseExtendedAttributes($
paramExtendedAttributes)); | |
| 346 | |
| 347 my $arrayRef = $newDataNode->parameters; | |
| 348 push(@$arrayRef, $paramDataNode); | |
| 349 | |
| 350 print " | |> Param; TYPE \"$paramType\" NAME \"$paramNam
e\"" . | |
| 351 dumpExtendedAttributes("\n | ", $paramData
Node->extendedAttributes) . "\n" unless $beQuiet; | |
| 352 } | |
| 353 | |
| 354 my $arrayRef = $dataNode->functions; | |
| 355 push(@$arrayRef, $newDataNode); | |
| 356 } elsif ($line =~ /^\s*const/) { | |
| 357 $line =~ /$IDLStructure::constantSelector/; | |
| 358 my $constType = (defined($1) ? $1 : die("Parsing error!\nSource:
\n$line\n)")); | |
| 359 my $constName = (defined($2) ? $2 : die("Parsing error!\nSource:
\n$line\n)")); | |
| 360 my $constValue = (defined($3) ? $3 : die("Parsing error!\nSource
:\n$line\n)")); | |
| 361 | |
| 362 my $newDataNode = new domConstant(); | |
| 363 $newDataNode->name($constName); | |
| 364 $newDataNode->type($constType); | |
| 365 $newDataNode->value($constValue); | |
| 366 | |
| 367 my $arrayRef = $dataNode->constants; | |
| 368 push(@$arrayRef, $newDataNode); | |
| 369 | |
| 370 print " | |> Constant; TYPE \"$constType\" NAME \"$constName
\" VALUE \"$constValue\"\n" unless $beQuiet; | |
| 371 } | |
| 372 } | |
| 373 | |
| 374 print " |----> Interface; NAME \"$interfaceName\"" . | |
| 375 dumpExtendedAttributes("\n | ", $dataNode->extended
Attributes) . "\n |-\n |\n" unless $beQuiet; | |
| 376 } | |
| 377 } | |
| 378 | |
| 379 # Internal helper | |
| 380 sub DetermineParseMode | |
| 381 { | |
| 382 my $object = shift; | |
| 383 my $line = shift; | |
| 384 | |
| 385 my $mode = MODE_UNDEF; | |
| 386 if ($_ =~ /module/) { | |
| 387 $mode = MODE_MODULE; | |
| 388 } elsif ($_ =~ /interface/) { | |
| 389 $mode = MODE_INTERFACE; | |
| 390 } elsif ($_ =~ /exception/) { | |
| 391 $mode = MODE_EXCEPTION; | |
| 392 } elsif ($_ =~ /alias/) { | |
| 393 $mode = MODE_ALIAS; | |
| 394 } | |
| 395 | |
| 396 return $mode; | |
| 397 } | |
| 398 | |
| 399 # Internal helper | |
| 400 sub ProcessSection | |
| 401 { | |
| 402 my $object = shift; | |
| 403 | |
| 404 if ($parseMode eq MODE_MODULE) { | |
| 405 die ("Two modules in one file! Fatal error!\n") if ($document ne 0); | |
| 406 $document = new idlDocument(); | |
| 407 $object->ParseModule($document); | |
| 408 } elsif ($parseMode eq MODE_INTERFACE) { | |
| 409 my $node = new domClass(); | |
| 410 $object->ParseInterface($node, "interface"); | |
| 411 | |
| 412 die ("No module specified! Fatal Error!\n") if ($document eq 0); | |
| 413 my $arrayRef = $document->classes; | |
| 414 push(@$arrayRef, $node); | |
| 415 } elsif($parseMode eq MODE_EXCEPTION) { | |
| 416 my $node = new domClass(); | |
| 417 $object->ParseInterface($node, "exception"); | |
| 418 | |
| 419 die ("No module specified! Fatal Error!\n") if ($document eq 0); | |
| 420 my $arrayRef = $document->classes; | |
| 421 push(@$arrayRef, $node); | |
| 422 } elsif($parseMode eq MODE_ALIAS) { | |
| 423 print " |- Trying to parse alias...\n" unless $beQuiet; | |
| 424 | |
| 425 my $line = join("", @temporaryContent); | |
| 426 $line =~ /$IDLStructure::aliasSelector/; | |
| 427 | |
| 428 my $interfaceName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$l
ine\n)")); | |
| 429 my $wrapperName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$lin
e\n)")); | |
| 430 | |
| 431 print " |----> Alias; INTERFACE \"$interfaceName\" WRAPPER \"$wrapperNa
me\"\n |-\n |\n" unless $beQuiet; | |
| 432 | |
| 433 # FIXME: Check if alias is already in aliases | |
| 434 my $aliases = $document->aliases; | |
| 435 $aliases->{$interfaceName} = $wrapperName; | |
| 436 } | |
| 437 | |
| 438 @temporaryContent = ""; | |
| 439 } | |
| 440 | |
| 441 1; | |
| OLD | NEW |