diff options
Diffstat (limited to 'dcop/dcopidlng/Iter.pm')
| -rw-r--r-- | dcop/dcopidlng/Iter.pm | 532 |
1 files changed, 532 insertions, 0 deletions
diff --git a/dcop/dcopidlng/Iter.pm b/dcop/dcopidlng/Iter.pm new file mode 100644 index 000000000..7279a6faf --- /dev/null +++ b/dcop/dcopidlng/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; |