summaryrefslogtreecommitdiffstats
path: root/dcopidlng/Iter.pm
diff options
context:
space:
mode:
Diffstat (limited to 'dcopidlng/Iter.pm')
-rw-r--r--dcopidlng/Iter.pm532
1 files changed, 0 insertions, 532 deletions
diff --git a/dcopidlng/Iter.pm b/dcopidlng/Iter.pm
deleted file mode 100644
index 7279a6faf..000000000
--- a/dcopidlng/Iter.pm
+++ /dev/null
@@ -1,532 +0,0 @@
-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;
generated by cgit v1.2.1 (git 2.18.0) at 2024-05-01 13:32:44 +0000