diff options
Diffstat (limited to 'dcopidlng/Iter.pm')
| -rw-r--r-- | dcopidlng/Iter.pm | 532 |
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; |