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 namespace::autoclean;
  12
  13 # how this works:
  14 #
  15 # On construction, we hook $self->result_class->result_source_instance
  16 # if present to get the superclass' source object
  17 #
  18 # When attached to a schema, we need to add sources to that schema with
  19 # appropriate relationships for the foreign keys so the concrete tables
  20 # get generated
  21 #
  22 # We also generate our own view definition using this class' concrete table
  23 # and the view for the superclass, and stored procedures for the insert,
  24 # update and delete operations on this view.
  25 #
  26 # deploying the postgres rules through SQLT may be a pain though.
  27
  28 __PACKAGE__->mk_group_accessors(simple => qw(parent_source));
  29
  30 method new ($class: @args) {
  31   my $new = $class->next::method(@args);
  32   my $rc = $new->result_class;
  33   if (my $meth = $rc->can('result_source_instance')) {
  34     my $source = $rc->$meth;
  35     if ($source->result_class ne $new->result_class
  36         && $new->result_class->isa($source->result_class)) {
  37       $new->parent_source($source);
  38     }
  39   }
  40   return $new;
  41 }
  42
  43 method schema (@args) {
  44   my $ret = $self->next::method(@args);
  45   if (@args) {
  46     $self->_attach_additional_sources;
  47   }
  48   return $ret;
  49 }
  50
  51 method _attach_additional_sources () {
  52   my $raw_name = $self->raw_source_name;
  53   my $schema = $self->schema;
  54
  55   # if the raw source is already present we can assume we're done
  56   return if grep { $_ eq $raw_name } $schema->sources;
  57
  58   # our parent should've been registered already actually due to DBIC
  59   # attaching subclass sources later in load_namespaces
  60
  61   my $parent;
  62   if ($self->parent_source) {
  63       my $parent_name = $self->parent_source->name;
  64     ($parent) =
  65       grep { $_->name eq $parent_name }
  66         map $schema->source($_), $schema->sources;
  67     confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
  68       unless $parent;
  69     $self->parent_source($parent); # so our parent is the one in this schema
  70   }
  71
  72   # create the raw table source
  73
  74   my $table = Table->new({ name => $self->raw_table_name });
  75
  76   # we don't need to add the PK cols explicitly if we're the root table
  77   # since they'll get added below
  78
  79   if ($parent) {
  80     my %join;
  81     foreach my $pri ($self->primary_columns) {
  82       my %info = %{$self->column_info($pri)};
  83       delete @info{qw(is_auto_increment sequence auto_nextval)};
  84       $table->add_column($pri => \%info);
  85       $join{"foreign.${pri}"} = "self.${pri}";
  86     }
  87     # have to use source name lookups rather than result class here
  88     # because we don't actually have a result class on the raw sources
  89     $table->add_relationship('parent', $parent->raw_source_name, \%join);
  90   }
  91
  92   # add every column that's actually a concrete part of us
  93
  94   $table->add_columns(
  95     map { ($_ => { %{$self->column_info($_)} }) }
  96       grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
  97         $self->columns
  98   );
  99   $table->set_primary_key($self->primary_columns);
 100   $schema->register_source($raw_name => $table);
 101 }
 102
 103 method set_primary_key (@args) {
 104   if ($self->parent_source) {
 105     confess "Can't set primary key on a subclass";
 106   }
 107   return $self->next::method(@args);
 108 }
 109
 110 method raw_source_name () {
 111   my $base = $self->source_name;
 112   confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
 113     unless $base;
 114   return 'Raw::'.$base;
 115 }
 116
 117 method raw_table_name () {
 118   return '_'.$self->name;
 119 }
 120
 121 method add_columns (@args) {
 122   my $ret = $self->next::method(@args);
 123   $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
 124   return $ret;
 125 }
 126
 127 BEGIN {
 128
 129   # helper routines, constructed as anon subs so autoclean nukes them
 130
 131   use signatures;
 132
 133   *argify = sub (@names) {
 134     map '_'.$_, @names;
 135   };
 136
 137   *qualify_with = sub ($source, @names) {
 138     map join('.', $source->name, $_), @names;
 139   };
 140
 141   *body_cols = sub ($source) {
 142     my %pk; @pk{$source->primary_columns} = ();
 143     map +{ %{$source->column_info($_)}, name => $_ },
 144       grep !exists $pk{$_}, $source->columns;
 145   };
 146
 147   *pk_cols = sub ($source) {
 148     map +{ %{$source->column_info($_)}, name => $_ },
 149       $source->primary_columns;
 150   };
 151
 152   *name_of = *names_of = sub (@cols) { map $_->{name}, @cols };
 153
 154   *function_body = sub ($name, $args, $body_parts) {
 155     my $arglist = join(
 156       ', ',
 157         map '_'.join(' ', @{$_}{qw(name data_type)}),
 158           @$args
 159     );
 160     my $body = join("\n", '', map "          $_;", @$body_parts);
 161     return strip tt q{
 162       CREATE OR REPLACE FUNCTION [% name %]
 163         ([% arglist %])
 164         RETURNS VOID AS $function$
 165         BEGIN
 166           [%- body %]
 167         END;
 168       $function$ LANGUAGE plpgsql;
 169     };
 170   };
 171
 172 }
 173
 174 BEGIN {
 175
 176   use signatures;
 177
 178   *arg_hash = sub ($source) {
 179     map +($_ => \(argify $_)), names_of body_cols $source;
 180   };
 181 }
 182
 183 method root_table () {
 184   $self->parent_source
 185     ? $self->parent_source->root_table
 186     : $self->schema->source($self->raw_source_name)
 187 }
 188
 189 method view_definition () {
 190   my $schema = $self->schema;
 191   confess "Can't generate view without connected schema, sorry"
 192     unless $schema && $schema->storage;
 193   my $sqla = $schema->storage->sql_maker;
 194   my @sources = my $table = $self->schema->source($self->raw_source_name);
 195   my $super_view = $self->parent_source;
 196   push(@sources, $super_view) if defined($super_view);
 197   my @body_cols = map body_cols($_), @sources;
 198   my @pk_cols = pk_cols $self;
 199   my $select = $sqla->select(
 200     ($super_view
 201       ? ([   # FROM _tbl _tbl
 202            { $table->name => $table->name },
 203            [ # JOIN view view
 204              { $super_view->name => $super_view->name },
 205              # ON _tbl.id = view.id
 206              { map +(qualify_with($super_view, $_), qualify_with($table, $_)),
 207                  names_of @pk_cols }
 208            ]
 209          ])
 210       : ($table->name)),
 211     [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
 212   ).';';
 213   my ($now, $next) = grep defined, $super_view, $table;
 214   # NOTE: this assumes a single PK col called id with a sequence somewhere
 215   # but nothing else -should- so fixing this should make everything work
 216   my $insert_func =
 217     function_body
 218       $self->name.'_insert',
 219       \@body_cols,
 220       [
 221         $sqla->insert( # INSERT INTO _tbl (foo, ...) VALUES (_foo, ...)
 222           $now->name,
 223           { arg_hash $now },
 224         ),
 225         ($next
 226           ? $sqla->insert( # INSERT INTO super_view (id, ...)
 227                            #   VALUES (currval('_root_tbl_id_seq'), ...)
 228               $next->name,
 229               {
 230                 (arg_hash $next),
 231                 id => \"currval('${\$self->root_table->name}_id_seq')",
 232               }
 233             )
 234           : ()
 235         )
 236       ];
 237   # note - similar to arg_hash but not quite enough to share code sanely
 238   my $pk_where = { # id = _id AND id2 = _id2 ...
 239     map +($_ => \"= ${\argify $_}"), names_of @pk_cols
 240   };
 241   my $update_func =
 242     function_body
 243       $self->name.'_update',
 244       [ @pk_cols, @body_cols ],
 245       [ map $sqla->update(
 246           $_->name, # UPDATE foo
 247           { arg_hash $_ }, # SET a = _a
 248           $pk_where,
 249         ), @sources
 250       ];
 251   my $delete_func =
 252     function_body
 253       $self->name.'_delete',
 254       [ @pk_cols ],
 255       [ map $sqla->delete($_->name, $pk_where), @sources ];
 256   return join("\n\n", $select, $insert_func, $update_func, $delete_func);
 257 }
 258
 259 1;