Nuked 08-inheritcols.t since it's duplicated in 01-columns.t
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / TableInstance.pm
CommitLineData
cda04c3a 1package DBIx::Class::TableInstance;
2
3use strict;
4use warnings;
5
6use base qw/DBIx::Class/;
7use DBIx::Class::Table;
8
9__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
10
11__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
12
13sub iterator_class { shift->table->resultset_class(@_) }
14sub resultset_class { shift->table->resultset_class(@_) }
15sub _table_name { shift->table->name }
16
17=head1 NAME
18
19DBIx::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
31sub _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
40Adds columns to the current class and creates accessors for them.
41
42=cut
43
44sub add_columns {
45 my ($class, @cols) = @_;
46 $class->table->add_columns(@cols);
47 $class->_mk_column_accessors(@cols);
48}
49
50sub resultset_instance {
51 my $class = shift;
52 $class->table->storage($class->storage);
53 $class->next::method($class->table->resultset);
54}
55
56sub _select_columns {
57 return shift->table->columns;
58}
59
60=head2 table
61
62 __PACKAGE__->table('tbl_name');
63
64Gets or sets the table name.
65
66=cut
67
68sub table {
69 my ($class, $table) = @_;
70 die "$class->table called and no table instance set yet" unless $table;
71 unless (ref $table) {
72 $table = DBIx::Class::Table->new(
73 {
74 name => $table,
75 result_class => $class,
76 #storage => $class->storage,
77 });
78 }
79 $class->mk_classdata('table' => $table);
80}
81
82=head2 find_or_create
83
84 $class->find_or_create({ key => $val, ... });
85
86Searches for a record matching the search condition; if it doesn't find one,
87creates one and returns that instead.
88
89=cut
90
91sub find_or_create {
92 my $class = shift;
93 my $hash = ref $_[0] eq "HASH" ? shift: {@_};
94 my $exists = $class->find($hash);
95 return defined($exists) ? $exists : $class->create($hash);
96}
97
98=head2 has_column
99
100 if ($obj->has_column($col)) { ... }
101
102Returns 1 if the class has a column of this name, 0 otherwise.
103
104=cut
105
106sub has_column {
107 my ($self, $column) = @_;
108 return $self->table->has_column($column);
109}
110
111=head2 column_info
112
113 my $info = $obj->column_info($col);
114
115Returns the column metadata hashref for a column.
116
117=cut
118
119sub column_info {
120 my ($self, $column) = @_;
121 return $self->table->column_info($column);
122}
123
124=head2 columns
125
126 my @column_names = $obj->columns;
127
128=cut
129
130sub columns {
131 return shift->table->columns(@_);
132}
133
1341;
135
136=head1 AUTHORS
137
138Matt S. Trout <mst@shadowcatsystems.co.uk>
139
140=head1 LICENSE
141
142You may distribute this code under the same terms as Perl itself.
143
144=cut
145