1 files changed, 536 insertions, 0 deletions
diff --git a/dcop/dcopidlng/kdocAstUtil.pm b/dcop/dcopidlng/kdocAstUtil.pm
new file mode 100644
index 000000000..ec67ace5f
--- /dev/null
+++ b/dcop/dcopidlng/kdocAstUtil.pm
@@ -0,0 +1,536 @@
+=head1 kdocAstUtil
+
+	Utilities for syntax trees.
+
+=cut
+
+
+package kdocAstUtil;
+
+use Ast;
+use Carp;
+use File::Basename;
+use kdocUtil;
+use Iter;
+use strict;
+
+use vars qw/ $depth $refcalls $refiters @noreflist %noref /;
+
+sub BEGIN {
+# statistics for findRef
+
+	$depth = 0;
+	$refcalls = 0;
+	$refiters = 0;
+
+# findRef will ignore these words
+
+	@noreflist = qw( const int char long double template 
+		unsigned signed float void bool true false uint 
+		uint32 uint64 extern static inline virtual operator );
+
+	foreach my $r ( @noreflist ) {
+		$noref{ $r } = 1;
+	}
+}
+
+
+=head2 findRef
+
+	Parameters: root, ident, report-on-fail
+	Returns: node, or undef
+
+	Given a root node and a fully qualified identifier (:: separated),
+	this function will try to find a child of the root node that matches
+	the identifier.
+
+=cut
+
+sub findRef
+{
+	my( $root, $name, $r ) = @_;
+
+	confess "findRef: no name" if !defined $name || $name eq "";
+
+	$name =~ s/\s+//g;	
+	return undef if exists $noref{ $name };
+
+	$name =~ s/^#//g;
+
+	my ($iter, @tree) = split /(?:\:\:|#)/, $name;
+	my $kid;
+
+	$refcalls++;
+
+	# Upward search for the first token
+	return undef if !defined $iter;
+
+	while ( !defined findIn( $root, $iter ) ) {
+		return undef if !defined $root->{Parent};
+		$root = $root->{Parent};
+	}
+	$root = $root->{KidHash}->{$iter};
+	carp if !defined $root;
+
+	# first token found, resolve the rest of the tree downwards
+	foreach $iter ( @tree ) {
+		confess "iter in $name is undefined\n" if !defined $iter;
+		next if $iter =~ /^\s*$/;
+
+		unless ( defined findIn( $root, $iter ) ) {
+			confess "findRef: failed on '$name' at '$iter'\n"
+				if defined $r;
+			return undef;
+		}
+
+		$root = $root->{KidHash}->{ $iter };	
+		carp if !defined $root;
+	}
+
+	return $root;
+}
+
+=head2 findIn
+
+	node, name: search for a child
+
+=cut
+
+sub findIn
+{
+	return undef unless defined $_[0]->{KidHash};
+
+	my $ret =  $_[0]->{KidHash}->{ $_[1] };
+
+	return $ret;
+}
+
+
+#
+# Inheritance utilities
+#
+
+=head2 makeInherit
+
+	Parameter: $rootnode, $parentnode
+
+	Make an inheritance graph from the parse tree that begins
+	at rootnode. parentnode is the node that is the parent of
+	all base class nodes.
+
+=cut
+
+sub makeInherit
+{
+	my( $rnode, $parent ) = @_;
+
+	foreach my $node ( @{ $rnode->{Kids} } ) {
+		next if !defined $node->{Compound};
+
+		# set parent to root if no inheritance
+
+		if ( !exists $node->{InList} ) {
+			newInherit( $node, "Global", $parent );
+			$parent->AddPropList( 'InBy', $node );
+
+			makeInherit( $node, $parent );
+			next;
+		}
+
+		# link each ancestor
+		my $acount = 0;
+ANITER:
+		foreach my $in ( @{ $node->{InList} } ) {
+			unless ( defined $in ) {
+				Carp::cluck "warning: $node->{astNodeName} "
+					." has undef in InList.";
+				next ANITER;
+			}
+
+			my $ref = kdocAstUtil::findRef( $rnode, 
+					$in->{astNodeName} );
+
+			if( !defined $ref ) {
+				# ancestor undefined
+				warn "warning: ", $node->{astNodeName},
+					" inherits unknown class '",
+						$in->{astNodeName},"'\n";
+
+				$parent->AddPropList( 'InBy', $node );
+			}
+			else {
+				# found ancestor
+				$in->AddProp( "Node", $ref );
+				$ref->AddPropList( 'InBy', $node );
+				$acount++;
+			}
+		}
+
+		if ( $acount == 0 ) {
+			# inherits no known class: just parent it to global
+			newInherit( $node, "Global", $parent );
+			$parent->AddPropList( 'InBy', $node );
+		}
+		makeInherit( $node, $parent );
+	}
+}
+
+=head2 newInherit
+
+	p: $node, $name, $lnode?
+
+	Add a new ancestor to $node with raw name = $name and
+	node = lnode.
+=cut
+
+sub newInherit
+{
+	my ( $node, $name, $link ) = @_;
+
+	my $n = Ast::New( $name );
+	$n->AddProp( "Node", $link ) unless !defined $link;
+
+	$node->AddPropList( "InList", $n );
+	return $n;
+}
+
+=head2 inheritName
+
+	pr: $inheritance node.
+
+	Returns the name of the inherited node. This checks for existence
+	of a linked node and will use the "raw" name if it is not found.
+
+=cut
+
+sub inheritName
+{
+	my ( $innode ) = @_;
+
+	return defined $innode->{Node} ? 
+		$innode->{Node}->{astNodeName}
+		: $innode->{astNodeName};
+}
+
+=head2 inheritedBy
+
+	Parameters: out listref, node
+
+	Recursively searches for nodes that inherit from this one, returning
+	a list of inheriting nodes in the list ref.
+
+=cut
+
+sub inheritedBy
+{
+	my ( $list, $node ) = @_;
+
+	return unless exists $node->{InBy};
+
+	foreach my $kid ( @{ $node->{InBy} } ) {
+		push @$list, $kid;
+		inheritedBy( $list, $kid );
+	}
+}
+
+=head2 hasLocalInheritor
+
+	Parameter: node
+	Returns: 0 on fail
+
+	Checks if the node has an inheritor that is defined within the
+	current library. This is useful for drawing the class hierarchy,
+	since you don't want to display classes that have no relationship
+	with classes within this library.
+
+	NOTE: perhaps we should cache the value to reduce recursion on 
+	subsequent calls.
+
+=cut
+
+sub hasLocalInheritor
+{
+	my $node = shift;
+
+	return 0 if !exists $node->{InBy};
+
+	my $in;
+	foreach $in ( @{$node->{InBy}} ) {
+		return 1 if !exists $in->{ExtSource}
+			|| hasLocalInheritor( $in );
+	}
+
+	return 0;
+}
+
+
+
+=head2 allMembers
+
+	Parameters: hashref outlist, node, $type
+
+	Fills the outlist hashref with all the methods of outlist,
+	recursively traversing the inheritance tree.
+
+	If type is not specified, it is assumed to be "method"
+
+=cut
+
+sub allMembers
+{
+	my ( $outlist, $n, $type ) = @_;
+	my $in;
+	$type = "method" if !defined $type;
+
+	if ( exists $n->{InList} ) {
+
+		foreach $in ( @{$n->{InList}} ) {
+			next if !defined $in->{Node};
+			my $i = $in->{Node};
+
+			allMembers( $outlist, $i ) 
+				unless $i == $main::rootNode;
+		}
+	}
+
+	return unless exists $n->{Kids};
+
+	foreach $in ( @{$n->{Kids}} ) {
+		next if $in->{NodeType} ne $type;
+
+		$outlist->{ $in->{astNodeName} } = $in;
+	}
+}
+
+=head2 findOverride
+
+	Parameters: root, node, name
+
+	Looks for nodes of the same name as the parameter, in its parent
+	and the parent's ancestors. It returns a node if it finds one.
+
+=cut
+
+sub findOverride
+{
+	my ( $root, $node, $name ) = @_;
+	return undef if !exists $node->{InList};
+
+	foreach my $in ( @{$node->{InList}} ) {
+		my $n = $in->{Node};
+		next unless defined $n && $n != $root && exists $n->{KidHash};
+
+		my $ref  = $n->{KidHash}->{ $name };
+		
+		return $n if defined $ref && $ref->{NodeType} eq "method";
+
+		if ( exists $n->{InList} ) {
+			$ref = findOverride( $root, $n, $name );
+			return $ref if defined $ref;
+		}
+	}
+
+	return undef;
+}
+
+=head2 attachChild
+
+	Parameters: parent, child
+
+	Attaches child to the parent, setting Access, Kids
+	and KidHash of respective nodes.
+
+=cut
+
+sub attachChild
+{
+	my ( $parent, $child ) = @_;
+	confess "Attempt to attach ".$child->{astNodeName}." to an ".
+		"undefined parent\n" if !defined $parent;
+
+	$child->AddProp( "Access", $parent->{KidAccess} );
+	$child->AddProp( "Parent", $parent );
+
+	$parent->AddPropList( "Kids", $child );
+
+	if( !exists $parent->{KidHash} ) {
+		my $kh = Ast::New( "LookupTable" );
+		$parent->AddProp( "KidHash", $kh );
+	}
+
+	$parent->{KidHash}->AddProp( $child->{astNodeName},
+		$child );
+}
+
+=head2 makeClassList
+
+	Parameters: node, outlist ref
+
+	fills outlist with a sorted list of all direct, non-external
+	compound children of node.
+
+=cut
+
+sub makeClassList
+{
+	my ( $rootnode, $list ) = @_;
+
+	@$list = ();
+
+	Iter::LocalCompounds( $rootnode,
+		sub { 
+				my $node = shift;
+
+				my $her = join ( "::", heritage( $node ) );
+				$node->AddProp( "FullName", $her );
+
+				if ( !exists $node->{DocNode}->{Internal} ||
+				     !$main::skipInternal ) {
+					push @$list, $node;
+				}
+	} );
+
+	@$list = sort { $a->{FullName} cmp $b->{FullName} } @$list;
+}
+
+#
+# Debugging utilities
+#
+
+=head2 dumpAst
+
+	Parameters: node, deep
+	Returns: none
+
+	Does a recursive dump of the node and its children.
+	If deep is set, it is used as the recursion property, otherwise
+	"Kids" is used.
+
+=cut
+
+sub dumpAst
+{
+	my ( $node, $deep ) = @_;
+
+	$deep = "Kids" if !defined $deep;
+
+	print "\t" x $depth, $node->{astNodeName}, 
+		" (", $node->{NodeType}, ")\n";
+
+	my $kid;
+
+	foreach $kid ( $node->GetProps() ) {
+		print "\t" x $depth, "  -\t", $kid, " -> ", $node->{$kid},"\n"
+			unless $kid =~ /^(astNodeName|NodeType|$deep)$/;
+	}
+	if ( exists  $node->{InList} ) {
+		print "\t" x $depth, "  -\tAncestors -> ";
+		foreach my $innode ( @{$node->{InList}} ) {
+			print $innode->{astNodeName} . ",";
+		}
+		print "\n";
+	}
+
+	print "\t" x $depth, "  -\n" if (defined $node->{ $deep } && scalar(@{$node->{ $deep }}) != 0);
+
+	$depth++;
+	foreach $kid ( @{$node->{ $deep }} ) {
+		dumpAst( $kid );
+	}
+
+	print "\t" x $depth, "Documentation nodes:\n" if defined 
+		@{ $node->{Doc}->{ "Text" }};
+
+	foreach $kid ( @{ $node->{Doc}->{ "Text" }} ) {
+		dumpAst( $kid );
+	}
+
+	$depth--;
+}
+
+=head2 testRef
+
+	Parameters: rootnode
+
+	Interactive testing of referencing system. Calling this
+	will use the readline library to allow interactive entering of
+	identifiers. If a matching node is found, its node name will be
+	printed.
+
+=cut
+
+sub testRef {
+	require Term::ReadLine;
+
+	my $rootNode = $_[ 0 ];
+
+	my $term = new Term::ReadLine 'Testing findRef';
+
+	my $OUT = $term->OUT || *STDOUT{IO};
+	my $prompt = "Identifier: ";
+
+	while( defined ($_ = $term->readline($prompt)) ) {
+
+		my $node = kdocAstUtil::findRef( $rootNode, $_ );
+
+		if( defined $node ) {
+			print $OUT "Reference: '", $node->{astNodeName}, 
+			"', Type: '", $node->{NodeType},"'\n";
+		}
+		else {
+			print $OUT "No reference found.\n";
+		}
+
+		$term->addhistory( $_ ) if /\S/;
+	}
+}
+
+sub printDebugStats
+{
+	print "findRef: ", $refcalls, " calls, ", 
+		$refiters, " iterations.\n";
+}
+
+sub External
+{
+	return defined $_[0]->{ExtSource};
+}
+
+sub Compound
+{
+	return defined $_[0]->{Compound};
+}
+
+sub localComp
+{
+	my ( $node ) = $_[0];
+	return defined $node->{Compound} 
+		&& !defined $node->{ExtSource} 
+		&& $node->{NodeType} ne "Forward";
+}
+
+sub hasDoc
+{
+	return defined $_[0]->{DocNode};
+}
+
+### Warning: this returns the list of parents, e.g. the 3 words in KParts::ReadOnlyPart::SomeEnum
+### It has nothing do to with inheritance.
+sub heritage
+{
+		my $node = shift;
+		my @heritage;
+
+		while( 1 ) {
+			push @heritage, $node->{astNodeName};
+
+			last unless defined $node->{Parent};
+			$node = $node->{Parent};
+			last unless defined $node->{Parent};
+		}
+
+		return reverse @heritage;
+}
+
+
+1;