Start of TableInstance code. CDBICompat currently b0rken
Matt S Trout [Wed, 14 Dec 2005 19:38:02 +0000 (19:38 +0000)]
lib/DBIx/Class/Core.pm
lib/DBIx/Class/PK.pm
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Table.pm
lib/DBIx/Class/TableInstance.pm [new file with mode: 0644]
t/20setuperrors.t

index 99c4b2a..5db8b01 100644 (file)
@@ -11,7 +11,7 @@ __PACKAGE__->load_components(qw/
   Relationship
   PK
   Row
-  Table
+  TableInstance
   ResultSetInstance
   Exception
   AccessorGroup/);
index eb2540d..4d46421 100644 (file)
@@ -79,10 +79,10 @@ sub find {
   $class->throw( "Can't find unless all primary keys are specified" )
     unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
                                   # column names etc. Not sure what to do yet
-  #return $class->search($query)->next;
-  my @cols = $class->_select_columns;
-  my @row = $class->storage->select_single($class->_table_name, \@cols, $query);
-  return (@row ? $class->_row_to_object(\@cols, \@row) : ());
+  return $class->search($query)->next;
+  #my @cols = $class->_select_columns;
+  #my @row = $class->storage->select_single($class->_table_name, \@cols, $query);
+  #return (@row ? $class->_row_to_object(\@cols, \@row) : ());
 }
 
 =head2 discard_changes
index 8b8da5f..ce038db 100644 (file)
@@ -33,13 +33,13 @@ any queries -- these are executed as needed by the other methods.
 =cut
 
 sub new {
-  my ($class, $db_class, $attrs) = @_;
+  my ($class, $source, $attrs) = @_;
   #use Data::Dumper; warn Dumper(@_);
   $class = ref $class if ref $class;
   $attrs = { %{ $attrs || {} } };
   my %seen;
-  $attrs->{cols} ||= [ map { "me.$_" } $db_class->_select_columns ];
-  $attrs->{from} ||= [ { 'me' => $db_class->_table_name } ];
+  $attrs->{cols} ||= [ map { "me.$_" } $source->columns ];
+  $attrs->{from} ||= [ { 'me' => $source->name } ];
   if ($attrs->{join}) {
     foreach my $j (ref $attrs->{join} eq 'ARRAY'
               ? (@{$attrs->{join}}) : ($attrs->{join})) {
@@ -49,17 +49,18 @@ sub new {
         $seen{$j} = 1;
       }
     }
-    push(@{$attrs->{from}}, $db_class->_resolve_join($attrs->{join}, 'me'));
+    push(@{$attrs->{from}}, $source->result_class->_resolve_join($attrs->{join}, 'me'));
   }
   foreach my $pre (@{$attrs->{prefetch} || []}) {
-    push(@{$attrs->{from}}, $db_class->_resolve_join($pre, 'me'))
+    push(@{$attrs->{from}}, $source->result_class->_resolve_join($pre, 'me'))
       unless $seen{$pre};
     push(@{$attrs->{cols}},
       map { "$pre.$_" }
-      $db_class->_relationships->{$pre}->{class}->_select_columns);
+      $source->result_class->_relationships->{$pre}->{class}->table->columns);
   }
   my $new = {
-    source => $db_class,
+    source => $source,
+    result_class => $source->result_class,
     cols => $attrs->{cols},
     cond => $attrs->{where},
     from => $attrs->{from},
@@ -166,7 +167,7 @@ Returns a subset of elements from the resultset.
 sub slice {
   my ($self, $min, $max) = @_;
   my $attrs = { %{ $self->{attrs} || {} } };
-  $self->{source}->throw("Can't slice without where") unless $attrs->{where};
+  $self->{source}->result_class->throw("Can't slice without where") unless $attrs->{where};
   $attrs->{offset} = $min;
   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
   my $slice = $self->new($self->{source}, $attrs);
@@ -193,17 +194,17 @@ sub _construct_object {
   @cols = grep { /\(/ or ! /\./ } @cols;
   my $new;
   unless ($self->{attrs}{prefetch}) {
-    $new = $self->{source}->_row_to_object(\@cols, \@row);
+    $new = $self->{source}->result_class->_row_to_object(\@cols, \@row);
   } else {
     my @main = splice(@row, 0, scalar @cols);
-    $new = $self->{source}->_row_to_object(\@cols, \@main);
+    $new = $self->{source}->result_class->_row_to_object(\@cols, \@main);
     PRE: foreach my $pre (@{$self->{attrs}{prefetch}}) {
-      my $rel_obj = $self->{source}->_relationships->{$pre};
-      my $pre_class = $self->{source}->resolve_class($rel_obj->{class});
+      my $rel_obj = $self->{source}->result_class->_relationships->{$pre};
+      my $pre_class = $self->{source}->result_class->resolve_class($rel_obj->{class});
       my @pre_cols = $pre_class->_select_columns;
       my @vals = splice(@row, 0, scalar @pre_cols);
       my $fetched = $pre_class->_row_to_object(\@pre_cols, \@vals);
-      $self->{source}->throw("No accessor for prefetched $pre")
+      $self->{source}->result_class->throw("No accessor for prefetched $pre")
         unless defined $rel_obj->{attrs}{accessor};
       if ($rel_obj->{attrs}{accessor} eq 'single') {
         foreach my $pri ($rel_obj->{class}->primary_columns) {
@@ -216,7 +217,7 @@ sub _construct_object {
       } elsif ($rel_obj->{attrs}{accessor} eq 'filter') {
         $new->{_inflated_column}{$pre} = $fetched;
       } else {
-        $self->{source}->throw("Don't know how to store prefetched $pre");
+        $self->{source}->result_class->throw("Don't know how to store prefetched $pre");
       }
     }
   }
index 4c4942b..fa8e850 100644 (file)
@@ -167,7 +167,9 @@ sub compose_connection {
   while (my ($comp, $comp_class) = each %reg) {
     my $target_class = "${target}::${comp}";
     $class->inject_base($target_class, $comp_class, $conn_class);
-    $target_class->table($comp_class->table);
+    my $table = $comp_class->table->new({ %{$comp_class->table} });
+    $table->result_class($target_class);
+    $target_class->table($table);
     @map{$comp, $comp_class} = ($target_class, $target_class);
   }
   {
index cce20ef..d370ce2 100644 (file)
@@ -6,20 +6,14 @@ use warnings;
 use DBIx::Class::ResultSet;
 
 use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/AccessorGroup/);
 
-__PACKAGE__->mk_classdata('_columns' => {});
-
-__PACKAGE__->mk_classdata('_table_name');
-
-__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
-
-__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
-
-sub iterator_class { shift->_resultset_class(@_) }
+__PACKAGE__->mk_group_accessors('simple' =>
+  qw/_columns name resultset_class result_class storage/);
 
 =head1 NAME 
 
-DBIx::Class::Table - Basic table methods
+DBIx::Class::Table - Table object
 
 =head1 SYNOPSIS
 
@@ -32,83 +26,51 @@ L<DBIx::Class> classes.
 
 =cut
 
-sub _register_columns {
-  my ($class, @cols) = @_;
-  my $names = { %{$class->_columns} };
-  while (my $col = shift @cols) {
-    $names->{$col} = (ref $cols[0] ? shift : {});
-  }
-  $class->_columns($names); 
-}
-
-sub _mk_column_accessors {
-  my ($class, @cols) = @_;
-  $class->mk_group_accessors('column' => @cols);
+sub new {
+  my ($class, $attrs) = @_;
+  $class = ref $class if ref $class;
+  my $new = bless($attrs || {}, $class);
+  $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
+  $new->{_columns} ||= {};
+  $new->{name} ||= "!!NAME NOT SET!!";
+  return $new;
 }
 
-=head2 add_columns
-
-  __PACKAGE__->add_columns(qw/col1 col2 col3/);
-
-Adds columns to the current class and creates accessors for them.
-
-=cut
-
 sub add_columns {
-  my ($class, @cols) = @_;
-  $class->_register_columns(@cols);
-  $class->_mk_column_accessors(@cols);
-}
-
-sub resultset_instance {
-  my $class = shift;
-  $class->next::method($class->construct_resultset);
-}
-
-sub construct_resultset {
-  my $class = shift;
-  my $rs_class = $class->_resultset_class;
-  eval "use $rs_class;";
-  return $rs_class->new($class);
+  my ($self, @cols) = @_;
+  while (my $col = shift @cols) {
+    $self->add_column($col => (ref $cols[0] ? shift : {}));
+  }
 }
 
-sub _select_columns {
-  return keys %{$_[0]->_columns};
+sub add_column {
+  my ($self, $col, $info) = @_;
+  $self->_columns->{$col} = $info || {};
 }
 
-=head2 table
-
-  __PACKAGE__->table('tbl_name');
-  
-Gets or sets the table name.
-
-=cut
-
-sub table {
-  shift->_table_name(@_);
-}
+=head2 add_columns
 
-=head2 find_or_create
+  $table->add_columns(qw/col1 col2 col3/);
 
-  $class->find_or_create({ key => $val, ... });
+  $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
 
-Searches for a record matching the search condition; if it doesn't find one,
-creates one and returns that instead.
+Adds columns to the table object. If supplied key => hashref pairs uses
+the hashref as the column_info for that column.
 
 =cut
 
-sub find_or_create {
-  my $class    = shift;
-  my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
-  my $exists = $class->find($hash);
-  return defined($exists) ? $exists : $class->create($hash);
+sub resultset {
+  my $self = shift;
+  my $rs_class = $self->resultset_class;
+  eval "use $rs_class;";
+  return $rs_class->new($self);
 }
 
 =head2 has_column                                                                
                                                                                 
   if ($obj->has_column($col)) { ... }                                           
                                                                                 
-Returns 1 if the class has a column of this name, 0 otherwise.                  
+Returns 1 if the table has a column of this name, 0 otherwise.                  
                                                                                 
 =cut                                                                            
 
diff --git a/lib/DBIx/Class/TableInstance.pm b/lib/DBIx/Class/TableInstance.pm
new file mode 100644 (file)
index 0000000..81c3c39
--- /dev/null
@@ -0,0 +1,145 @@
+package DBIx::Class::TableInstance;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class/;
+use DBIx::Class::Table;
+
+__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
+
+__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
+
+sub iterator_class { shift->table->resultset_class(@_) }
+sub resultset_class { shift->table->resultset_class(@_) }
+sub _table_name { shift->table->name }
+
+=head1 NAME 
+
+DBIx::Class::TableInstance - provides a classdata table object and method proxies
+
+=head1 SYNOPSIS
+
+  __PACKAGE__->table('foo');
+  __PACKAGE__->add_columns(qw/id bar baz/);
+  __PACKAGE__->set_primary_key('id');
+
+=head1 METHODS
+
+=cut
+
+sub _mk_column_accessors {
+  my ($class, @cols) = @_;
+  $class->mk_group_accessors('column' => @cols);
+}
+
+=head2 add_columns
+
+  __PACKAGE__->add_columns(qw/col1 col2 col3/);
+
+Adds columns to the current class and creates accessors for them.
+
+=cut
+
+sub add_columns {
+  my ($class, @cols) = @_;
+  $class->table->add_columns(@cols);
+  $class->_mk_column_accessors(@cols);
+}
+
+sub resultset_instance {
+  my $class = shift;
+  $class->table->storage($class->storage);
+  $class->next::method($class->table->resultset);
+}
+
+sub _select_columns {
+  return shift->table->columns;
+}
+
+=head2 table
+
+  __PACKAGE__->table('tbl_name');
+  
+Gets or sets the table name.
+
+=cut
+
+sub table {
+  my ($class, $table) = @_;
+  die "$class->table called and no table instance set yet" unless $table;
+  unless (ref $table) {
+    $table = DBIx::Class::Table->new(
+      {
+        name => $table,
+        result_class => $class,
+        #storage => $class->storage,
+      });
+  }
+  $class->mk_classdata('table' => $table);
+}
+
+=head2 find_or_create
+
+  $class->find_or_create({ key => $val, ... });
+
+Searches for a record matching the search condition; if it doesn't find one,
+creates one and returns that instead.
+
+=cut
+
+sub find_or_create {
+  my $class    = shift;
+  my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
+  my $exists = $class->find($hash);
+  return defined($exists) ? $exists : $class->create($hash);
+}
+
+=head2 has_column                                                                
+                                                                                
+  if ($obj->has_column($col)) { ... }                                           
+                                                                                
+Returns 1 if the class has a column of this name, 0 otherwise.                  
+                                                                                
+=cut                                                                            
+
+sub has_column {
+  my ($self, $column) = @_;
+  return $self->table->has_column($column);
+}
+
+=head2 column_info                                                               
+                                                                                
+  my $info = $obj->column_info($col);                                           
+                                                                                
+Returns the column metadata hashref for a column.
+                                                                                
+=cut                                                                            
+
+sub column_info {
+  my ($self, $column) = @_;
+  return $self->table->column_info($column);
+}
+
+=head2 columns                                                                   
+                                                                                
+  my @column_names = $obj->columns;                                             
+                                                                                
+=cut                                                                            
+
+sub columns {
+  return shift->table->columns(@_);
+}
+
+1;
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
index f082e93..3d36bd4 100644 (file)
@@ -7,6 +7,7 @@ eval {
   use base 'DBIx::Class';
 
   __PACKAGE__->load_components qw/Core/;
+  __PACKAGE__->table('buggy_table');
   __PACKAGE__->columns qw/this doesnt work as expected/;
 };