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 | |
28 | This class is responsible for defining and doing basic operations on |
29 | L<DBIx::Class> objects. |
30 | |
31 | =head1 METHODS |
32 | |
33 | =over 4 |
34 | |
39fe0e65 |
35 | =cut |
36 | |
ea2e61bf |
37 | sub _register_columns { |
38 | my ($class, @cols) = @_; |
39 | my $names = { %{$class->_columns} }; |
0a3c5b43 |
40 | while (my $col = shift @cols) { |
41 | $names->{$col} = (ref $cols[0] ? shift : {}); |
42 | } |
ea2e61bf |
43 | $class->_columns($names); |
44 | } |
45 | |
46 | sub _mk_column_accessors { |
47 | my ($class, @cols) = @_; |
510ca912 |
48 | $class->mk_group_accessors('column' => @cols); |
ea2e61bf |
49 | } |
50 | |
39fe0e65 |
51 | =item add_columns |
52 | |
53 | __PACKAGE__->add_columns(qw/col1 col2 col3/); |
54 | |
55 | Adds columns to the current package, and creates accessors for them |
56 | |
57 | =cut |
58 | |
510ca912 |
59 | sub add_columns { |
8fe001e1 |
60 | my ($class, @cols) = @_; |
61 | $class->_register_columns(@cols); |
62 | $class->_mk_column_accessors(@cols); |
63 | } |
64 | |
3c0068c1 |
65 | sub resultset_instance { |
7624b19f |
66 | my $class = shift; |
3c0068c1 |
67 | $class->next::method($class->construct_resultset); |
68 | } |
7624b19f |
69 | |
3c0068c1 |
70 | sub construct_resultset { |
71 | my $class = shift; |
7624b19f |
72 | my $rs_class = $class->_resultset_class; |
73 | eval "use $rs_class;"; |
3c0068c1 |
74 | return $rs_class->new($class); |
a3018bd3 |
75 | } |
76 | |
8fe001e1 |
77 | sub _select_columns { |
78 | return keys %{$_[0]->_columns}; |
79 | } |
80 | |
39fe0e65 |
81 | =item table |
82 | |
83 | __PACKAGE__->table('tbl_name'); |
84 | |
85 | =cut |
86 | |
510ca912 |
87 | sub table { |
88 | shift->_table_name(@_); |
89 | } |
90 | |
39fe0e65 |
91 | =item find_or_create |
92 | |
93 | $class->find_or_create({ key => $val, ... }); |
94 | |
95 | Searches for a record matching the search condition; if it doesn't find one, |
96 | creates one and returns that instead |
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 | |
103647d5 |
107 | =item has_column |
108 | |
109 | if ($obj->has_column($col)) { ... } |
110 | |
111 | Returns 1 if the object has a column of this name, 0 otherwise |
112 | |
113 | =cut |
114 | |
115 | sub has_column { |
116 | my ($self, $column) = @_; |
117 | return exists $self->_columns->{$column}; |
118 | } |
119 | |
120 | =item column_info |
121 | |
122 | my $info = $obj->column_info($col); |
123 | |
124 | Returns the column metadata hashref for the column |
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 | |
134 | =item columns |
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 | |
147 | =back |
148 | |
149 | =head1 AUTHORS |
150 | |
daec44b8 |
151 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
34d52be2 |
152 | |
153 | =head1 LICENSE |
154 | |
155 | You may distribute this code under the same terms as Perl itself. |
156 | |
157 | =cut |
158 | |