Use DBIx-Class via delegation instead of inheritance

First of all, thank you to everyone who has joined gittip. So far we've put Perl into the top ten largest communities on the site and even passed the Ruby on Rails community. Keep it going!

Next, I've decided to upload a very strange module to the CPAN, one that may prove incomprehensible to most folks, but if it works, it might make working with DBIx::Class a bit more interesting (for curious values of 'interesting'). In short, it allows you to automatically create an object hierarchy of objects that delegate off to their DBIx::Class counterparts rather than inherit from DBIx::Class. That sounds weird, but let me explain.

Consider a database where you have people and each person might be a customer. The following two tables might demonstrate that relationship.

CREATE TABLE people (
    person_id INTEGER PRIMARY KEY AUTOINCREMENT,
    name      VARCHAR(255) NOT NULL,
    email     VARCHAR(255)     NULL UNIQUE,
    birthday  DATETIME     NOT NULL
);

CREATE TABLE customers (
    customer_id    INTEGER PRIMARY KEY AUTOINCREMENT,
    person_id      INTEGER  NOT NULL UNIQUE,
    first_purchase DATETIME NOT NULL,
    FOREIGN KEY(person_id) REFERENCES people(person_id)
);

If your schema starts with Sample::Schema::, in DBIx::Class terms you'll find that Sample::Schema::Result::Person might_have a Sample::Schema::Result::Customer:

__PACKAGE__->might_have(
    "customer",
    "Sample::Schema::Result::Customer",
    { "foreign.person_id" => "self.person_id" },
);

As a programmer, you might find that frustrating. For one thing, the Person result has 157 methods because you've inherited from DBIx::Class! Better hope you didn't override any (I've done this before and it's not fun to track down).

Also, from your viewpoint you might think that Customer isa Person. Or perhaps you also have Employees in your database and a person can be both a customer and an employee, how do you model that? For DBIx::Class, you have delegation:

my $customer = $person->customer;
my $employee = $person->employee;

But what if you want inheritance or roles? That's what DBIx::Class::Objects attempts to solve, though at the present time, we only support inheritance, not roles (if you read through the code, you'll understand why).

Instead, wouldn't it be nice to do this?

my $customers = $objects->objectset('Customer')->search;

while ( my $customer = $customers->next ) {
    say $customer->name;            # inherited from person
    say $customer->birthday;        # from person
    say $customer->first_purchase;  # from customer
}

Or do this?

$customer->name('new name'); # sets person.name
$customer->update;           # updates customer and person

Right now everything I've shown above works. The code itself is easy to use and starts like this:

my $schema = My::DBIx::Class::Schema->connect(@args);

my $objects = DBIx::Class::Objects->new({
    schema      => $schema,
    object_base => 'My::Object',
});
$objects->load_objects;

my $person = $objects->objectset('Person')
                     ->find( { email => 'not@home.com' } );

# If found, $person is a My::Object::Person object, not a
# My::DBIx::Class::Schema::Result::Person

Note that the $objects->objectset($source) method behaves just like $schema->resultset($source), but when you fetch an object from the set, you don't get a dbic result, you get something that inherits from DBIx::Class::Objects::Base.

You don't need to write any object code to make things work. Just calling new() and load_objects() will create all of your objects on the fly for you. However, if you want to use inheritance or some other form of composition, you'll need to write the object classes yourself. Here's how they look for the Person and Customer example:

package My::Object::Person;

use Moose;
use namespace::autoclean;

# this is optional. If you forget to include it, DBIx::Class::Objects will
# inject this for you. However, it's good to have it here for
# documentation purposes.
extends 'DBIx::Class::Objects::Base';

sub is_customer {
    my $self = shift;
    return defined $self->customer;
}

__PACKAGE__->meta->make_immutable;

1;

And for your customer:

package My::Object::Customer;

use Moose;
extends 'My::Object::Person';

__PACKAGE__->meta->make_immutable;

1;

If you need the original dbic objects:

my $dbic_customer = $customer->result_source;
my $dbic_person   = $customer->person->result_source;

I have no idea if this is a good idea or not, but it sure was fun to write. You can read through the code to see a lot of Moose metaprotocol hacking.

It needs a lot of work (for example, you can't yet create objects directly, but have to use the DBIC interface) and I certainly wouldn't recommend it for production use, but hopefully someone will find it interesting.

2 Comments

This stuff blows my tiny mind :-)

This is pretty sweet. I do have this exact problem with persons and multiple other sources using the person source.

About Ovid

user-pic Freelance Perl/Testing/Agile consultant and trainer. See http://www.allaroundtheworld.fr/ for our services. If you have a problem with Perl, we will solve it for you. And don't forget to buy my book! http://www.amazon.com/Beginning-Perl-Curtis-Poe/dp/1118013840/