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 namespace::autoclean;
  11
  12 # how this works:
  13 #
  14 # On construction, we hook $self->result_class->result_source_instance
  15 # if present to get the superclass' source object
  16 #
  17 # When attached to a schema, we need to add sources to that schema with
  18 # appropriate relationships for the foreign keys so the concrete tables
  19 # get generated
  20 #
  21 # We also generate our own view definition using this class' concrete table
  22 # and the view for the superclass, and stored procedures for the insert,
  23 # update and delete operations on this view.
  24 #
  25 # deploying the postgres rules through SQLT may be a pain though.
  26
  27 __PACKAGE__->mk_group_accessors(simple => qw(parent_source));
  28
  29 method new ($class: @args) {
  30   my $new = $class->next::method(@args);
  31   my $rc = $new->result_class;
  32   if (my $meth = $rc->can('result_source_instance')) {
  33     my $source = $rc->$meth;
  34     if ($source->result_class ne $new->result_class
  35         && $new->result_class->isa($source->result_class)) {
  36       $new->parent_source($source);
  37     }
  38   }
  39   return $new;
  40 }
  41
  42 method schema (@args) {
  43   my $ret = $self->next::method(@args);
  44   if (@args) {
  45     $self->_attach_additional_sources;
  46   }
  47   return $ret;
  48 }
  49
  50 method _attach_additional_sources () {
  51   my $raw_name = $self->raw_source_name;
  52   my $schema = $self->schema;
  53
  54   # if the raw source is already present we can assume we're done
  55   return if grep { $_ eq $raw_name } $schema->sources;
  56
  57   # our parent should've been registered already actually due to DBIC
  58   # attaching subclass sources later in load_namespaces
  59
  60   my $parent;
  61   if ($self->parent_source) {
  62       my $parent_name = $self->parent_source->name;
  63     ($parent) =
  64       grep { $_->name eq $parent_name }
  65         map $schema->source($_), $schema->sources;
  66     confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
  67       unless $parent;
  68   }
  69
  70   # create the raw table source
  71
  72   my $table = Table->new({ name => $self->raw_table_name });
  73
  74   # we don't need to add the PK cols explicitly if we're the root table
  75   # since they'll get added below
  76
  77   if ($parent) {
  78     my %join;
  79     foreach my $pri ($self->primary_columns) {
  80       my %info = %{$self->column_info($pri)};
  81       delete @info{qw(is_auto_increment sequence auto_nextval)};
  82       $table->add_column($pri => \%info);
  83       $join{"foreign.${pri}"} = "self.${pri}";
  84     }
  85     # have to use source name lookups rather than result class here
  86     # because we don't actually have a result class on the raw sources
  87     $table->add_relationship('parent', $parent->raw_source_name, \%join);
  88   }
  89
  90   # add every column that's actually a concrete part of us
  91
  92   $table->add_columns(
  93     map { ($_ => { %{$self->column_info($_)} }) }
  94       grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
  95         $self->columns
  96   );
  97   $table->set_primary_key($self->primary_columns);
  98   $schema->register_source($raw_name => $table);
  99 }
 100
 101 method set_primary_key (@args) {
 102   if ($self->parent_source) {
 103     confess "Can't set primary key on a subclass";
 104   }
 105   return $self->next::method(@args);
 106 }
 107
 108 method raw_source_name () {
 109   my $base = $self->source_name;
 110   confess "Can't generate raw source name when we don't have a source_name"
 111     unless $base;
 112   return 'Raw::'.$base;
 113 }
 114
 115 method raw_table_name () {
 116   return '_'.$self->name;
 117 }
 118
 119 method add_columns (@args) {
 120   my $ret = $self->next::method(@args);
 121   $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
 122   return $ret;
 123 }
 124
 125 BEGIN {
 126
 127   # helper routines, constructed as anon subs so autoclean nukes them
 128
 129   use signatures;
 130
 131   *argify = sub (@names) {
 132     map '_'.$_, @names;
 133   };
 134
 135   *qualify_with = sub ($source, @names) {
 136     map join('.', $source->name, $_), @names;
 137   };
 138
 139   *body_cols = sub ($source) {
 140     my %pk; @pk{$source->primary_columns} = ();
 141     map +{ %{$source->column_info($_)}, name => $_ },
 142       grep !exists $pk{$_}, $source->columns;
 143   };
 144
 145   *pk_cols = sub ($source) {
 146     map +{ %{$source->column_info($_)}, name => $_ },
 147       $source->primary_columns;
 148   };
 149
 150   *names_of = sub (@cols) { map $_->{name}, @cols };
 151
 152   *arglist = sub (@cols) {
 153     map join(' ', @{$_}{qw(name data_type)}), @cols;
 154   };
 155
 156 }
 157
 158 method view_definition () {
 159   my $schema = $self->schema;
 160   confess "Can't generate view without connected schema, sorry"
 161     unless $schema && $schema->storage;
 162   my $sqla = $schema->storage->sql_maker;
 163   my @sources = my $table = $self->schema->source($self->raw_source_name);
 164   my $super_view = $self->parent_source;
 165   push(@sources, $super_view) if defined($super_view);
 166   my @body_cols = map body_cols($_), @sources;
 167   my @pk_cols = pk_cols $self;
 168   my $select = $sqla->select(
 169     ($super_view
 170       ? ([   # FROM _tbl _tbl
 171            { $table->name => $table->name },
 172            [ # JOIN view view
 173              { $super_view->name => $super_view->name },
 174              # ON _tbl.id = view.id
 175              { map +(qualify_with($super_view, $_), qualify_with($table, $_)),
 176                  names_of @pk_cols }
 177            ]
 178          ])
 179       : ($table->name)),
 180     [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
 181   );
 182   return $select;
 183 }
 184
 185 1;