use Carp::Clan qw/^DBIx::Class/;
use aliased 'DBIx::Class::ResultSource::Table';
use aliased 'DBIx::Class::ResultClass::HashRefInflator';
+use String::TT qw(strip tt);
+use Scalar::Util qw(blessed);
use namespace::autoclean;
# how this works:
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;
+ $self->parent_source($parent); # so our parent is the one in this schema
}
# create the raw table source
method raw_source_name () {
my $base = $self->source_name;
- confess "Can't generate raw source name when we don't have a source_name"
+ confess "Can't generate raw source name for ${\$self->name} when we don't have a source_name"
unless $base;
return 'Raw::'.$base;
}
return $ret;
}
+BEGIN {
+
+ # helper routines, constructed as anon subs so autoclean nukes them
+
+ use signatures;
+
+ *argify = sub (@names) {
+ map '_'.$_, @names;
+ };
+
+ *qualify_with = sub ($source, @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 => $_ },
+ grep !exists $pk{$_}, $source->columns;
+ };
+
+ *pk_cols = sub ($source) {
+ map +{ %{$source->column_info($_)}, name => $_ },
+ $source->primary_columns;
+ };
+
+ *names_of = sub (@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);
+ return strip tt q{
+ CREATE OR REPLACE FUNCTION [% name %]
+ ([% arglist %])
+ RETURNS VOID AS $function$
+ BEGIN
+ [%- body %]
+ END;
+ $function$ LANGUAGE plpgsql;
+ };
+ };
+}
+
+BEGIN {
+
+ use signatures;
+
+ *arg_hash = sub ($source) {
+ 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),
+ );
+ $to = $to->name if blessed($to);
+ return strip tt q{
+ CREATE RULE _[% to %]_[% on %]_rule AS
+ ON [% on | upper %] TO [% to %]
+ DO INSTEAD (
+ SELECT _[% to %]_[% on %]([% arglist %])
+ );
+ };
+ };
+}
+
+method root_table () {
+ $self->parent_source
+ ? $self->parent_source->root_table
+ : $self->schema->source($self->raw_source_name)
+}
+
+method view_definition () {
+ my $schema = $self->schema;
+ confess "Can't generate view without connected schema, sorry"
+ unless $schema && $schema->storage;
+ my $sqla = $schema->storage->sql_maker;
+ my @sources = my $table = $self->schema->source($self->raw_source_name);
+ my $super_view = $self->parent_source;
+ push(@sources, $super_view) if defined($super_view);
+ my @body_cols = map body_cols($_), @sources;
+ my @pk_cols = pk_cols $self;
+
+ # SELECT statement
+
+ my $select = $sqla->select(
+ ($super_view
+ ? ([ # FROM _tbl _tbl
+ { $table->name => $table->name },
+ [ # JOIN view view
+ { $super_view->name => $super_view->name },
+ # ON _tbl.id = view.id
+ { map +(qualify_with($super_view, $_), qualify_with($table, $_)),
+ names_of @pk_cols }
+ ]
+ ])
+ : ($table->name)),
+ [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
+ ).';';
+
+ my ($now, $next) = grep defined, $super_view, $table;
+
+ # INSERT function
+
+ # NOTE: this assumes a single PK col called id with a sequence somewhere
+ # but nothing else -should- so fixing this should make everything work
+ my $insert_func =
+ function_body
+ $self->name.'_insert',
+ \@body_cols,
+ [
+ $sqla->insert( # INSERT INTO _tbl (foo, ...) VALUES (_foo, ...)
+ $now->name,
+ { arg_hash $now },
+ ),
+ ($next
+ ? $sqla->insert( # INSERT INTO super_view (id, ...)
+ # VALUES (currval('_root_tbl_id_seq'), ...)
+ $next->name,
+ {
+ (arg_hash $next),
+ id => \"currval('${\$self->root_table->name}_id_seq')",
+ }
+ )
+ : ()
+ )
+ ];
+
+ # note - similar to arg_hash but not quite enough to share code sanely
+ my $pk_where = { # id = _id AND id2 = _id2 ...
+ map +($_ => \"= ${\argify $_}"), names_of @pk_cols
+ };
+
+ # UPDATE function
+
+ my $update_func =
+ function_body
+ $self->name.'_update',
+ [ @pk_cols, @body_cols ],
+ [ map $sqla->update(
+ $_->name, # UPDATE foo
+ { arg_hash $_ }, # SET a = _a
+ $pk_where,
+ ), @sources
+ ];
+
+ # DELETE function
+
+ my $delete_func =
+ function_body
+ $self->name.'_delete',
+ [ @pk_cols ],
+ [ map $sqla->delete($_->name, $pk_where), @sources ];
+
+ my @rules = (
+ (rule_body insert => $self, [], \@body_cols),
+ (rule_body update => $self, \@pk_cols, \@body_cols),
+ (rule_body delete => $self, \@pk_cols, []),
+ );
+ return join("\n\n", $select, $insert_func, $update_func, $delete_func, @rules);
+}
+
1;
--- /dev/null
+sub argify (@cols) {
+ map $_->new(%$_, name => '_'.$_->name), @cols;
+}
+
+sub body_cols ($source) {
+ grep $_->name ne 'id', $source->all_cols;
+}
+
+my @pk_col = ($table->col('id'));
+
+my @sources = grep defined, $table, $super_view;
+
+my @body_cols = map body_cols($_), @sources;
+
+CREATE VIEW $view_name =>
+ SELECT {
+ (map $_->qualify, @pk_col),
+ @body_cols,
+ } FROM {
+ $super_view ? ($table->join($super_view)->using(@pk_col)) : $table
+ };
+
+my ($now, $next) = grep defined, $super_view, $table;
+
+CREATE FUNCTION "${view_name}_insert" =>
+ (argify @body_cols)
+ => RETURNS VOID => AS {
+ INSERT INTO { $now } (body_cols $now)
+ => VALUES (argify body_cols $now);
+ if ($next) {
+ INSERT INTO { $next } ($next->all_cols)
+ => VALUES {
+ $root_table->col('id')->sequence->currval,
+ argify body_cols $next
+ };
+ }
+ };
+
+my $pk_eq = AND( map (expr { $_ == argify $_ }), @pk_col);
+
+CREATE FUNCTION "${view_name}_update" =>
+ (argify @pk_col, @body_cols)
+ => RETURNS VOID => AS {
+ foreach my $s (@sources) {
+ UPDATE { $s } SET { map ($_ => argify $_), body_cols $s }
+ WHERE { $pk_eq };
+ }
+ };
+
+CREATE FUNCTION "${view_name}_delete" =>
+ (argify @pk_col)
+ => RETURNS VOID => AS {
+ foreach my $s (@sources) {
+ DELETE FROM { $s } WHERE { $pk_eq };
+ }
+ };
+
+
projects / dbsrgits/DBIx-Class-ResultSource-MultipleTableInheritance.git / commitdiff