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) { |
48 | $self->_columns->{$col} = (ref $cols[0] ? shift : {}); |
49 | } |
50 | } |
51 | |
52 | *add_column = \&add_columns; |
53 | |
54 | =head2 add_columns |
55 | |
56 | $table->add_columns(qw/col1 col2 col3/); |
57 | |
58 | $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...); |
59 | |
60 | Adds columns to the result source. If supplied key => hashref pairs uses |
61 | the hashref as the column_info for that column. |
62 | |
63 | =head2 add_column |
64 | |
65 | $table->add_column('col' => \%info?); |
66 | |
67 | Convenience alias to add_columns |
68 | |
69 | =cut |
70 | |
71 | sub resultset { |
72 | my $self = shift; |
73 | return $self->resultset_class->new($self); |
74 | } |
75 | |
76 | =head2 has_column |
77 | |
78 | if ($obj->has_column($col)) { ... } |
79 | |
80 | Returns 1 if the source has a column of this name, 0 otherwise. |
81 | |
82 | =cut |
83 | |
84 | sub has_column { |
85 | my ($self, $column) = @_; |
86 | return exists $self->_columns->{$column}; |
87 | } |
88 | |
89 | =head2 column_info |
90 | |
91 | my $info = $obj->column_info($col); |
92 | |
93 | Returns the column metadata hashref for a column. |
94 | |
95 | =cut |
96 | |
97 | sub column_info { |
98 | my ($self, $column) = @_; |
99 | croak "No such column $column" unless exists $self->_columns->{$column}; |
100 | return $self->_columns->{$column}; |
101 | } |
102 | |
103 | =head2 columns |
104 | |
105 | my @column_names = $obj->columns; |
106 | |
107 | =cut |
108 | |
109 | sub columns { |
110 | croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1); |
111 | return keys %{shift->_columns}; |
112 | } |
113 | |
571dced3 |
114 | =head2 ordered_columns |
115 | |
116 | my @column_names = $obj->ordered_columns; |
117 | |
118 | Like columns(), but returns column names using the order in which they were |
119 | originally supplied to add_columns(). |
120 | |
121 | =cut |
122 | |
123 | sub ordered_columns { |
124 | return @{shift->{_ordered_columns}||[]}; |
125 | } |
126 | |
9c992ba1 |
127 | =head2 set_primary_key(@cols) |
128 | |
129 | Defines one or more columns as primary key for this source. Should be |
130 | called after C<add_columns>. |
131 | |
132 | =cut |
133 | |
134 | sub set_primary_key { |
135 | my ($self, @cols) = @_; |
136 | # check if primary key columns are valid columns |
137 | for (@cols) { |
138 | $self->throw("No such column $_ on table ".$self->name) |
139 | unless $self->has_column($_); |
140 | } |
141 | $self->_primaries(\@cols); |
142 | } |
143 | |
144 | =head2 primary_columns |
145 | |
146 | Read-only accessor which returns the list of primary keys. |
147 | |
148 | =cut |
149 | |
150 | sub primary_columns { |
151 | return @{shift->_primaries||[]}; |
152 | } |
153 | |
154 | =head2 from |
155 | |
156 | Returns an expression of the source to be supplied to storage to specify |
157 | retrieval from this source; in the case of a database the required FROM clause |
158 | contents. |
159 | |
160 | =cut |
161 | |
162 | =head2 storage |
163 | |
164 | Returns the storage handle for the current schema |
165 | |
166 | =cut |
167 | |
168 | sub storage { shift->schema->storage; } |
169 | |
170 | 1; |
171 | |
172 | =head1 AUTHORS |
173 | |
174 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
175 | |
176 | =head1 LICENSE |
177 | |
178 | You may distribute this code under the same terms as Perl itself. |
179 | |
180 | =cut |
181 | |