X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource%2FMultipleTableInheritance.pm;h=9dceab69b551a97eff0190db3fb5219242b2ef5d;hb=ebcd7e950dc50fd9529d2d59acd1fb9fb72e3916;hp=0a45aa8eabf31394f3e32491255e81ddc085186c;hpb=2816c8ed6bd9d17cf62277b0c3133ecfe7f44429;p=dbsrgits%2FDBIx-Class-ResultSource-MultipleTableInheritance.git diff --git a/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm b/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm index 0a45aa8..9dceab6 100644 --- a/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm +++ b/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm @@ -11,6 +11,10 @@ use String::TT qw(strip tt); use Scalar::Util qw(blessed); use namespace::autoclean; +our $VERSION = 0.01; + +__PACKAGE__->mk_group_accessors(simple => qw(parent_source additional_parents)); + # how this works: # # On construction, we hook $self->result_class->result_source_instance @@ -26,8 +30,6 @@ use namespace::autoclean; # # deploying the postgres rules through SQLT may be a pain though. -__PACKAGE__->mk_group_accessors(simple => qw(parent_source additional_parents)); - method new ($class: @args) { my $new = $class->next::method(@args); my $rc = $new->result_class; @@ -41,6 +43,15 @@ method new ($class: @args) { return $new; } +method add_additional_parents (@classes) { + foreach my $class (@classes) { + Class::C3::Componentised->ensure_class_loaded($class); + $self->add_additional_parent( + $class->result_source_instance + ); + } +} + method add_additional_parent ($source) { my ($our_pk, $their_pk) = map { join('|',sort $_->primary_columns) @@ -65,21 +76,32 @@ method add_additional_parent ($source) { {originally_defined_in => $source->name, %{$rel_info->{attrs}}}, ); } + { no strict 'refs'; + push(@{$self->result_class.'::ISA'}, $source->result_class); + } +} + +method _source_by_name ($name) { + my $schema = $self->schema; + my ($source) = + grep { $_->name eq $name } + map $schema->source($_), $schema->sources; + confess "Couldn't find attached source for parent $name - did you use load_classes? This module is only compatible with load_namespaces" + unless $source; + return $source; } method schema (@args) { my $ret = $self->next::method(@args); if (@args) { if ($self->parent_source) { - my $schema = $self->schema; my $parent_name = $self->parent_source->name; - my ($parent) = - grep { $_->name eq $parent_name } - map $schema->source($_), $schema->sources; - confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces" - unless $parent; - $self->parent_source($parent); # so our parent is the one in this schema + $self->parent_source($self->_source_by_name($parent_name)); } + $self->additional_parents([ + map { $self->_source_by_name($_->name) } + @{$self->additional_parents||[]} + ]); } return $ret; } @@ -124,14 +146,14 @@ method attach_additional_sources () { # have to use source name lookups rather than result class here # because we don't actually have a result class on the raw sources $table->add_relationship('parent', $parent->raw_source_name, \%pk_join); - $self->depends_on->{$parent->source_name} = 1; + $self->deploy_depends_on->{$parent->result_class} = 1; } foreach my $add (@{$self->additional_parents||[]}) { $table->add_relationship( 'parent_'.$add->name, $add->source_name, \%pk_join ); - $self->depends_on->{$add->source_name} = 1; + $self->deploy_depends_on->{$add->result_class} = 1; } # add every column that's actually a concrete part of us @@ -254,7 +276,8 @@ BEGIN { *names_of = sub (@cols) { map $_->{name}, @cols }; - *function_body = sub ($name, $args, $body_parts) { + *function_body = sub { + my ($name,$args,$body_parts) = @_; my $arglist = join( ', ', map "_${\$_->{name}} ${\uc($_->{data_type})}", @@ -271,6 +294,23 @@ BEGIN { $function$ LANGUAGE plpgsql; }; }; + #*function_body = sub ($name,$args,$body_parts) { + #my $arglist = join( + #', ', + #map "_${\$_->{name}} ${\uc($_->{data_type})}", + #@$args + #); + #my $body = join("\n", '', map " $_;", @$body_parts); + #return strip tt q{ + #CREATE OR REPLACE FUNCTION [% name %] + #([% arglist %]) + #RETURNS VOID AS $function$ + #BEGIN + #[%- body %] + #END; + #$function$ LANGUAGE plpgsql; + #}; + #}; } BEGIN { @@ -401,3 +441,284 @@ method view_definition () { } 1; + +__END__ + +=head1 NAME + +DBIx::Class::ResultSource::MultipleTableInheritance +Use multiple tables to define your classes + +=head1 NOTICE + +This only works with PostgreSQL for the moment. + +=head1 SYNOPSIS + + { + package Cafe::Result::Coffee; + + use strict; + use warnings; + use parent 'DBIx::Class::Core'; + use aliased 'DBIx::Class::ResultSource::MultipleTableInheritance' + => 'MTI'; + + __PACKAGE__->table_class(MTI); + __PACKAGE__->table('coffee'); + __PACKAGE__->add_columns( + "id", { data_type => "integer" }, + "flavor", { + data_type => "text", + default_value => "good" }, + ); + + __PACKAGE__->set_primary_key("id"); + + 1; + } + + { + package Cafe::Result::Sumatra; + + use parent 'Cafe::Result::Coffee'; + + __PACKAGE__->table('sumatra'); + + __PACKAGE__->add_columns( "aroma", + { data_type => "text" } + ); + + 1; + } + + ... + + my $schema = Cafe->connect($dsn,$user,$pass); + + my $cup = $schema->resultset('Sumatra'); + + print STDERR Dwarn $cup->result_source->columns; + + "id" + "flavor" + "aroma" + .. + +Inherit from this package and you can make a resultset class from a view, but +that's more than a little bit misleading: the result is B. + +This is accomplished through the use of stored procedures that map changes +written to the view to changes to the underlying concrete tables. + +=head1 WHY? + +In many applications, many classes are subclasses of others. Let's say you +have this schema: + + # Conceptual domain model + + class User { + has id, + has name, + has password + } + + class Investor { + has id, + has name, + has password, + has dollars + } + +That's redundant. Hold on a sec... + + class User { + has id, + has name, + has password + } + + class Investor extends User { + has dollars + } + +Good idea, but how to put this into code? + +One far-too common and absolutely horrendous solution is to have a "checkbox" +in your database: a nullable "investor" column, which entails a nullable +"dollars" column, in the user table. + + create table "user" ( + "id" integer not null primary key autoincrement, + "name" text not null, + "password" text not null, + "investor" tinyint(1), + "dollars" integer + ); + +Let's not discuss that further. + +A second, better, solution is to break out the two tables into user and +investor: + + create table "user" ( + "id" integer not null primary key autoincrement, + "name" text not null, + "password" text not null + ); + + create table "investor" ( + "id" integer not null references user("id"), + "dollars" integer + ); + +So that investor's PK is just an FK to the user. We can clearly see the class +hierarchy here, in which investor is a subclass of user. In DBIx::Class +applications, this second strategy looks like: + + my $user_rs = $schema->resultset('User'); + my $new_user = $user_rs->create( + name => $args->{name}, + password => $args->{password}, + ); + + ... + + my $new_investor = $schema->resultset('Investor')->create( + id => $new_user->id, + dollars => $args->{dollars}, + ); + +One can cope well with the second strategy, and it seems to be the most popular +smart choice. + +=head1 HOW? + +There is a third strategy implemented here. Make the database do more of the +work: hide the nasty bits so we don't have to handle them unless we really want +to. It'll save us some typing and it'll make for more expressive code. What if +we could do this: + + my $new_investor = $schema->resultset('Investor')->create( + name => $args->{name}, + password => $args->{password}, + dollars => $args->{dollars}, + ); + +And have it Just Work? The user... + + { + name => $args->{name}, + password => $args->{password}, + } + +should be created behind the scenes, and the use of either user or investor +in your code should require no special handling. Deleting and updating +$new_investor should also delete or update the user row. + +It does. User and investor are both views, their concrete tables abstracted +away behind a set of rules and triggers. You would expect the above DBIC +create statement to look like this in SQL: + + INSERT INTO investor ("name","password","dollars") VALUES (...); + +But using MTI, it is really this: + + INSERT INTO _user_table ("username","password") VALUES (...); + INSERT INTO _investor_table ("id","dollars") VALUES (currval('_user_table_id_seq',...) ); + +For deletes, the triggers fire in reverse, to preserve referential integrity +(foreign key constraints). For instance: + + my $investor = $schema->resultset('Investor')->find({id => $args->{id}}); + $investor->delete; + +Becomes: + + DELETE FROM _investor_table WHERE ("id" = ?); + DELETE FROM _user_table WHERE ("id" = ?); + + +=head1 METHODS + +=over + +=item new + + +MTI find the parents, if any, of your resultset class and adds them to the +list of parent_sources for the table. + + +=item add_additional_parents + + +Continuing with coffee: + + __PACKAGE__->result_source_instance->add_additional_parents( + qw/ + MyApp::Schema::Result::Beverage + MyApp::Schema::Result::Liquid + / + ); + +This just lets you manually add additional parents beyond the ones MTI finds. + +=item add_additional_parent + + __PACKAGE__->result_source_instance->add_additional_parent( + MyApp::Schema::Result::Beverage + ); + +You can also add just one. + +=item attach_additional_sources + +MTI takes the parents' sources and relationships, creates a new +DBIx::Class::Table object from them, and registers this as a new, raw, source +in the schema, e.g., + + use MyApp::Schema; + + print STDERR map { "$_\n" } MyApp::Schema->sources; + + # Coffee + # Beverage + # Liquid + # Sumatra + # Raw::Sumatra + +Raw::Sumatra will be used to generate the view. + +=item view_definition + +This takes the raw table and generates the view (and stored procedures) you will use. + +=back + +=head1 AUTHOR + +Matt S. Trout, Emst@shadowcatsystems.co.ukE + +=head2 CONTRIBUTORS + +Amiri Barksdale, Eamiri@metalabel.comE + +=head1 COPYRIGHT + +Copyright (c) 2010 the DBIx::Class::ResultSource::MultipleTableInheritance +L and L as listed above. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 SEE ALSO + +L +L + +=cut