package CodeGenerator;
my $useDocument = "";
my $useGenerator = "";
my $useOutputDir = "";
my $useDirectories = "";
my $useLayerOnTop = 0;
my $codeGenerator = 0;
my %moduleNamespaceHash;
my %moduleImplementationNamespaceHash;
my $endCondition = 0;
my $foundFilename = "";
my @foundFilenames = ();
sub new
{
my $object = shift;
my $reference = { };
$useDirectories = shift;
$useGenerator = shift;
$useOutputDir = shift;
$useLayerOnTop = shift;
bless($reference, $object);
return $reference;
}
sub StripModule($)
{
my $object = shift;
my $name = shift;
$name =~ s/[a-zA-Z0-9]*:://;
return $name;
}
sub ProcessDocument
{
my $object = shift;
$useDocument = shift;
my $ifaceName = $useGenerator;
$ifaceName =~ s/\b(\w)/\U$1/g; $ifaceName = "CodeGenerator$ifaceName";
require $ifaceName . ".pm";
$codeGenerator = $ifaceName->new($object, $useOutputDir, $useLayerOnTop);
$codeGenerator->GenerateModule($useDocument);
my $arrayRef = $useDocument->classes;
foreach(@$arrayRef) {
my $class = $_;
print "Generating code for IDL interface \"" . $class->name . "\"...\n";
$codeGenerator->GenerateInterface($class);
}
$codeGenerator->finish();
}
sub FindTopBaseClass
{
my $object = shift;
my $interface = StripModule(shift);
my $topBaseClass = "";
while($interface ne "") {
$endCondition = 0; $foundFilename = "";
foreach(@{$useDirectories}) {
if($foundFilename eq "") {
$object->ScanDirectory("$interface.idl", $_, $_, 0);
}
}
if($foundFilename ne "") {
print " | |> Parsing parent IDL \"$foundFilename\" for interface \"$interface\"\n";
my $parser = IDLParser->new(1);
my $document = $parser->Parse($foundFilename);
foreach(@{$document->classes}) {
my $class = $_;
my $useInterface = $interface;
if($class->name eq $useInterface) {
my @parents = @{$class->parents};
my $parentsMax = @{$class->parents};
$interface = "";
if(($parentsMax > 0) and ($parents[0] ne "events::EventTarget")) {
$interface = StripModule($parents[0]);
} elsif(!$class->noDPtrFlag) { $topBaseClass = $document->module . "::" . $class->name;
}
}
}
} else {
die("Could NOT find specified parent interface \"$interface\"!\n");
}
}
return $topBaseClass;
}
sub ClassHasWriteableAttributes
{
my $object = shift;
my $interface = StripModule(shift);
my $hasWriteableAttributes = 0;
$endCondition = 0; $foundFilename = "";
foreach(@{$useDirectories}) {
if($foundFilename eq "") {
$object->ScanDirectory("$interface.idl", $_, $_, 0);
}
}
my $parser = IDLParser->new(1);
my $document = $parser->Parse($foundFilename);
foreach(@{$document->classes}) {
my $class = $_;
if($class->name eq $interface) {
foreach(@{$class->attributes}) {
if($_->type !~ /^readonly\ attribute$/) {
$hasWriteableAttributes = 1;
}
}
}
}
return $hasWriteableAttributes;
}
sub AllClassesWhichInheritFrom
{
my $object = shift;
my $interface = shift;
$interface =~ s/([a-zA-Z0-9]*::)*//; # Strip namespace(s).
my @allIDLFiles = ();
foreach(@{$useDirectories}) {
$endCondition = 0;
@foundFilenames = ();
$object->ScanDirectory("allidls", $_, $_, 1);
foreach(@foundFilenames) {
push(@allIDLFiles, $_);
}
}
my %classDataCache;
foreach(@allIDLFiles) {
my $parser = IDLParser->new(1);
my $document = $parser->Parse($_);
my $cacheHandle = $_; $cacheHandle =~ s/.*\/(.*)\.idl//;
$classDataCache{$1} = $document;
}
my %classDataCacheCopy = %classDataCache;
my @classList = ();
while(my($name, $document) = each %classDataCache) {
$endCondition = 0;
$object->RecursiveInheritanceHelper($document, $interface, \@classList, \%classDataCacheCopy);
}
return \@classList;
}
sub AllClasses
{
my $object = shift;
my @allIDLFiles = ();
foreach(@{$useDirectories}) {
$endCondition = 0;
@foundFilenames = ();
$object->ScanDirectory("allidls", $_, $_, 1);
foreach(@foundFilenames) {
push(@allIDLFiles, $_);
}
}
my @classList = ();
foreach(@allIDLFiles) {
my $parser = IDLParser->new(1);
my $document = $parser->Parse($_);
foreach(@{$document->classes}) {
my $class = $_;
my $identifier = $class->name;
my $namespace = $moduleNamespaceHash{$document->module};
$identifier = $namespace . "::" . $identifier if($namespace ne "");
my @array = grep { /^$identifier$/ } @$classList;
my $arraySize = @array;
if($arraySize eq 0) {
push(@classList, $identifier);
}
}
}
return \@classList;
}
sub RecursiveInheritanceHelper
{
my $object = shift;
my $document = shift;
my $interface = shift;
my $classList = shift;
my $classDataCache = shift;
if($endCondition eq 1) {
return 1;
}
foreach(@{$document->classes}) {
my $class = $_;
foreach(@{$class->parents}) {
my $cacheHandle = StripModule($_);
if($cacheHandle eq $interface) {
my $identifier = $document->module . "::" . $class->name;
my @array = grep { /^$identifier$/ } @$classList; my $arraySize = @array;
push(@$classList, $identifier) if($arraySize eq 0);
$endCondition = 1;
return $endCondition;
} else {
my %cache = %{$classDataCache};
my $checkDocument = $cache{$cacheHandle};
$endCondition = $object->RecursiveInheritanceHelper($checkDocument, $interface,
$classList, $classDataCache);
if($endCondition eq 1) {
my $identifier = $document->module . "::" . $class->name;
my @array = grep { /^$identifier$/ } @$classList; my $arraySize = @array;
push(@$classList, $identifier) if($arraySize eq 0);
return $endCondition;
}
}
}
}
return $endCondition;
}
sub IsPrimitiveType
{
my $object = shift;
my $type = shift;
if(($type =~ /^int$/) or ($type =~ /^short$/) or ($type =~ /^long$/) or
($type =~ /^unsigned int$/) or ($type =~ /^unsigned short$/) or ($type =~ /^unsigned long$/) or
($type =~ /^float$/) or ($type =~ /^double$/) or ($type =~ /^boolean$/) or ($type =~ /^void$/)) {
return 1;
}
return 0;
}
sub ScanDirectory
{
my $object = shift;
my $interface = shift;
my $directory = shift;
my $useDirectory = shift;
my $reportAllFiles = shift;
if(($endCondition eq 1) and ($reportAllFiles eq 0)) {
return;
}
chdir($directory) or die "[ERROR] Can't enter directory $directory: \"$!\"\n";
opendir(DIR, ".") or die "[ERROR] Can't open directory $directory: \"$!\"\n";
my @names = readdir(DIR) or die "[ERROR] Cant't read directory $directory: \"$!\"\n";
closedir(DIR);
foreach(@names) {
my $name = $_;
if(($endCondition eq 1) or ($name =~ /^\./)) {
next;
}
if(-d $name) {
$object->ScanDirectory($interface, $name, $useDirectory, $reportAllFiles);
next;
}
my $condition = ($name eq $interface);
if(($interface eq "allidls") and
($name =~ /\.idl$/)) {
$condition = 1;
}
if($condition) {
$foundFilename = "$useDirectory/$directory/$name";
if($reportAllFiles eq 0) {
$endCondition = 1;
} else {
push(@foundFilenames, $foundFilename);
}
}
chdir($useDirectory) or die "[ERROR] Can't change directory to $useDirectory: \"$!\"\n";
}
}
1;