Merge 'trunk' into 'DBIx-Class-C3'
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Row.pm
CommitLineData
7624b19f 1package DBIx::Class::Row;
2
3use strict;
4use warnings;
5
1edd1722 6use base qw/DBIx::Class/;
7
7624b19f 8=head1 NAME
9
10DBIx::Class::Row - Basic row methods
11
12=head1 SYNOPSIS
13
14=head1 DESCRIPTION
15
16This class is responsible for defining and doing basic operations on rows
17derived from L<DBIx::Class::Table> objects.
18
19=head1 METHODS
20
21=over 4
22
23=item new
24
25 my $obj = My::Class->new($attrs);
26
27Creates a new row object from column => value mappings passed as a hash ref
28
29=cut
30
31sub new {
32 my ($class, $attrs) = @_;
33 $class = ref $class if ref $class;
34 my $new = bless({ _column_data => { } }, $class);
35 if ($attrs) {
36 $new->throw("attrs must be a hashref" ) unless ref($attrs) eq 'HASH';
37 while (my ($k, $v) = each %{$attrs}) {
103647d5 38 die "No such column $k on $class" unless $class->has_column($k);
484c9dda 39 $new->store_column($k => $v);
7624b19f 40 }
41 }
42 return $new;
43}
44
45=item insert
46
47 $obj->insert;
48
49Inserts an object into the database if it isn't already in there. Returns
50the object itself.
51
52=cut
53
54sub insert {
55 my ($self) = @_;
56 return $self if $self->in_storage;
57 #use Data::Dumper; warn Dumper($self);
58 my %in;
59 $in{$_} = $self->get_column($_)
60 for grep { defined $self->get_column($_) } $self->columns;
61 my %out = %{ $self->storage->insert($self->_table_name, \%in) };
62 $self->store_column($_, $out{$_})
63 for grep { $self->get_column($_) ne $out{$_} } keys %out;
64 $self->in_storage(1);
65 $self->{_dirty_columns} = {};
66 return $self;
67}
68
69=item in_storage
70
71 $obj->in_storage; # Get value
72 $obj->in_storage(1); # Set value
73
74Indicated whether the object exists as a row in the database or not
75
76=cut
77
78sub in_storage {
79 my ($self, $val) = @_;
80 $self->{_in_storage} = $val if @_ > 1;
81 return $self->{_in_storage};
82}
83
84=item create
85
86 my $new = My::Class->create($attrs);
87
88A shortcut for My::Class->new($attrs)->insert;
89
90=cut
91
92sub create {
93 my ($class, $attrs) = @_;
94 $class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
95 return $class->new($attrs)->insert;
96}
97
98=item update
99
100 $obj->update;
101
102Must be run on an object that is already in the database; issues an SQL
103UPDATE query to commit any changes to the object to the db if required.
104
105=cut
106
107sub update {
108 my ($self, $upd) = @_;
109 $self->throw( "Not in database" ) unless $self->in_storage;
99be059e 110 if (ref $upd eq 'HASH') {
111 $self->$_($upd->{$_}) for keys %$upd;
112 }
113 my %to_update;
7624b19f 114 $to_update{$_} = $self->get_column($_) for $self->is_changed;
115 return -1 unless keys %to_update;
116 my $rows = $self->storage->update($self->_table_name, \%to_update,
117 $self->ident_condition);
118 if ($rows == 0) {
119 $self->throw( "Can't update ${self}: row not found" );
120 } elsif ($rows > 1) {
121 $self->throw("Can't update ${self}: updated more than one row");
122 }
123 $self->{_dirty_columns} = {};
124 return $self;
125}
126
7624b19f 127=item delete
128
129 $obj->delete
130
131Deletes the object from the database. The object is still perfectly usable
132accessor-wise etc. but ->in_storage will now return 0 and the object must
133be re ->insert'ed before it can be ->update'ed
134
135=cut
136
137sub delete {
138 my $self = shift;
139 if (ref $self) {
140 $self->throw( "Not in database" ) unless $self->in_storage;
141 #warn $self->_ident_cond.' '.join(', ', $self->_ident_values);
142 $self->storage->delete($self->_table_name, $self->ident_condition);
143 $self->in_storage(undef);
144 #$self->store_column($_ => undef) for $self->primary_columns;
145 # Should probably also arrange to trash PK if auto
146 # but if we do, post-delete cascade triggers fail :/
147 } else {
148 my $attrs = { };
149 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
150 $attrs = { %{ pop(@_) } };
151 }
152 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
153 $self->storage->delete($self->_table_name, $query);
154 }
155 return $self;
156}
157
158=item get_column
159
160 my $val = $obj->get_column($col);
161
162Fetches a column value
163
164=cut
165
166sub get_column {
167 my ($self, $column) = @_;
168 $self->throw( "Can't fetch data as class method" ) unless ref $self;
103647d5 169 $self->throw( "No such column '${column}'" ) unless $self->has_column($column);
7624b19f 170 return $self->{_column_data}{$column}
171 if exists $self->{_column_data}{$column};
172 return undef;
173}
174
076a6864 175=item get_columns
176
177 my %data = $obj->get_columns;
178
179Fetch all column values at once.
180
181=cut
182
183sub get_columns {
184 my $self = shift;
185 return map { $_ => $self->get_column($_) } $self->columns;
186}
187
7624b19f 188=item set_column
189
190 $obj->set_column($col => $val);
191
192Sets a column value; if the new value is different to the old the column
193is marked as dirty for when you next call $obj->update
194
195=cut
196
197sub set_column {
198 my $self = shift;
199 my ($column) = @_;
200 my $old = $self->get_column($column);
201 my $ret = $self->store_column(@_);
202 $self->{_dirty_columns}{$column} = 1 unless defined $old && $old eq $ret;
203 return $ret;
204}
205
076a6864 206=item set_columns
207
dc818523 208 my $copy = $orig->set_columns({ $col => $val, ... });
076a6864 209
210Set more than one column value at once.
211
212=cut
213
214sub set_columns {
215 my ($self,$data) = @_;
216 while (my ($col,$val) = each %$data) {
217 $self->set_column($col,$val);
218 }
219}
220
221=item copy
222
223 my $copy = $orig->copy({ change => $to, ... });
224
225Insert a new row with the specified changes.
226
227=cut
228
7624b19f 229=item store_column
230
231 $obj->store_column($col => $val);
232
233Sets a column value without marking it as dirty
234
235=cut
236
237sub store_column {
238 my ($self, $column, $value) = @_;
239 $self->throw( "No such column '${column}'" )
103647d5 240 unless $self->has_column($column);
7624b19f 241 $self->throw( "set_column called for ${column} without value" )
242 if @_ < 3;
243 return $self->{_column_data}{$column} = $value;
244}
245
1a14aa3f 246sub _row_to_object {
7624b19f 247 my ($class, $cols, $row) = @_;
1a14aa3f 248 my %vals;
249 $vals{$cols->[$_]} = $row->[$_] for 0 .. $#$cols;
484c9dda 250 my $new = bless({ _column_data => \%vals }, ref $class || $class);
7624b19f 251 $new->in_storage(1);
252 return $new;
253}
254
7624b19f 255sub copy {
256 my ($self, $changes) = @_;
257 my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
258 $new->set_column($_ => $changes->{$_}) for keys %$changes;
259 return $new->insert;
260}
261
262=item insert_or_update
263
264 $obj->insert_or_update
265
266Updates the object if it's already in the db, else inserts it
267
268=cut
269
270sub insert_or_update {
271 my $self = shift;
272 return ($self->in_storage ? $self->update : $self->insert);
273}
274
275=item is_changed
276
277 my @changed_col_names = $obj->is_changed
278
279=cut
280
281sub is_changed {
282 return keys %{shift->{_dirty_columns} || {}};
283}
284
2851;
286
287=back
288
289=head1 AUTHORS
290
daec44b8 291Matt S. Trout <mst@shadowcatsystems.co.uk>
7624b19f 292
293=head1 LICENSE
294
295You may distribute this code under the same terms as Perl itself.
296
297=cut
298