use strict; use warnings; BEGIN { package Node; sub new { my ($class, $name) = @_; return bless({ name => $name, }, $class); } sub name { $_[0]{name} } } BEGIN { package Label; sub new { my ($class, $name, $nodes, $branches) = @_; return bless({ name => $name, nodes => $nodes, branches => $branches, }, $class); } sub name { $_[0]{name} } sub nodes { @{ $_[0]{nodes} } } sub flatten { my ($self) = @_; my @orphans; local *_flatten = sub { my ($self) = @_; our @nodes; local *nodes = $self->{nodes}; our @branches; local *branches = $self->{branches}; push @orphans, shift @nodes if @nodes == 1; @branches = map _flatten($_), @branches; return @nodes ? $self : @branches; }; _flatten($self); push @{ $self->{nodes} }, @orphans; } sub visit { my ($self, $visitor) = @_; local *_visit = sub { my ($self, $depth) = @_; our @branches; local *branches = $self->{branches}; $visitor->($self, $depth); for my $branch ( @branches ) { _visit($branch, $depth+1); } }; _visit($self, 0); } } { sub node { return Node->new(@_); } sub label { return Label->new(@_); } sub printer { my ($label, $depth) = @_; my $indent = ' ' x $depth; print("$indent+ ", $label->name(), "\n"); for my $node ( $label->nodes() ) { print("$indent = ", $node->name(), "\n"); } } my $tree = ( label('Label1', [ node('Node1'), node('Node2') ], [ label('Label2', [ node('Node3') ], [ label('Label3', [ node('Node4'), node('Node5') ], [ label('Label4', [ node('Node6') ], [ ]) ]) ]) ]) ); $tree->visit(\&printer); print("\n"); $tree->flatten(); $tree->visit(\&printer); print("\n"); } #### + Label1 = Node1 = Node2 + Label2 = Node3 + Label3 = Node4 = Node5 + Label4 = Node6 + Label1 = Node1 = Node2 = Node3 = Node6 + Label3 = Node4 = Node5