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 additional_parents));
  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 add_additional_parents (@classes) {
  45   foreach my $class (@classes) {
  46     Class::C3::Componentised->ensure_class_loaded($class);
  47     $self->add_additional_parent(
  48       $class->result_source_instance
  49     );
  50   }
  51 }
  52
  53 method add_additional_parent ($source) {
  54   my ($our_pk, $their_pk) = map {
  55     join('|',sort $_->primary_columns)
  56   } ($self, $source);
  57
  58   confess "Can't attach additional parent ${\$source->name} - it has different PKs ($their_pk versus our $our_pk)"
  59     unless $their_pk eq $our_pk;
  60   $self->additional_parents([
  61     @{$self->additional_parents||[]}, $source
  62   ]);
  63   $self->add_columns(
  64     map {
  65       $_ => # put the extra key first to default it
  66       { originally_defined_in => $source->name, %{$source->column_info($_)}, },
  67     } grep !$self->has_column($_), $source->columns
  68   );
  69   foreach my $rel ($source->relationships) {
  70     my $rel_info = $source->relationship_info($rel);
  71     $self->add_relationship(
  72       $rel, $rel_info->{source}, $rel_info->{cond},
  73       # extra key first to default it
  74       {originally_defined_in => $source->name, %{$rel_info->{attrs}}},
  75     );
  76   }
  77   { no strict 'refs';
  78     push(@{$self->result_class.'::ISA'}, $source->result_class);
  79   }
  80 }
  81
  82 method _source_by_name ($name) {
  83   my $schema = $self->schema;
  84   my ($source) =
  85     grep { $_->name eq $name }
  86       map $schema->source($_), $schema->sources;
  87   confess "Couldn't find attached source for parent $name - did you use load_classes? This module is only compatible with load_namespaces"
  88     unless $source;
  89   return $source;
  90 }
  91
  92 method schema (@args) {
  93   my $ret = $self->next::method(@args);
  94   if (@args) {
  95     if ($self->parent_source) {
  96       my $parent_name = $self->parent_source->name;
  97       $self->parent_source($self->_source_by_name($parent_name));
  98     }
  99     $self->additional_parents([
 100       map { $self->_source_by_name($_->name) }
 101       @{$self->additional_parents||[]}
 102     ]);
 103   }
 104   return $ret;
 105 }
 106
 107 method attach_additional_sources () {
 108   my $raw_name = $self->raw_source_name;
 109   my $schema = $self->schema;
 110
 111   # if the raw source is already present we can assume we're done
 112   return if grep { $_ eq $raw_name } $schema->sources;
 113
 114   # our parent should've been registered already actually due to DBIC
 115   # attaching subclass sources later in load_namespaces
 116
 117   my $parent;
 118   if ($self->parent_source) {
 119       my $parent_name = $self->parent_source->name;
 120     ($parent) =
 121       grep { $_->name eq $parent_name }
 122         map $schema->source($_), $schema->sources;
 123     confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
 124       unless $parent;
 125     $self->parent_source($parent); # so our parent is the one in this schema
 126   }
 127
 128   # create the raw table source
 129
 130   my $table = Table->new({ name => $self->raw_table_name });
 131
 132   # we don't need to add the PK cols explicitly if we're the root table
 133   # since they'll get added below
 134
 135   my %pk_join;
 136
 137   if ($parent) {
 138     foreach my $pri ($self->primary_columns) {
 139       my %info = %{$self->column_info($pri)};
 140       delete @info{qw(is_auto_increment sequence auto_nextval)};
 141       $table->add_column($pri => \%info);
 142       $pk_join{"foreign.${pri}"} = "self.${pri}";
 143     }
 144     # have to use source name lookups rather than result class here
 145     # because we don't actually have a result class on the raw sources
 146     $table->add_relationship('parent', $parent->raw_source_name, \%pk_join);
 147     $self->depends_on->{$parent->source_name} = 1;
 148   }
 149
 150   foreach my $add (@{$self->additional_parents||[]}) {
 151     $table->add_relationship(
 152       'parent_'.$add->name, $add->source_name, \%pk_join
 153     );
 154     $self->depends_on->{$add->source_name} = 1;
 155   }
 156
 157   # add every column that's actually a concrete part of us
 158
 159   $table->add_columns(
 160     map { ($_ => { %{$self->column_info($_)} }) }
 161       grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
 162         $self->columns
 163   );
 164   $table->set_primary_key($self->primary_columns);
 165
 166   # we need to copy our rels to the raw object as well
 167   # note that ->add_relationship on a source object doesn't create an
 168   # accessor so we can leave that part in the attributes
 169
 170   # if the other side is a table then we need to copy any rels it has
 171   # back to us, as well, so that they point at the raw table. if the
 172   # other side is an MTI view then we need to create the rels to it to
 173   # point at -its- raw table; we don't need to worry about backrels because
 174   # it's going to run this method too (and its raw source might not exist
 175   # yet so we can't, anyway)
 176
 177   foreach my $rel ($self->relationships) {
 178     my $rel_info = $self->relationship_info($rel);
 179
 180     # if we got this from the superclass, -its- raw table will nail this.
 181     # if we got it from an additional parent, it's its problem.
 182     next unless $rel_info->{attrs}{originally_defined_in} eq $self->name;
 183
 184     my $f_source = $schema->source($rel_info->{source});
 185
 186     # __PACKAGE__ is correct here because subclasses should be caught
 187
 188     my $one_of_us = $f_source->isa(__PACKAGE__);
 189
 190     my $f_source_name = $f_source->${\
 191                         ($one_of_us ? 'raw_source_name' : 'source_name')
 192                       };
 193
 194     $table->add_relationship(
 195       '_'.$rel, $f_source_name, @{$rel_info}{qw(cond attrs)}
 196     );
 197
 198     unless ($one_of_us) {
 199       my $reverse = do {
 200         # we haven't been registered yet, so reverse_ cries
 201         # XXX this is evil and will probably break eventually
 202         local @{$schema->source_registrations}
 203                {map $self->$_, qw(source_name result_class)}
 204           = ($self, $self);
 205         $self->reverse_relationship_info($rel);
 206       };
 207       foreach my $rev_rel (keys %$reverse) {
 208         $f_source->add_relationship(
 209           '_raw_'.$rev_rel, $raw_name, @{$reverse->{$rev_rel}}{qw(cond attrs)}
 210         );
 211       }
 212     }
 213   }
 214
 215   $schema->register_source($raw_name => $table);
 216 }
 217
 218 method set_primary_key (@args) {
 219   if ($self->parent_source) {
 220     confess "Can't set primary key on a subclass";
 221   }
 222   return $self->next::method(@args);
 223 }
 224
 225 method raw_source_name () {
 226   my $base = $self->source_name;
 227   confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
 228     unless $base;
 229   return 'Raw::'.$base;
 230 }
 231
 232 method raw_table_name () {
 233   return '_'.$self->name;
 234 }
 235
 236 method add_columns (@args) {
 237   my $ret = $self->next::method(@args);
 238   $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
 239   return $ret;
 240 }
 241
 242 method add_relationship ($name, $f_source, $cond, $attrs) {
 243   $self->next::method(
 244     $name, $f_source, $cond,
 245     { originally_defined_in => $self->name, %{$attrs||{}}, }
 246   );
 247 }
 248
 249 BEGIN {
 250
 251   # helper routines, constructed as anon subs so autoclean nukes them
 252
 253   use signatures;
 254
 255   *argify = sub (@names) {
 256     map '_'.$_, @names;
 257   };
 258
 259   *qualify_with = sub ($source, @names) {
 260     my $name = blessed($source) ? $source->name : $source;
 261     map join('.', $name, $_), @names;
 262   };
 263
 264   *body_cols = sub ($source) {
 265     my %pk; @pk{$source->primary_columns} = ();
 266     map +{ %{$source->column_info($_)}, name => $_ },
 267       grep !exists $pk{$_}, $source->columns;
 268   };
 269
 270   *pk_cols = sub ($source) {
 271     map +{ %{$source->column_info($_)}, name => $_ },
 272       $source->primary_columns;
 273   };
 274
 275   *names_of = sub (@cols) { map $_->{name}, @cols };
 276
 277   *function_body = sub ($name, $args, $body_parts) {
 278     my $arglist = join(
 279       ', ',
 280         map "_${\$_->{name}} ${\uc($_->{data_type})}",
 281           @$args
 282     );
 283     my $body = join("\n", '', map "          $_;", @$body_parts);
 284     return strip tt q{
 285       CREATE OR REPLACE FUNCTION [% name %]
 286         ([% arglist %])
 287         RETURNS VOID AS $function$
 288         BEGIN
 289           [%- body %]
 290         END;
 291       $function$ LANGUAGE plpgsql;
 292     };
 293   };
 294 }
 295
 296 BEGIN {
 297
 298   use signatures;
 299
 300   *arg_hash = sub ($source) {
 301     map +($_ => \(argify $_)), names_of body_cols $source;
 302   };
 303
 304   *rule_body = sub ($on, $to, $oldlist, $newlist) {
 305     my $arglist = join(', ',
 306       (qualify_with 'OLD', names_of @$oldlist),
 307       (qualify_with 'NEW', names_of @$newlist),
 308     );
 309     $to = $to->name if blessed($to);
 310     return strip tt q{
 311       CREATE RULE _[% to %]_[% on %]_rule AS
 312         ON [% on | upper %] TO [% to %]
 313         DO INSTEAD (
 314           SELECT [% to %]_[% on %]([% arglist %])
 315         );
 316     };
 317   };
 318 }
 319
 320 method root_table () {
 321   $self->parent_source
 322     ? $self->parent_source->root_table
 323     : $self->schema->source($self->raw_source_name)
 324 }
 325
 326 method view_definition () {
 327   my $schema = $self->schema;
 328   confess "Can't generate view without connected schema, sorry"
 329     unless $schema && $schema->storage;
 330   my $sqla = $schema->storage->sql_maker;
 331   my $table = $self->schema->source($self->raw_source_name);
 332   my $super_view = $self->parent_source;
 333   my @all_parents = my @other_parents = @{$self->additional_parents||[]};
 334   push(@all_parents, $super_view) if defined($super_view);
 335   my @sources = ($table, @all_parents);
 336   my @body_cols = map body_cols($_), @sources;
 337   my @pk_cols = pk_cols $self;
 338
 339   # SELECT statement
 340
 341   my $am_root = !($super_view || @other_parents);
 342
 343   my $select = $sqla->select(
 344     ($am_root
 345       ? ($table->name)
 346       : ([   # FROM _tbl _tbl
 347            { $table->name => $table->name },
 348            map {
 349              my $parent = $_;
 350              [ # JOIN view view
 351                { $parent->name => $parent->name },
 352                # ON _tbl.id = view.id
 353                { map +(qualify_with($parent, $_), qualify_with($table, $_)),
 354                    names_of @pk_cols }
 355              ]
 356            } @all_parents
 357          ])
 358       ),
 359     [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
 360   ).';';
 361
 362   my ($now, @next) = grep defined, $super_view, $table, @other_parents;
 363
 364   # INSERT function
 365
 366   # NOTE: this assumes a single PK col called id with a sequence somewhere
 367   # but nothing else -should- so fixing this should make everything work
 368   my $insert_func =
 369     function_body
 370       $self->name.'_insert',
 371       \@body_cols,
 372       [
 373         $sqla->insert( # INSERT INTO tbl/super_view (foo, ...) VALUES (_foo, ...)
 374           $now->name,
 375           { arg_hash $now },
 376         ),
 377         (map {
 378           $sqla->insert( # INSERT INTO parent (id, ...)
 379                          #   VALUES (currval('_root_tbl_id_seq'), ...)
 380             $_->name,
 381             {
 382               (arg_hash $_),
 383               id => \"currval('${\$self->root_table->name}_id_seq')",
 384             }
 385           )
 386         } @next)
 387       ];
 388
 389   # note - similar to arg_hash but not quite enough to share code sanely
 390   my $pk_where = { # id = _id AND id2 = _id2 ...
 391     map +($_ => \"= ${\argify $_}"), names_of @pk_cols
 392   };
 393
 394   # UPDATE function
 395
 396   my $update_func =
 397     function_body
 398       $self->name.'_update',
 399       [ @pk_cols, @body_cols ],
 400       [ map $sqla->update(
 401           $_->name, # UPDATE foo
 402           { arg_hash $_ }, # SET a = _a
 403           $pk_where,
 404         ), @sources
 405       ];
 406
 407   # DELETE function
 408
 409   my $delete_func =
 410     function_body
 411       $self->name.'_delete',
 412       [ @pk_cols ],
 413       [ map $sqla->delete($_->name, $pk_where), @sources ];
 414
 415   my @rules = (
 416     (rule_body insert => $self, [], \@body_cols),
 417     (rule_body update => $self, \@pk_cols, \@body_cols),
 418     (rule_body delete => $self, \@pk_cols, []),
 419   );
 420   return join("\n\n", $select, $insert_func, $update_func, $delete_func, @rules);
 421 }
 422
 423 1;