X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource%2FMultipleTableInheritance.pm;h=ab2a213cbc0de4ee5ee93005873c12adc37661aa;hb=f49b3ff102d369c2cf79fa25c3ac3845d75e133b;hp=2606b95c1abc7ef4603b2ea77e1eb1115fef5314;hpb=490d5481d31e1ec638e07e21b8bbbdc3b161297d;p=dbsrgits%2FDBIx-Class-ResultSource-MultipleTableInheritance.git diff --git a/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm b/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm index 2606b95..ab2a213 100644 --- a/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm +++ b/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm @@ -11,11 +11,15 @@ 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 # if present to get the superclass' source object -# +# # When attached to a schema, we need to add sources to that schema with # appropriate relationships for the foreign keys so the concrete tables # get generated @@ -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)); - method new ($class: @args) { my $new = $class->next::method(@args); my $rc = $new->result_class; @@ -41,15 +43,70 @@ 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) + } ($self, $source); + + confess "Can't attach additional parent ${\$source->name} - it has different PKs ($their_pk versus our $our_pk)" + unless $their_pk eq $our_pk; + $self->additional_parents([ + @{$self->additional_parents||[]}, $source + ]); + $self->add_columns( + map { + $_ => # put the extra key first to default it + { originally_defined_in => $source->name, %{$source->column_info($_)}, }, + } grep !$self->has_column($_), $source->columns + ); + foreach my $rel ($source->relationships) { + my $rel_info = $source->relationship_info($rel); + $self->add_relationship( + $rel, $rel_info->{source}, $rel_info->{cond}, + # extra key first to default it + {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) { - $self->_attach_additional_sources; + if ($self->parent_source) { + my $parent_name = $self->parent_source->name; + $self->parent_source($self->_source_by_name($parent_name)); + } + $self->additional_parents([ + map { $self->_source_by_name($_->name) } + @{$self->additional_parents||[]} + ]); } return $ret; } -method _attach_additional_sources () { +method attach_additional_sources () { my $raw_name = $self->raw_source_name; my $schema = $self->schema; @@ -62,7 +119,7 @@ method _attach_additional_sources () { my $parent; if ($self->parent_source) { my $parent_name = $self->parent_source->name; - ($parent) = + ($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" @@ -77,21 +134,27 @@ method _attach_additional_sources () { # we don't need to add the PK cols explicitly if we're the root table # since they'll get added below + my %pk_join; + if ($parent) { - my %join; foreach my $pri ($self->primary_columns) { my %info = %{$self->column_info($pri)}; delete @info{qw(is_auto_increment sequence auto_nextval)}; $table->add_column($pri => \%info); - $join{"foreign.${pri}"} = "self.${pri}"; + $pk_join{"foreign.${pri}"} = "self.${pri}"; } # 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, \%join); + $table->add_relationship('parent', $parent->raw_source_name, \%pk_join); + $self->deploy_depends_on->{$parent->result_class} = 1; } - # add every column that's actually a concrete part of us - + foreach my $add (@{$self->additional_parents||[]}) { + $table->add_relationship( + 'parent_'.$add->name, $add->source_name, \%pk_join + ); + $self->deploy_depends_on->{$add->result_class} = 1 if $add->isa('DBIx::Class::ResultSource::View'); + } $table->add_columns( map { ($_ => { %{$self->column_info($_)} }) } grep { $self->column_info($_)->{originally_defined_in} eq $self->name } @@ -113,6 +176,10 @@ method _attach_additional_sources () { foreach my $rel ($self->relationships) { my $rel_info = $self->relationship_info($rel); + # if we got this from the superclass, -its- raw table will nail this. + # if we got it from an additional parent, it's its problem. + next unless $rel_info->{attrs}{originally_defined_in} eq $self->name; + my $f_source = $schema->source($rel_info->{source}); # __PACKAGE__ is correct here because subclasses should be caught @@ -122,7 +189,7 @@ method _attach_additional_sources () { my $f_source_name = $f_source->${\ ($one_of_us ? 'raw_source_name' : 'source_name') }; - + $table->add_relationship( '_'.$rel, $f_source_name, @{$rel_info}{qw(cond attrs)} ); @@ -154,6 +221,10 @@ method set_primary_key (@args) { return $self->next::method(@args); } +method set_sequence ($table_name, @pks) { + return $table_name . '_' . join('_',@pks) . '_' . 'seq'; +} + method raw_source_name () { my $base = $self->source_name; confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name" @@ -171,6 +242,13 @@ method add_columns (@args) { return $ret; } +method add_relationship ($name, $f_source, $cond, $attrs) { + $self->next::method( + $name, $f_source, $cond, + { originally_defined_in => $self->name, %{$attrs||{}}, } + ); +} + BEGIN { # helper routines, constructed as anon subs so autoclean nukes them @@ -199,7 +277,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})}", @@ -236,7 +315,7 @@ BEGIN { CREATE RULE _[% to %]_[% on %]_rule AS ON [% on | upper %] TO [% to %] DO INSTEAD ( - SELECT _[% to %]_[% on %]([% arglist %]) + SELECT [% to %]_[% on %]([% arglist %]) ); }; }; @@ -253,30 +332,53 @@ 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; + + # Order body_cols to match the columns order. + # Must match or you get typecast errors. + my %body_cols = map { $_->{name} => $_ } @body_cols; + @body_cols = + map { $body_cols{$_} } + grep { defined $body_cols{$_} } + $self->columns; my @pk_cols = pk_cols $self; + # Grab sequence from root table. Only works with one PK named id... + # TBD: Fix this so it's more flexible. + for my $pk_col (@pk_cols) { + $self->columns_info->{ $pk_col->{name} }->{sequence} = + $self->root_table->name . '_id_seq'; + } + # 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 @@ -287,21 +389,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 @@ -339,3 +440,289 @@ 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 at the moment. It has been tested with +PostgreSQL 9.0 and 9.1 beta. + +There is one additional caveat: the "parent" result classes that you +defined with this resultsource must have one primary column and it must +be named "id." + +=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@roosterpirates.comE + +=head1 COPYRIGHT + +Copyright (c) 2011 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