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