Take your PERSON class and give it an attribute called ROLES, which is an unordered set (OO term: aggregation) of ROLEs. Derive CUSTOMER, EMPLOYEE, etc from ROLE. ROLE is an abstract or virtual base class.

For your persistence, I really recommend you useTangram; it really is the best OO persistence tool I've seen for Perl so far. You might also want to check out my Tao::Object cass, which lets you merely define the fields of an object you wish to stay persistent, and then you get automatic attribute accessors, constructors and the like. Forget coding individual Save methods for objects, that's for monkeys!

So, using Tao::Object, you might implement this as follows (except, of course, you'd be using strict etc):

use Tao::Object 1.04;
use Tangram;
use Tangram::Storage;
use Tangram::Set;
use Tangram::mysql;

#------------------------------------------------------------
package Person;

@ISA = qw(Tao::Object);

$schema = {
    table => "person",
    fields => {
        string => {
            name => undef,
        },
        set => {
            roles => {
                class => 'Role',
                table => 'person_role',
            },
        },
    },
};

#------------------------------------------------------------
package Role;

@ISA = qw(Tao::Object);

$schema = {
    abstract => 1,
    fields => {
        string => {
            name => undef,
        }
    }
};

#------------------------------------------------------------
package Customer;

@ISA = qw(Tao::Object Role);

$schema = {
    bases => [ qw(Role) ],
    fields => {
 string => {
     # redefine the name attribute for this type; give it a
            # default.
            name => {
         init_default => "customer",
            }
 },
        int => {
            cust_id => undef,
        }
    }
};

#------------------------------------------------------------
package Vendor;

@ISA = qw(Tao::Object Role);

$schema = {
    bases => [ qw(Role) ],
    fields => {
        int => {
            illuminati_member => undef,
        }
    }
};

#------------------------------------------------------------
package Employee;

@ISA = qw(Tao::Object Role);

$schema = {
    bases => [ qw(Role) ],
    fields => {
        string => {
            coffee_cup => undef,
        }
    }
};

#============================================================
package Main;

# 
my $db_schema = Tangram::Schema->new(
    {
        classes => [ 'Role' => $Role::schema,
                     'Person' => $Person::schema,
                     'Employee' => $Employee::schema,
                     'Vendor' => $Vendor::schema,
                     'Customer' => $Customer::schema ]
    });

my ($dsn, $u, $p) = ("dbi:mysql:database=test", "root", "");

# create database tables
my $dbh = DBI->connect($dsn, $u, $p);
Tangram::mysql->deploy($db_schema, $dbh);
$dbh->disconnect();

# re-log in
my $storage = Tangram::Storage->connect($db_schema, $dsn, $u, $p);

{
    # create a customer role
    my $customer = Customer->new( cust_id => 12345 );
    # create an employee role
    my $employee = Employee->new( coffee_cup => "Look into my OOs",
      name => "Coffee Pourer"          );

    # Set::Object acts as a "Container" class for the roles
    my $roles = Set::Object->new($customer, $employee);
    my $person = Person->new( name => "Bob",
         roles => $roles );

    # stores $person and $customer
    $storage->insert($person);

    # drop references to customer and $person, they will be freed from
    # memory.  This is optional, the normal thing to do is just let
    # these accumulate in memory and hope that someone will write a
    # decent garbage collector before it burns you.
    $storage->unload($customer, $employee, $person);
}

# return an object that represents the 
my $db_person = $storage->remote("Person");

# if you can't be bothered keeping all of your objects in a container,
# you can do the RDBMS "lookup by value" thing.
my @persons = $storage->select($db_person,
          $db_person->{name} eq "Bob");

print "Got ".@persons." people back.\n";
print "First one is : ".$persons[0]->name()."\n";
print "Roles:\n";
for ($persons[0]->roles->members()) {
    print("Type: ", ref $_, " - name: ", $_->name(), "\n");
}

[download]

In reply to Re: Objects in PERL by mugwumpjism
in thread Objects in PERL by Vuud

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.