khtml/bindings/scripts/IDLParser.pm

   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., 51 Franklin Street, Fifth Floor,
  21 # Boston, MA 02110-1301, USA.
  22 #
  23
  24 package IDLParser;
  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
  45 # Default Constructor
  46 sub new
  47 {
  48     my $object = shift;
  49     my $reference = { };
  50
  51     $document = 0;
  52     $beQuiet = shift;
  53
  54     bless($reference, $object);
  55     return $reference;
  56 }
  57
  58 # Returns the parsed 'idlDocument'
  59 sub Parse
  60 {
  61     my $object = shift;
  62     my $fileName = shift;
  63     my $defines = shift;
  64     my $preprocessor = 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     }
 162
 163     return \%attrs;
 164 }
 165
 166 sub ParseInterface
 167 {
 168     my $object = shift;
 169     my $dataNode = shift;
 170     my $sectionName = shift;
 171
 172     my $data = join("", @temporaryContent);
 173
 174     # Look for end-of-interface mark
 175     $data =~ /};/g;
 176     $data = substr($data, index($data, $sectionName), pos($data) - length($data));
 177
 178     $data =~ s/[\n\r]/ /g;
 179
 180     # Beginning of the regexp parsing magic
 181     if ($sectionName eq "exception") {
 182         print " |- Trying to parse exception...\n" unless $beQuiet;
 183
 184         my $exceptionName = "";
 185         my $exceptionData = "";
 186         my $exceptionDataName = "";
 187         my $exceptionDataType = "";
 188
 189         # Match identifier of the exception, and enclosed data...
 190         $data =~ /$IDLStructure::exceptionSelector/;
 191         $exceptionName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
 192         $exceptionData = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
 193
 194         ('' =~ /^/); # Reset variables needed for regexp matching
 195
 196         # ... parse enclosed data (get. name & type)
 197         $exceptionData =~ /$IDLStructure::exceptionSubSelector/;
 198         $exceptionDataType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
 199         $exceptionDataName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
 200
 201         # Fill in domClass datastructure
 202         $dataNode->name($exceptionName);
 203
 204         my $newDataNode = new domAttribute();
 205         $newDataNode->type("readonly attribute");
 206         $newDataNode->signature(new domSignature());
 207
 208         $newDataNode->signature->name($exceptionDataName);
 209         $newDataNode->signature->type($exceptionDataType);
 210
 211         my $arrayRef = $dataNode->attributes;
 212         push(@$arrayRef, $newDataNode);
 213
 214         print "  |----> Exception; NAME \"$exceptionName\" DATA TYPE \"$exceptionDataType\" DATA NAME \"$exceptionDataName\"\n |-\n |\n" unless $beQuiet;
 215     } elsif ($sectionName eq "interface") {
 216         print " |- Trying to parse interface...\n" unless $beQuiet;
 217
 218         my $interfaceName = "";
 219         my $interfaceData = "";
 220
 221         # Match identifier of the interface, and enclosed data...
 222         $data =~ /$IDLStructure::interfaceSelector/;
 223
 224         $interfaceExtendedAttributes = (defined($1) ? $1 : " "); chop($interfaceExtendedAttributes);
 225         $interfaceName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
 226         $interfaceBase = (defined($3) ? $3 : "");
 227         $interfaceData = (defined($4) ? $4 : die("Parsing error!\nSource:\n$data\n)"));
 228
 229         # Fill in known parts of the domClass datastructure now...
 230         $dataNode->name($interfaceName);
 231         $dataNode->extendedAttributes(parseExtendedAttributes($interfaceExtendedAttributes));
 232
 233         # Inheritance detection
 234         my @interfaceParents = split(/,/, $interfaceBase);
 235         foreach(@interfaceParents) {
 236             my $line = $_;
 237             $line =~ s/\s*//g;
 238
 239             my $arrayRef = $dataNode->parents;
 240             push(@$arrayRef, $line);
 241         }
 242
 243         $interfaceData =~ s/[\n\r]/ /g;
 244         my @interfaceMethods = split(/;/, $interfaceData);
 245
 246         foreach my $line (@interfaceMethods) {
 247             if ($line =~ /attribute/) {
 248                 $line =~ /$IDLStructure::interfaceAttributeSelector/;
 249
 250                 my $attributeType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
 251                 my $attributeExtendedAttributes = (defined($2) ? $2 : " "); chop($attributeExtendedAttributes);
 252
 253                 my $attributeDataType = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
 254                 my $attributeDataName = (defined($4) ? $4 : die("Parsing error!\nSource:\n$line\n)"));
 255
 256                 ('' =~ /^/); # Reset variables needed for regexp matching
 257
 258                 $line =~ /$IDLStructure::getterRaisesSelector/;
 259                 my $getterException = (defined($1) ? $1 : "");
 260
 261                 $line =~ /$IDLStructure::setterRaisesSelector/;
 262                 my $setterException = (defined($1) ? $1 : "");
 263
 264                 my $newDataNode = new domAttribute();
 265                 $newDataNode->type($attributeType);
 266                 $newDataNode->signature(new domSignature());
 267
 268                 $newDataNode->signature->name($attributeDataName);
 269                 $newDataNode->signature->type($attributeDataType);
 270                 $newDataNode->signature->extendedAttributes(parseExtendedAttributes($attributeExtendedAttributes));
 271
 272                 my $arrayRef = $dataNode->attributes;
 273                 push(@$arrayRef, $newDataNode);
 274
 275                 print "  |  |>  Attribute; TYPE \"$attributeType\" DATA NAME \"$attributeDataName\" DATA TYPE \"$attributeDataType\" GET EXCEPTION? \"$getterException\" SET EXCEPTION? \"$setterException\"" .
 276                     dumpExtendedAttributes("\n  |                 ", $newDataNode->signature->extendedAttributes) . "\n" unless $beQuiet;
 277
 278                 $getterException =~ s/\s+//g;
 279                 $setterException =~ s/\s+//g;
 280                 @{$newDataNode->getterExceptions} = split(/,/, $getterException);
 281                 @{$newDataNode->setterExceptions} = split(/,/, $setterException);
 282             } elsif (($line !~ s/^\s*$//g) and ($line !~ /^\s*const/)) {
 283                 $line =~ /$IDLStructure::interfaceMethodSelector/ or die "Parsing error!\nSource:\n$line\n)";
 284
 285                 my $methodExtendedAttributes = (defined($1) ? $1 : " "); chop($methodExtendedAttributes);
 286                 my $methodType = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
 287                 my $methodName = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
 288                 my $methodSignature = (defined($4) ? $4 : die("Parsing error!\nSource:\n$line\n)"));
 289
 290                 ('' =~ /^/); # Reset variables needed for regexp matching
 291
 292                 $line =~ /$IDLStructure::raisesSelector/;
 293                 my $methodException = (defined($1) ? $1 : "");
 294
 295                 my $newDataNode = new domFunction();
 296
 297                 $newDataNode->signature(new domSignature());
 298                 $newDataNode->signature->name($methodName);
 299                 $newDataNode->signature->type($methodType);
 300                 $newDataNode->signature->extendedAttributes(parseExtendedAttributes($methodExtendedAttributes));
 301
 302                 print "  |  |-  Method; TYPE \"$methodType\" NAME \"$methodName\" EXCEPTION? \"$methodException\"" .
 303                     dumpExtendedAttributes("\n  |              ", $newDataNode->signature->extendedAttributes) . "\n" unless $beQuiet;
 304
 305                 $methodException =~ s/\s+//g;
 306                 @{$newDataNode->raisesExceptions} = split(/,/, $methodException);
 307
 308                 my @params = split(/,/, $methodSignature);
 309                 foreach(@params) {
 310                     my $line = $_;
 311
 312                     $line =~ /$IDLStructure::interfaceParameterSelector/;
 313                     my $paramExtendedAttributes = (defined($1) ? $1 : " "); chop($paramExtendedAttributes);
 314                     my $paramType = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
 315                     my $paramName = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
 316
 317                     my $paramDataNode = new domSignature();
 318                     $paramDataNode->name($paramName);
 319                     $paramDataNode->type($paramType);
 320                     $paramDataNode->extendedAttributes(parseExtendedAttributes($paramExtendedAttributes));
 321
 322                     my $arrayRef = $newDataNode->parameters;
 323                     push(@$arrayRef, $paramDataNode);
 324
 325                     print "  |   |>  Param; TYPE \"$paramType\" NAME \"$paramName\"" .
 326                         dumpExtendedAttributes("\n  |              ", $paramDataNode->extendedAttributes) . "\n" unless $beQuiet;
 327                 }
 328
 329                 my $arrayRef = $dataNode->functions;
 330                 push(@$arrayRef, $newDataNode);
 331             } elsif ($line =~ /^\s*const/) {
 332                 $line =~ /$IDLStructure::constantSelector/;
 333                 my $constType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
 334                 my $constName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
 335                 my $constValue = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
 336
 337                 my $newDataNode = new domConstant();
 338                 $newDataNode->name($constName);
 339                 $newDataNode->type($constType);
 340                 $newDataNode->value($constValue);
 341
 342                 my $arrayRef = $dataNode->constants;
 343                 push(@$arrayRef, $newDataNode);
 344
 345                 print "  |   |>  Constant; TYPE \"$constType\" NAME \"$constName\" VALUE \"$constValue\"\n" unless $beQuiet;
 346             }
 347         }
 348
 349         print "  |----> Interface; NAME \"$interfaceName\"" .
 350             dumpExtendedAttributes("\n  |                 ", $dataNode->extendedAttributes) . "\n |-\n |\n" unless $beQuiet;
 351     }
 352 }
 353
 354 # Internal helper
 355 sub DetermineParseMode
 356 {
 357     my $object = shift;
 358     my $line = shift;
 359
 360     my $mode = MODE_UNDEF;
 361     if ($_ =~ /module/) {
 362         $mode = MODE_MODULE;
 363     } elsif ($_ =~ /interface/) {
 364         $mode = MODE_INTERFACE;
 365     } elsif ($_ =~ /exception/) {
 366         $mode = MODE_EXCEPTION;
 367     } elsif ($_ =~ /alias/) {
 368         $mode = MODE_ALIAS;
 369     }
 370
 371     return $mode;
 372 }
 373
 374 # Internal helper
 375 sub ProcessSection
 376 {
 377     my $object = shift;
 378
 379     if ($parseMode eq MODE_MODULE) {
 380         die ("Two modules in one file! Fatal error!\n") if ($document ne 0);
 381         $document = new idlDocument();
 382         $object->ParseModule($document);
 383     } elsif ($parseMode eq MODE_INTERFACE) {
 384         my $node = new domClass();
 385         $object->ParseInterface($node, "interface");
 386
 387         die ("No module specified! Fatal Error!\n") if ($document eq 0);
 388         my $arrayRef = $document->classes;
 389         push(@$arrayRef, $node);
 390     } elsif($parseMode eq MODE_EXCEPTION) {
 391         my $node = new domClass();
 392         $object->ParseInterface($node, "exception");
 393
 394         die ("No module specified! Fatal Error!\n") if ($document eq 0);
 395         my $arrayRef = $document->classes;
 396         push(@$arrayRef, $node);
 397     } elsif($parseMode eq MODE_ALIAS) {
 398         print " |- Trying to parse alias...\n" unless $beQuiet;
 399
 400         my $line = join("", @temporaryContent);
 401         $line =~ /$IDLStructure::aliasSelector/;
 402
 403         my $interfaceName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
 404         my $wrapperName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
 405
 406         print "  |----> Alias; INTERFACE \"$interfaceName\" WRAPPER \"$wrapperName\"\n |-\n |\n" unless $beQuiet;
 407
 408         # FIXME: Check if alias is already in aliases
 409         my $aliases = $document->aliases;
 410         $aliases->{$interfaceName} = $wrapperName;
 411     }
 412
 413     @temporaryContent = "";
 414 }
 415
 416 1;