Fix view ordering by requiring ddo declaration in result class
[dbsrgits/DBIx-Class-ResultSource-MultipleTableInheritance.git] / lib / DBIx / Class / ResultSource / MultipleTableInheritance.pm
CommitLineData
876f6525 1package DBIx::Class::ResultSource::MultipleTableInheritance;
2
3use strict;
4use warnings;
5use parent qw(DBIx::Class::ResultSource::View);
876f6525 6use Method::Signatures::Simple;
7use Carp::Clan qw/^DBIx::Class/;
ca79850d 8use aliased 'DBIx::Class::ResultSource::Table';
7abe3af2 9use aliased 'DBIx::Class::ResultClass::HashRefInflator';
05fd2477 10use String::TT qw(strip tt);
92ebfc06 11use Scalar::Util qw(blessed);
ca79850d 12use namespace::autoclean;
70d56286 13
146ec120 14our $VERSION = 0.01;
70d56286 15
803ffff2 16__PACKAGE__->mk_group_accessors(simple => qw(parent_source additional_parents));
876f6525 17
e7189506 18# how this works:
19#
20# On construction, we hook $self->result_class->result_source_instance
21# if present to get the superclass' source object
22#
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
25# get generated
26#
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.
30#
31# deploying the postgres rules through SQLT may be a pain though.
32
876f6525 33method 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')) {
7abe3af2 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);
41 }
876f6525 42 }
43 return $new;
44}
45
4e4f71e3 46method 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
51 );
52 }
53}
54
803ffff2 55method add_additional_parent ($source) {
56 my ($our_pk, $their_pk) = map {
57 join('|',sort $_->primary_columns)
58 } ($self, $source);
59
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
64 ]);
65 $self->add_columns(
66 map {
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
70 );
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}}},
77 );
78 }
a010ebf9 79 { no strict 'refs';
80 push(@{$self->result_class.'::ISA'}, $source->result_class);
81 }
803ffff2 82}
83
8b229aa6 84method _source_by_name ($name) {
85 my $schema = $self->schema;
86 my ($source) =
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"
90 unless $source;
91 return $source;
92}
93
7abe3af2 94method schema (@args) {
95 my $ret = $self->next::method(@args);
96 if (@args) {
c73d582b 97 if ($self->parent_source) {
c73d582b 98 my $parent_name = $self->parent_source->name;
8b229aa6 99 $self->parent_source($self->_source_by_name($parent_name));
c73d582b 100 }
8b229aa6 101 $self->additional_parents([
102 map { $self->_source_by_name($_->name) }
103 @{$self->additional_parents||[]}
104 ]);
7abe3af2 105 }
106 return $ret;
107}
108
c73d582b 109method attach_additional_sources () {
4d88a8d7 110 my $raw_name = $self->raw_source_name;
ca79850d 111 my $schema = $self->schema;
112
113 # if the raw source is already present we can assume we're done
114 return if grep { $_ eq $raw_name } $schema->sources;
4d88a8d7 115
ca79850d 116 # our parent should've been registered already actually due to DBIC
117 # attaching subclass sources later in load_namespaces
4d88a8d7 118
ca79850d 119 my $parent;
120 if ($self->parent_source) {
121 my $parent_name = $self->parent_source->name;
122 ($parent) =
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"
126 unless $parent;
05fd2477 127 $self->parent_source($parent); # so our parent is the one in this schema
ca79850d 128 }
4d88a8d7 129
130 # create the raw table source
131
132 my $table = Table->new({ name => $self->raw_table_name });
133
ca79850d 134 # we don't need to add the PK cols explicitly if we're the root table
4d88a8d7 135 # since they'll get added below
136
803ffff2 137 my %pk_join;
138
ca79850d 139 if ($parent) {
ca79850d 140 foreach my $pri ($self->primary_columns) {
141 my %info = %{$self->column_info($pri)};
142 delete @info{qw(is_auto_increment sequence auto_nextval)};
7abe3af2 143 $table->add_column($pri => \%info);
803ffff2 144 $pk_join{"foreign.${pri}"} = "self.${pri}";
ca79850d 145 }
4d88a8d7 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
803ffff2 148 $table->add_relationship('parent', $parent->raw_source_name, \%pk_join);
c8e085ba 149 $self->deploy_depends_on->{$parent->result_class} = 1;
803ffff2 150 }
151
152 foreach my $add (@{$self->additional_parents||[]}) {
153 $table->add_relationship(
154 'parent_'.$add->name, $add->source_name, \%pk_join
155 );
c965b761 156 $self->deploy_depends_on->{$add->result_class} = 1 if $add->isa('DBIx::Class::ResultSource::View');
ca79850d 157 }
4d88a8d7 158 $table->add_columns(
159 map { ($_ => { %{$self->column_info($_)} }) }
160 grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
161 $self->columns
162 );
ca79850d 163 $table->set_primary_key($self->primary_columns);
e96b2eeb 164
165 # Attempting to re-add sequence here -- AKB
166 for my $pk ( $self->primary_columns ) {
167 $table->columns_info->{$pk}->{sequence} =
168 $self->set_sequence( $table->name, $self->primary_columns )
169 unless grep {
170 $table->columns_info->{$_}->{originally_defined_in} ne $self->name
171 } keys %{ $table->columns_info };
172 }
490d5481 173
174 # we need to copy our rels to the raw object as well
175 # note that ->add_relationship on a source object doesn't create an
176 # accessor so we can leave that part in the attributes
177
178 # if the other side is a table then we need to copy any rels it has
179 # back to us, as well, so that they point at the raw table. if the
180 # other side is an MTI view then we need to create the rels to it to
181 # point at -its- raw table; we don't need to worry about backrels because
182 # it's going to run this method too (and its raw source might not exist
183 # yet so we can't, anyway)
184
185 foreach my $rel ($self->relationships) {
186 my $rel_info = $self->relationship_info($rel);
187
803ffff2 188 # if we got this from the superclass, -its- raw table will nail this.
189 # if we got it from an additional parent, it's its problem.
190 next unless $rel_info->{attrs}{originally_defined_in} eq $self->name;
191
490d5481 192 my $f_source = $schema->source($rel_info->{source});
193
194 # __PACKAGE__ is correct here because subclasses should be caught
195
196 my $one_of_us = $f_source->isa(__PACKAGE__);
197
198 my $f_source_name = $f_source->${\
199 ($one_of_us ? 'raw_source_name' : 'source_name')
200 };
201
202 $table->add_relationship(
203 '_'.$rel, $f_source_name, @{$rel_info}{qw(cond attrs)}
204 );
205
206 unless ($one_of_us) {
207 my $reverse = do {
208 # we haven't been registered yet, so reverse_ cries
209 # XXX this is evil and will probably break eventually
210 local @{$schema->source_registrations}
211 {map $self->$_, qw(source_name result_class)}
212 = ($self, $self);
213 $self->reverse_relationship_info($rel);
214 };
215 foreach my $rev_rel (keys %$reverse) {
216 $f_source->add_relationship(
217 '_raw_'.$rev_rel, $raw_name, @{$reverse->{$rev_rel}}{qw(cond attrs)}
218 );
219 }
220 }
221 }
222
ca79850d 223 $schema->register_source($raw_name => $table);
224}
225
226method set_primary_key (@args) {
227 if ($self->parent_source) {
228 confess "Can't set primary key on a subclass";
229 }
230 return $self->next::method(@args);
876f6525 231}
232
e96b2eeb 233method set_sequence ($table_name, @pks) {
234 return $table_name . '_' . join('_',@pks) . '_' . 'seq';
235}
236
4d88a8d7 237method raw_source_name () {
876f6525 238 my $base = $self->source_name;
05fd2477 239 confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
876f6525 240 unless $base;
241 return 'Raw::'.$base;
242}
70d56286 243
4d88a8d7 244method raw_table_name () {
245 return '_'.$self->name;
246}
247
876f6525 248method add_columns (@args) {
249 my $ret = $self->next::method(@args);
250 $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
251 return $ret;
70d56286 252}
253
803ffff2 254method add_relationship ($name, $f_source, $cond, $attrs) {
255 $self->next::method(
256 $name, $f_source, $cond,
257 { originally_defined_in => $self->name, %{$attrs||{}}, }
258 );
259}
260
487f4489 261BEGIN {
262
263 # helper routines, constructed as anon subs so autoclean nukes them
264
265 use signatures;
266
267 *argify = sub (@names) {
268 map '_'.$_, @names;
269 };
270
271 *qualify_with = sub ($source, @names) {
92ebfc06 272 my $name = blessed($source) ? $source->name : $source;
273 map join('.', $name, $_), @names;
487f4489 274 };
275
276 *body_cols = sub ($source) {
277 my %pk; @pk{$source->primary_columns} = ();
278 map +{ %{$source->column_info($_)}, name => $_ },
279 grep !exists $pk{$_}, $source->columns;
280 };
281
282 *pk_cols = sub ($source) {
283 map +{ %{$source->column_info($_)}, name => $_ },
284 $source->primary_columns;
285 };
286
92ebfc06 287 *names_of = sub (@cols) { map $_->{name}, @cols };
487f4489 288
c8e085ba 289 *function_body = sub {
290 my ($name,$args,$body_parts) = @_;
05fd2477 291 my $arglist = join(
292 ', ',
388d83fc 293 map "_${\$_->{name}} ${\uc($_->{data_type})}",
05fd2477 294 @$args
295 );
296 my $body = join("\n", '', map " $_;", @$body_parts);
297 return strip tt q{
298 CREATE OR REPLACE FUNCTION [% name %]
299 ([% arglist %])
300 RETURNS VOID AS $function$
301 BEGIN
302 [%- body %]
303 END;
304 $function$ LANGUAGE plpgsql;
305 };
487f4489 306 };
c8e085ba 307 #*function_body = sub ($name,$args,$body_parts) {
308 #my $arglist = join(
309 #', ',
310 #map "_${\$_->{name}} ${\uc($_->{data_type})}",
311 #@$args
312 #);
313 #my $body = join("\n", '', map " $_;", @$body_parts);
314 #return strip tt q{
315 #CREATE OR REPLACE FUNCTION [% name %]
316 #([% arglist %])
317 #RETURNS VOID AS $function$
318 #BEGIN
319 #[%- body %]
320 #END;
321 #$function$ LANGUAGE plpgsql;
322 #};
323 #};
487f4489 324}
325
05fd2477 326BEGIN {
327
328 use signatures;
329
330 *arg_hash = sub ($source) {
331 map +($_ => \(argify $_)), names_of body_cols $source;
332 };
92ebfc06 333
334 *rule_body = sub ($on, $to, $oldlist, $newlist) {
335 my $arglist = join(', ',
336 (qualify_with 'OLD', names_of @$oldlist),
337 (qualify_with 'NEW', names_of @$newlist),
338 );
339 $to = $to->name if blessed($to);
340 return strip tt q{
341 CREATE RULE _[% to %]_[% on %]_rule AS
342 ON [% on | upper %] TO [% to %]
343 DO INSTEAD (
3c259cfb 344 SELECT [% to %]_[% on %]([% arglist %])
92ebfc06 345 );
346 };
347 };
05fd2477 348}
349
350method root_table () {
351 $self->parent_source
352 ? $self->parent_source->root_table
353 : $self->schema->source($self->raw_source_name)
354}
355
487f4489 356method view_definition () {
357 my $schema = $self->schema;
358 confess "Can't generate view without connected schema, sorry"
359 unless $schema && $schema->storage;
360 my $sqla = $schema->storage->sql_maker;
2816c8ed 361 my $table = $self->schema->source($self->raw_source_name);
487f4489 362 my $super_view = $self->parent_source;
2816c8ed 363 my @all_parents = my @other_parents = @{$self->additional_parents||[]};
364 push(@all_parents, $super_view) if defined($super_view);
365 my @sources = ($table, @all_parents);
487f4489 366 my @body_cols = map body_cols($_), @sources;
367 my @pk_cols = pk_cols $self;
92ebfc06 368
369 # SELECT statement
370
2816c8ed 371 my $am_root = !($super_view || @other_parents);
372
487f4489 373 my $select = $sqla->select(
2816c8ed 374 ($am_root
375 ? ($table->name)
376 : ([ # FROM _tbl _tbl
487f4489 377 { $table->name => $table->name },
2816c8ed 378 map {
379 my $parent = $_;
380 [ # JOIN view view
381 { $parent->name => $parent->name },
382 # ON _tbl.id = view.id
383 { map +(qualify_with($parent, $_), qualify_with($table, $_)),
384 names_of @pk_cols }
385 ]
386 } @all_parents
487f4489 387 ])
2816c8ed 388 ),
487f4489 389 [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
05fd2477 390 ).';';
92ebfc06 391
2816c8ed 392 my ($now, @next) = grep defined, $super_view, $table, @other_parents;
92ebfc06 393
394 # INSERT function
395
05fd2477 396 # NOTE: this assumes a single PK col called id with a sequence somewhere
397 # but nothing else -should- so fixing this should make everything work
398 my $insert_func =
c8e085ba 399 function_body
05fd2477 400 $self->name.'_insert',
401 \@body_cols,
402 [
2816c8ed 403 $sqla->insert( # INSERT INTO tbl/super_view (foo, ...) VALUES (_foo, ...)
05fd2477 404 $now->name,
405 { arg_hash $now },
406 ),
2816c8ed 407 (map {
408 $sqla->insert( # INSERT INTO parent (id, ...)
409 # VALUES (currval('_root_tbl_id_seq'), ...)
410 $_->name,
411 {
412 (arg_hash $_),
413 id => \"currval('${\$self->root_table->name}_id_seq')",
414 }
415 )
416 } @next)
05fd2477 417 ];
92ebfc06 418
05fd2477 419 # note - similar to arg_hash but not quite enough to share code sanely
420 my $pk_where = { # id = _id AND id2 = _id2 ...
421 map +($_ => \"= ${\argify $_}"), names_of @pk_cols
422 };
92ebfc06 423
424 # UPDATE function
425
05fd2477 426 my $update_func =
c8e085ba 427 function_body
05fd2477 428 $self->name.'_update',
429 [ @pk_cols, @body_cols ],
430 [ map $sqla->update(
431 $_->name, # UPDATE foo
432 { arg_hash $_ }, # SET a = _a
433 $pk_where,
434 ), @sources
435 ];
92ebfc06 436
437 # DELETE function
438
05fd2477 439 my $delete_func =
c8e085ba 440 function_body
05fd2477 441 $self->name.'_delete',
442 [ @pk_cols ],
443 [ map $sqla->delete($_->name, $pk_where), @sources ];
92ebfc06 444
445 my @rules = (
446 (rule_body insert => $self, [], \@body_cols),
447 (rule_body update => $self, \@pk_cols, \@body_cols),
448 (rule_body delete => $self, \@pk_cols, []),
449 );
450 return join("\n\n", $select, $insert_func, $update_func, $delete_func, @rules);
487f4489 451}
452
70d56286 4531;
146ec120 454
455__END__
f5c54951 456
146ec120 457=head1 NAME
458
f5c54951 459DBIx::Class::ResultSource::MultipleTableInheritance
460Use multiple tables to define your classes
461
462=head1 NOTICE
463
464This only works with PostgreSQL for the moment.
146ec120 465
466=head1 SYNOPSIS
467
146ec120 468 {
f8864134 469 package Cafe::Result::Coffee;
146ec120 470
f8864134 471 use strict;
472 use warnings;
473 use parent 'DBIx::Class::Core';
474 use aliased 'DBIx::Class::ResultSource::MultipleTableInheritance'
475 => 'MTI';
476
477 __PACKAGE__->table_class(MTI);
146ec120 478 __PACKAGE__->table('coffee');
479 __PACKAGE__->add_columns(
f8864134 480 "id", { data_type => "integer" },
481 "flavor", {
482 data_type => "text",
483 default_value => "good" },
146ec120 484 );
485
486 __PACKAGE__->set_primary_key("id");
487
488 1;
489 }
490
491 {
f8864134 492 package Cafe::Result::Sumatra;
146ec120 493
f8864134 494 use parent 'Cafe::Result::Coffee';
146ec120 495
496 __PACKAGE__->table('sumatra');
497
f8864134 498 __PACKAGE__->add_columns( "aroma",
499 { data_type => "text" }
146ec120 500 );
501
502 1;
503 }
504
505 ...
506
f8864134 507 my $schema = Cafe->connect($dsn,$user,$pass);
146ec120 508
f8864134 509 my $cup = $schema->resultset('Sumatra');
146ec120 510
f8864134 511 print STDERR Dwarn $cup->result_source->columns;
146ec120 512
f8864134 513 "id"
514 "flavor"
515 "aroma"
516 ..
146ec120 517
f5c54951 518Inherit from this package and you can make a resultset class from a view, but
519that's more than a little bit misleading: the result is B<transparently
520writable>.
146ec120 521
f5c54951 522This is accomplished through the use of stored procedures that map changes
523written to the view to changes to the underlying concrete tables.
146ec120 524
525=head1 WHY?
526
f5c54951 527In many applications, many classes are subclasses of others. Let's say you
528have this schema:
146ec120 529
530 # Conceptual domain model
531
532 class User {
f5c54951 533 has id,
534 has name,
535 has password
146ec120 536 }
537
538 class Investor {
539 has id,
540 has name,
541 has password,
542 has dollars
543 }
544
545That's redundant. Hold on a sec...
546
547 class User {
f5c54951 548 has id,
549 has name,
550 has password
146ec120 551 }
552
e7189506 553 class Investor extends User {
146ec120 554 has dollars
555 }
556
557Good idea, but how to put this into code?
558
f5c54951 559One far-too common and absolutely horrendous solution is to have a "checkbox"
560in your database: a nullable "investor" column, which entails a nullable
561"dollars" column, in the user table.
146ec120 562
563 create table "user" (
564 "id" integer not null primary key autoincrement,
565 "name" text not null,
566 "password" text not null,
567 "investor" tinyint(1),
568 "dollars" integer
569 );
570
571Let's not discuss that further.
572
f5c54951 573A second, better, solution is to break out the two tables into user and
574investor:
146ec120 575
576 create table "user" (
577 "id" integer not null primary key autoincrement,
578 "name" text not null,
579 "password" text not null
580 );
581
582 create table "investor" (
583 "id" integer not null references user("id"),
584 "dollars" integer
585 );
586
f5c54951 587So that investor's PK is just an FK to the user. We can clearly see the class
588hierarchy here, in which investor is a subclass of user. In DBIx::Class
589applications, this second strategy looks like:
146ec120 590
591 my $user_rs = $schema->resultset('User');
592 my $new_user = $user_rs->create(
593 name => $args->{name},
594 password => $args->{password},
595 );
596
597 ...
598
599 my $new_investor = $schema->resultset('Investor')->create(
600 id => $new_user->id,
601 dollars => $args->{dollars},
602 );
603
f5c54951 604One can cope well with the second strategy, and it seems to be the most popular
605smart choice.
e7189506 606
146ec120 607=head1 HOW?
608
f5c54951 609There is a third strategy implemented here. Make the database do more of the
610work: hide the nasty bits so we don't have to handle them unless we really want
611to. It'll save us some typing and it'll make for more expressive code. What if
612we could do this:
146ec120 613
614 my $new_investor = $schema->resultset('Investor')->create(
615 name => $args->{name},
616 password => $args->{password},
617 dollars => $args->{dollars},
618 );
619
e7189506 620And have it Just Work? The user...
621
622 {
623 name => $args->{name},
624 password => $args->{password},
625 }
626
f5c54951 627should be created behind the scenes, and the use of either user or investor
628in your code should require no special handling. Deleting and updating
629$new_investor should also delete or update the user row.
146ec120 630
f5c54951 631It does. User and investor are both views, their concrete tables abstracted
632away behind a set of rules and triggers. You would expect the above DBIC
633create statement to look like this in SQL:
146ec120 634
635 INSERT INTO investor ("name","password","dollars") VALUES (...);
636
637But using MTI, it is really this:
638
639 INSERT INTO _user_table ("username","password") VALUES (...);
640 INSERT INTO _investor_table ("id","dollars") VALUES (currval('_user_table_id_seq',...) );
641
f5c54951 642For deletes, the triggers fire in reverse, to preserve referential integrity
643(foreign key constraints). For instance:
146ec120 644
645 my $investor = $schema->resultset('Investor')->find({id => $args->{id}});
646 $investor->delete;
647
648Becomes:
649
650 DELETE FROM _investor_table WHERE ("id" = ?);
651 DELETE FROM _user_table WHERE ("id" = ?);
652
653
e7189506 654=head1 METHODS
655
656=over
657
658=item new
659
660
f5c54951 661MTI find the parents, if any, of your resultset class and adds them to the
662list of parent_sources for the table.
e7189506 663
664
665=item add_additional_parents
666
667
668Continuing with coffee:
669
670 __PACKAGE__->result_source_instance->add_additional_parents(
671 qw/
672 MyApp::Schema::Result::Beverage
673 MyApp::Schema::Result::Liquid
674 /
675 );
676
677This just lets you manually add additional parents beyond the ones MTI finds.
678
679=item add_additional_parent
680
681 __PACKAGE__->result_source_instance->add_additional_parent(
682 MyApp::Schema::Result::Beverage
683 );
684
685You can also add just one.
686
687=item attach_additional_sources
688
f5c54951 689MTI takes the parents' sources and relationships, creates a new
690DBIx::Class::Table object from them, and registers this as a new, raw, source
691in the schema, e.g.,
e7189506 692
693 use MyApp::Schema;
694
695 print STDERR map { "$_\n" } MyApp::Schema->sources;
696
697 # Coffee
698 # Beverage
699 # Liquid
700 # Sumatra
701 # Raw::Sumatra
146ec120 702
e7189506 703Raw::Sumatra will be used to generate the view.
146ec120 704
e7189506 705=item view_definition
146ec120 706
e7189506 707This takes the raw table and generates the view (and stored procedures) you will use.
146ec120 708
e7189506 709=back
146ec120 710
711=head1 AUTHOR
712
713Matt S. Trout, E<lt>mst@shadowcatsystems.co.ukE<gt>
714
715=head2 CONTRIBUTORS
716
f5c54951 717Amiri Barksdale, E<lt>amiri@metalabel.comE<gt>
718
719=head1 COPYRIGHT
720
721Copyright (c) 2010 the DBIx::Class::ResultSource::MultipleTableInheritance
722L</AUTHOR> and L</CONTRIBUTORS> as listed above.
146ec120 723
724=head1 LICENSE
725
726This library is free software; you can redistribute it and/or modify
727it under the same terms as Perl itself.
728
729=head1 SEE ALSO
730
731L<DBIx::Class>
732L<DBIx::Class::ResultSource>
733
734=cut