# | |
# KDOM IDL parser | |
# | |
# Copyright (C) 2005 Nikolas Zimmermann <wildfox@kde.org> | |
# | |
# 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 | |
# along 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' | |
my $parentsOnly = 0; # If 1, parse only enough to populate parents list | |
# 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; | |
$parentsOnly = shift; | |
if (!$preprocessor) { | |
require Config; | |
my $gccLocation = ""; | |
if (($Config::Config{'osname'}) =~ /solaris/i) { | |
$gccLocation = "/usr/sfw/bin/gcc"; | |
} else { | |
$gccLocation = "/usr/bin/gcc"; | |
} | |
$preprocessor = $gccLocation . " -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; | |
die("Invalid extended attribute name: '$name'\n") if $name =~ /\s/; | |
} | |
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); | |
} | |
return if $parentsOnly; | |
$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); | |
# Split arguments at commas but only if the comma | |
# is not within attribute brackets, expressed here | |
# as being followed by a ']' without a preceding '['. | |
# Note that this assumes that attributes don't nest. | |
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 ($_ =~ /(\A|\b)alias/) { | |
# The (\A|\b) above is needed so we don't match attributes | |
# whose names contain the substring "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; |