package IDLParser;
use strict;
use IPC::Open2;
use IDLStructure;
use constant MODE_UNDEF => 0;
use constant MODE_MODULE => 10; use constant MODE_INTERFACE => 11; use constant MODE_EXCEPTION => 12; use constant MODE_ALIAS => 13;
my @temporaryContent = "";
my $parseMode = MODE_UNDEF;
my $preservedParseMode = MODE_UNDEF;
my $beQuiet; my $document = 0; my $parentsOnly = 0;
sub new
{
my $object = shift;
my $reference = { };
$document = 0;
$beQuiet = shift;
bless($reference, $object);
return $reference;
}
sub Parse
{
my $object = shift;
my $fileName = shift;
my $defines = shift;
my $preprocessor = shift;
$parentsOnly = shift;
if (!$preprocessor) {
require Config;
my $gccLocation = "";
if ($ENV{CC}) {
$gccLocation = $ENV{CC};
} elsif (($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;
my $pid = open2(\*PP_OUT, \*PP_IN, split(' ', $preprocessor), (map { "-D$_" } split(' ', $defines)), $fileName);
close PP_IN;
my @documentContent = <PP_OUT>;
close PP_OUT;
waitpid($pid, 0);
my $dataAvailable = 0;
foreach (@documentContent) {
my $newParseMode = $object->DetermineParseMode($_);
if ($newParseMode ne MODE_UNDEF) {
if ($dataAvailable eq 0) {
$dataAvailable = 1; } else {
$object->ProcessSection();
}
}
if ($newParseMode ne MODE_UNDEF) {
$parseMode = $newParseMode;
}
push(@temporaryContent, $_);
}
if (($parseMode ne MODE_UNDEF) and ($ $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 ((my $name, my $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)) {
(my $name, my $val) = split(/\s*=\s*/, $value, 2);
$val = 1 unless defined $val;
$attrs{$name} = $val;
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);
$data =~ /};/g;
$data = substr($data, index($data, $sectionName), pos($data) - length($data));
$data =~ s/[\n\r]/ /g;
if ($sectionName eq "exception") {
print " |- Trying to parse exception...\n" unless $beQuiet;
my $exceptionName = "";
my $exceptionData = "";
my $exceptionDataName = "";
my $exceptionDataType = "";
$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)"));
('' =~ /^/);
$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)"));
$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 = "";
$data =~ /$IDLStructure::interfaceSelector/;
my $interfaceExtendedAttributes = (defined($1) ? $1 : " "); chop($interfaceExtendedAttributes);
$interfaceName = (defined($2) ? $2 : die("Parsing error!\nSource:\n$data\n)"));
my $interfaceBase = (defined($3) ? $3 : "");
$interfaceData = (defined($4) ? $4 : die("Parsing error!\nSource:\n$data\n)"));
$dataNode->name($interfaceName);
$dataNode->extendedAttributes(parseExtendedAttributes($interfaceExtendedAttributes));
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 =~ /\Wattribute\W/) {
$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)"));
('' =~ /^/);
$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)"));
('' =~ /^/);
$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 $paramDirection = $1;
my $paramExtendedAttributes = (defined($2) ? $2 : " "); chop($paramExtendedAttributes);
my $paramType = (defined($3) ? $3 : die("Parsing error!\nSource:\n$line\n)"));
my $paramName = (defined($4) ? $4 : die("Parsing error!\nSource:\n$line\n)"));
my $paramDataNode = new domSignature();
$paramDataNode->direction($paramDirection);
$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;
}
}
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/) {
$mode = MODE_ALIAS;
}
return $mode;
}
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;
my $aliases = $document->aliases;
$aliases->{$interfaceName} = $wrapperName;
}
@temporaryContent = "";
}
1;