Perl example of inside-out object number 3

code=yes

# object oriented example - inside out
# tags #perl #programming #objectoriented

# http://perldoc.perl.org/perlobj.html#Inside-Out-objects

##### test-pc.pl

#!/usr/bin/perl -wT

# use Object::InsideOut;

require '../lib/PC.pm';

print "\n### Testing PC.pm ###\n\n";

print "Object A\n\n";
print "init A with (A rank 1) and (A suit 1)\n";
my $a = PC->new("A rank 1", "A suit 1");
print "A rank = " . $a->get_rank . "\n";
print "A suit = " . $a->get_suit . "\n";
print "setting A rank to new value (A rank 2)\n";
$a->set_rank("A rank 2");
print "A rank now = " . $a->get_rank . "\n";


print "\nObject B \n\n";

print "init B with (B rank 1) and (B suit 1)\n";
my $b = PC->new("B rank 1", "B suit 1");
print "B rank = " . $b->get_rank . "\n";
print "B suit = " . $b->get_suit . "\n";
print "setting B rank to new value (B rank 2)\n";
$b->set_rank("B rank 2");
print "B rank now = " . $b->get_rank . "\n";

print "\nback to Object A for A rank = " . $a->get_rank . "\n";


print "\nObject C \n\n";

print "init C with no params and accept default vals\n";
my $c = PC->new;
print "C rank = " . $c->get_rank . "\n";
print "C suit = " . $c->get_suit . "\n";
print "setting C rank to new value (C rank 2)\n";
$c->set_rank("C rank 2");
print "C rank now = " . $c->get_rank . "\n";

print "\nback to Object A for A rank = " . $a->get_rank . "\n";
print "back to Object B for B rank = " . $b->get_rank . "\n";
print "back to Object C for C rank = " . $c->get_rank . "\n";



################

# PC.pm

package PC;
use strict;
use warnings;
use NEXT;
use Hash::Util::FieldHash 'fieldhash';
{
        fieldhash my %suit_of;
        fieldhash my %rank_of;

        sub new {
                my ($class, $rank, $suit) = @_;

                my $this = bless \do{my $anon_scalar}, $class;

                $rank_of{$this} = "Default Rank";
                $suit_of{$this} = "Default Suit";

                if ( $rank and !$suit ) {
                    $rank_of{$this} = $rank;
                } elsif ( $rank and $suit ) {
                    $rank_of{$this} = $rank;
                    $suit_of{$this} = $suit;
                }

                return $this;
        }


       sub get_suit {
                my ($this) = @_;
                return $suit_of{$this};
        }

        sub get_rank {
                my ($this) = @_;
                return $rank_of{$this};
        }

        sub set_rank {
            my ($this, $new_rank) = @_;
            $rank_of{$this} = $new_rank;
        }

        sub DESTROY {
                my ($this) = @_;
                $this->EVERY::_destroy;
        }

        sub _destroy {
                my ($this) = @_;
                delete $suit_of{$this};
                delete $rank_of{$this};

        }

}
1;