File indexing completed on 2024-05-19 15:11:19

 # 
 # KDOM IDL parser
 #
 # Copyright (C) 2005 Nikolas Zimmermann <wildfox@kde.org>
 # 
 # This file is part of the KDE project
 # 
 # This library is free software; you can redistribute it and/or
 # modify it under the terms of the GNU Library General Public
 # License as published by the Free Software Foundation; either
 # version 2 of the License, or (at your option) any later version.
 # 
 # This library is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # Library General Public License for more details.
 # 
 # You should have received a copy of the GNU Library General Public License
 # aint with this library; see the file COPYING.LIB.  If not, write to
 # the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 # Boston, MA 02110-1301, USA.
 # 
 
 package IDLParser;
 
 use IPC::Open2;
 use IDLStructure;
 
 use constant MODE_UNDEF    => 0; # Default mode.
 
 use constant MODE_MODULE  => 10; # 'module' section
 use constant MODE_INTERFACE  => 11; # 'interface' section
 use constant MODE_EXCEPTION  => 12; # 'exception' section
 use constant MODE_ALIAS    => 13; # 'alias' section
 
 # Helper variables
 my @temporaryContent = "";
 
 my $parseMode = MODE_UNDEF;
 my $preservedParseMode = MODE_UNDEF;
 
 my $beQuiet; # Should not display anything on STDOUT?
 my $document = 0; # Will hold the resulting 'idlDocument'
 
 # Default Constructor
 sub new
 {
     my $object = shift;
     my $reference = { };
 
     $document = 0;
     $beQuiet = shift;
 
     bless($reference, $object);
     return $reference;
 }
 
 # Returns the parsed 'idlDocument'
 sub Parse
 {
     my $object = shift;
     my $fileName = shift;
     my $defines = shift;
     my $preprocessor = shift;
 
     if (!$preprocessor) {
         $preprocessor = "/usr/bin/gcc -E -P -x c++";
     }
 
     if (!$defines) {
         $defines = "";
     }
 
     print " | *** Starting to parse $fileName...\n |\n" unless $beQuiet;
 
     open2(\*PP_OUT, \*PP_IN, split(' ', $preprocessor), (map { "-D$_" } split(' ', $defines)), $fileName);
     close PP_IN;
     my @documentContent = <PP_OUT>;
     close PP_OUT;
 
     my $dataAvailable = 0;
 
     # Simple IDL Parser (tm)
     foreach (@documentContent) {
         my $newParseMode = $object->DetermineParseMode($_);
 
         if ($newParseMode ne MODE_UNDEF) {
             if ($dataAvailable eq 0) {
                 $dataAvailable = 1; # Start node building...
             } else {
                 $object->ProcessSection();
             }
         }
 
         # Update detected data stream mode...
         if ($newParseMode ne MODE_UNDEF) {
             $parseMode = $newParseMode;
         }
 
         push(@temporaryContent, $_);
     }
 
     # Check if there is anything remaining to parse...
     if (($parseMode ne MODE_UNDEF) and ($#temporaryContent > 0)) {
         $object->ProcessSection();
     }
 
     print " | *** Finished parsing!\n" unless $beQuiet;
  
     $document->fileName($fileName);
 
     return $document;
 }
 
 sub ParseModule
 {
     my $object = shift;
     my $dataNode = shift;
 
     print " |- Trying to parse module...\n" unless $beQuiet;
 
     my $data = join("", @temporaryContent);
     $data =~ /$IDLStructure::moduleSelector/;
 
     my $moduleName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
     $dataNode->module($moduleName);
 
     print "  |----> Module; NAME \"$moduleName\"\n |-\n |\n" unless $beQuiet;
 }
 
 sub dumpExtendedAttributes
 {
     my $padStr = shift;
     my $attrs = shift;
 
     if (!%{$attrs}) {
         return "";
     }
 
     my @temp;
     while (($name, $value) = each(%{$attrs})) {
         push(@temp, "$name=$value");
     }
 
     return $padStr . "[" . join(", ", @temp) . "]";
 }
 
 sub parseExtendedAttributes
 {
     my $str = shift;
     $str =~ s/\[\s*(.*?)\s*\]/$1/g;
 
     my %attrs = ();
 
     foreach my $value (split(/\s*,\s*/, $str)) {
         ($name,$value) = split(/\s*=\s*/, $value, 2);
 
         # Attributes with no value are set to be true
         $value = 1 unless defined $value;
         $attrs{$name} = $value;
     }
 
     return \%attrs;
 }
 
 sub ParseInterface
 {
     my $object = shift;
     my $dataNode = shift;
     my $sectionName = shift;
 
     my $data = join("", @temporaryContent);
 
     # Look for end-of-interface mark
     $data =~ /};/g;
     $data = substr($data, index($data, $sectionName), pos($data) - length($data));
 
     $data =~ s/[\n\r]/ /g;
 
     # Beginning of the regexp parsing magic
     if ($sectionName eq "exception") {
         print " |- Trying to parse exception...\n" unless $beQuiet;
 
         my $exceptionName = "";
         my $exceptionData = "";
         my $exceptionDataName = "";
         my $exceptionDataType = "";
 
         # Match identifier of the exception, and enclosed data...
         $data =~ /$IDLStructure::exceptionSelector/;
         $exceptionName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
         $exceptionData = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
 
         ('' =~ /^/); # Reset variables needed for regexp matching
 
         # ... parse enclosed data (get. name & type)
         $exceptionData =~ /$IDLStructure::exceptionSubSelector/;
         $exceptionDataType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$data\n)"));
         $exceptionDataName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
 
         # Fill in domClass datastructure
         $dataNode->name($exceptionName);
 
         my $newDataNode = new domAttribute();
         $newDataNode->type("readonly attribute");
         $newDataNode->signature(new domSignature());
 
         $newDataNode->signature->name($exceptionDataName);
         $newDataNode->signature->type($exceptionDataType);
 
         my $arrayRef = $dataNode->attributes;
         push(@$arrayRef, $newDataNode);
 
         print "  |----> Exception; NAME \"$exceptionName\" DATA TYPE \"$exceptionDataType\" DATA NAME \"$exceptionDataName\"\n |-\n |\n" unless $beQuiet;
     } elsif ($sectionName eq "interface") {
         print " |- Trying to parse interface...\n" unless $beQuiet;
 
         my $interfaceName = "";
         my $interfaceData = "";
 
         # Match identifier of the interface, and enclosed data...
         $data =~ /$IDLStructure::interfaceSelector/;
 
         $interfaceExtendedAttributes = (defined($1) ? $1 : " "); chop($interfaceExtendedAttributes);
         $interfaceName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
         $interfaceBase = (defined($3) ? $3 : "");
         $interfaceData = (defined($4) ? $4 : die("Parsing error!\nSource:\n$data\n)"));
 
         # Fill in known parts of the domClass datastructure now...
         $dataNode->name($interfaceName);
         $dataNode->extendedAttributes(parseExtendedAttributes($interfaceExtendedAttributes));
 
         # Inheritance detection
         my @interfaceParents = split(/,/, $interfaceBase);
         foreach(@interfaceParents) {
             my $line = $_;
             $line =~ s/\s*//g;
 
             my $arrayRef = $dataNode->parents;
             push(@$arrayRef, $line);
         }
 
         $interfaceData =~ s/[\n\r]/ /g;
         my @interfaceMethods = split(/;/, $interfaceData);
 
         foreach my $line (@interfaceMethods) {
             if ($line =~ /attribute/) {
                 $line =~ /$IDLStructure::interfaceAttributeSelector/;
 
                 my $attributeType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
                 my $attributeExtendedAttributes = (defined($2) ? $2 : " "); chop($attributeExtendedAttributes);
 
                 my $attributeDataType = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
                 my $attributeDataName = (defined($4) ? $4 : die("Parsing error!\nSource:\n$line\n)"));
   
                 ('' =~ /^/); # Reset variables needed for regexp matching
 
                 $line =~ /$IDLStructure::getterRaisesSelector/;
                 my $getterException = (defined($1) ? $1 : "");
 
                 $line =~ /$IDLStructure::setterRaisesSelector/;
                 my $setterException = (defined($1) ? $1 : "");
 
                 my $newDataNode = new domAttribute();
                 $newDataNode->type($attributeType);
                 $newDataNode->signature(new domSignature());
 
                 $newDataNode->signature->name($attributeDataName);
                 $newDataNode->signature->type($attributeDataType);
                 $newDataNode->signature->extendedAttributes(parseExtendedAttributes($attributeExtendedAttributes));
 
                 my $arrayRef = $dataNode->attributes;
                 push(@$arrayRef, $newDataNode);
 
                 print "  |  |>  Attribute; TYPE \"$attributeType\" DATA NAME \"$attributeDataName\" DATA TYPE \"$attributeDataType\" GET EXCEPTION? \"$getterException\" SET EXCEPTION? \"$setterException\"" .
                     dumpExtendedAttributes("\n  |                 ", $newDataNode->signature->extendedAttributes) . "\n" unless $beQuiet;
 
                 $getterException =~ s/\s+//g;
                 $setterException =~ s/\s+//g;
                 @{$newDataNode->getterExceptions} = split(/,/, $getterException);
                 @{$newDataNode->setterExceptions} = split(/,/, $setterException);
             } elsif (($line !~ s/^\s*$//g) and ($line !~ /^\s*const/)) {
                 $line =~ /$IDLStructure::interfaceMethodSelector/ or die "Parsing error!\nSource:\n$line\n)";
 
                 my $methodExtendedAttributes = (defined($1) ? $1 : " "); chop($methodExtendedAttributes);
                 my $methodType = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
                 my $methodName = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
                 my $methodSignature = (defined($4) ? $4 : die("Parsing error!\nSource:\n$line\n)"));
 
                 ('' =~ /^/); # Reset variables needed for regexp matching
 
                 $line =~ /$IDLStructure::raisesSelector/;
                 my $methodException = (defined($1) ? $1 : "");
 
                 my $newDataNode = new domFunction();
 
                 $newDataNode->signature(new domSignature());
                 $newDataNode->signature->name($methodName);
                 $newDataNode->signature->type($methodType);
                 $newDataNode->signature->extendedAttributes(parseExtendedAttributes($methodExtendedAttributes));
 
                 print "  |  |-  Method; TYPE \"$methodType\" NAME \"$methodName\" EXCEPTION? \"$methodException\"" .
                     dumpExtendedAttributes("\n  |              ", $newDataNode->signature->extendedAttributes) . "\n" unless $beQuiet;
 
                 $methodException =~ s/\s+//g;
                 @{$newDataNode->raisesExceptions} = split(/,/, $methodException);
 
                 my @params = split(/,/, $methodSignature);
                 foreach(@params) {
                     my $line = $_;
 
                     $line =~ /$IDLStructure::interfaceParameterSelector/;
                     my $paramExtendedAttributes = (defined($1) ? $1 : " "); chop($paramExtendedAttributes);
                     my $paramType = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
                     my $paramName = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
 
                     my $paramDataNode = new domSignature();
                     $paramDataNode->name($paramName);
                     $paramDataNode->type($paramType);
                     $paramDataNode->extendedAttributes(parseExtendedAttributes($paramExtendedAttributes));
 
                     my $arrayRef = $newDataNode->parameters;
                     push(@$arrayRef, $paramDataNode);
 
                     print "  |   |>  Param; TYPE \"$paramType\" NAME \"$paramName\"" . 
                         dumpExtendedAttributes("\n  |              ", $paramDataNode->extendedAttributes) . "\n" unless $beQuiet;          
                 }
 
                 my $arrayRef = $dataNode->functions;
                 push(@$arrayRef, $newDataNode);
             } elsif ($line =~ /^\s*const/) {
                 $line =~ /$IDLStructure::constantSelector/;
                 my $constType = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
                 my $constName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
                 my $constValue = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
 
                 my $newDataNode = new domConstant();
                 $newDataNode->name($constName);
                 $newDataNode->type($constType);
                 $newDataNode->value($constValue);
 
                 my $arrayRef = $dataNode->constants;
                 push(@$arrayRef, $newDataNode);
 
                 print "  |   |>  Constant; TYPE \"$constType\" NAME \"$constName\" VALUE \"$constValue\"\n" unless $beQuiet;
             }
         }
 
         print "  |----> Interface; NAME \"$interfaceName\"" .
             dumpExtendedAttributes("\n  |                 ", $dataNode->extendedAttributes) . "\n |-\n |\n" unless $beQuiet;
     }
 }
 
 # Internal helper
 sub DetermineParseMode
 {
     my $object = shift;  
     my $line = shift;
 
     my $mode = MODE_UNDEF;
     if ($_ =~ /module/) {
         $mode = MODE_MODULE;
     } elsif ($_ =~ /interface/) {
         $mode = MODE_INTERFACE;
     } elsif ($_ =~ /exception/) {
         $mode = MODE_EXCEPTION;
     } elsif ($_ =~ /alias/) {
         $mode = MODE_ALIAS;
     }
 
     return $mode;
 }
 
 # Internal helper
 sub ProcessSection
 {
     my $object = shift;
   
     if ($parseMode eq MODE_MODULE) {
         die ("Two modules in one file! Fatal error!\n") if ($document ne 0);
         $document = new idlDocument();
         $object->ParseModule($document);
     } elsif ($parseMode eq MODE_INTERFACE) {
         my $node = new domClass();
         $object->ParseInterface($node, "interface");
     
         die ("No module specified! Fatal Error!\n") if ($document eq 0);
         my $arrayRef = $document->classes;
         push(@$arrayRef, $node);
     } elsif($parseMode eq MODE_EXCEPTION) {
         my $node = new domClass();
         $object->ParseInterface($node, "exception");
 
         die ("No module specified! Fatal Error!\n") if ($document eq 0);
         my $arrayRef = $document->classes;
         push(@$arrayRef, $node);
     } elsif($parseMode eq MODE_ALIAS) {
         print " |- Trying to parse alias...\n" unless $beQuiet;
     
         my $line = join("", @temporaryContent);
         $line =~ /$IDLStructure::aliasSelector/;
 
         my $interfaceName = (defined($1) ? $1 : die("Parsing error!\nSource:\n$line\n)"));
         my $wrapperName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$line\n)"));
     
         print "  |----> Alias; INTERFACE \"$interfaceName\" WRAPPER \"$wrapperName\"\n |-\n |\n" unless $beQuiet;
 
         # FIXME: Check if alias is already in aliases
         my $aliases = $document->aliases;
         $aliases->{$interfaceName} = $wrapperName;
     }
 
     @temporaryContent = "";
 }
 
 1;