X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FBinaryTree.pm;h=539800a68b593a708b67b019c632227876de13b4;hb=d004c8d565f9b314da7652e9368aeb4587ffaa3d;hp=04c0e3f85f99d38e859b2fef2d3ca0bb1954efc4;hpb=727919c540c7d73b1abc551d528c827f1b71fc0d;p=gitmo%2FClass-MOP.git diff --git a/t/lib/BinaryTree.pm b/t/lib/BinaryTree.pm index 04c0e3f..539800a 100644 --- a/t/lib/BinaryTree.pm +++ b/t/lib/BinaryTree.pm @@ -1,125 +1,134 @@ -use Class::MOP ':universal'; - package BinaryTree; use strict; use warnings; - -our $VERSION = '0.01'; - -__PACKAGE__->meta->add_attribute( - Class::MOP::Attribute->new('$:uid' => ( - reader => 'getUID', - writer => 'setUID', - default => sub { - my $instance = shift; - ("$instance" =~ /\((.*?)\)$/); +use Carp qw/confess/; + +use metaclass; + +our $VERSION = '0.02'; + +BinaryTree->meta->add_attribute('uid' => ( + reader => 'getUID', + writer => 'setUID', + default => sub { + my $instance = shift; + ("$instance" =~ /\((.*?)\)$/)[0]; + } +)); + +BinaryTree->meta->add_attribute('node' => ( + reader => 'getNodeValue', + writer => 'setNodeValue', + clearer => 'clearNodeValue', + init_arg => ':node' +)); + +BinaryTree->meta->add_attribute('parent' => ( + predicate => 'hasParent', + reader => 'getParent', + writer => 'setParent', + clearer => 'clearParent', +)); + +BinaryTree->meta->add_attribute('left' => ( + predicate => 'hasLeft', + clearer => 'clearLeft', + reader => 'getLeft', + writer => { + 'setLeft' => sub { + my ($self, $tree) = @_; + confess "undef left" unless defined $tree; + $tree->setParent($self) if defined $tree; + $self->{'left'} = $tree; + $self; } - )) -); - -__PACKAGE__->meta->add_attribute( - Class::MOP::Attribute->new('$:node' => ( - reader => 'getNodeValue', - writer => 'setNodeValue', - init_arg => ':node' - )) -); - -__PACKAGE__->meta->add_attribute( - Class::MOP::Attribute->new('$:parent' => ( - predicate => 'hasParent', - reader => 'getParent', - writer => 'setParent' - )) -); - -__PACKAGE__->meta->add_attribute( - Class::MOP::Attribute->new('$:left' => ( - predicate => 'hasLeft', - reader => 'getLeft', - writer => { - 'setLeft' => sub { - my ($self, $tree) = @_; - $tree->setParent($self) if defined $tree; - $self->{'$:left'} = $tree; - $self; - } - }, - )) -); - -__PACKAGE__->meta->add_attribute( - Class::MOP::Attribute->new('$:right' => ( - predicate => 'hasRight', - reader => 'getRight', - writer => { - 'setRight' => sub { - my ($self, $tree) = @_; - $tree->setParent($self) if defined $tree; - $self->{'$:right'} = $tree; - $self; - } + }, +)); + +BinaryTree->meta->add_attribute('right' => ( + predicate => 'hasRight', + clearer => 'clearRight', + reader => 'getRight', + writer => { + 'setRight' => sub { + my ($self, $tree) = @_; + confess "undef right" unless defined $tree; + $tree->setParent($self) if defined $tree; + $self->{'right'} = $tree; + $self; } - )) -); + } +)); sub new { my $class = shift; - bless $class->meta->construct_instance(':node' => shift) => $class; -} - + $class->meta->new_object(':node' => shift); +} + sub removeLeft { my ($self) = @_; my $left = $self->getLeft(); - $left->setParent(undef); - $self->setLeft(undef); + $left->clearParent; + $self->clearLeft; return $left; } sub removeRight { my ($self) = @_; my $right = $self->getRight; - $right->setParent(undef); - $self->setRight(undef); + $right->clearParent; + $self->clearRight; return $right; } - + sub isLeaf { - my ($self) = @_; - return (!$self->hasLeft && !$self->hasRight); + my ($self) = @_; + return (!$self->hasLeft && !$self->hasRight); } sub isRoot { - my ($self) = @_; - return !$self->hasParent; + my ($self) = @_; + return !$self->hasParent; } - + sub traverse { - my ($self, $func) = @_; + my ($self, $func) = @_; $func->($self); - $self->getLeft->traverse($func) if $self->hasLeft; + $self->getLeft->traverse($func) if $self->hasLeft; $self->getRight->traverse($func) if $self->hasRight; } sub mirror { my ($self) = @_; # swap left for right - my $left = $self->getLeft; - $self->setLeft($self->getRight()); - $self->setRight($left); + if( $self->hasLeft && $self->hasRight) { + my $left = $self->getLeft; + my $right = $self->getRight; + $self->setLeft($right); + $self->setRight($left); + } elsif( $self->hasLeft && !$self->hasRight){ + my $left = $self->getLeft; + $self->clearLeft; + $self->setRight($left); + } elsif( !$self->hasLeft && $self->hasRight){ + my $right = $self->getRight; + $self->clearRight; + $self->setLeft($right); + } + # and recurse - $self->getLeft->mirror() if $self->hasLeft(); - $self->getRight->mirror() if $self->hasRight(); + $self->getLeft->mirror if $self->hasLeft; + $self->getRight->mirror if $self->hasRight; $self; } sub size { my ($self) = @_; my $size = 1; - $size += $self->getLeft->size() if $self->hasLeft(); - $size += $self->getRight->size() if $self->hasRight(); + $size += $self->getLeft->size if $self->hasLeft; + $size += $self->getRight->size if $self->hasRight; return $size; } @@ -127,7 +136,8 @@ sub height { my ($self) = @_; my ($left_height, $right_height) = (0, 0); $left_height = $self->getLeft->height() if $self->hasLeft(); - $right_height = $self->getRight->height() if $self->hasRight(); + $right_height = $self->getRight->height() if $self->hasRight(); return 1 + (($left_height > $right_height) ? $left_height : $right_height); -} +} +1;