use aliased 'DBIx::Class::ResultClass::HashRefInflator';
use String::TT qw(strip tt);
use Scalar::Util qw(blessed);
-use namespace::autoclean;
+use namespace::autoclean -also => [qw/argify qualify_with body_cols pk_cols names_of function_body arg_hash rule_body/];
-our $VERSION = 0.01;
+our $VERSION = 0.02;
__PACKAGE__->mk_group_accessors(simple => qw(parent_source additional_parents));
#
# 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
method _source_by_name ($name) {
my $schema = $self->schema;
- my ($source) =
+ my ($source) =
grep { $_->name eq $name }
map $schema->source($_), $schema->sources;
confess "Couldn't find attached source for parent $name - did you use load_classes? This module is only compatible with load_namespaces"
my $parent;
if ($self->parent_source) {
my $parent_name = $self->parent_source->name;
- ($parent) =
+ ($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"
# have to use source name lookups rather than result class here
# because we don't actually have a result class on the raw sources
$table->add_relationship('parent', $parent->raw_source_name, \%pk_join);
- $self->deploy_depends_on->{$parent->source_name} = 1;
+ $self->deploy_depends_on->{$parent->result_class} = 1;
}
foreach my $add (@{$self->additional_parents||[]}) {
$table->add_relationship(
'parent_'.$add->name, $add->source_name, \%pk_join
);
- $self->deploy_depends_on->{$add->source_name} = 1;
+ $self->deploy_depends_on->{$add->result_class} = 1 if $add->isa('DBIx::Class::ResultSource::View');
}
-
- # add every column that's actually a concrete part of us
-
$table->add_columns(
map { ($_ => { %{$self->column_info($_)} }) }
grep { $self->column_info($_)->{originally_defined_in} eq $self->name }
my $f_source_name = $f_source->${\
($one_of_us ? 'raw_source_name' : 'source_name')
};
-
+
$table->add_relationship(
'_'.$rel, $f_source_name, @{$rel_info}{qw(cond attrs)}
);
return $self->next::method(@args);
}
+method set_sequence ($table_name, @pks) {
+ return $table_name . '_' . join('_',@pks) . '_' . 'seq';
+}
+
method raw_source_name () {
my $base = $self->source_name;
confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
BEGIN {
- # helper routines, constructed as anon subs so autoclean nukes them
-
- use signatures;
+ # helper routines
- *argify = sub (@names) {
- map '_'.$_, @names;
- };
+ sub argify {
+ my @names = @_;
+ map '_' . $_, @names;
+ }
- *qualify_with = sub ($source, @names) {
- my $name = blessed($source) ? $source->name : $source;
- map join('.', $name, $_), @names;
- };
+ sub qualify_with {
+ my $source = shift;
+ my @names = @_;
+ my $name = blessed($source) ? $source->name : $source;
+ map join( '.', $name, $_ ), @names;
+ }
- *body_cols = sub ($source) {
- my %pk; @pk{$source->primary_columns} = ();
- map +{ %{$source->column_info($_)}, name => $_ },
+ sub body_cols {
+ my $source = shift;
+ my %pk;
+ @pk{ $source->primary_columns } = ();
+ map +{ %{ $source->column_info($_) }, name => $_ },
grep !exists $pk{$_}, $source->columns;
- };
+ }
- *pk_cols = sub ($source) {
- map +{ %{$source->column_info($_)}, name => $_ },
+ sub pk_cols {
+ my $source = shift;
+ map +{ %{ $source->column_info($_) }, name => $_ },
$source->primary_columns;
- };
+ }
- *names_of = sub (@cols) { map $_->{name}, @cols };
+ sub names_of { my @cols = @_; map $_->{name}, @cols }
- *function_body = sub ($name, $args, $body_parts) {
- my $arglist = join(
- ', ',
- map "_${\$_->{name}} ${\uc($_->{data_type})}",
- @$args
- );
- my $body = join("\n", '', map " $_;", @$body_parts);
+ sub function_body {
+ my ( $name, $args, $body_parts ) = @_;
+ my $arglist =
+ join( ', ', map "_${\$_->{name}} ${\uc($_->{data_type})}", @$args );
+ my $body = join( "\n", '', map " $_;", @$body_parts );
return strip tt q{
CREATE OR REPLACE FUNCTION [% name %]
([% arglist %])
END;
$function$ LANGUAGE plpgsql;
};
- };
+ }
}
BEGIN {
- use signatures;
-
- *arg_hash = sub ($source) {
- map +($_ => \(argify $_)), names_of body_cols $source;
- };
+ sub arg_hash {
+ my $source = shift;
+ map +( $_ => \( argify $_) ), names_of body_cols $source;
+ }
- *rule_body = sub ($on, $to, $oldlist, $newlist) {
- my $arglist = join(', ',
- (qualify_with 'OLD', names_of @$oldlist),
- (qualify_with 'NEW', names_of @$newlist),
+ sub rule_body {
+ my ( $on, $to, $oldlist, $newlist ) = @_;
+ my $arglist = join( ', ',
+ ( qualify_with 'OLD', names_of @$oldlist ),
+ ( qualify_with 'NEW', names_of @$newlist ),
);
$to = $to->name if blessed($to);
return strip tt q{
SELECT [% to %]_[% on %]([% arglist %])
);
};
- };
+ }
}
method root_table () {
push(@all_parents, $super_view) if defined($super_view);
my @sources = ($table, @all_parents);
my @body_cols = map body_cols($_), @sources;
+
+ # Order body_cols to match the columns order.
+ # Must match or you get typecast errors.
+ my %body_cols = map { $_->{name} => $_ } @body_cols;
+ @body_cols =
+ map { $body_cols{$_} }
+ grep { defined $body_cols{$_} }
+ $self->columns;
my @pk_cols = pk_cols $self;
+ # Grab sequence from root table. Only works with one PK named id...
+ # TBD: Fix this so it's more flexible.
+ for my $pk_col (@pk_cols) {
+ $self->columns_info->{ $pk_col->{name} }->{sequence} =
+ $self->root_table->name . '_id_seq';
+ }
+
# SELECT statement
my $am_root = !($super_view || @other_parents);
=head1 NAME
DBIx::Class::ResultSource::MultipleTableInheritance
-Use multiple tables to define your classes
+Use multiple tables to define your classes
=head1 NOTICE
-This only works with PostgreSQL for the moment.
+This only works with PostgreSQL at the moment. It has been tested with
+PostgreSQL 9.0, 9.1 beta, and 9.1.
+
+There is one additional caveat: the "parent" result classes that you
+defined with this resultsource must have one primary column and it must
+be named "id."
=head1 SYNOPSIS
{
- package MyApp::Schema::Result::Coffee;
+ package Cafe::Result::Coffee;
- __PACKAGE__->table_class(
- 'DBIx::Class::ResultSource::MultipleTableInheritance'
- );
+ use strict;
+ use warnings;
+ use parent 'DBIx::Class::Core';
+ use aliased 'DBIx::Class::ResultSource::MultipleTableInheritance'
+ => 'MTI';
+
+ __PACKAGE__->table_class(MTI);
__PACKAGE__->table('coffee');
__PACKAGE__->add_columns(
- "id",
- {
- data_type => "integer",
- default_value => "nextval('coffee_seq'::regclass)",
- is_auto_increment => 1,
- is_foreign_key => 1,
- is_nullable => 0,
- size => 4,
- },
- "flavor",
- {
- data_type => "text",
- default_value => "good",
- },
+ "id", { data_type => "integer" },
+ "flavor", {
+ data_type => "text",
+ default_value => "good" },
);
__PACKAGE__->set_primary_key("id");
}
{
- package MyApp::Schema::Result::Sumatra;
+ package Cafe::Result::Sumatra;
- use parent 'Coffee';
+ use parent 'Cafe::Result::Coffee';
__PACKAGE__->table('sumatra');
- __PACKAGE__->add_columns(
- "aroma",
- {
- data_type => "text",
- default_value => undef,
- is_nullable => 0,
- },
+ __PACKAGE__->add_columns( "aroma",
+ { data_type => "text" }
);
1;
}
-
- ...
- my $schema = MyApp::Schema->connect($dsn);
+ ...
- my $cup = $schema->resultset('Sumatra')->new;
+ my $schema = Cafe->connect($dsn,$user,$pass);
- print STDERR DwarnS $cup->columns;
+ my $cup = $schema->resultset('Sumatra');
- $VAR1 = 'id';
- $VAR2 = 'flavor';
- $VAR3 = 'aroma';
+ print STDERR Dwarn $cup->result_source->columns;
+ "id"
+ "flavor"
+ "aroma"
+ ..
Inherit from this package and you can make a resultset class from a view, but
that's more than a little bit misleading: the result is B<transparently
have this schema:
# Conceptual domain model
-
+
class User {
has id,
has name,
"name" text not null,
"password" text not null
);
-
+
create table "investor" (
"id" integer not null references user("id"),
"dollars" integer
So that investor's PK is just an FK to the user. We can clearly see the class
hierarchy here, in which investor is a subclass of user. In DBIx::Class
applications, this second strategy looks like:
-
+
my $user_rs = $schema->resultset('User');
my $new_user = $user_rs->create(
name => $args->{name},
password => $args->{password},
dollars => $args->{dollars},
);
-
+
And have it Just Work? The user...
{
print STDERR map { "$_\n" } MyApp::Schema->sources;
- # Coffee
+ # Coffee
# Beverage
# Liquid
# Sumatra
=head2 CONTRIBUTORS
-Amiri Barksdale, E<lt>amiri@metalabel.comE<gt>
+Amiri Barksdale, E<lt>amiri@roosterpirates.comE<gt>
=head1 COPYRIGHT
-Copyright (c) 2010 the DBIx::Class::ResultSource::MultipleTableInheritance
+Copyright (c) 2011 the DBIx::Class::ResultSource::MultipleTableInheritance
L</AUTHOR> and L</CONTRIBUTORS> as listed above.
=head1 LICENSE
projects / dbsrgits/DBIx-Class-ResultSource-MultipleTableInheritance.git / blobdiff