File Coverage

blib/lib/B/Tree.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package B::Tree;
2              
3 1     1   520 use strict;
  1         1  
  1         36  
4             our $VERSION = "0.02";
5              
6 1     1   1202 use GraphViz;
  0            
  0            
7             use B qw(main_root walkoptree_slow);
8              
9             my $g;
10              
11             sub compile {
12             return sub {
13             $g = new GraphViz;
14             walkoptree_slow(main_root, "visit");
15             print $g->as_dot;
16             };
17             }
18              
19             sub B::LISTOP::visit {
20             my $self = shift;
21             $g->add_node({name => $$self, label => $self->name});
22             my $node = $self->first;
23             $g->add_edge({from => $$self, to => $$node});
24             sibvisit($self, $node);
25             }
26              
27             sub B::BINOP::visit {
28             my $self = shift;
29             my $first = $self->first;
30             my $last = $self->last;
31             $g->add_node({name => $$self, label => $self->name});
32             $g->add_edge({from => $$self, to => $$first});
33             $g->add_edge({from => $$self, to => $$last});
34             }
35              
36             sub B::UNOP::visit {
37             my $self = shift;
38             my $first = $self->first;
39             $g->add_node({name => $$self, label => $self->name});
40             $g->add_edge({from => $$self, to => $$first});
41             B::Tree::sibvisit($self, $first); # For nulls.
42             }
43              
44             sub B::LOOP::visit {
45             my $self = shift;
46             if ($self->children) {
47             B::LISTOP::visit($self);
48             } else {
49             $g->add_node({name => $$self, label => $self->name});
50             }
51             }
52              
53             sub B::OP::visit {
54             my $self = shift;
55             $g->add_node({name => $$self, label => $self->name});
56             }
57              
58             sub B::PMOP::visit { # PMOPs think they're unary, but they aren't.
59             my $self = shift;
60             $g->add_node({name => $$self, label => $self->name});
61             }
62              
63             sub sibvisit {
64             my ($parent, $child) = @_;
65             while ($child->can("sibling") and ${$child->sibling}) {
66             $child = $child->sibling;
67             $g->add_edge({from => $$parent, to => $$child});
68             }
69             }
70             1;
71              
72             =head1 NAME
73              
74             B::Tree - Simplified version of B::Graph for demonstration
75              
76             =head1 SYNOPSIS
77              
78             perl -MO=Tree program | dot -Tps > tree.ps
79              
80             =head1 DESCRIPTION
81              
82             This is a very cut-down version of C; it generates minimalist
83             tree graphs of the op tree of a Perl program, merely connecting the op
84             nodes and labelling each node with the type of op.
85              
86             It was written as an example of how to write compiler modules for
87             "Professional Perl", but I've found it extremely useful for creating
88             simple op tree graphs for use in presentations on Perl internals.
89              
90             It requires the CPAN C module and the GraphViz package from
91             C. It takes no
92             options.
93              
94             =head1 AUTHOR
95              
96             Simon Cozens, C
97              
98             =head1 SEE ALSO
99              
100             L, L