don't do metaclass checking/fixing on attributes and methods
[gitmo/Class-MOP.git] / t / lib / BinaryTree.pm
CommitLineData
c50c603e 1
2package BinaryTree;
3
4use strict;
5use warnings;
8d2d4c67 6use Carp qw/confess/;
c50c603e 7
de64f9ba 8use metaclass;
9
10our $VERSION = '0.02';
11
1aeb4c53 12BinaryTree->meta->add_attribute('uid' => (
de64f9ba 13 reader => 'getUID',
14 writer => 'setUID',
8d2d4c67 15 default => sub {
de64f9ba 16 my $instance = shift;
8d2d4c67 17 ("$instance" =~ /\((.*?)\)$/)[0];
de64f9ba 18 }
19));
20
1aeb4c53 21BinaryTree->meta->add_attribute('node' => (
de64f9ba 22 reader => 'getNodeValue',
23 writer => 'setNodeValue',
8d2d4c67 24 clearer => 'clearNodeValue',
de64f9ba 25 init_arg => ':node'
26));
27
1aeb4c53 28BinaryTree->meta->add_attribute('parent' => (
de64f9ba 29 predicate => 'hasParent',
30 reader => 'getParent',
8d2d4c67 31 writer => 'setParent',
32 clearer => 'clearParent',
de64f9ba 33));
34
1aeb4c53 35BinaryTree->meta->add_attribute('left' => (
8d2d4c67 36 predicate => 'hasLeft',
37 clearer => 'clearLeft',
de64f9ba 38 reader => 'getLeft',
8d2d4c67 39 writer => {
de64f9ba 40 'setLeft' => sub {
41 my ($self, $tree) = @_;
8d2d4c67 42 confess "undef left" unless defined $tree;
43 $tree->setParent($self) if defined $tree;
1aeb4c53 44 $self->{'left'} = $tree;
8d2d4c67 45 $self;
c50c603e 46 }
de64f9ba 47 },
48));
49
1aeb4c53 50BinaryTree->meta->add_attribute('right' => (
8d2d4c67 51 predicate => 'hasRight',
52 clearer => 'clearRight',
de64f9ba 53 reader => 'getRight',
54 writer => {
55 'setRight' => sub {
8d2d4c67 56 my ($self, $tree) = @_;
57 confess "undef right" unless defined $tree;
58 $tree->setParent($self) if defined $tree;
1aeb4c53 59 $self->{'right'} = $tree;
8d2d4c67 60 $self;
c50c603e 61 }
de64f9ba 62 }
63));
c50c603e 64
c50c603e 65sub new {
66 my $class = shift;
8d2d4c67 67 $class->meta->new_object(':node' => shift);
68}
69
c50c603e 70sub removeLeft {
71 my ($self) = @_;
68deeb05 72 my $left = $self->getLeft();
8d2d4c67 73 $left->clearParent;
74 $self->clearLeft;
c50c603e 75 return $left;
76}
77
78sub removeRight {
79 my ($self) = @_;
68deeb05 80 my $right = $self->getRight;
8d2d4c67 81 $right->clearParent;
82 $self->clearRight;
c50c603e 83 return $right;
84}
8d2d4c67 85
c50c603e 86sub isLeaf {
8d2d4c67 87 my ($self) = @_;
88 return (!$self->hasLeft && !$self->hasRight);
c50c603e 89}
90
68deeb05 91sub isRoot {
8d2d4c67 92 my ($self) = @_;
93 return !$self->hasParent;
c50c603e 94}
8d2d4c67 95
c50c603e 96sub traverse {
8d2d4c67 97 my ($self, $func) = @_;
c50c603e 98 $func->($self);
8d2d4c67 99 $self->getLeft->traverse($func) if $self->hasLeft;
68deeb05 100 $self->getRight->traverse($func) if $self->hasRight;
c50c603e 101}
102
103sub mirror {
104 my ($self) = @_;
105 # swap left for right
8d2d4c67 106 if( $self->hasLeft && $self->hasRight) {
107 my $left = $self->getLeft;
108 my $right = $self->getRight;
109 $self->setLeft($right);
110 $self->setRight($left);
111 } elsif( $self->hasLeft && !$self->hasRight){
112 my $left = $self->getLeft;
113 $self->clearLeft;
114 $self->setRight($left);
115 } elsif( !$self->hasLeft && $self->hasRight){
116 my $right = $self->getRight;
117 $self->clearRight;
118 $self->setLeft($right);
119 }
120
c50c603e 121 # and recurse
8d2d4c67 122 $self->getLeft->mirror if $self->hasLeft;
123 $self->getRight->mirror if $self->hasRight;
c50c603e 124 $self;
125}
126
127sub size {
128 my ($self) = @_;
129 my $size = 1;
8d2d4c67 130 $size += $self->getLeft->size if $self->hasLeft;
131 $size += $self->getRight->size if $self->hasRight;
c50c603e 132 return $size;
133}
134
135sub height {
136 my ($self) = @_;
137 my ($left_height, $right_height) = (0, 0);
68deeb05 138 $left_height = $self->getLeft->height() if $self->hasLeft();
8d2d4c67 139 $right_height = $self->getRight->height() if $self->hasRight();
c50c603e 140 return 1 + (($left_height > $right_height) ? $left_height : $right_height);
8d2d4c67 141}
c50c603e 142
8d2d4c67 1431;