Commit | Line | Data |
---|---|---|
ea2e61bf | 1 | package DBIx::Class::Table; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
223b8fe3 | 6 | use DBIx::Class::ResultSet; |
95a70f01 | 7 | |
1edd1722 | 8 | use base qw/DBIx::Class/; |
ea2e61bf | 9 | |
10 | __PACKAGE__->mk_classdata('_columns' => {}); | |
11 | ||
ea2e61bf | 12 | __PACKAGE__->mk_classdata('_table_name'); |
13 | ||
34d52be2 | 14 | __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet! |
15 | ||
223b8fe3 | 16 | __PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet'); |
95a70f01 | 17 | |
223b8fe3 | 18 | sub iterator_class { shift->_resultset_class(@_) } |
525035fb | 19 | |
34d52be2 | 20 | =head1 NAME |
21 | ||
22 | DBIx::Class::Table - Basic table methods | |
23 | ||
24 | =head1 SYNOPSIS | |
25 | ||
26 | =head1 DESCRIPTION | |
27 | ||
8091aa91 | 28 | This class is responsible for defining and doing table-level operations on |
29 | L<DBIx::Class> classes. | |
34d52be2 | 30 | |
31 | =head1 METHODS | |
32 | ||
39fe0e65 | 33 | =cut |
34 | ||
ea2e61bf | 35 | sub _register_columns { |
36 | my ($class, @cols) = @_; | |
37 | my $names = { %{$class->_columns} }; | |
0a3c5b43 | 38 | while (my $col = shift @cols) { |
39 | $names->{$col} = (ref $cols[0] ? shift : {}); | |
40 | } | |
ea2e61bf | 41 | $class->_columns($names); |
42 | } | |
43 | ||
44 | sub _mk_column_accessors { | |
45 | my ($class, @cols) = @_; | |
510ca912 | 46 | $class->mk_group_accessors('column' => @cols); |
ea2e61bf | 47 | } |
48 | ||
8091aa91 | 49 | =head2 add_columns |
39fe0e65 | 50 | |
51 | __PACKAGE__->add_columns(qw/col1 col2 col3/); | |
52 | ||
8091aa91 | 53 | Adds columns to the current class and creates accessors for them. |
39fe0e65 | 54 | |
55 | =cut | |
56 | ||
510ca912 | 57 | sub add_columns { |
8fe001e1 | 58 | my ($class, @cols) = @_; |
59 | $class->_register_columns(@cols); | |
60 | $class->_mk_column_accessors(@cols); | |
61 | } | |
62 | ||
3c0068c1 | 63 | sub resultset_instance { |
7624b19f | 64 | my $class = shift; |
3c0068c1 | 65 | $class->next::method($class->construct_resultset); |
66 | } | |
7624b19f | 67 | |
3c0068c1 | 68 | sub construct_resultset { |
69 | my $class = shift; | |
7624b19f | 70 | my $rs_class = $class->_resultset_class; |
71 | eval "use $rs_class;"; | |
3c0068c1 | 72 | return $rs_class->new($class); |
a3018bd3 | 73 | } |
74 | ||
8fe001e1 | 75 | sub _select_columns { |
76 | return keys %{$_[0]->_columns}; | |
77 | } | |
78 | ||
8091aa91 | 79 | =head2 table |
39fe0e65 | 80 | |
81 | __PACKAGE__->table('tbl_name'); | |
8091aa91 | 82 | |
83 | Gets or sets the table name. | |
39fe0e65 | 84 | |
85 | =cut | |
86 | ||
510ca912 | 87 | sub table { |
88 | shift->_table_name(@_); | |
89 | } | |
90 | ||
8091aa91 | 91 | =head2 find_or_create |
39fe0e65 | 92 | |
93 | $class->find_or_create({ key => $val, ... }); | |
94 | ||
95 | Searches for a record matching the search condition; if it doesn't find one, | |
8091aa91 | 96 | creates one and returns that instead. |
39fe0e65 | 97 | |
98 | =cut | |
99 | ||
95a70f01 | 100 | sub find_or_create { |
101 | my $class = shift; | |
102 | my $hash = ref $_[0] eq "HASH" ? shift: {@_}; | |
1a14aa3f | 103 | my $exists = $class->find($hash); |
95a70f01 | 104 | return defined($exists) ? $exists : $class->create($hash); |
105 | } | |
106 | ||
8091aa91 | 107 | =head2 has_column |
103647d5 | 108 | |
109 | if ($obj->has_column($col)) { ... } | |
110 | ||
8091aa91 | 111 | Returns 1 if the class has a column of this name, 0 otherwise. |
103647d5 | 112 | |
113 | =cut | |
114 | ||
115 | sub has_column { | |
116 | my ($self, $column) = @_; | |
117 | return exists $self->_columns->{$column}; | |
118 | } | |
119 | ||
8091aa91 | 120 | =head2 column_info |
103647d5 | 121 | |
122 | my $info = $obj->column_info($col); | |
123 | ||
8091aa91 | 124 | Returns the column metadata hashref for a column. |
103647d5 | 125 | |
126 | =cut | |
127 | ||
128 | sub column_info { | |
129 | my ($self, $column) = @_; | |
130 | die "No such column $column" unless exists $self->_columns->{$column}; | |
131 | return $self->_columns->{$column}; | |
132 | } | |
133 | ||
8091aa91 | 134 | =head2 columns |
103647d5 | 135 | |
136 | my @column_names = $obj->columns; | |
137 | ||
138 | =cut | |
139 | ||
e7513319 | 140 | sub columns { |
141 | die "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1); | |
142 | return keys %{shift->_columns}; | |
143 | } | |
8b445e33 | 144 | |
ea2e61bf | 145 | 1; |
34d52be2 | 146 | |
34d52be2 | 147 | =head1 AUTHORS |
148 | ||
daec44b8 | 149 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
34d52be2 | 150 | |
151 | =head1 LICENSE | |
152 | ||
153 | You may distribute this code under the same terms as Perl itself. | |
154 | ||
155 | =cut | |
156 |