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