first cut at additional source code

[dbsrgits/DBIx-Class-ResultSource-MultipleTableInheritance.git] / lib / DBIx / Class / ResultSource / MultipleTableInheritance.pm

package DBIx::Class::ResultSource::MultipleTableInheritance;

use strict;
use warnings;
use parent qw(DBIx::Class::ResultSource::View);
use Method::Signatures::Simple;
use Carp::Clan qw/^DBIx::Class/;
use aliased 'DBIx::Class::ResultSource::Table';
use namespace::autoclean;

# how this works:
#
# On construction, we hook $self->result_class->result_source_instance
# if present to get the superclass' source object
# 
# When attached to a schema, we need to add sources to that schema with
# appropriate relationships for the foreign keys so the concrete tables
# get generated
#
# We also generate our own view definition using this class' concrete table
# and the view for the superclass, and stored procedures for the insert,
# update and delete operations on this view.
#
# deploying the postgres rules through SQLT may be a pain though.

__PACKAGE__->mk_group_accessors(simple => qw(parent_source));

method new ($class: @args) {
  my $new = $class->next::method(@args);
  my $rc = $new->result_class;
  if (my $meth = $rc->can('result_source_instance')) {
    $new->parent_source($rc->$meth);
  }
  if ($new->schema) {
    $new->_attach_additional_sources;
  }
  return $new;
}

method _attach_additional_sources () {
  my $raw_name = $self->_raw_source_name;
  my $schema = $self->schema;

  # if the raw source is already present we can assume we're done
  return if grep { $_ eq $raw_name } $schema->sources;
  # our parent should've been registered already actually due to DBIC
  # attaching subclass sources later in load_namespaces
  my $parent;
  if ($self->parent_source) {
      my $parent_name = $self->parent_source->name;
    ($parent) = 
      grep { $_->name eq $parent_name }
        map $schema->source($_), $schema->sources;
    confess "Couldn't find attached source for parent $parent_name - did you use load_classes? This module is only compatible with load_namespaces"
      unless $parent;
  }
  my $table = Table->new({ name => '_'.$self->name });
  $table->add_columns(
    map { ($_ => { %{$self->column_info($_)} }) }
      grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
        $self->columns
  );
  # we don't need to add the PK cols explicitly if we're the root table
  # since they already got added above
  if ($parent) {
    my %join;
    foreach my $pri ($self->primary_columns) {
      my %info = %{$self->column_info($pri)};
      delete @info{qw(is_auto_increment sequence auto_nextval)};
      $self->add_column($pri => \%info);
      $join{"foreign.${pri}"} = "self.${pri}";
    }
    $self->add_relationship('parent', $parent->source_name, \%join);
  }
  $table->set_primary_key($self->primary_columns);
  $schema->register_source($raw_name => $table);
}

method set_primary_key (@args) {
  if ($self->parent_source) {
    confess "Can't set primary key on a subclass";
  }
  return $self->next::method(@args);
}

method _raw_source_name () {
  my $base = $self->source_name;
  confess "Can't generate raw source name when we don't have a source_name"
    unless $base;
  return 'Raw::'.$base;
}

method add_columns (@args) {
  my $ret = $self->next::method(@args);
  $_->{originally_defined_in} ||= $self->name for values %{$self->_columns};
  return $ret;
}

1;