Commit | Line | Data |
ea2e61bf |
1 | package DBIx::Class::Table; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
223b8fe3 |
6 | use DBIx::Class::ResultSet; |
2a21de92 |
7 | use Data::Page; |
95a70f01 |
8 | |
181d4574 |
9 | use Carp qw/croak/; |
10 | |
1edd1722 |
11 | use base qw/DBIx::Class/; |
ea2e61bf |
12 | |
13 | __PACKAGE__->mk_classdata('_columns' => {}); |
14 | |
ea2e61bf |
15 | __PACKAGE__->mk_classdata('_table_name'); |
16 | |
34d52be2 |
17 | __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet! |
18 | |
223b8fe3 |
19 | __PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet'); |
95a70f01 |
20 | |
223b8fe3 |
21 | sub iterator_class { shift->_resultset_class(@_) } |
525035fb |
22 | |
34d52be2 |
23 | =head1 NAME |
24 | |
25 | DBIx::Class::Table - Basic table methods |
26 | |
27 | =head1 SYNOPSIS |
28 | |
29 | =head1 DESCRIPTION |
30 | |
958bcea5 |
31 | This class is responsible for defining and doing table-level operations on |
32 | L<DBIx::Class> classes. |
34d52be2 |
33 | |
34 | =head1 METHODS |
35 | |
39fe0e65 |
36 | =cut |
37 | |
ea2e61bf |
38 | sub _register_columns { |
39 | my ($class, @cols) = @_; |
40 | my $names = { %{$class->_columns} }; |
41 | $names->{$_} ||= {} for @cols; |
42 | $class->_columns($names); |
43 | } |
44 | |
45 | sub _mk_column_accessors { |
46 | my ($class, @cols) = @_; |
510ca912 |
47 | $class->mk_group_accessors('column' => @cols); |
ea2e61bf |
48 | } |
49 | |
130c6439 |
50 | =head2 add_columns |
39fe0e65 |
51 | |
52 | __PACKAGE__->add_columns(qw/col1 col2 col3/); |
53 | |
958bcea5 |
54 | Adds columns to the current class and creates accessors for them. |
39fe0e65 |
55 | |
56 | =cut |
57 | |
510ca912 |
58 | sub add_columns { |
8fe001e1 |
59 | my ($class, @cols) = @_; |
60 | $class->_register_columns(@cols); |
61 | $class->_mk_column_accessors(@cols); |
62 | } |
63 | |
130c6439 |
64 | =head2 search_literal |
39fe0e65 |
65 | |
656796f2 |
66 | my @obj = $class->search_literal($literal_where_cond, @bind); |
67 | my $cursor = $class->search_literal($literal_where_cond, @bind); |
39fe0e65 |
68 | |
69 | =cut |
70 | |
656796f2 |
71 | sub search_literal { |
8fe001e1 |
72 | my ($class, $cond, @vals) = @_; |
a3018bd3 |
73 | $cond =~ s/^\s*WHERE//i; |
8da9889b |
74 | my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {}); |
75 | $attrs->{bind} = \@vals; |
76 | return $class->search(\$cond, $attrs); |
510ca912 |
77 | } |
78 | |
130c6439 |
79 | =head2 count_literal |
39fe0e65 |
80 | |
656796f2 |
81 | my $count = $class->count_literal($literal_where_cond); |
39fe0e65 |
82 | |
83 | =cut |
84 | |
656796f2 |
85 | sub count_literal { |
7624b19f |
86 | my $class = shift; |
87 | return $class->search_literal(@_)->count; |
fcbc5f29 |
88 | } |
89 | |
130c6439 |
90 | =head2 count |
39fe0e65 |
91 | |
92 | my $count = $class->count({ foo => 3 }); |
93 | |
94 | =cut |
95 | |
06d90c6b |
96 | sub count { |
97 | my $class = shift; |
7624b19f |
98 | return $class->search(@_)->count; |
c1d23573 |
99 | } |
100 | |
130c6439 |
101 | =head2 search |
39fe0e65 |
102 | |
20f67ac7 |
103 | my @obj = $class->search({ foo => 3 }); # "... WHERE foo = 3" |
39fe0e65 |
104 | my $cursor = $class->search({ foo => 3 }); |
105 | |
20f67ac7 |
106 | To retrieve all rows, simply call C<search()> with no condition parameter, |
107 | |
108 | my @all = $class->search(); # equivalent to search({}) |
109 | |
110 | If you need to pass in additional attributes (see |
111 | L<DBIx::Class::ResultSet/Attributes> for details) an empty hash indicates |
112 | no condition, |
113 | |
114 | my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table" |
115 | |
39fe0e65 |
116 | =cut |
117 | |
8fe001e1 |
118 | sub search { |
12bbb339 |
119 | my $class = shift; |
120 | my $attrs = { }; |
181d4574 |
121 | croak "Table not defined for ". ( ref $class || $class ) unless $class->table(); |
12bbb339 |
122 | if (@_ > 1 && ref $_[$#_] eq 'HASH') { |
123 | $attrs = { %{ pop(@_) } }; |
124 | } |
7624b19f |
125 | $attrs->{where} = (@_ == 1 || ref $_[0] eq "HASH" ? shift: {@_}); |
2a21de92 |
126 | |
7624b19f |
127 | my $rs = $class->resultset($attrs); |
2a21de92 |
128 | |
7624b19f |
129 | return (wantarray ? $rs->all : $rs); |
130 | } |
131 | |
132 | sub resultset { |
133 | my $class = shift; |
134 | |
135 | my $rs_class = $class->_resultset_class; |
136 | eval "use $rs_class;"; |
137 | my $rs = $rs_class->new($class, @_); |
a3018bd3 |
138 | } |
139 | |
130c6439 |
140 | =head2 search_like |
39fe0e65 |
141 | |
142 | Identical to search except defaults to 'LIKE' instead of '=' in condition |
143 | |
144 | =cut |
145 | |
a3018bd3 |
146 | sub search_like { |
147 | my $class = shift; |
12bbb339 |
148 | my $attrs = { }; |
149 | if (@_ > 1 && ref $_[$#_] eq 'HASH') { |
150 | $attrs = pop(@_); |
151 | } |
223b8fe3 |
152 | my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_}; |
153 | $query->{$_} = { 'like' => $query->{$_} } for keys %$query; |
154 | return $class->search($query, { %$attrs }); |
8fe001e1 |
155 | } |
156 | |
157 | sub _select_columns { |
158 | return keys %{$_[0]->_columns}; |
159 | } |
160 | |
130c6439 |
161 | =head2 table |
39fe0e65 |
162 | |
163 | __PACKAGE__->table('tbl_name'); |
958bcea5 |
164 | |
165 | Gets or sets the table name. |
39fe0e65 |
166 | |
167 | =cut |
168 | |
510ca912 |
169 | sub table { |
170 | shift->_table_name(@_); |
171 | } |
172 | |
130c6439 |
173 | =head2 find_or_create |
39fe0e65 |
174 | |
175 | $class->find_or_create({ key => $val, ... }); |
176 | |
177 | Searches for a record matching the search condition; if it doesn't find one, |
958bcea5 |
178 | creates one and returns that instead. |
39fe0e65 |
179 | |
180 | =cut |
181 | |
95a70f01 |
182 | sub find_or_create { |
183 | my $class = shift; |
184 | my $hash = ref $_[0] eq "HASH" ? shift: {@_}; |
1a14aa3f |
185 | my $exists = $class->find($hash); |
95a70f01 |
186 | return defined($exists) ? $exists : $class->create($hash); |
187 | } |
188 | |
130c6439 |
189 | =head2 has_column |
103647d5 |
190 | |
191 | if ($obj->has_column($col)) { ... } |
192 | |
958bcea5 |
193 | Returns 1 if the class has a column of this name, 0 otherwise. |
103647d5 |
194 | |
195 | =cut |
196 | |
197 | sub has_column { |
198 | my ($self, $column) = @_; |
199 | return exists $self->_columns->{$column}; |
200 | } |
201 | |
130c6439 |
202 | =head2 column_info |
103647d5 |
203 | |
204 | my $info = $obj->column_info($col); |
205 | |
958bcea5 |
206 | Returns the column metadata hashref for a column. |
103647d5 |
207 | |
208 | =cut |
209 | |
210 | sub column_info { |
211 | my ($self, $column) = @_; |
181d4574 |
212 | croak "No such column $column" unless exists $self->_columns->{$column}; |
103647d5 |
213 | return $self->_columns->{$column}; |
214 | } |
215 | |
130c6439 |
216 | =head2 columns |
103647d5 |
217 | |
218 | my @column_names = $obj->columns; |
219 | |
220 | =cut |
221 | |
e7513319 |
222 | sub columns { |
181d4574 |
223 | croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1); |
e7513319 |
224 | return keys %{shift->_columns}; |
225 | } |
8b445e33 |
226 | |
ea2e61bf |
227 | 1; |
34d52be2 |
228 | |
34d52be2 |
229 | =head1 AUTHORS |
230 | |
daec44b8 |
231 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
34d52be2 |
232 | |
233 | =head1 LICENSE |
234 | |
235 | You may distribute this code under the same terms as Perl itself. |
236 | |
237 | =cut |
238 | |