Release 0.02
[dbsrgits/DBIx-Class-ResultSource-MultipleTableInheritance.git] / lib / DBIx / Class / ResultSource / MultipleTableInheritance.pm
index ea14a3d..980d58b 100644 (file)
@@ -9,9 +9,9 @@ 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;
+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));
 
@@ -19,7 +19,7 @@ __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
@@ -83,7 +83,7 @@ method add_additional_parent ($source) {
 
 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"
@@ -103,7 +103,6 @@ method schema (@args) {
       @{$self->additional_parents||[]}
     ]);
   }
-  use Devel::Dwarn; use 5.012; say Dwarn $ret;
   return $ret;
 }
 
@@ -120,7 +119,7 @@ method attach_additional_sources () {
   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"
@@ -162,20 +161,6 @@ method attach_additional_sources () {
         $self->columns
   );
   $table->set_primary_key($self->primary_columns);
-  
-  ## Attempting to re-add sequence here -- AKB
-  for my $pk ( $self->primary_columns ) {
-    if ($parent) {
-
-#use 5.012; use Devel::Dwarn; say Dwarn $schema->source($table->_relationships->{parent}->{class}) if $table->_relationships->{parent}->{class};
-      $table->columns_info->{$pk}->{sequence} =
-        $self->set_sequence(
-        $schema->source( $table->_relationships->{parent}->{class} )->name,
-        $self->primary_columns )
-        if $table->columns_info->{$pk}->{originally_defined_in} ne $self->name
-          && $table->_relationships->{parent}->{class};
-    }
-  }
 
   # we need to copy our rels to the raw object as well
   # note that ->add_relationship on a source object doesn't create an
@@ -204,7 +189,7 @@ method attach_additional_sources () {
     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)}
     );
@@ -266,40 +251,41 @@ method add_relationship ($name, $f_source, $cond, $attrs) {
 
 BEGIN {
 
-  # helper routines, constructed as anon subs so autoclean nukes them
+  # helper routines
 
-  use signatures;
-
-  *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 {
-    my ($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 %])
@@ -309,38 +295,21 @@ BEGIN {
         END;
       $function$ LANGUAGE plpgsql;
     };
-  };
-  #*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;
-  };
+  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{
@@ -350,7 +319,7 @@ BEGIN {
           SELECT [% to %]_[% on %]([% arglist %])
         );
     };
-  };
+  }
 }
 
 method root_table () {
@@ -370,8 +339,23 @@ method view_definition () {
   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);
@@ -463,11 +447,16 @@ __END__
 =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
 
@@ -507,7 +496,7 @@ This only works with PostgreSQL for the moment.
 
         1;
     }
-    
+
     ...
 
     my $schema = Cafe->connect($dsn,$user,$pass);
@@ -534,7 +523,7 @@ In many applications, many classes are subclasses of others. Let's say you
 have this schema:
 
     # Conceptual domain model
-    
+
     class User {
         has id,
         has name,
@@ -584,7 +573,7 @@ investor:
         "name" text not null,
         "password" text not null
     );
-        
+
     create table "investor" (
         "id" integer not null references user("id"),
         "dollars" integer
@@ -593,7 +582,7 @@ investor:
 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},
@@ -622,7 +611,7 @@ we could do this:
         password => $args->{password},
         dollars => $args->{dollars},
     );
-    
+
 And have it Just Work? The user...
 
     {
@@ -700,7 +689,7 @@ in the schema, e.g.,
 
     print STDERR map { "$_\n" } MyApp::Schema->sources;
 
-    # Coffee 
+    # Coffee
     # Beverage
     # Liquid
     # Sumatra
@@ -720,11 +709,11 @@ Matt S. Trout, E<lt>mst@shadowcatsystems.co.ukE<gt>
 
 =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