You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
tdelibs/dcop/dcopidlng/kalyptusCxxToDcopIDL.pm

229 lines
6.6 KiB

#***************************************************************************
# kalyptusCxxToDcopIDL.pm - Generates idl from dcop headers
# -------------------
# begin : Fri Jan 25 12:00:00 2000
# copyright : (C) 2003 Alexander Kellett
# email : lypanov@kde.org
# author : Alexander Kellett
#***************************************************************************/
#/***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
#***************************************************************************/
package kalyptusCxxToDcopIDL;
use File::Path;
use File::Basename;
use Carp;
use Ast;
use kdocAstUtil;
use kdocUtil;
use Iter;
use strict;
no strict "subs";
use vars qw/$libname $rootnode $outputdir $opt $debug/;
BEGIN
{
}
sub writeDoc
{
( $libname, $rootnode, $outputdir, $opt ) = @_;
$debug = $main::debuggen;
print STDERR "Preparsing...\n";
# Preparse everything, to prepare some additional data in the classes and methods
Iter::LocalCompounds( $rootnode, sub { preParseClass( shift ); } );
kdocAstUtil::dumpAst($rootnode) if ($debug);
print STDERR "Writing dcopidl...\n";
print STDOUT "<!DOCTYPE DCOP-IDL><DCOP-IDL>\n";
print STDOUT "<SOURCE>".@{$rootnode->{Sources}}[0]->{astNodeName}."</SOURCE>\n";
print STDOUT map { "<INCLUDE>$_</INCLUDE>\n" } @main::includes_list;
Iter::LocalCompounds( $rootnode, sub {
my ($node) = @_;
my ($methodCode) = generateAllMethods( $node );
my $className = join "::", kdocAstUtil::heritage($node);
if ($node->{DcopExported}) {
print STDOUT "<CLASS>\n";
print STDOUT " <NAME>$className</NAME>\n";
print STDOUT " <LINK_SCOPE>$node->{Export}</LINK_SCOPE>\n" if ($node->{Export});
print STDOUT join("\n", map { " <SUPER>$_</SUPER>"; } grep { $_ ne "Global"; }
map {
my $name = $_->{astNodeName};
$name =~ s/</&lt;/;
$name =~ s/>/&gt;/;
my $tmpl = $_->{TmplType};
$tmpl =~ s/</&lt;/;
$tmpl =~ s/>/&gt;/;
$tmpl ? "$name&lt;<TYPE>$tmpl</TYPE>&gt;" : $name;
} @{$node->{InList}}) . "\n";
print STDOUT $methodCode;
print STDOUT "</CLASS>\n";
}
});
print STDOUT "</DCOP-IDL>\n";
print STDERR "Done.\n";
}
=head2 preParseClass
Called for each class
=cut
sub preParseClass
{
my( $classNode ) = @_;
my $className = join( "::", kdocAstUtil::heritage($classNode) );
if( $#{$classNode->{Kids}} < 0 ||
$classNode->{Access} eq "private" ||
$classNode->{Access} eq "protected" || # e.g. QPixmap::QPixmapData
exists $classNode->{Tmpl} ||
$classNode->{NodeType} eq 'union' # Skip unions for now, e.g. QPDevCmdParam
) {
print STDERR "Skipping $className\n" if ($debug);
print STDERR "Skipping union $className\n" if ( $classNode->{NodeType} eq 'union');
delete $classNode->{Compound}; # Cheat, to get it excluded from Iter::LocalCompounds
return;
}
}
sub generateMethod($$)
{
my( $classNode, $m ) = @_; # input
my $methodCode = ''; # output
my $name = $m->{astNodeName}; # method name
my @heritage = kdocAstUtil::heritage($classNode);
my $className = join( "::", @heritage );
# Check some method flags: constructor, destructor etc.
my $flags = $m->{Flags};
if ( !defined $flags ) {
warn "Method ".$name. " has no flags\n";
}
my $returnType = $m->{ReturnType};
$returnType = undef if ($returnType eq 'void');
# Don't use $className here, it's never the fully qualified (A::B) name for a ctor.
my $isConstructor = ($name eq $classNode->{astNodeName} );
my $isDestructor = ($returnType eq '~');
if ($debug) {
print STDERR " Method $name";
print STDERR ", is DTOR" if $isDestructor;
print STDERR ", returns $returnType" if $returnType;
#print STDERR " ($m->{Access})";
print STDERR "\n";
}
# Don't generate anything for destructors
return if $isDestructor;
my $args = "";
foreach my $arg ( @{$m->{ParamList}} ) {
print STDERR " Param ".$arg->{astNodeName}." type: ".$arg->{ArgType}." name:".$arg->{ArgName}." default: ".$arg->{DefaultValue}."\n" if ($debug);
my $argType = $arg->{ArgType};
my $x_isConst = ($argType =~ s/const//);
my $x_isRef = ($argType =~ s/&//);
my $typeAttrs = "";
$typeAttrs .= " qleft=\"const\"" if $x_isConst;
$typeAttrs .= " qright=\"&amp;\"" if $x_isRef;
$argType =~ s/^\s*(.*?)\s*$/$1/;
$argType =~ s/</&lt;/g;
$argType =~ s/>/&gt;/g;
$argType =~ s/(\W)\s+/$1/g;
$argType =~ s/\s+(\W)/$1/g;
$argType =~ s/\b(signed|unsigned|long|short)$/$1 int/;
$args .= " ";
$args .= "<ARG><TYPE$typeAttrs>$argType</TYPE>";
$args .= "<NAME>$arg->{ArgName}</NAME>" if $arg->{ArgName} !~ /^$/;
$args .= "</ARG>\n";
}
my $qual = "";
$qual .= " qual=\"const\"" if $flags =~ "c";
my $r_isConst = ($returnType =~ s/^\s*const\s*//);
my $r_isRef = ($returnType =~ s/&//);
my $retTypeAttrs = "";
$retTypeAttrs .= " qleft=\"const\"" if $r_isConst;
$retTypeAttrs .= " qright=\"&amp;\"" if $r_isRef;
$returnType = "void" unless $returnType;
$returnType =~ s/^\s*(.*?)\s*$/$1/;
$returnType =~ s/</&lt;/g;
$returnType =~ s/>/&gt;/g;
$returnType =~ s/(\W)\s+/$1/g;
$returnType =~ s/\s+(\W)/$1/g;
$returnType =~ s/\b(signed|unsigned|long|short)$/$1 int/;
my $methodCode = "";
my $tagType = ($flags !~ /z/) ? "FUNC" : "SIGNAL";
my $tagAttr = "";
$tagAttr .= " hidden=\"yes\"" if $flags =~ /y/;
if (!$isConstructor) {
$methodCode .= " <$tagType$tagAttr$qual>\n";
$methodCode .= " <TYPE$retTypeAttrs>$returnType</TYPE>\n";
$methodCode .= " <NAME>$name</NAME>\n";
$methodCode .= "$args";
$methodCode .= " </$tagType>\n";
}
return ( $methodCode );
}
sub generateAllMethods
{
my ($classNode) = @_;
my $methodCode = '';
# Then all methods
Iter::MembersByType ( $classNode, undef,
sub { my ($classNode, $methodNode ) = @_;
if ( $methodNode->{NodeType} eq 'method' ) {
next unless $methodNode->{Flags} =~ /(d|z|y)/;
my ($meth) = generateMethod( $classNode, $methodNode );
$methodCode .= $meth;
}
}, undef );
return ( $methodCode );
}
1;