2 min
Perl example of hash-style object oriented code with multiple packages per module

# tags #perl #programming #objectoriented

### test-pc3.pl

#!/usr/bin/perl -wT

require '../lib/PC3.pm';

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

print "Object A\n\n";
print "init A with (A rank 1) and (A suit 1)\n";
my $a = PC3A->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 = PC3A->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 = PC3A->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";

print "\n\n accessing a non-object sub \n";
PC3B::print_hello_world("this is a test");

print "\n\n creating bird object \n";
my $bird = PC3Bird->new;
$bird->set_bird("junco");
print $bird->get_bird . "\n";


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


use strict;
use warnings;
use NEXT;

{
    package PC3A;

        sub new {
                my ($class, $rank, $suit) = @_;
                
                my $this = (); 
                $this->{rank_of} = "PC3A Default Rank";
                $this->{suit_of} = "PC3A Default Suit";

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

                bless($this, $class); 
                 
                return $this;
        }
         
        sub get_suit {
                my ($this) = @_;
                return $this->{suit_of};
        }
         
        sub get_rank {
                my ($this) = @_;
                return $this->{rank_of};
        }

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

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

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

}


{
    package PC3B;
    # static class method called directly. no need to create object.
    sub print_hello_world {
        my $str = shift;
        print $str . "\n" if $str;
    }
}

{
    package PC3Bird;

        sub new {
                my ($class, $rank, $suit) = @_;
                my $this = {};
                bless($this, $class); 
                return $this;
        }

        sub set_bird {
                my ($this, $bird) = @_;
                $this->{bird} = $bird;
        }

        sub get_bird {
                my ($this) = @_;
                return $this->{bird};
        }
}

1;
From JR's : articles
477 words - 3553 chars - 2 min read
created on Jul 10, 2013 at 09:00:38 am
import date 2013-08-12 21:50:51 - #
source - versions