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=191448cef6319c1c6f3f7cd502702102b7b03705;hpb=803ffff298b3034e5b04a3b3a5e2e1565f8ba7f5;p=dbsrgits%2FDBIx-Class-ResultSource-MultipleTableInheritance.git diff --git a/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm b/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm index 191448c..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 { @@ -291,7 +331,7 @@ BEGIN { CREATE RULE _[% to %]_[% on %]_rule AS ON [% on | upper %] TO [% to %] DO INSTEAD ( - SELECT _[% to %]_[% on %]([% arglist %]) + SELECT [% to %]_[% on %]([% arglist %]) ); }; }; @@ -308,30 +348,38 @@ method view_definition () { confess "Can't generate view without connected schema, sorry" unless $schema && $schema->storage; my $sqla = $schema->storage->sql_maker; - my @sources = my $table = $self->schema->source($self->raw_source_name); + my $table = $self->schema->source($self->raw_source_name); my $super_view = $self->parent_source; - push(@sources, $super_view) if defined($super_view); + my @all_parents = my @other_parents = @{$self->additional_parents||[]}; + push(@all_parents, $super_view) if defined($super_view); + my @sources = ($table, @all_parents); my @body_cols = map body_cols($_), @sources; my @pk_cols = pk_cols $self; # SELECT statement + my $am_root = !($super_view || @other_parents); + my $select = $sqla->select( - ($super_view - ? ([ # FROM _tbl _tbl + ($am_root + ? ($table->name) + : ([ # FROM _tbl _tbl { $table->name => $table->name }, - [ # JOIN view view - { $super_view->name => $super_view->name }, - # ON _tbl.id = view.id - { map +(qualify_with($super_view, $_), qualify_with($table, $_)), - names_of @pk_cols } - ] + map { + my $parent = $_; + [ # JOIN view view + { $parent->name => $parent->name }, + # ON _tbl.id = view.id + { map +(qualify_with($parent, $_), qualify_with($table, $_)), + names_of @pk_cols } + ] + } @all_parents ]) - : ($table->name)), + ), [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ], ).';'; - my ($now, $next) = grep defined, $super_view, $table; + my ($now, @next) = grep defined, $super_view, $table, @other_parents; # INSERT function @@ -342,21 +390,20 @@ method view_definition () { $self->name.'_insert', \@body_cols, [ - $sqla->insert( # INSERT INTO _tbl (foo, ...) VALUES (_foo, ...) + $sqla->insert( # INSERT INTO tbl/super_view (foo, ...) VALUES (_foo, ...) $now->name, { arg_hash $now }, ), - ($next - ? $sqla->insert( # INSERT INTO super_view (id, ...) - # VALUES (currval('_root_tbl_id_seq'), ...) - $next->name, - { - (arg_hash $next), - id => \"currval('${\$self->root_table->name}_id_seq')", - } - ) - : () - ) + (map { + $sqla->insert( # INSERT INTO parent (id, ...) + # VALUES (currval('_root_tbl_id_seq'), ...) + $_->name, + { + (arg_hash $_), + id => \"currval('${\$self->root_table->name}_id_seq')", + } + ) + } @next) ]; # note - similar to arg_hash but not quite enough to share code sanely @@ -394,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