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||[]}
109 method attach_additional_sources () {
110 my $raw_name = $self->raw_source_name;
111 my $schema = $self->schema;
113 # if the raw source is already present we can assume we're done
114 return if grep { $_ eq $raw_name } $schema->sources;
116 # our parent should've been registered already actually due to DBIC
117 # attaching subclass sources later in load_namespaces
120 if ($self->parent_source) {
121 my $parent_name = $self->parent_source->name;
123 grep { $_->name eq $parent_name }
124 map $schema->source($_), $schema->sources;
125 confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
127 $self->parent_source($parent); # so our parent is the one in this schema
130 # create the raw table source
132 my $table = Table->new({ name => $self->raw_table_name });
134 # we don't need to add the PK cols explicitly if we're the root table
135 # since they'll get added below
140 foreach my $pri ($self->primary_columns) {
141 my %info = %{$self->column_info($pri)};
142 delete @info{qw(is_auto_increment sequence auto_nextval)};
143 $table->add_column($pri => \%info);
144 $pk_join{"foreign.${pri}"} = "self.${pri}";
146 # have to use source name lookups rather than result class here
147 # because we don't actually have a result class on the raw sources
148 $table->add_relationship('parent', $parent->raw_source_name, \%pk_join);
149 $self->deploy_depends_on->{$parent->result_class} = 1;
152 foreach my $add (@{$self->additional_parents||[]}) {
153 $table->add_relationship(
154 'parent_'.$add->name, $add->source_name, \%pk_join
156 $self->deploy_depends_on->{$add->result_class} = 1;
159 # add every column that's actually a concrete part of us
162 map { ($_ => { %{$self->column_info($_)} }) }
163 grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
166 $table->set_primary_key($self->primary_columns);
168 # Attempting to re-add sequence here -- AKB
169 for my $pk ( $self->primary_columns ) {
170 $table->columns_info->{$pk}->{sequence} =
171 $self->set_sequence( $table->name, $self->primary_columns )
173 $table->columns_info->{$_}->{originally_defined_in} ne $self->name
174 } keys %{ $table->columns_info };
177 # we need to copy our rels to the raw object as well
178 # note that ->add_relationship on a source object doesn't create an
179 # accessor so we can leave that part in the attributes
181 # if the other side is a table then we need to copy any rels it has
182 # back to us, as well, so that they point at the raw table. if the
183 # other side is an MTI view then we need to create the rels to it to
184 # point at -its- raw table; we don't need to worry about backrels because
185 # it's going to run this method too (and its raw source might not exist
186 # yet so we can't, anyway)
188 foreach my $rel ($self->relationships) {
189 my $rel_info = $self->relationship_info($rel);
191 # if we got this from the superclass, -its- raw table will nail this.
192 # if we got it from an additional parent, it's its problem.
193 next unless $rel_info->{attrs}{originally_defined_in} eq $self->name;
195 my $f_source = $schema->source($rel_info->{source});
197 # __PACKAGE__ is correct here because subclasses should be caught
199 my $one_of_us = $f_source->isa(__PACKAGE__);
201 my $f_source_name = $f_source->${\
202 ($one_of_us ? 'raw_source_name' : 'source_name')
205 $table->add_relationship(
206 '_'.$rel, $f_source_name, @{$rel_info}{qw(cond attrs)}
209 unless ($one_of_us) {
211 # we haven't been registered yet, so reverse_ cries
212 # XXX this is evil and will probably break eventually
213 local @{$schema->source_registrations}
214 {map $self->$_, qw(source_name result_class)}
216 $self->reverse_relationship_info($rel);
218 foreach my $rev_rel (keys %$reverse) {
219 $f_source->add_relationship(
220 '_raw_'.$rev_rel, $raw_name, @{$reverse->{$rev_rel}}{qw(cond attrs)}
226 $schema->register_source($raw_name => $table);
229 method set_primary_key (@args) {
230 if ($self->parent_source) {
231 confess "Can't set primary key on a subclass";
233 return $self->next::method(@args);
236 method set_sequence ($table_name, @pks) {
237 return $table_name . '_' . join('_',@pks) . '_' . 'seq';
240 method raw_source_name () {
241 my $base = $self->source_name;
242 confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
244 return 'Raw::'.$base;
247 method raw_table_name () {
248 return '_'.$self->name;
251 method add_columns (@args) {
252 my $ret = $self->next::method(@args);
253 $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
257 method add_relationship ($name, $f_source, $cond, $attrs) {
259 $name, $f_source, $cond,
260 { originally_defined_in => $self->name, %{$attrs||{}}, }
266 # helper routines, constructed as anon subs so autoclean nukes them
270 *argify = sub (@names) {
274 *qualify_with = sub ($source, @names) {
275 my $name = blessed($source) ? $source->name : $source;
276 map join('.', $name, $_), @names;
279 *body_cols = sub ($source) {
280 my %pk; @pk{$source->primary_columns} = ();
281 map +{ %{$source->column_info($_)}, name => $_ },
282 grep !exists $pk{$_}, $source->columns;
285 *pk_cols = sub ($source) {
286 map +{ %{$source->column_info($_)}, name => $_ },
287 $source->primary_columns;
290 *names_of = sub (@cols) { map $_->{name}, @cols };
292 *function_body = sub {
293 my ($name,$args,$body_parts) = @_;
296 map "_${\$_->{name}} ${\uc($_->{data_type})}",
299 my $body = join("\n", '', map " $_;", @$body_parts);
301 CREATE OR REPLACE FUNCTION [% name %]
303 RETURNS VOID AS $function$
307 $function$ LANGUAGE plpgsql;
310 #*function_body = sub ($name,$args,$body_parts) {
313 #map "_${\$_->{name}} ${\uc($_->{data_type})}",
316 #my $body = join("\n", '', map " $_;", @$body_parts);
318 #CREATE OR REPLACE FUNCTION [% name %]
320 #RETURNS VOID AS $function$
324 #$function$ LANGUAGE plpgsql;
333 *arg_hash = sub ($source) {
334 map +($_ => \(argify $_)), names_of body_cols $source;
337 *rule_body = sub ($on, $to, $oldlist, $newlist) {
338 my $arglist = join(', ',
339 (qualify_with 'OLD', names_of @$oldlist),
340 (qualify_with 'NEW', names_of @$newlist),
342 $to = $to->name if blessed($to);
344 CREATE RULE _[% to %]_[% on %]_rule AS
345 ON [% on | upper %] TO [% to %]
347 SELECT [% to %]_[% on %]([% arglist %])
353 method root_table () {
355 ? $self->parent_source->root_table
356 : $self->schema->source($self->raw_source_name)
359 method view_definition () {
360 my $schema = $self->schema;
361 confess "Can't generate view without connected schema, sorry"
362 unless $schema && $schema->storage;
363 my $sqla = $schema->storage->sql_maker;
364 my $table = $self->schema->source($self->raw_source_name);
365 my $super_view = $self->parent_source;
366 my @all_parents = my @other_parents = @{$self->additional_parents||[]};
367 push(@all_parents, $super_view) if defined($super_view);
368 my @sources = ($table, @all_parents);
369 my @body_cols = map body_cols($_), @sources;
370 my @pk_cols = pk_cols $self;
374 my $am_root = !($super_view || @other_parents);
376 my $select = $sqla->select(
379 : ([ # FROM _tbl _tbl
380 { $table->name => $table->name },
384 { $parent->name => $parent->name },
385 # ON _tbl.id = view.id
386 { map +(qualify_with($parent, $_), qualify_with($table, $_)),
392 [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
395 my ($now, @next) = grep defined, $super_view, $table, @other_parents;
399 # NOTE: this assumes a single PK col called id with a sequence somewhere
400 # but nothing else -should- so fixing this should make everything work
403 $self->name.'_insert',
406 $sqla->insert( # INSERT INTO tbl/super_view (foo, ...) VALUES (_foo, ...)
411 $sqla->insert( # INSERT INTO parent (id, ...)
412 # VALUES (currval('_root_tbl_id_seq'), ...)
416 id => \"currval('${\$self->root_table->name}_id_seq')",
422 # note - similar to arg_hash but not quite enough to share code sanely
423 my $pk_where = { # id = _id AND id2 = _id2 ...
424 map +($_ => \"= ${\argify $_}"), names_of @pk_cols
431 $self->name.'_update',
432 [ @pk_cols, @body_cols ],
434 $_->name, # UPDATE foo
435 { arg_hash $_ }, # SET a = _a
444 $self->name.'_delete',
446 [ map $sqla->delete($_->name, $pk_where), @sources ];
449 (rule_body insert => $self, [], \@body_cols),
450 (rule_body update => $self, \@pk_cols, \@body_cols),
451 (rule_body delete => $self, \@pk_cols, []),
453 return join("\n\n", $select, $insert_func, $update_func, $delete_func, @rules);
462 DBIx::Class::ResultSource::MultipleTableInheritance
463 Use multiple tables to define your classes
467 This only works with PostgreSQL for the moment.
472 package Cafe::Result::Coffee;
476 use parent 'DBIx::Class::Core';
477 use aliased 'DBIx::Class::ResultSource::MultipleTableInheritance'
480 __PACKAGE__->table_class(MTI);
481 __PACKAGE__->table('coffee');
482 __PACKAGE__->add_columns(
483 "id", { data_type => "integer" },
486 default_value => "good" },
489 __PACKAGE__->set_primary_key("id");
495 package Cafe::Result::Sumatra;
497 use parent 'Cafe::Result::Coffee';
499 __PACKAGE__->table('sumatra');
501 __PACKAGE__->add_columns( "aroma",
502 { data_type => "text" }
510 my $schema = Cafe->connect($dsn,$user,$pass);
512 my $cup = $schema->resultset('Sumatra');
514 print STDERR Dwarn $cup->result_source->columns;
521 Inherit from this package and you can make a resultset class from a view, but
522 that's more than a little bit misleading: the result is B<transparently
525 This is accomplished through the use of stored procedures that map changes
526 written to the view to changes to the underlying concrete tables.
530 In many applications, many classes are subclasses of others. Let's say you
533 # Conceptual domain model
548 That's redundant. Hold on a sec...
556 class Investor extends User {
560 Good idea, but how to put this into code?
562 One far-too common and absolutely horrendous solution is to have a "checkbox"
563 in your database: a nullable "investor" column, which entails a nullable
564 "dollars" column, in the user table.
566 create table "user" (
567 "id" integer not null primary key autoincrement,
568 "name" text not null,
569 "password" text not null,
570 "investor" tinyint(1),
574 Let's not discuss that further.
576 A second, better, solution is to break out the two tables into user and
579 create table "user" (
580 "id" integer not null primary key autoincrement,
581 "name" text not null,
582 "password" text not null
585 create table "investor" (
586 "id" integer not null references user("id"),
590 So that investor's PK is just an FK to the user. We can clearly see the class
591 hierarchy here, in which investor is a subclass of user. In DBIx::Class
592 applications, this second strategy looks like:
594 my $user_rs = $schema->resultset('User');
595 my $new_user = $user_rs->create(
596 name => $args->{name},
597 password => $args->{password},
602 my $new_investor = $schema->resultset('Investor')->create(
604 dollars => $args->{dollars},
607 One can cope well with the second strategy, and it seems to be the most popular
612 There is a third strategy implemented here. Make the database do more of the
613 work: hide the nasty bits so we don't have to handle them unless we really want
614 to. It'll save us some typing and it'll make for more expressive code. What if
617 my $new_investor = $schema->resultset('Investor')->create(
618 name => $args->{name},
619 password => $args->{password},
620 dollars => $args->{dollars},
623 And have it Just Work? The user...
626 name => $args->{name},
627 password => $args->{password},
630 should be created behind the scenes, and the use of either user or investor
631 in your code should require no special handling. Deleting and updating
632 $new_investor should also delete or update the user row.
634 It does. User and investor are both views, their concrete tables abstracted
635 away behind a set of rules and triggers. You would expect the above DBIC
636 create statement to look like this in SQL:
638 INSERT INTO investor ("name","password","dollars") VALUES (...);
640 But using MTI, it is really this:
642 INSERT INTO _user_table ("username","password") VALUES (...);
643 INSERT INTO _investor_table ("id","dollars") VALUES (currval('_user_table_id_seq',...) );
645 For deletes, the triggers fire in reverse, to preserve referential integrity
646 (foreign key constraints). For instance:
648 my $investor = $schema->resultset('Investor')->find({id => $args->{id}});
653 DELETE FROM _investor_table WHERE ("id" = ?);
654 DELETE FROM _user_table WHERE ("id" = ?);
664 MTI find the parents, if any, of your resultset class and adds them to the
665 list of parent_sources for the table.
668 =item add_additional_parents
671 Continuing with coffee:
673 __PACKAGE__->result_source_instance->add_additional_parents(
675 MyApp::Schema::Result::Beverage
676 MyApp::Schema::Result::Liquid
680 This just lets you manually add additional parents beyond the ones MTI finds.
682 =item add_additional_parent
684 __PACKAGE__->result_source_instance->add_additional_parent(
685 MyApp::Schema::Result::Beverage
688 You can also add just one.
690 =item attach_additional_sources
692 MTI takes the parents' sources and relationships, creates a new
693 DBIx::Class::Table object from them, and registers this as a new, raw, source
698 print STDERR map { "$_\n" } MyApp::Schema->sources;
706 Raw::Sumatra will be used to generate the view.
708 =item view_definition
710 This takes the raw table and generates the view (and stored procedures) you will use.
716 Matt S. Trout, E<lt>mst@shadowcatsystems.co.ukE<gt>
720 Amiri Barksdale, E<lt>amiri@metalabel.comE<gt>
724 Copyright (c) 2010 the DBIx::Class::ResultSource::MultipleTableInheritance
725 L</AUTHOR> and L</CONTRIBUTORS> as listed above.
729 This library is free software; you can redistribute it and/or modify
730 it under the same terms as Perl itself.
735 L<DBIx::Class::ResultSource>