From bcc95cd92ca12c1783464b8ada6816d430dc0e98 Mon Sep 17 00:00:00 2001
From: Timothy Pearson <kb9vqf@pearsoncomputing.net>
Date: Sun, 18 Dec 2011 03:08:08 -0600
Subject: Initial import of libqt-perl (not yet TQt compatible)

---
 kalyptus/Iter.pm | 532 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 532 insertions(+)
 create mode 100644 kalyptus/Iter.pm

(limited to 'kalyptus/Iter.pm')

diff --git a/kalyptus/Iter.pm b/kalyptus/Iter.pm
new file mode 100644
index 0000000..7279a6f
--- /dev/null
+++ b/kalyptus/Iter.pm
@@ -0,0 +1,532 @@
+package Iter;
+
+=head1 Iterator Module
+
+A set of iterator functions for traversing the various trees and indexes.
+Each iterator expects closures that operate on the elements in the iterated
+data structure.
+
+
+=head2 Generic
+
+	Params: $node, &$loopsub, &$skipsub, &$applysub, &$recursesub
+
+Iterate over $node\'s children. For each iteration:
+	
+If loopsub( $node, $kid ) returns false, the loop is terminated.
+If skipsub( $node, $kid )  returns true, the element is skipped.
+
+Applysub( $node, $kid ) is called
+If recursesub( $node, $kid ) returns true, the function recurses into
+the current node.
+
+=cut
+
+sub Generic
+{
+	my ( $root, $loopcond, $skipcond, $applysub, $recursecond ) = @_;
+
+	return sub {
+		foreach my $node ( @{$root->{Kids}} ) {
+
+			if ( defined  $loopcond ) {
+				return 0 unless $loopcond->( $root, $node );
+			}
+
+			if ( defined $skipcond ) {
+				next if $skipcond->( $root, $node );
+			}
+
+			my $ret = $applysub->( $root, $node );
+			return $ret if defined $ret && $ret;
+
+			if ( defined $recursecond 
+					&& $recursecond->( $root, $node ) ) {
+				$ret = Generic( $node, $loopcond, $skipcond,
+						$applysub, $recursecond)->();
+				if ( $ret ) {
+					return $ret;
+				}
+			}
+		}
+
+		return 0;
+	};
+}
+
+sub Class
+{
+	my ( $root, $applysub, $recurse ) = @_;
+
+	return Generic( $root, undef,
+		sub {
+			return !( $node->{NodeType} eq "class" 
+				|| $node->{NodeType} eq "struct" );
+		}, 
+		$applysub, $recurse );
+}
+
+=head2 Tree
+
+	Params: $root, $recurse?, $commonsub, $compoundsub, $membersub,
+		$skipsub
+
+Traverse the ast tree starting at $root, skipping if skipsub returns true.
+
+Applying $commonsub( $node, $kid),
+then $compoundsub( $node, $kid ) or $membersub( $node, $kid ) depending on
+the Compound flag of the node.
+
+=cut
+
+sub Tree
+{
+	my ( $rootnode, $recurse, $commonsub, $compoundsub, $membersub, 
+		 $skipsub ) = @_;
+
+	my $recsub = $recurse ? sub { return 1 if $_[1]->{Compound}; } 
+				: undef;
+
+	Generic( $rootnode, undef, $skipsub,
+		sub { 					# apply
+			my ( $root, $node ) = @_;
+			my $ret;
+
+			if ( defined $commonsub ) {
+				$ret = $commonsub->( $root, $node );
+				return $ret if defined $ret;
+			}
+
+			if ( $node->{Compound} && defined $compoundsub ) {
+				$ret = $compoundsub->( $root, $node );
+				return $ret if defined $ret;
+			}
+			
+			if( !$node->{Compound} && defined $membersub ) {
+				$ret = $membersub->( $root, $node );
+				return $ret if defined $ret;
+			}
+			return;
+		},
+		$recsub 				# skip
+	)->();
+}
+
+=head2 LocalCompounds
+
+Apply $compoundsub( $node ) to all locally defined compound nodes
+(ie nodes that are not external to the library being processed).
+
+=cut
+
+sub LocalCompounds
+{
+		my ( $rootnode, $compoundsub ) = @_;
+
+		return unless defined $rootnode && defined $rootnode->{Kids};
+
+		foreach my $kid ( sort { $a->{astNodeName} cmp $b->{astNodeName} }
+								 @{$rootnode->{Kids}} ) {
+				next if !defined $kid->{Compound};
+
+				$compoundsub->( $kid ) unless defined $kid->{ExtSource};
+				LocalCompounds( $kid, $compoundsub );
+		}
+}
+
+=head2 Hierarchy
+
+	Params: $node, $levelDownSub, $printSub, $levelUpSub
+
+This allows easy hierarchy traversal and printing.
+
+Traverses the inheritance hierarchy starting at $node, calling printsub
+for each node. When recursing downward into the tree, $levelDownSub($node) is
+called, the recursion takes place, and $levelUpSub is called when the
+recursion call is completed. 
+
+=cut
+
+sub Hierarchy
+{
+	my ( $node, $ldownsub, $printsub, $lupsub, $nokidssub ) = @_;
+
+	return if defined $node->{ExtSource}
+		&& (!defined $node->{InBy} 
+			|| !kdocAstUtil::hasLocalInheritor( $node ));
+
+	$printsub->( $node );
+
+	if ( defined $node->{InBy} ) {
+		$ldownsub->( $node );
+
+		foreach my $kid ( 
+				sort {$a->{astNodeName} cmp $b->{astNodeName}}
+				@{ $node->{InBy} } ) {
+			Hierarchy( $kid, $ldownsub, $printsub, $lupsub );
+		}
+
+		$lupsub->( $node );
+	}
+	elsif ( defined $nokidssub ) {
+		$nokidssub->( $node );
+	}
+
+	return;
+}
+
+=head2
+
+	Call $printsub for each *direct* ancestor of $node.
+	Only multiple inheritance can lead to $printsub being called more than once.
+
+=cut
+sub Ancestors
+{
+	my ( $node, $rootnode, $noancessub, $startsub, $printsub,
+		$endsub ) = @_;
+	my @anlist = ();
+
+	return if $node eq $rootnode;
+
+	if ( !exists $node->{InList} ) {
+		$noancessub->( $node ) unless !defined $noancessub;
+		return;
+	}
+	
+	foreach my $innode ( @{ $node->{InList} } ) {
+		my $nref = $innode->{Node};	# real ancestor
+		next if defined $nref && $nref == $rootnode;
+
+		push @anlist, $innode;
+	}
+
+	if ( $#anlist < 0 ) {
+		$noancessub->( $node ) unless !defined $noancessub;
+		return;
+	}
+
+	$startsub->( $node ) unless !defined $startsub;
+
+	foreach my $innode ( sort { $a->{astNodeName} cmp $b->{astNodeName} }
+				@anlist ) {
+
+		# print
+		$printsub->( $innode->{Node}, $innode->{astNodeName},
+			$innode->{Type}, $innode->{TmplType} ) 
+			unless !defined $printsub;
+	}
+
+	$endsub->( $node ) unless !defined $endsub;
+
+	return;
+
+}
+
+sub Descendants
+{
+	my ( $node, $nodescsub, $startsub, $printsub, $endsub ) = @_;
+
+	if ( !exists $node->{InBy} ) {
+		$nodescsub->( $node ) unless !defined $nodescsub;
+		return;
+	}
+
+	
+	my @desclist = ();
+	DescendantList( \@desclist, $node );
+	
+	if ( $#desclist < 0 ) {
+		$nodescsub->( $node ) unless !defined $nodescsub;
+		return;
+	}
+
+	$startsub->( $node ) unless !defined $startsub;
+
+	foreach my $innode ( sort { $a->{astNodeName} cmp $b->{astNodeName} }
+				@desclist ) {
+
+		$printsub->( $innode) 
+			unless !defined $printsub;
+	}
+
+	$endsub->( $node ) unless !defined $endsub;
+
+	return;
+
+}
+
+sub DescendantList
+{
+	my ( $list, $node ) = @_;
+
+	return unless exists $node->{InBy};
+
+	foreach my $kid ( @{ $node->{InBy} } ) {
+		push @$list, $kid;
+		DescendantList( $list, $kid );
+	}
+}
+
+=head2 DocTree
+
+=cut
+
+sub DocTree
+{
+	my ( $rootnode, $allowforward, $recurse, 
+		$commonsub, $compoundsub, $membersub ) = @_;
+		
+	Generic( $rootnode, undef,
+		sub {				# skip
+			my( $node, $kid ) = @_;
+
+			unless (!(defined $kid->{ExtSource}) 
+					&& ($allowforward || $kid->{NodeType} ne "Forward")
+					&& ($main::doPrivate || !($kid->{Access} =~ /private/))
+					&& exists $kid->{DocNode} ) {
+
+				return 1;
+			}
+
+			return;
+		},
+		sub { 				# apply
+			my ( $root, $node ) = @_;
+
+			my $ret;
+
+			if ( defined $commonsub ) {
+				$ret = $commonsub->( $root, $node );
+				return $ret if defined $ret;
+			}
+
+			if ( $node->{Compound} && defined $compoundsub ) {
+				$ret = $compoundsub->( $root, $node );
+				return $ret if defined $ret;
+			}
+			elsif( defined $membersub ) {
+				$ret = $membersub->( $root, $node );
+				return $ret if defined $ret;
+			}
+
+			return;
+		},
+		sub { return 1 if $recurse; return; }	# recurse
+		)->();
+
+}
+
+sub MembersByType
+{
+	my ( $node, $startgrpsub, $methodsub, $endgrpsub, $nokidssub ) = @_;
+
+# public
+	# types
+	# data
+	# methods
+	# signals
+	# slots
+	# static
+# protected
+# private (if enabled)
+
+	if ( !defined $node->{Kids} ) {
+			$nokidssub->( $node ) if defined $nokidssub;
+			return;
+	}
+
+	foreach my $acc ( qw/public protected private/ ) {
+		next if $acc eq "private" && !$main::doPrivate;
+		$access = $acc;
+
+		my @types = ();
+		my @data = ();
+		my @signals = ();
+		my @k_dcops = ();
+		my @k_dcop_signals = ();
+		my @k_dcop_hiddens = ();
+		my @slots =();
+		my @methods = ();
+		my @static = ();
+		my @modules = ();
+		my @interfaces = ();
+
+		# Build lists
+		foreach my $kid ( @{$node->{Kids}} ) {
+			next unless ( $kid->{Access} =~ /$access/
+			          && !$kid->{ExtSource})
+			         || ( $access eq "public" 
+				    && ( $kid->{Access} eq "signals" 
+				      || $kid->{Access} =~ "k_dcop" # note the =~ 
+                  || $kid->{Access} eq "K_DCOP"));
+
+			my $type = $kid->{NodeType};
+
+			if ( $type eq "method" ) {
+				if ( $kid->{Flags} =~ "s" ) {
+					push @static, $kid;
+				}
+				elsif ( $kid->{Flags} =~ "l" ) {
+					push @slots, $kid;
+				}
+				elsif ( $kid->{Flags} =~ "n" ) {
+					push @signals, $kid;
+				}
+				elsif ( $kid->{Flags} =~ "d" ) {
+					push @k_dcops, $kid;
+				}
+				elsif ( $kid->{Flags} =~ "z" ) {
+					push @k_dcop_signals, $kid;
+				}
+				elsif ( $kid->{Flags} =~ "y" ) {
+					push @k_dcop_hiddens, $kid;
+				}
+				else {
+					push @methods, $kid; }
+			}
+			elsif ( $kid->{Compound} ) {
+				if ( $type eq "module" ) {
+					push @modules, $kid;
+				}
+				elsif ( $type eq "interface" ) {
+					push @interfaces, $kid;
+				}
+				else {
+					push @types, $kid;
+				}
+			}
+			elsif ( $type eq "typedef" || $type eq "enum" ) {
+				push @types, $kid;
+			}
+			else {
+				push @data, $kid;
+			}
+		}
+
+		# apply
+		$uc_access = ucfirst( $access );
+		
+		doGroup( "$uc_access Types", $node, \@types, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "Modules", $node, \@modules, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "Interfaces", $node, \@interfaces, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "$uc_access Methods", $node, \@methods, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "$uc_access Slots", $node, \@slots, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "Signals", $node, \@signals, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "k_dcop", $node, \@k_dcops, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "k_dcop_signals", $node, \@k_dcop_signals, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "k_dcop_hiddens", $node, \@k_dcop_hiddens, $startgrpsub,
+			$methodsub, $endgrpsub);
+		doGroup( "$uc_access Static Methods", $node, \@static, 
+			$startgrpsub, $methodsub, $endgrpsub);
+		doGroup( "$uc_access Members", $node, \@data, $startgrpsub,
+			$methodsub, $endgrpsub);
+	}
+}
+
+sub doGroup
+{
+	my ( $name, $node, $list, $startgrpsub, $methodsub, $endgrpsub ) = @_;
+
+        my ( $hasMembers ) = 0;
+        foreach my $kid ( @$list ) {
+                if ( !exists $kid->{DocNode}->{Reimplemented} ) {
+                        $hasMembers = 1;
+                        break;
+                }
+        }
+	return if !$hasMembers;
+	
+	if ( defined $methodsub ) {
+		foreach my $kid ( @$list ) {
+                        if ( !exists $kid->{DocNode}->{Reimplemented} ) {
+         		        $methodsub->( $node, $kid );
+                        }
+		}
+	}
+
+	$endgrpsub->( $name ) if defined $endgrpsub;
+}
+
+sub ByGroupLogical
+{
+	my ( $root, $startgrpsub, $itemsub, $endgrpsub ) = @_;
+
+	return 0 unless defined $root->{Groups};
+
+	foreach my $groupname ( sort keys %{$root->{Groups}} ) {
+		next if $groupname eq "astNodeName"||$groupname eq "NodeType";
+
+		my $group = $root->{Groups}->{ $group };
+		next unless $group->{Kids};
+		
+		$startgrpsub->( $group->{astNodeName}, $group->{Desc} );
+
+		foreach my $kid (sort {$a->{astNodeName} cmp $b->{astNodeName}}
+					@group->{Kids} ) {
+			$itemsub->( $root, $kid );
+		}
+		$endgrpsub->( $group->{Desc} );	
+	}
+
+	return 1;
+}
+
+sub SeeAlso
+{
+	my ( $node, $nonesub, $startsub, $printsub, $endsub ) = @_;
+
+	if( !defined $node ) {
+		$nonesub->();
+		return;
+	}
+
+	my $doc = $node;
+
+	if ( $node->{NodeType} ne "DocNode" ) {
+		$doc = $node->{DocNode};
+		if ( !defined $doc ) {
+			$nonesub->() if defined $nonesub;
+			return;
+		}
+	}
+
+	if ( !defined $doc->{See} ) {
+		$nonesub->() if defined $nonesub;
+		return;
+	}
+
+	my $see = $doc->{See};
+	my $ref = $doc->{SeeRef};
+
+	if ( $#$see < 1 ) {
+		$nonesub->() if defined $nonesub;
+		return;
+	}
+
+	$startsub->( $node ) if defined $startsub;
+
+	for my $i ( 0..$#$see ) {
+		my $seelabel = $see->[ $i ];
+		my $seenode = undef;
+		if ( defined $ref ) {
+			$seenode = $ref->[ $i ]; 
+		}
+
+		$printsub->( $seelabel, $seenode ) if defined $printsub;
+	}
+
+	$endsub->( $node ) if defined $endsub;
+
+	return;
+}
+
+1;
-- 
cgit v1.2.1