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;