add_relationship, relationship_info, relationships moved to ResultSource
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / TableInstance.pm
1 package DBIx::Class::TableInstance;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class/;
7 use DBIx::Class::Table;
8
9 __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
10
11 __PACKAGE__->mk_classdata('table_class' => 'DBIx::Class::Table');
12
13 sub iterator_class { shift->result_source->resultset_class(@_) }
14 sub resultset_class { shift->result_source->resultset_class(@_) }
15 sub _table_name { shift->result_source->name }
16
17 =head1 NAME 
18
19 DBIx::Class::TableInstance - provides a classdata table object and method proxies
20
21 =head1 SYNOPSIS
22
23   __PACKAGE__->table('foo');
24   __PACKAGE__->add_columns(qw/id bar baz/);
25   __PACKAGE__->set_primary_key('id');
26
27 =head1 METHODS
28
29 =cut
30
31 sub _mk_column_accessors {
32   my ($class, @cols) = @_;
33   $class->mk_group_accessors('column' => @cols);
34 }
35
36 =head2 add_columns
37
38   __PACKAGE__->add_columns(qw/col1 col2 col3/);
39
40 Adds columns to the current class and creates accessors for them.
41
42 =cut
43
44 sub add_columns {
45   my ($class, @cols) = @_;
46   $class->result_source->add_columns(@cols);
47   $class->_mk_column_accessors(@cols);
48 }
49
50 sub _select_columns {
51   return shift->result_source->columns;
52 }
53
54 =head2 table
55
56   __PACKAGE__->table('tbl_name');
57   
58 Gets or sets the table name.
59
60 =cut
61
62 sub table {
63   my ($class, $table) = @_;
64   return $class->result_source->name unless $table;
65   unless (ref $table) {
66     $table = $class->table_class->new(
67       {
68         name => $table,
69         result_class => $class,
70       });
71     if ($class->can('result_source')) {
72       $table->{_columns} = { %{$class->result_source->{_columns}||{}} };
73     }
74   }
75   $class->mk_classdata('result_source' => $table);
76   if ($class->can('schema_instance')) {
77     $class =~ m/([^:]+)$/;
78     $class->schema_instance->register_class($class, $class);
79   }
80 }
81
82 =head2 has_column                                                                
83                                                                                 
84   if ($obj->has_column($col)) { ... }                                           
85                                                                                 
86 Returns 1 if the class has a column of this name, 0 otherwise.                  
87                                                                                 
88 =cut                                                                            
89
90 sub has_column {
91   my ($self, $column) = @_;
92   return $self->result_source->has_column($column);
93 }
94
95 =head2 column_info                                                               
96                                                                                 
97   my $info = $obj->column_info($col);                                           
98                                                                                 
99 Returns the column metadata hashref for a column.
100                                                                                 
101 =cut                                                                            
102
103 sub column_info {
104   my ($self, $column) = @_;
105   return $self->result_source->column_info($column);
106 }
107
108 =head2 columns
109
110   my @column_names = $obj->columns;                                             
111                                                                                 
112 =cut                                                                            
113
114 sub columns {
115   return shift->result_source->columns(@_);
116 }
117
118 sub set_primary_key { shift->result_source->set_primary_key(@_); }
119 sub primary_columns { shift->result_source->primary_columns(@_); }
120
121 1;
122
123 =head1 AUTHORS
124
125 Matt S. Trout <mst@shadowcatsystems.co.uk>
126
127 =head1 LICENSE
128
129 You may distribute this code under the same terms as Perl itself.
130
131 =cut
132