lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm

   1 package DBIx::Class::ResultSource::MultipleTableInheritance;
   2
   3 use strict;
   4 use warnings;
   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;
  13
  14 # how this works:
  15 #
  16 # On construction, we hook $self->result_class->result_source_instance
  17 # if present to get the superclass' source object
  18 #
  19 # When attached to a schema, we need to add sources to that schema with
  20 # appropriate relationships for the foreign keys so the concrete tables
  21 # get generated
  22 #
  23 # We also generate our own view definition using this class' concrete table
  24 # and the view for the superclass, and stored procedures for the insert,
  25 # update and delete operations on this view.
  26 #
  27 # deploying the postgres rules through SQLT may be a pain though.
  28
  29 __PACKAGE__->mk_group_accessors(simple => qw(parent_source));
  30
  31 method new ($class: @args) {
  32   my $new = $class->next::method(@args);
  33   my $rc = $new->result_class;
  34   if (my $meth = $rc->can('result_source_instance')) {
  35     my $source = $rc->$meth;
  36     if ($source->result_class ne $new->result_class
  37         && $new->result_class->isa($source->result_class)) {
  38       $new->parent_source($source);
  39     }
  40   }
  41   return $new;
  42 }
  43
  44 method schema (@args) {
  45   my $ret = $self->next::method(@args);
  46   if (@args) {
  47     if ($self->parent_source) {
  48       my $schema = $self->schema;
  49       my $parent_name = $self->parent_source->name;
  50       my ($parent) =
  51         grep { $_->name eq $parent_name }
  52           map $schema->source($_), $schema->sources;
  53       confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
  54         unless $parent;
  55       $self->parent_source($parent); # so our parent is the one in this schema
  56     }
  57   }
  58   return $ret;
  59 }
  60
  61 method attach_additional_sources () {
  62   my $raw_name = $self->raw_source_name;
  63   my $schema = $self->schema;
  64
  65   # if the raw source is already present we can assume we're done
  66   return if grep { $_ eq $raw_name } $schema->sources;
  67
  68   # our parent should've been registered already actually due to DBIC
  69   # attaching subclass sources later in load_namespaces
  70
  71   my $parent;
  72   if ($self->parent_source) {
  73       my $parent_name = $self->parent_source->name;
  74     ($parent) =
  75       grep { $_->name eq $parent_name }
  76         map $schema->source($_), $schema->sources;
  77     confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
  78       unless $parent;
  79     $self->parent_source($parent); # so our parent is the one in this schema
  80   }
  81
  82   # create the raw table source
  83
  84   my $table = Table->new({ name => $self->raw_table_name });
  85
  86   # we don't need to add the PK cols explicitly if we're the root table
  87   # since they'll get added below
  88
  89   if ($parent) {
  90     my %join;
  91     foreach my $pri ($self->primary_columns) {
  92       my %info = %{$self->column_info($pri)};
  93       delete @info{qw(is_auto_increment sequence auto_nextval)};
  94       $table->add_column($pri => \%info);
  95       $join{"foreign.${pri}"} = "self.${pri}";
  96     }
  97     # have to use source name lookups rather than result class here
  98     # because we don't actually have a result class on the raw sources
  99     $table->add_relationship('parent', $parent->raw_source_name, \%join);
 100   }
 101
 102   # add every column that's actually a concrete part of us
 103
 104   $table->add_columns(
 105     map { ($_ => { %{$self->column_info($_)} }) }
 106       grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
 107         $self->columns
 108   );
 109   $table->set_primary_key($self->primary_columns);
 110
 111   # we need to copy our rels to the raw object as well
 112   # note that ->add_relationship on a source object doesn't create an
 113   # accessor so we can leave that part in the attributes
 114
 115   # if the other side is a table then we need to copy any rels it has
 116   # back to us, as well, so that they point at the raw table. if the
 117   # other side is an MTI view then we need to create the rels to it to
 118   # point at -its- raw table; we don't need to worry about backrels because
 119   # it's going to run this method too (and its raw source might not exist
 120   # yet so we can't, anyway)
 121
 122   foreach my $rel ($self->relationships) {
 123     my $rel_info = $self->relationship_info($rel);
 124
 125     my $f_source = $schema->source($rel_info->{source});
 126
 127     # __PACKAGE__ is correct here because subclasses should be caught
 128
 129     my $one_of_us = $f_source->isa(__PACKAGE__);
 130
 131     my $f_source_name = $f_source->${\
 132                         ($one_of_us ? 'raw_source_name' : 'source_name')
 133                       };
 134
 135     $table->add_relationship(
 136       '_'.$rel, $f_source_name, @{$rel_info}{qw(cond attrs)}
 137     );
 138
 139     unless ($one_of_us) {
 140       my $reverse = do {
 141         # we haven't been registered yet, so reverse_ cries
 142         # XXX this is evil and will probably break eventually
 143         local @{$schema->source_registrations}
 144                {map $self->$_, qw(source_name result_class)}
 145           = ($self, $self);
 146         $self->reverse_relationship_info($rel);
 147       };
 148       foreach my $rev_rel (keys %$reverse) {
 149         $f_source->add_relationship(
 150           '_raw_'.$rev_rel, $raw_name, @{$reverse->{$rev_rel}}{qw(cond attrs)}
 151         );
 152       }
 153     }
 154   }
 155
 156   $schema->register_source($raw_name => $table);
 157 }
 158
 159 method set_primary_key (@args) {
 160   if ($self->parent_source) {
 161     confess "Can't set primary key on a subclass";
 162   }
 163   return $self->next::method(@args);
 164 }
 165
 166 method raw_source_name () {
 167   my $base = $self->source_name;
 168   confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
 169     unless $base;
 170   return 'Raw::'.$base;
 171 }
 172
 173 method raw_table_name () {
 174   return '_'.$self->name;
 175 }
 176
 177 method add_columns (@args) {
 178   my $ret = $self->next::method(@args);
 179   $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
 180   return $ret;
 181 }
 182
 183 BEGIN {
 184
 185   # helper routines, constructed as anon subs so autoclean nukes them
 186
 187   use signatures;
 188
 189   *argify = sub (@names) {
 190     map '_'.$_, @names;
 191   };
 192
 193   *qualify_with = sub ($source, @names) {
 194     my $name = blessed($source) ? $source->name : $source;
 195     map join('.', $name, $_), @names;
 196   };
 197
 198   *body_cols = sub ($source) {
 199     my %pk; @pk{$source->primary_columns} = ();
 200     map +{ %{$source->column_info($_)}, name => $_ },
 201       grep !exists $pk{$_}, $source->columns;
 202   };
 203
 204   *pk_cols = sub ($source) {
 205     map +{ %{$source->column_info($_)}, name => $_ },
 206       $source->primary_columns;
 207   };
 208
 209   *names_of = sub (@cols) { map $_->{name}, @cols };
 210
 211   *function_body = sub ($name, $args, $body_parts) {
 212     my $arglist = join(
 213       ', ',
 214         map "_${\$_->{name}} ${\uc($_->{data_type})}",
 215           @$args
 216     );
 217     my $body = join("\n", '', map "          $_;", @$body_parts);
 218     return strip tt q{
 219       CREATE OR REPLACE FUNCTION [% name %]
 220         ([% arglist %])
 221         RETURNS VOID AS $function$
 222         BEGIN
 223           [%- body %]
 224         END;
 225       $function$ LANGUAGE plpgsql;
 226     };
 227   };
 228 }
 229
 230 BEGIN {
 231
 232   use signatures;
 233
 234   *arg_hash = sub ($source) {
 235     map +($_ => \(argify $_)), names_of body_cols $source;
 236   };
 237
 238   *rule_body = sub ($on, $to, $oldlist, $newlist) {
 239     my $arglist = join(', ',
 240       (qualify_with 'OLD', names_of @$oldlist),
 241       (qualify_with 'NEW', names_of @$newlist),
 242     );
 243     $to = $to->name if blessed($to);
 244     return strip tt q{
 245       CREATE RULE _[% to %]_[% on %]_rule AS
 246         ON [% on | upper %] TO [% to %]
 247         DO INSTEAD (
 248           SELECT _[% to %]_[% on %]([% arglist %])
 249         );
 250     };
 251   };
 252 }
 253
 254 method root_table () {
 255   $self->parent_source
 256     ? $self->parent_source->root_table
 257     : $self->schema->source($self->raw_source_name)
 258 }
 259
 260 method view_definition () {
 261   my $schema = $self->schema;
 262   confess "Can't generate view without connected schema, sorry"
 263     unless $schema && $schema->storage;
 264   my $sqla = $schema->storage->sql_maker;
 265   my @sources = my $table = $self->schema->source($self->raw_source_name);
 266   my $super_view = $self->parent_source;
 267   push(@sources, $super_view) if defined($super_view);
 268   my @body_cols = map body_cols($_), @sources;
 269   my @pk_cols = pk_cols $self;
 270
 271   # SELECT statement
 272
 273   my $select = $sqla->select(
 274     ($super_view
 275       ? ([   # FROM _tbl _tbl
 276            { $table->name => $table->name },
 277            [ # JOIN view view
 278              { $super_view->name => $super_view->name },
 279              # ON _tbl.id = view.id
 280              { map +(qualify_with($super_view, $_), qualify_with($table, $_)),
 281                  names_of @pk_cols }
 282            ]
 283          ])
 284       : ($table->name)),
 285     [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
 286   ).';';
 287
 288   my ($now, $next) = grep defined, $super_view, $table;
 289
 290   # INSERT function
 291
 292   # NOTE: this assumes a single PK col called id with a sequence somewhere
 293   # but nothing else -should- so fixing this should make everything work
 294   my $insert_func =
 295     function_body
 296       $self->name.'_insert',
 297       \@body_cols,
 298       [
 299         $sqla->insert( # INSERT INTO _tbl (foo, ...) VALUES (_foo, ...)
 300           $now->name,
 301           { arg_hash $now },
 302         ),
 303         ($next
 304           ? $sqla->insert( # INSERT INTO super_view (id, ...)
 305                            #   VALUES (currval('_root_tbl_id_seq'), ...)
 306               $next->name,
 307               {
 308                 (arg_hash $next),
 309                 id => \"currval('${\$self->root_table->name}_id_seq')",
 310               }
 311             )
 312           : ()
 313         )
 314       ];
 315
 316   # note - similar to arg_hash but not quite enough to share code sanely
 317   my $pk_where = { # id = _id AND id2 = _id2 ...
 318     map +($_ => \"= ${\argify $_}"), names_of @pk_cols
 319   };
 320
 321   # UPDATE function
 322
 323   my $update_func =
 324     function_body
 325       $self->name.'_update',
 326       [ @pk_cols, @body_cols ],
 327       [ map $sqla->update(
 328           $_->name, # UPDATE foo
 329           { arg_hash $_ }, # SET a = _a
 330           $pk_where,
 331         ), @sources
 332       ];
 333
 334   # DELETE function
 335
 336   my $delete_func =
 337     function_body
 338       $self->name.'_delete',
 339       [ @pk_cols ],
 340       [ map $sqla->delete($_->name, $pk_where), @sources ];
 341
 342   my @rules = (
 343     (rule_body insert => $self, [], \@body_cols),
 344     (rule_body update => $self, \@pk_cols, \@body_cols),
 345     (rule_body delete => $self, \@pk_cols, []),
 346   );
 347   return join("\n\n", $select, $insert_func, $update_func, $delete_func, @rules);
 348 }
 349
 350 1;