1 package DBIx::Class::ResultSource::MultipleTableInheritance;
5 use parent qw(DBIx::Class::ResultSource::View);
6 use Method::Signatures::Simple;
7 use Carp::Clan qw/^DBIx::Class/;
8 use aliased 'DBIx::Class::ResultSource::Table';
9 use aliased 'DBIx::Class::ResultClass::HashRefInflator';
10 use String::TT qw(strip tt);
11 use Scalar::Util qw(blessed);
12 use namespace::autoclean;
16 __PACKAGE__->mk_group_accessors(simple => qw(parent_source additional_parents));
20 # On construction, we hook $self->result_class->result_source_instance
21 # if present to get the superclass' source object
23 # When attached to a schema, we need to add sources to that schema with
24 # appropriate relationships for the foreign keys so the concrete tables
27 # We also generate our own view definition using this class' concrete table
28 # and the view for the superclass, and stored procedures for the insert,
29 # update and delete operations on this view.
31 # deploying the postgres rules through SQLT may be a pain though.
33 method new ($class: @args) {
34 my $new = $class->next::method(@args);
35 my $rc = $new->result_class;
36 if (my $meth = $rc->can('result_source_instance')) {
37 my $source = $rc->$meth;
38 if ($source->result_class ne $new->result_class
39 && $new->result_class->isa($source->result_class)) {
40 $new->parent_source($source);
46 method add_additional_parents (@classes) {
47 foreach my $class (@classes) {
48 Class::C3::Componentised->ensure_class_loaded($class);
49 $self->add_additional_parent(
50 $class->result_source_instance
55 method add_additional_parent ($source) {
56 my ($our_pk, $their_pk) = map {
57 join('|',sort $_->primary_columns)
60 confess "Can't attach additional parent ${\$source->name} - it has different PKs ($their_pk versus our $our_pk)"
61 unless $their_pk eq $our_pk;
62 $self->additional_parents([
63 @{$self->additional_parents||[]}, $source
67 $_ => # put the extra key first to default it
68 { originally_defined_in => $source->name, %{$source->column_info($_)}, },
69 } grep !$self->has_column($_), $source->columns
71 foreach my $rel ($source->relationships) {
72 my $rel_info = $source->relationship_info($rel);
73 $self->add_relationship(
74 $rel, $rel_info->{source}, $rel_info->{cond},
75 # extra key first to default it
76 {originally_defined_in => $source->name, %{$rel_info->{attrs}}},
80 push(@{$self->result_class.'::ISA'}, $source->result_class);
84 method _source_by_name ($name) {
85 my $schema = $self->schema;
87 grep { $_->name eq $name }
88 map $schema->source($_), $schema->sources;
89 confess "Couldn't find attached source for parent $name - did you use load_classes? This module is only compatible with load_namespaces"
94 method schema (@args) {
95 my $ret = $self->next::method(@args);
97 if ($self->parent_source) {
98 my $parent_name = $self->parent_source->name;
99 $self->parent_source($self->_source_by_name($parent_name));
101 $self->additional_parents([
102 map { $self->_source_by_name($_->name) }
103 @{$self->additional_parents||[]}
106 use Devel::Dwarn; use 5.012; say Dwarn $ret;
110 method attach_additional_sources () {
111 my $raw_name = $self->raw_source_name;
112 my $schema = $self->schema;
114 # if the raw source is already present we can assume we're done
115 return if grep { $_ eq $raw_name } $schema->sources;
117 # our parent should've been registered already actually due to DBIC
118 # attaching subclass sources later in load_namespaces
121 if ($self->parent_source) {
122 my $parent_name = $self->parent_source->name;
124 grep { $_->name eq $parent_name }
125 map $schema->source($_), $schema->sources;
126 confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
128 $self->parent_source($parent); # so our parent is the one in this schema
131 # create the raw table source
133 my $table = Table->new({ name => $self->raw_table_name });
135 # we don't need to add the PK cols explicitly if we're the root table
136 # since they'll get added below
141 foreach my $pri ($self->primary_columns) {
142 my %info = %{$self->column_info($pri)};
143 delete @info{qw(is_auto_increment sequence auto_nextval)};
144 $table->add_column($pri => \%info);
145 $pk_join{"foreign.${pri}"} = "self.${pri}";
147 # have to use source name lookups rather than result class here
148 # because we don't actually have a result class on the raw sources
149 $table->add_relationship('parent', $parent->raw_source_name, \%pk_join);
150 $self->deploy_depends_on->{$parent->result_class} = 1;
153 foreach my $add (@{$self->additional_parents||[]}) {
154 $table->add_relationship(
155 'parent_'.$add->name, $add->source_name, \%pk_join
157 $self->deploy_depends_on->{$add->result_class} = 1 if $add->isa('DBIx::Class::ResultSource::View');
160 map { ($_ => { %{$self->column_info($_)} }) }
161 grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
164 $table->set_primary_key($self->primary_columns);
166 ## Attempting to re-add sequence here -- AKB
167 for my $pk ( $self->primary_columns ) {
170 #use 5.012; use Devel::Dwarn; say Dwarn $schema->source($table->_relationships->{parent}->{class}) if $table->_relationships->{parent}->{class};
171 $table->columns_info->{$pk}->{sequence} =
173 $schema->source( $table->_relationships->{parent}->{class} )->name,
174 $self->primary_columns )
175 if $table->columns_info->{$pk}->{originally_defined_in} ne $self->name
176 && $table->_relationships->{parent}->{class};
180 # we need to copy our rels to the raw object as well
181 # note that ->add_relationship on a source object doesn't create an
182 # accessor so we can leave that part in the attributes
184 # if the other side is a table then we need to copy any rels it has
185 # back to us, as well, so that they point at the raw table. if the
186 # other side is an MTI view then we need to create the rels to it to
187 # point at -its- raw table; we don't need to worry about backrels because
188 # it's going to run this method too (and its raw source might not exist
189 # yet so we can't, anyway)
191 foreach my $rel ($self->relationships) {
192 my $rel_info = $self->relationship_info($rel);
194 # if we got this from the superclass, -its- raw table will nail this.
195 # if we got it from an additional parent, it's its problem.
196 next unless $rel_info->{attrs}{originally_defined_in} eq $self->name;
198 my $f_source = $schema->source($rel_info->{source});
200 # __PACKAGE__ is correct here because subclasses should be caught
202 my $one_of_us = $f_source->isa(__PACKAGE__);
204 my $f_source_name = $f_source->${\
205 ($one_of_us ? 'raw_source_name' : 'source_name')
208 $table->add_relationship(
209 '_'.$rel, $f_source_name, @{$rel_info}{qw(cond attrs)}
212 unless ($one_of_us) {
214 # we haven't been registered yet, so reverse_ cries
215 # XXX this is evil and will probably break eventually
216 local @{$schema->source_registrations}
217 {map $self->$_, qw(source_name result_class)}
219 $self->reverse_relationship_info($rel);
221 foreach my $rev_rel (keys %$reverse) {
222 $f_source->add_relationship(
223 '_raw_'.$rev_rel, $raw_name, @{$reverse->{$rev_rel}}{qw(cond attrs)}
229 $schema->register_source($raw_name => $table);
232 method set_primary_key (@args) {
233 if ($self->parent_source) {
234 confess "Can't set primary key on a subclass";
236 return $self->next::method(@args);
239 method set_sequence ($table_name, @pks) {
240 return $table_name . '_' . join('_',@pks) . '_' . 'seq';
243 method raw_source_name () {
244 my $base = $self->source_name;
245 confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
247 return 'Raw::'.$base;
250 method raw_table_name () {
251 return '_'.$self->name;
254 method add_columns (@args) {
255 my $ret = $self->next::method(@args);
256 $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
260 method add_relationship ($name, $f_source, $cond, $attrs) {
262 $name, $f_source, $cond,
263 { originally_defined_in => $self->name, %{$attrs||{}}, }
269 # helper routines, constructed as anon subs so autoclean nukes them
273 *argify = sub (@names) {
277 *qualify_with = sub ($source, @names) {
278 my $name = blessed($source) ? $source->name : $source;
279 map join('.', $name, $_), @names;
282 *body_cols = sub ($source) {
283 my %pk; @pk{$source->primary_columns} = ();
284 map +{ %{$source->column_info($_)}, name => $_ },
285 grep !exists $pk{$_}, $source->columns;
288 *pk_cols = sub ($source) {
289 map +{ %{$source->column_info($_)}, name => $_ },
290 $source->primary_columns;
293 *names_of = sub (@cols) { map $_->{name}, @cols };
295 *function_body = sub {
296 my ($name,$args,$body_parts) = @_;
299 map "_${\$_->{name}} ${\uc($_->{data_type})}",
302 my $body = join("\n", '', map " $_;", @$body_parts);
304 CREATE OR REPLACE FUNCTION [% name %]
306 RETURNS VOID AS $function$
310 $function$ LANGUAGE plpgsql;
313 #*function_body = sub ($name,$args,$body_parts) {
316 #map "_${\$_->{name}} ${\uc($_->{data_type})}",
319 #my $body = join("\n", '', map " $_;", @$body_parts);
321 #CREATE OR REPLACE FUNCTION [% name %]
323 #RETURNS VOID AS $function$
327 #$function$ LANGUAGE plpgsql;
336 *arg_hash = sub ($source) {
337 map +($_ => \(argify $_)), names_of body_cols $source;
340 *rule_body = sub ($on, $to, $oldlist, $newlist) {
341 my $arglist = join(', ',
342 (qualify_with 'OLD', names_of @$oldlist),
343 (qualify_with 'NEW', names_of @$newlist),
345 $to = $to->name if blessed($to);
347 CREATE RULE _[% to %]_[% on %]_rule AS
348 ON [% on | upper %] TO [% to %]
350 SELECT [% to %]_[% on %]([% arglist %])
356 method root_table () {
358 ? $self->parent_source->root_table
359 : $self->schema->source($self->raw_source_name)
362 method view_definition () {
363 my $schema = $self->schema;
364 confess "Can't generate view without connected schema, sorry"
365 unless $schema && $schema->storage;
366 my $sqla = $schema->storage->sql_maker;
367 my $table = $self->schema->source($self->raw_source_name);
368 my $super_view = $self->parent_source;
369 my @all_parents = my @other_parents = @{$self->additional_parents||[]};
370 push(@all_parents, $super_view) if defined($super_view);
371 my @sources = ($table, @all_parents);
372 my @body_cols = map body_cols($_), @sources;
373 my @pk_cols = pk_cols $self;
377 my $am_root = !($super_view || @other_parents);
379 my $select = $sqla->select(
382 : ([ # FROM _tbl _tbl
383 { $table->name => $table->name },
387 { $parent->name => $parent->name },
388 # ON _tbl.id = view.id
389 { map +(qualify_with($parent, $_), qualify_with($table, $_)),
395 [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
398 my ($now, @next) = grep defined, $super_view, $table, @other_parents;
402 # NOTE: this assumes a single PK col called id with a sequence somewhere
403 # but nothing else -should- so fixing this should make everything work
406 $self->name.'_insert',
409 $sqla->insert( # INSERT INTO tbl/super_view (foo, ...) VALUES (_foo, ...)
414 $sqla->insert( # INSERT INTO parent (id, ...)
415 # VALUES (currval('_root_tbl_id_seq'), ...)
419 id => \"currval('${\$self->root_table->name}_id_seq')",
425 # note - similar to arg_hash but not quite enough to share code sanely
426 my $pk_where = { # id = _id AND id2 = _id2 ...
427 map +($_ => \"= ${\argify $_}"), names_of @pk_cols
434 $self->name.'_update',
435 [ @pk_cols, @body_cols ],
437 $_->name, # UPDATE foo
438 { arg_hash $_ }, # SET a = _a
447 $self->name.'_delete',
449 [ map $sqla->delete($_->name, $pk_where), @sources ];
452 (rule_body insert => $self, [], \@body_cols),
453 (rule_body update => $self, \@pk_cols, \@body_cols),
454 (rule_body delete => $self, \@pk_cols, []),
456 return join("\n\n", $select, $insert_func, $update_func, $delete_func, @rules);
465 DBIx::Class::ResultSource::MultipleTableInheritance
466 Use multiple tables to define your classes
470 This only works with PostgreSQL for the moment.
475 package Cafe::Result::Coffee;
479 use parent 'DBIx::Class::Core';
480 use aliased 'DBIx::Class::ResultSource::MultipleTableInheritance'
483 __PACKAGE__->table_class(MTI);
484 __PACKAGE__->table('coffee');
485 __PACKAGE__->add_columns(
486 "id", { data_type => "integer" },
489 default_value => "good" },
492 __PACKAGE__->set_primary_key("id");
498 package Cafe::Result::Sumatra;
500 use parent 'Cafe::Result::Coffee';
502 __PACKAGE__->table('sumatra');
504 __PACKAGE__->add_columns( "aroma",
505 { data_type => "text" }
513 my $schema = Cafe->connect($dsn,$user,$pass);
515 my $cup = $schema->resultset('Sumatra');
517 print STDERR Dwarn $cup->result_source->columns;
524 Inherit from this package and you can make a resultset class from a view, but
525 that's more than a little bit misleading: the result is B<transparently
528 This is accomplished through the use of stored procedures that map changes
529 written to the view to changes to the underlying concrete tables.
533 In many applications, many classes are subclasses of others. Let's say you
536 # Conceptual domain model
551 That's redundant. Hold on a sec...
559 class Investor extends User {
563 Good idea, but how to put this into code?
565 One far-too common and absolutely horrendous solution is to have a "checkbox"
566 in your database: a nullable "investor" column, which entails a nullable
567 "dollars" column, in the user table.
569 create table "user" (
570 "id" integer not null primary key autoincrement,
571 "name" text not null,
572 "password" text not null,
573 "investor" tinyint(1),
577 Let's not discuss that further.
579 A second, better, solution is to break out the two tables into user and
582 create table "user" (
583 "id" integer not null primary key autoincrement,
584 "name" text not null,
585 "password" text not null
588 create table "investor" (
589 "id" integer not null references user("id"),
593 So that investor's PK is just an FK to the user. We can clearly see the class
594 hierarchy here, in which investor is a subclass of user. In DBIx::Class
595 applications, this second strategy looks like:
597 my $user_rs = $schema->resultset('User');
598 my $new_user = $user_rs->create(
599 name => $args->{name},
600 password => $args->{password},
605 my $new_investor = $schema->resultset('Investor')->create(
607 dollars => $args->{dollars},
610 One can cope well with the second strategy, and it seems to be the most popular
615 There is a third strategy implemented here. Make the database do more of the
616 work: hide the nasty bits so we don't have to handle them unless we really want
617 to. It'll save us some typing and it'll make for more expressive code. What if
620 my $new_investor = $schema->resultset('Investor')->create(
621 name => $args->{name},
622 password => $args->{password},
623 dollars => $args->{dollars},
626 And have it Just Work? The user...
629 name => $args->{name},
630 password => $args->{password},
633 should be created behind the scenes, and the use of either user or investor
634 in your code should require no special handling. Deleting and updating
635 $new_investor should also delete or update the user row.
637 It does. User and investor are both views, their concrete tables abstracted
638 away behind a set of rules and triggers. You would expect the above DBIC
639 create statement to look like this in SQL:
641 INSERT INTO investor ("name","password","dollars") VALUES (...);
643 But using MTI, it is really this:
645 INSERT INTO _user_table ("username","password") VALUES (...);
646 INSERT INTO _investor_table ("id","dollars") VALUES (currval('_user_table_id_seq',...) );
648 For deletes, the triggers fire in reverse, to preserve referential integrity
649 (foreign key constraints). For instance:
651 my $investor = $schema->resultset('Investor')->find({id => $args->{id}});
656 DELETE FROM _investor_table WHERE ("id" = ?);
657 DELETE FROM _user_table WHERE ("id" = ?);
667 MTI find the parents, if any, of your resultset class and adds them to the
668 list of parent_sources for the table.
671 =item add_additional_parents
674 Continuing with coffee:
676 __PACKAGE__->result_source_instance->add_additional_parents(
678 MyApp::Schema::Result::Beverage
679 MyApp::Schema::Result::Liquid
683 This just lets you manually add additional parents beyond the ones MTI finds.
685 =item add_additional_parent
687 __PACKAGE__->result_source_instance->add_additional_parent(
688 MyApp::Schema::Result::Beverage
691 You can also add just one.
693 =item attach_additional_sources
695 MTI takes the parents' sources and relationships, creates a new
696 DBIx::Class::Table object from them, and registers this as a new, raw, source
701 print STDERR map { "$_\n" } MyApp::Schema->sources;
709 Raw::Sumatra will be used to generate the view.
711 =item view_definition
713 This takes the raw table and generates the view (and stored procedures) you will use.
719 Matt S. Trout, E<lt>mst@shadowcatsystems.co.ukE<gt>
723 Amiri Barksdale, E<lt>amiri@metalabel.comE<gt>
727 Copyright (c) 2010 the DBIx::Class::ResultSource::MultipleTableInheritance
728 L</AUTHOR> and L</CONTRIBUTORS> as listed above.
732 This library is free software; you can redistribute it and/or modify
733 it under the same terms as Perl itself.
738 L<DBIx::Class::ResultSource>