Merge 'trunk' into 'DBIx-Class-C3'
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Row.pm
1 package DBIx::Class::Row;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class/;
7
8 =head1 NAME 
9
10 DBIx::Class::Row - Basic row methods
11
12 =head1 SYNOPSIS
13
14 =head1 DESCRIPTION
15
16 This class is responsible for defining and doing basic operations on rows
17 derived 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
27 Creates a new row object from column => value mappings passed as a hash ref
28
29 =cut
30
31 sub 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}) {
38       die "No such column $k on $class" unless $class->has_column($k);
39       $new->store_column($k => $v);
40     }
41   }
42   return $new;
43 }
44
45 =item insert
46
47   $obj->insert;
48
49 Inserts an object into the database if it isn't already in there. Returns
50 the object itself.
51
52 =cut
53
54 sub 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
74 Indicated whether the object exists as a row in the database or not
75
76 =cut
77
78 sub 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
88 A shortcut for My::Class->new($attrs)->insert;
89
90 =cut
91
92 sub 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
102 Must be run on an object that is already in the database; issues an SQL
103 UPDATE query to commit any changes to the object to the db if required.
104
105 =cut
106
107 sub update {
108   my ($self, $upd) = @_;
109   $self->throw( "Not in database" ) unless $self->in_storage;
110   if (ref $upd eq 'HASH') {
111     $self->$_($upd->{$_}) for keys %$upd;
112   }
113   my %to_update;
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
127 =item delete
128
129   $obj->delete
130
131 Deletes the object from the database. The object is still perfectly usable
132 accessor-wise etc. but ->in_storage will now return 0 and the object must
133 be re ->insert'ed before it can be ->update'ed
134
135 =cut
136
137 sub 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
162 Fetches a column value
163
164 =cut
165
166 sub get_column {
167   my ($self, $column) = @_;
168   $self->throw( "Can't fetch data as class method" ) unless ref $self;
169   $self->throw( "No such column '${column}'" ) unless $self->has_column($column);
170   return $self->{_column_data}{$column}
171     if exists $self->{_column_data}{$column};
172   return undef;
173 }
174
175 =item get_columns
176
177   my %data = $obj->get_columns;
178
179 Fetch all column values at once.
180
181 =cut
182
183 sub get_columns {
184   my $self = shift;
185   return map { $_ => $self->get_column($_) } $self->columns;
186 }
187
188 =item set_column
189
190   $obj->set_column($col => $val);
191
192 Sets a column value; if the new value is different to the old the column
193 is marked as dirty for when you next call $obj->update
194
195 =cut
196
197 sub 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
206 =item set_columns
207
208   my $copy = $orig->set_columns({ $col => $val, ... });
209
210 Set more than one column value at once.
211
212 =cut
213
214 sub 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
225 Insert a new row with the specified changes.
226
227 =cut
228
229 =item store_column
230
231   $obj->store_column($col => $val);
232
233 Sets a column value without marking it as dirty
234
235 =cut
236
237 sub store_column {
238   my ($self, $column, $value) = @_;
239   $self->throw( "No such column '${column}'" ) 
240     unless $self->has_column($column);
241   $self->throw( "set_column called for ${column} without value" ) 
242     if @_ < 3;
243   return $self->{_column_data}{$column} = $value;
244 }
245
246 sub _row_to_object {
247   my ($class, $cols, $row) = @_;
248   my %vals;
249   $vals{$cols->[$_]} = $row->[$_] for 0 .. $#$cols;
250   my $new = bless({ _column_data => \%vals }, ref $class || $class);
251   $new->in_storage(1);
252   return $new;
253 }
254
255 sub 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
266 Updates the object if it's already in the db, else inserts it
267
268 =cut
269
270 sub 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
281 sub is_changed {
282   return keys %{shift->{_dirty_columns} || {}};
283 }
284
285 1;
286
287 =back
288
289 =head1 AUTHORS
290
291 Matt S. Trout <mst@shadowcatsystems.co.uk>
292
293 =head1 LICENSE
294
295 You may distribute this code under the same terms as Perl itself.
296
297 =cut
298