Commit | Line | Data |
9c992ba1 |
1 | package DBIx::Class::ResultSource; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use DBIx::Class::ResultSet; |
7 | |
8 | use Carp qw/croak/; |
9 | |
10 | use base qw/DBIx::Class/; |
11 | __PACKAGE__->load_components(qw/AccessorGroup/); |
12 | |
13 | __PACKAGE__->mk_group_accessors('simple' => |
571dced3 |
14 | qw/_ordered_columns _columns _primaries name resultset_class result_class schema from/); |
9c992ba1 |
15 | |
16 | =head1 NAME |
17 | |
18 | DBIx::Class::ResultSource - Result source object |
19 | |
20 | =head1 SYNOPSIS |
21 | |
22 | =head1 DESCRIPTION |
23 | |
24 | A ResultSource is a component of a schema from which results can be directly |
25 | retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>) |
26 | |
27 | =head1 METHODS |
28 | |
29 | =cut |
30 | |
31 | sub new { |
32 | my ($class, $attrs) = @_; |
33 | $class = ref $class if ref $class; |
34 | my $new = bless({ %{$attrs || {}} }, $class); |
35 | $new->{resultset_class} ||= 'DBIx::Class::ResultSet'; |
571dced3 |
36 | $new->{_ordered_columns} ||= []; |
9c992ba1 |
37 | $new->{_columns} ||= {}; |
38 | $new->{name} ||= "!!NAME NOT SET!!"; |
39 | return $new; |
40 | } |
41 | |
42 | sub add_columns { |
43 | my ($self, @cols) = @_; |
571dced3 |
44 | $self->_ordered_columns( \@cols ) |
45 | if !$self->_ordered_columns; |
46 | push @{ $self->_ordered_columns }, @cols; |
9c992ba1 |
47 | while (my $col = shift @cols) { |
53509665 |
48 | |
49 | my $column_info = ref $cols[0] ? shift : {}; |
50 | # If next entry is { ... } use that for the column info, if not |
51 | # use an empty hashref |
52 | |
53 | $self->_columns->{$col} = $column_info; |
9c992ba1 |
54 | } |
55 | } |
56 | |
57 | *add_column = \&add_columns; |
58 | |
59 | =head2 add_columns |
60 | |
61 | $table->add_columns(qw/col1 col2 col3/); |
62 | |
63 | $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...); |
64 | |
65 | Adds columns to the result source. If supplied key => hashref pairs uses |
66 | the hashref as the column_info for that column. |
67 | |
68 | =head2 add_column |
69 | |
70 | $table->add_column('col' => \%info?); |
71 | |
72 | Convenience alias to add_columns |
73 | |
74 | =cut |
75 | |
76 | sub resultset { |
77 | my $self = shift; |
78 | return $self->resultset_class->new($self); |
79 | } |
80 | |
81 | =head2 has_column |
82 | |
83 | if ($obj->has_column($col)) { ... } |
84 | |
85 | Returns 1 if the source has a column of this name, 0 otherwise. |
86 | |
87 | =cut |
88 | |
89 | sub has_column { |
90 | my ($self, $column) = @_; |
91 | return exists $self->_columns->{$column}; |
92 | } |
93 | |
94 | =head2 column_info |
95 | |
96 | my $info = $obj->column_info($col); |
97 | |
98 | Returns the column metadata hashref for a column. |
99 | |
100 | =cut |
101 | |
102 | sub column_info { |
103 | my ($self, $column) = @_; |
104 | croak "No such column $column" unless exists $self->_columns->{$column}; |
105 | return $self->_columns->{$column}; |
106 | } |
107 | |
108 | =head2 columns |
109 | |
110 | my @column_names = $obj->columns; |
111 | |
112 | =cut |
113 | |
114 | sub columns { |
115 | croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1); |
116 | return keys %{shift->_columns}; |
117 | } |
118 | |
571dced3 |
119 | =head2 ordered_columns |
120 | |
121 | my @column_names = $obj->ordered_columns; |
122 | |
123 | Like columns(), but returns column names using the order in which they were |
124 | originally supplied to add_columns(). |
125 | |
126 | =cut |
127 | |
128 | sub ordered_columns { |
129 | return @{shift->{_ordered_columns}||[]}; |
130 | } |
131 | |
9c992ba1 |
132 | =head2 set_primary_key(@cols) |
133 | |
134 | Defines one or more columns as primary key for this source. Should be |
135 | called after C<add_columns>. |
136 | |
137 | =cut |
138 | |
139 | sub set_primary_key { |
140 | my ($self, @cols) = @_; |
141 | # check if primary key columns are valid columns |
142 | for (@cols) { |
143 | $self->throw("No such column $_ on table ".$self->name) |
144 | unless $self->has_column($_); |
145 | } |
146 | $self->_primaries(\@cols); |
147 | } |
148 | |
149 | =head2 primary_columns |
150 | |
151 | Read-only accessor which returns the list of primary keys. |
152 | |
153 | =cut |
154 | |
155 | sub primary_columns { |
156 | return @{shift->_primaries||[]}; |
157 | } |
158 | |
159 | =head2 from |
160 | |
161 | Returns an expression of the source to be supplied to storage to specify |
162 | retrieval from this source; in the case of a database the required FROM clause |
163 | contents. |
164 | |
165 | =cut |
166 | |
167 | =head2 storage |
168 | |
169 | Returns the storage handle for the current schema |
170 | |
171 | =cut |
172 | |
173 | sub storage { shift->schema->storage; } |
174 | |
175 | 1; |
176 | |
177 | =head1 AUTHORS |
178 | |
179 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
180 | |
181 | =head1 LICENSE |
182 | |
183 | You may distribute this code under the same terms as Perl itself. |
184 | |
185 | =cut |
186 | |