Filename	/usr/share/perl5/DBIx/Class/Row.pm
Statements	Executed 7385 statements in 21.7ms

Subroutines

Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1602	1	1	16.5ms	628ms	DBIx::Class::Row::::register_columnDBIx::Class::Row::register_column
1	1	1	9.57ms	9.72ms	DBIx::Class::Row::::BEGIN@12DBIx::Class::Row::BEGIN@12
87	1	1	742µs	884µs	DBIx::Class::Row::::inflate_resultDBIx::Class::Row::inflate_result
1	1	1	25µs	36µs	DBIx::Class::Row::::BEGIN@9DBIx::Class::Row::BEGIN@9
1	1	1	17µs	38µs	DBIx::Class::Row::::BEGIN@401DBIx::Class::Row::BEGIN@401
1	1	1	14µs	18µs	DBIx::Class::Row::::BEGIN@4DBIx::Class::Row::BEGIN@4
1	1	1	14µs	20µs	DBIx::Class::Row::::BEGIN@3DBIx::Class::Row::BEGIN@3
1	1	1	10µs	30µs	DBIx::Class::Row::::BEGIN@10DBIx::Class::Row::BEGIN@10
1	1	1	9µs	32µs	DBIx::Class::Row::::BEGIN@8DBIx::Class::Row::BEGIN@8
1	1	1	9µs	49µs	DBIx::Class::Row::::BEGIN@6DBIx::Class::Row::BEGIN@6
1	1	1	9µs	188µs	DBIx::Class::Row::::BEGIN@25DBIx::Class::Row::BEGIN@25
1	1	1	8µs	53µs	DBIx::Class::Row::::BEGIN@11DBIx::Class::Row::BEGIN@11
1	1	1	5µs	5µs	DBIx::Class::Row::::BEGIN@18DBIx::Class::Row::BEGIN@18
0	0	0	0s	0s	DBIx::Class::Row::::__ANON__[:1029]DBIx::Class::Row::__ANON__[:1029]
0	0	0	0s	0s	DBIx::Class::Row::::__ANON__[:1568]DBIx::Class::Row::__ANON__[:1568]
0	0	0	0s	0s	DBIx::Class::Row::::__ANON__[:624]DBIx::Class::Row::__ANON__[:624]
0	0	0	0s	0s	DBIx::Class::Row::::__ANON__[:903]DBIx::Class::Row::__ANON__[:903]
0	0	0	0s	0s	DBIx::Class::Row::::__new_related_find_or_new_helperDBIx::Class::Row::__new_related_find_or_new_helper
0	0	0	0s	0s	DBIx::Class::Row::::__their_pk_needs_usDBIx::Class::Row::__their_pk_needs_us
0	0	0	0s	0s	DBIx::Class::Row::::_eq_column_valuesDBIx::Class::Row::_eq_column_values
0	0	0	0s	0s	DBIx::Class::Row::::_is_column_numericDBIx::Class::Row::_is_column_numeric
0	0	0	0s	0s	DBIx::Class::Row::::_track_storage_valueDBIx::Class::Row::_track_storage_value
0	0	0	0s	0s	DBIx::Class::Row::::copyDBIx::Class::Row::copy
0	0	0	0s	0s	DBIx::Class::Row::::deleteDBIx::Class::Row::delete
0	0	0	0s	0s	DBIx::Class::Row::::discard_changesDBIx::Class::Row::discard_changes
0	0	0	0s	0s	DBIx::Class::Row::::get_columnDBIx::Class::Row::get_column
0	0	0	0s	0s	DBIx::Class::Row::::get_columnsDBIx::Class::Row::get_columns
0	0	0	0s	0s	DBIx::Class::Row::::get_dirty_columnsDBIx::Class::Row::get_dirty_columns
0	0	0	0s	0s	DBIx::Class::Row::::get_from_storageDBIx::Class::Row::get_from_storage
0	0	0	0s	0s	DBIx::Class::Row::::get_inflated_columnsDBIx::Class::Row::get_inflated_columns
0	0	0	0s	0s	DBIx::Class::Row::::has_column_loadedDBIx::Class::Row::has_column_loaded
0	0	0	0s	0s	DBIx::Class::Row::::insertDBIx::Class::Row::insert
0	0	0	0s	0s	DBIx::Class::Row::::insert_or_updateDBIx::Class::Row::insert_or_update
0	0	0	0s	0s	DBIx::Class::Row::::is_changedDBIx::Class::Row::is_changed
0	0	0	0s	0s	DBIx::Class::Row::::is_column_changedDBIx::Class::Row::is_column_changed
0	0	0	0s	0s	DBIx::Class::Row::::make_column_dirtyDBIx::Class::Row::make_column_dirty
0	0	0	0s	0s	DBIx::Class::Row::::newDBIx::Class::Row::new
0	0	0	0s	0s	DBIx::Class::Row::::result_sourceDBIx::Class::Row::result_source
0	0	0	0s	0s	DBIx::Class::Row::::set_columnDBIx::Class::Row::set_column
0	0	0	0s	0s	DBIx::Class::Row::::set_columnsDBIx::Class::Row::set_columns
0	0	0	0s	0s	DBIx::Class::Row::::set_inflated_columnsDBIx::Class::Row::set_inflated_columns
0	0	0	0s	0s	DBIx::Class::Row::::store_columnDBIx::Class::Row::store_column
0	0	0	0s	0s	DBIx::Class::Row::::throw_exceptionDBIx::Class::Row::throw_exception
0	0	0	0s	0s	DBIx::Class::Row::::updateDBIx::Class::Row::update
0	0	0	0s	0s	DBIx::Class::Row::::update_or_insertDBIx::Class::Row::update_or_insert

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package DBIx::Class::Row;
2
3	2	39µs	2	27µs	# spent 20µs (14+7) within DBIx::Class::Row::BEGIN@3 which was called: # once (14µs+7µs) by base::import at line 3 use strict; # spent 20µs making 1 call to DBIx::Class::Row::BEGIN@3 # spent 7µs making 1 call to strict::import
4	2	40µs	2	22µs	# spent 18µs (14+4) within DBIx::Class::Row::BEGIN@4 which was called: # once (14µs+4µs) by base::import at line 4 use warnings; # spent 18µs making 1 call to DBIx::Class::Row::BEGIN@4 # spent 4µs making 1 call to warnings::import
5
6	2	76µs	2	49µs	# spent 49µs (9+40) within DBIx::Class::Row::BEGIN@6 which was called: # once (9µs+40µs) by base::import at line 6 use base qw/DBIx::Class/; # spent 49µs making 1 call to DBIx::Class::Row::BEGIN@6 # spent 40µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 40µs
7
8	2	51µs	2	54µs	# spent 32µs (9+22) within DBIx::Class::Row::BEGIN@8 which was called: # once (9µs+22µs) by base::import at line 8 use Scalar::Util 'blessed'; # spent 32µs making 1 call to DBIx::Class::Row::BEGIN@8 # spent 22µs making 1 call to Exporter::import
9	2	56µs	2	47µs	# spent 36µs (25+11) within DBIx::Class::Row::BEGIN@9 which was called: # once (25µs+11µs) by base::import at line 9 use List::Util 'first'; # spent 36µs making 1 call to DBIx::Class::Row::BEGIN@9 # spent 11µs making 1 call to List::Util::import
10	2	47µs	2	49µs	# spent 30µs (10+20) within DBIx::Class::Row::BEGIN@10 which was called: # once (10µs+20µs) by base::import at line 10 use Try::Tiny; # spent 30µs making 1 call to DBIx::Class::Row::BEGIN@10 # spent 20µs making 1 call to Exporter::import
11	2	15µs	2	97µs	# spent 53µs (8+44) within DBIx::Class::Row::BEGIN@11 which was called: # once (8µs+44µs) by base::import at line 11 use DBIx::Class::Carp; # spent 53µs making 1 call to DBIx::Class::Row::BEGIN@11 # spent 44µs making 1 call to DBIx::Class::Carp::import
12	2	165µs	2	9.77ms	# spent 9.72ms (9.57+153µs) within DBIx::Class::Row::BEGIN@12 which was called: # once (9.57ms+153µs) by base::import at line 12 use SQL::Abstract 'is_literal_value'; # spent 9.72ms making 1 call to DBIx::Class::Row::BEGIN@12 # spent 46µs making 1 call to Exporter::import
13
14					###
15					### Internal method
16					### Do not use
17					###
18					# spent 5µs within DBIx::Class::Row::BEGIN@18 which was called: # once (5µs+0s) by base::import at line 23 BEGIN {
19					*MULTICREATE_DEBUG =
20					$ENV{DBIC_MULTICREATE_DEBUG}
21					? sub () { 1 }
22	1	6µs			: sub () { 0 };
23	1	21µs	1	5µs	} # spent 5µs making 1 call to DBIx::Class::Row::BEGIN@18
24
25	2	1.36ms	2	368µs	# spent 188µs (9+180) within DBIx::Class::Row::BEGIN@25 which was called: # once (9µs+180µs) by base::import at line 25 use namespace::clean; # spent 188µs making 1 call to DBIx::Class::Row::BEGIN@25 # spent 180µs making 1 call to namespace::clean::import
26
27	1	16µs	1	112µs	__PACKAGE__->mk_group_accessors ( simple => [ in_storage => '_in_storage' ] ); # spent 112µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
28
29					=head1 NAME
30
31					DBIx::Class::Row - Basic row methods
32
33					=head1 SYNOPSIS
34
35					=head1 DESCRIPTION
36
37					This class is responsible for defining and doing basic operations on rows
38					derived from L<DBIx::Class::ResultSource> objects.
39
40					Result objects are returned from L<DBIx::Class::ResultSet>s using the
41					L<create|DBIx::Class::ResultSet/create>, L<find|DBIx::Class::ResultSet/find>,
42					L<next|DBIx::Class::ResultSet/next> and L<all|DBIx::Class::ResultSet/all> methods,
43					as well as invocations of 'single' (
44					L<belongs_to|DBIx::Class::Relationship/belongs_to>,
45					L<has_one|DBIx::Class::Relationship/has_one> or
46					L<might_have|DBIx::Class::Relationship/might_have>)
47					relationship accessors of L<Result|DBIx::Class::Manual::ResultClass> objects.
48
49					=head1 NOTE
50
51					All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
52					object (such as a typical C<< L<search|DBIx::Class::ResultSet/search>->
53					L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
54					instances, based on your application's
55					L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
56
57					L<DBIx::Class::Row> implements most of the row-based communication with the
58					underlying storage, but a Result class B<should not inherit from it directly>.
59					Usually, Result classes inherit from L<DBIx::Class::Core>, which in turn
60					combines the methods from several classes, one of them being
61					L<DBIx::Class::Row>. Therefore, while many of the methods available to a
62					L<DBIx::Class::Core>-derived Result class are described in the following
63					documentation, it does not detail all of the methods available to Result
64					objects. Refer to L<DBIx::Class::Manual::ResultClass> for more info.
65
66					=head1 METHODS
67
68					=head2 new
69
70					my $result = My::Class->new(\%attrs);
71
72					my $result = $schema->resultset('MySource')->new(\%colsandvalues);
73
74					=over
75
76					=item Arguments: \%attrs or \%colsandvalues
77
78					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
79
80					=back
81
82					While you can create a new result object by calling C<new> directly on
83					this class, you are better off calling it on a
84					L<DBIx::Class::ResultSet> object.
85
86					When calling it directly, you will not get a complete, usable row
87					object until you pass or set the C<result_source> attribute, to a
88					L<DBIx::Class::ResultSource> instance that is attached to a
89					L<DBIx::Class::Schema> with a valid connection.
90
91					C<$attrs> is a hashref of column name, value data. It can also contain
92					some other attributes such as the C<result_source>.
93
94					Passing an object, or an arrayref of objects as a value will call
95					L<DBIx::Class::Relationship::Base/set_from_related> for you. When
96					passed a hashref or an arrayref of hashrefs as the value, these will
97					be turned into objects via new_related, and treated as if you had
98					passed objects.
99
100					For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
101
102					Please note that if a value is not passed to new, no value will be sent
103					in the SQL INSERT call, and the column will therefore assume whatever
104					default value was specified in your database. While DBIC will retrieve the
105					value of autoincrement columns, it will never make an explicit database
106					trip to retrieve default values assigned by the RDBMS. You can explicitly
107					request that all values be fetched back from the database by calling
108					L</discard_changes>, or you can supply an explicit C<undef> to columns
109					with NULL as the default, and save yourself a SELECT.
110
111					CAVEAT:
112
113					The behavior described above will backfire if you use a foreign key column
114					with a database-defined default. If you call the relationship accessor on
115					an object that doesn't have a set value for the FK column, DBIC will throw
116					an exception, as it has no way of knowing the PK of the related object (if
117					there is one).
118
119					=cut
120
121					## It needs to store the new objects somewhere, and call insert on that list later when insert is called on this object. We may need an accessor for these so the user can retrieve them, if just doing ->new().
122					## This only works because DBIC doesn't yet care to check whether the new_related objects have been passed all their mandatory columns
123					## When doing the later insert, we need to make sure the PKs are set.
124					## using _relationship_data in new and funky ways..
125					## check Relationship::CascadeActions and Relationship::Accessor for compat
126					## tests!
127
128					sub __new_related_find_or_new_helper {
129					my ($self, $rel_name, $values) = @_;
130
131					my $rsrc = $self->result_source;
132
133					# create a mock-object so all new/set_column component overrides will run:
134					my $rel_rs = $rsrc->related_source($rel_name)->resultset;
135					my $new_rel_obj = $rel_rs->new_result($values);
136					my $proc_data = { $new_rel_obj->get_columns };
137
138					if ($self->__their_pk_needs_us($rel_name)) {
139					MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via new_result\n";
140					return $new_rel_obj;
141					}
142					elsif ($rsrc->_pk_depends_on($rel_name, $proc_data )) {
143					if (! keys %$proc_data) {
144					# there is nothing to search for - blind create
145					MULTICREATE_DEBUG and print STDERR "MC $self constructing default-insert $rel_name\n";
146					}
147					else {
148					MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via find_or_new\n";
149					# this is not *really* find or new, as we don't want to double-new the
150					# data (thus potentially double encoding or whatever)
151					my $exists = $rel_rs->find ($proc_data);
152					return $exists if $exists;
153					}
154					return $new_rel_obj;
155					}
156					else {
157					my $us = $rsrc->source_name;
158					$self->throw_exception (
159					"Unable to determine relationship '$rel_name' direction from '$us', "
160					. "possibly due to a missing reverse-relationship on '$rel_name' to '$us'."
161					);
162					}
163					}
164
165					sub __their_pk_needs_us { # this should maybe be in resultsource.
166					my ($self, $rel_name) = @_;
167					my $rsrc = $self->result_source;
168					my $reverse = $rsrc->reverse_relationship_info($rel_name);
169					my $rel_source = $rsrc->related_source($rel_name);
170					my $us = { $self->get_columns };
171					foreach my $key (keys %$reverse) {
172					# if their primary key depends on us, then we have to
173					# just create a result and we'll fill it out afterwards
174					return 1 if $rel_source->_pk_depends_on($key, $us);
175					}
176					return 0;
177					}
178
179					sub new {
180					my ($class, $attrs) = @_;
181					$class = ref $class if ref $class;
182
183					my $new = bless { _column_data => {}, _in_storage => 0 }, $class;
184
185					if ($attrs) {
186					$new->throw_exception("attrs must be a hashref")
187					unless ref($attrs) eq 'HASH';
188
189					my $rsrc = delete $attrs->{-result_source};
190					if ( my $h = delete $attrs->{-source_handle} ) {
191					$rsrc ||= $h->resolve;
192					}
193
194					$new->result_source($rsrc) if $rsrc;
195
196					if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
197					@{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
198					}
199
200					my ($related,$inflated);
201
202					foreach my $key (keys %$attrs) {
203					if (ref $attrs->{$key} and ! is_literal_value($attrs->{$key}) ) {
204					## Can we extract this lot to use with update(_or .. ) ?
205					$new->throw_exception("Can't do multi-create without result source")
206					unless $rsrc;
207					my $info = $rsrc->relationship_info($key);
208					my $acc_type = $info->{attrs}{accessor} || '';
209					if ($acc_type eq 'single') {
210					my $rel_obj = delete $attrs->{$key};
211					if(!blessed $rel_obj) {
212					$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
213					}
214
215					if ($rel_obj->in_storage) {
216					$new->{_rel_in_storage}{$key} = 1;
217					$new->set_from_related($key, $rel_obj);
218					} else {
219					MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
220					}
221
222					$related->{$key} = $rel_obj;
223					next;
224					}
225					elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
226					my $others = delete $attrs->{$key};
227					my $total = @$others;
228					my @objects;
229					foreach my $idx (0 .. $#$others) {
230					my $rel_obj = $others->[$idx];
231					if(!blessed $rel_obj) {
232					$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
233					}
234
235					if ($rel_obj->in_storage) {
236					$rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
237					} else {
238					MULTICREATE_DEBUG and
239					print STDERR "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
240					}
241					push(@objects, $rel_obj);
242					}
243					$related->{$key} = \@objects;
244					next;
245					}
246					elsif ($acc_type eq 'filter') {
247					## 'filter' should disappear and get merged in with 'single' above!
248					my $rel_obj = delete $attrs->{$key};
249					if(!blessed $rel_obj) {
250					$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
251					}
252					if ($rel_obj->in_storage) {
253					$new->{_rel_in_storage}{$key} = 1;
254					}
255					else {
256					MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
257					}
258					$inflated->{$key} = $rel_obj;
259					next;
260					}
261					elsif (
262					$rsrc->has_column($key)
263					and
264					$rsrc->column_info($key)->{_inflate_info}
265					) {
266					$inflated->{$key} = $attrs->{$key};
267					next;
268					}
269					}
270					$new->store_column($key => $attrs->{$key});
271					}
272
273					$new->{_relationship_data} = $related if $related;
274					$new->{_inflated_column} = $inflated if $inflated;
275					}
276
277					return $new;
278					}
279
280					=head2 $column_accessor
281
282					# Each pair does the same thing
283
284					# (un-inflated, regular column)
285					my $val = $result->get_column('first_name');
286					my $val = $result->first_name;
287
288					$result->set_column('first_name' => $val);
289					$result->first_name($val);
290
291					# (inflated column via DBIx::Class::InflateColumn::DateTime)
292					my $val = $result->get_inflated_column('last_modified');
293					my $val = $result->last_modified;
294
295					$result->set_inflated_column('last_modified' => $val);
296					$result->last_modified($val);
297
298					=over
299
300					=item Arguments: $value?
301
302					=item Return Value: $value
303
304					=back
305
306					A column accessor method is created for each column, which is used for
307					getting/setting the value for that column.
308
309					The actual method name is based on the
310					L<accessor|DBIx::Class::ResultSource/accessor> name given during the
311					L<Result Class|DBIx::Class::Manual::ResultClass> L<column definition
312					|DBIx::Class::ResultSource/add_columns>. Like L</set_column>, this
313					will not store the data in the database until L</insert> or L</update>
314					is called on the row.
315
316					=head2 insert
317
318					$result->insert;
319
320					=over
321
322					=item Arguments: none
323
324					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
325
326					=back
327
328					Inserts an object previously created by L</new> into the database if
329					it isn't already in there. Returns the object itself. To insert an
330					entirely new row into the database, use L<DBIx::Class::ResultSet/create>.
331
332					To fetch an uninserted result object, call
333					L<new_result|DBIx::Class::ResultSet/new_result> on a resultset.
334
335					This will also insert any uninserted, related objects held inside this
336					one, see L<DBIx::Class::ResultSet/create> for more details.
337
338					=cut
339
340					sub insert {
341					my ($self) = @_;
342					return $self if $self->in_storage;
343					my $rsrc = $self->result_source;
344					$self->throw_exception("No result_source set on this object; can't insert")
345					unless $rsrc;
346
347					my $storage = $rsrc->storage;
348
349					my $rollback_guard;
350
351					# Check if we stored uninserted relobjs here in new()
352					my %related_stuff = (%{$self->{_relationship_data} || {}},
353					%{$self->{_inflated_column} || {}});
354
355					# insert what needs to be inserted before us
356					my %pre_insert;
357					for my $rel_name (keys %related_stuff) {
358					my $rel_obj = $related_stuff{$rel_name};
359
360					if (! $self->{_rel_in_storage}{$rel_name}) {
361					next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
362
363					next unless $rsrc->_pk_depends_on(
364					$rel_name, { $rel_obj->get_columns }
365					);
366
367					# The guard will save us if we blow out of this scope via die
368					$rollback_guard ||= $storage->txn_scope_guard;
369
370					MULTICREATE_DEBUG and print STDERR "MC $self pre-reconstructing $rel_name $rel_obj\n";
371
372					my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns };
373					my $existing;
374
375					# if there are no keys - nothing to search for
376					if (keys %$them and $existing = $self->result_source
377					->related_source($rel_name)
378					->resultset
379					->find($them)
380					) {
381					%{$rel_obj} = %{$existing};
382					}
383					else {
384					$rel_obj->insert;
385					}
386
387					$self->{_rel_in_storage}{$rel_name} = 1;
388					}
389
390					$self->set_from_related($rel_name, $rel_obj);
391					delete $related_stuff{$rel_name};
392					}
393
394					# start a transaction here if not started yet and there is more stuff
395					# to insert after us
396					if (keys %related_stuff) {
397					$rollback_guard ||= $storage->txn_scope_guard
398					}
399
400					MULTICREATE_DEBUG and do {
401	2	3.62ms	2	60µs	# spent 38µs (17+21) within DBIx::Class::Row::BEGIN@401 which was called: # once (17µs+21µs) by base::import at line 401 no warnings 'uninitialized'; # spent 38µs making 1 call to DBIx::Class::Row::BEGIN@401 # spent 21µs making 1 call to warnings::unimport
402					print STDERR "MC $self inserting (".join(', ', $self->get_columns).")\n";
403					};
404
405					# perform the insert - the storage will return everything it is asked to
406					# (autoinc primary columns and any retrieve_on_insert columns)
407					my %current_rowdata = $self->get_columns;
408					my $returned_cols = $storage->insert(
409					$rsrc,
410					{ %current_rowdata }, # what to insert, copy because the storage *will* change it
411					);
412
413					for (keys %$returned_cols) {
414					$self->store_column($_, $returned_cols->{$_})
415					# this ensures we fire store_column only once
416					# (some asshats like overriding it)
417					if (
418					(!exists $current_rowdata{$_})
419					or
420					(defined $current_rowdata{$_} xor defined $returned_cols->{$_})
421					or
422					(defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_})
423					);
424					}
425
426					delete $self->{_column_data_in_storage};
427					$self->in_storage(1);
428
429					$self->{_dirty_columns} = {};
430					$self->{related_resultsets} = {};
431
432					foreach my $rel_name (keys %related_stuff) {
433					next unless $rsrc->has_relationship ($rel_name);
434
435					my @cands = ref $related_stuff{$rel_name} eq 'ARRAY'
436					? @{$related_stuff{$rel_name}}
437					: $related_stuff{$rel_name}
438					;
439
440					if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
441					) {
442					my $reverse = $rsrc->reverse_relationship_info($rel_name);
443					foreach my $obj (@cands) {
444					$obj->set_from_related($_, $self) for keys %$reverse;
445					if ($self->__their_pk_needs_us($rel_name)) {
446					if (exists $self->{_ignore_at_insert}{$rel_name}) {
447					MULTICREATE_DEBUG and print STDERR "MC $self skipping post-insert on $rel_name\n";
448					}
449					else {
450					MULTICREATE_DEBUG and print STDERR "MC $self inserting $rel_name $obj\n";
451					$obj->insert;
452					}
453					} else {
454					MULTICREATE_DEBUG and print STDERR "MC $self post-inserting $obj\n";
455					$obj->insert();
456					}
457					}
458					}
459					}
460
461					delete $self->{_ignore_at_insert};
462
463					$rollback_guard->commit if $rollback_guard;
464
465					return $self;
466					}
467
468					=head2 in_storage
469
470					$result->in_storage; # Get value
471					$result->in_storage(1); # Set value
472
473					=over
474
475					=item Arguments: none or 1|0
476
477					=item Return Value: 1|0
478
479					=back
480
481					Indicates whether the object exists as a row in the database or
482					not. This is set to true when L<DBIx::Class::ResultSet/find>,
483					L<DBIx::Class::ResultSet/create> or L<DBIx::Class::Row/insert>
484					are invoked.
485
486					Creating a result object using L<DBIx::Class::ResultSet/new_result>, or
487					calling L</delete> on one, sets it to false.
488
489
490					=head2 update
491
492					$result->update(\%columns?)
493
494					=over
495
496					=item Arguments: none or a hashref
497
498					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
499
500					=back
501
502					Throws an exception if the result object is not yet in the database,
503					according to L</in_storage>. Returns the object itself.
504
505					This method issues an SQL UPDATE query to commit any changes to the
506					object to the database if required (see L</get_dirty_columns>).
507					It throws an exception if a proper WHERE clause uniquely identifying
508					the database row can not be constructed (see
509					L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
510					for more details).
511
512					Also takes an optional hashref of C<< column_name => value >> pairs
513					to update on the object first. Be aware that the hashref will be
514					passed to C<set_inflated_columns>, which might edit it in place, so
515					don't rely on it being the same after a call to C<update>. If you
516					need to preserve the hashref, it is sufficient to pass a shallow copy
517					to C<update>, e.g. ( { %{ $href } } )
518
519					If the values passed or any of the column values set on the object
520					contain scalar references, e.g.:
521
522					$result->last_modified(\'NOW()')->update();
523					# OR
524					$result->update({ last_modified => \'NOW()' });
525
526					The update will pass the values verbatim into SQL. (See
527					L<SQL::Abstract> docs). The values in your Result object will NOT change
528					as a result of the update call, if you want the object to be updated
529					with the actual values from the database, call L</discard_changes>
530					after the update.
531
532					$result->update()->discard_changes();
533
534					To determine before calling this method, which column values have
535					changed and will be updated, call L</get_dirty_columns>.
536
537					To check if any columns will be updated, call L</is_changed>.
538
539					To force a column to be updated, call L</make_column_dirty> before
540					this method.
541
542					=cut
543
544					sub update {
545					my ($self, $upd) = @_;
546
547					$self->set_inflated_columns($upd) if $upd;
548
549					my %to_update = $self->get_dirty_columns
550					or return $self;
551
552					$self->throw_exception( "Not in database" ) unless $self->in_storage;
553
554					my $rows = $self->result_source->storage->update(
555					$self->result_source, \%to_update, $self->_storage_ident_condition
556					);
557					if ($rows == 0) {
558					$self->throw_exception( "Can't update ${self}: row not found" );
559					} elsif ($rows > 1) {
560					$self->throw_exception("Can't update ${self}: updated more than one row");
561					}
562					$self->{_dirty_columns} = {};
563					$self->{related_resultsets} = {};
564					delete $self->{_column_data_in_storage};
565					return $self;
566					}
567
568					=head2 delete
569
570					$result->delete
571
572					=over
573
574					=item Arguments: none
575
576					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
577
578					=back
579
580					Throws an exception if the object is not in the database according to
581					L</in_storage>. Also throws an exception if a proper WHERE clause
582					uniquely identifying the database row can not be constructed (see
583					L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
584					for more details).
585
586					The object is still perfectly usable, but L</in_storage> will
587					now return 0 and the object must be reinserted using L</insert>
588					before it can be used to L</update> the row again.
589
590					If you delete an object in a class with a C<has_many> relationship, an
591					attempt is made to delete all the related objects as well. To turn
592					this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
593					hashref of the relationship, see L<DBIx::Class::Relationship>. Any
594					database-level cascade or restrict will take precedence over a
595					DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
596					main row first> and only then attempts to delete any remaining related
597					rows.
598
599					If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
600					and the transaction subsequently fails, the result object will remain marked as
601					not being in storage. If you know for a fact that the object is still in
602					storage (i.e. by inspecting the cause of the transaction's failure), you can
603					use C<< $obj->in_storage(1) >> to restore consistency between the object and
604					the database. This would allow a subsequent C<< $obj->delete >> to work
605					as expected.
606
607					See also L<DBIx::Class::ResultSet/delete>.
608
609					=cut
610
611					sub delete {
612					my $self = shift;
613					if (ref $self) {
614					$self->throw_exception( "Not in database" ) unless $self->in_storage;
615
616					$self->result_source->storage->delete(
617					$self->result_source, $self->_storage_ident_condition
618					);
619
620					delete $self->{_column_data_in_storage};
621					$self->in_storage(0);
622					}
623					else {
624					my $rsrc = try { $self->result_source_instance }
625					or $self->throw_exception("Can't do class delete without a ResultSource instance");
626
627					my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
628					my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
629					$rsrc->resultset->search(@_)->delete;
630					}
631					return $self;
632					}
633
634					=head2 get_column
635
636					my $val = $result->get_column($col);
637
638					=over
639
640					=item Arguments: $columnname
641
642					=item Return Value: The value of the column
643
644					=back
645
646					Throws an exception if the column name given doesn't exist according
647					to L<has_column|DBIx::Class::ResultSource/has_column>.
648
649					Returns a raw column value from the result object, if it has already
650					been fetched from the database or set by an accessor.
651
652					If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
653					will be deflated and returned.
654
655					Note that if you used the C<columns> or the C<select/as>
656					L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
657					which C<$result> was derived, and B<did not include> C<$columnname> in the list,
658					this method will return C<undef> even if the database contains some value.
659
660					To retrieve all loaded column values as a hash, use L</get_columns>.
661
662					=cut
663
664					sub get_column {
665	87	47µs			my ($self, $column) = @_;
666	87	44µs			$self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
667
668	87	135µs			return $self->{_column_data}{$column}
669					if exists $self->{_column_data}{$column};
670
671					if (exists $self->{_inflated_column}{$column}) {
672					# deflate+return cycle
673					return $self->store_column($column, $self->_deflated_column(
674					$column, $self->{_inflated_column}{$column}
675					));
676					}
677
678					$self->throw_exception( "No such column '${column}' on " . ref $self )
679					unless $self->result_source->has_column($column);
680
681					return undef;
682					}
683
684					=head2 has_column_loaded
685
686					if ( $result->has_column_loaded($col) ) {
687					print "$col has been loaded from db";
688					}
689
690					=over
691
692					=item Arguments: $columnname
693
694					=item Return Value: 0|1
695
696					=back
697
698					Returns a true value if the column value has been loaded from the
699					database (or set locally).
700
701					=cut
702
703					sub has_column_loaded {
704					my ($self, $column) = @_;
705					$self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
706
707					return (
708					exists $self->{_inflated_column}{$column}
709					or
710					exists $self->{_column_data}{$column}
711					) ? 1 : 0;
712					}
713
714					=head2 get_columns
715
716					my %data = $result->get_columns;
717
718					=over
719
720					=item Arguments: none
721
722					=item Return Value: A hash of columnname, value pairs.
723
724					=back
725
726					Returns all loaded column data as a hash, containing raw values. To
727					get just one value for a particular column, use L</get_column>.
728
729					See L</get_inflated_columns> to get the inflated values.
730
731					=cut
732
733					sub get_columns {
734					my $self = shift;
735					if (exists $self->{_inflated_column}) {
736					# deflate cycle for each inflation, including filter rels
737					foreach my $col (keys %{$self->{_inflated_column}}) {
738					unless (exists $self->{_column_data}{$col}) {
739
740					# if cached related_resultset is present assume this was a prefetch
741					carp_unique(
742					"Returning primary keys of prefetched 'filter' rels as part of get_columns() is deprecated and will "
743					. 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
744					) if (
745					! $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}
746					and
747					defined $self->{related_resultsets}{$col}
748					and
749					defined $self->{related_resultsets}{$col}->get_cache
750					);
751
752					$self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
753					}
754					}
755					}
756					return %{$self->{_column_data}};
757					}
758
759					=head2 get_dirty_columns
760
761					my %data = $result->get_dirty_columns;
762
763					=over
764
765					=item Arguments: none
766
767					=item Return Value: A hash of column, value pairs
768
769					=back
770
771					Only returns the column, value pairs for those columns that have been
772					changed on this object since the last L</update> or L</insert> call.
773
774					See L</get_columns> to fetch all column/value pairs.
775
776					=cut
777
778					sub get_dirty_columns {
779					my $self = shift;
780					return map { $_ => $self->{_column_data}{$_} }
781					keys %{$self->{_dirty_columns}};
782					}
783
784					=head2 make_column_dirty
785
786					$result->make_column_dirty($col)
787
788					=over
789
790					=item Arguments: $columnname
791
792					=item Return Value: not defined
793
794					=back
795
796					Throws an exception if the column does not exist.
797
798					Marks a column as having been changed regardless of whether it has
799					really changed.
800
801					=cut
802
803					sub make_column_dirty {
804					my ($self, $column) = @_;
805
806					$self->throw_exception( "No such column '${column}' on " . ref $self )
807					unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
808
809					# the entire clean/dirty code relies on exists, not on true/false
810					return 1 if exists $self->{_dirty_columns}{$column};
811
812					$self->{_dirty_columns}{$column} = 1;
813
814					# if we are just now making the column dirty, and if there is an inflated
815					# value, force it over the deflated one
816					if (exists $self->{_inflated_column}{$column}) {
817					$self->store_column($column,
818					$self->_deflated_column(
819					$column, $self->{_inflated_column}{$column}
820					)
821					);
822					}
823					}
824
825					=head2 get_inflated_columns
826
827					my %inflated_data = $obj->get_inflated_columns;
828
829					=over
830
831					=item Arguments: none
832
833					=item Return Value: A hash of column, object|value pairs
834
835					=back
836
837					Returns a hash of all column keys and associated values. Values for any
838					columns set to use inflation will be inflated and returns as objects.
839
840					See L</get_columns> to get the uninflated values.
841
842					See L<DBIx::Class::InflateColumn> for how to setup inflation.
843
844					=cut
845
846					sub get_inflated_columns {
847					my $self = shift;
848
849					my $loaded_colinfo = $self->result_source->columns_info;
850					$self->has_column_loaded($_) or delete $loaded_colinfo->{$_}
851					for keys %$loaded_colinfo;
852
853					my %cols_to_return = ( %{$self->{_column_data}}, %$loaded_colinfo );
854
855					unless ($ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}) {
856					for (keys %$loaded_colinfo) {
857					# if cached related_resultset is present assume this was a prefetch
858					if (
859					$loaded_colinfo->{$_}{_inflate_info}
860					and
861					defined $self->{related_resultsets}{$_}
862					and
863					defined $self->{related_resultsets}{$_}->get_cache
864					) {
865					carp_unique(
866					"Returning prefetched 'filter' rels as part of get_inflated_columns() is deprecated and will "
867					. 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
868					);
869					last;
870					}
871					}
872					}
873
874					map { $_ => (
875					(
876					! exists $loaded_colinfo->{$_}
877					or
878					(
879					exists $loaded_colinfo->{$_}{accessor}
880					and
881					! defined $loaded_colinfo->{$_}{accessor}
882					)
883					) ? $self->get_column($_)
884					: $self->${ \(
885					defined $loaded_colinfo->{$_}{accessor}
886					? $loaded_colinfo->{$_}{accessor}
887					: $_
888					)}
889					)} keys %cols_to_return;
890					}
891
892					sub _is_column_numeric {
893					my ($self, $column) = @_;
894
895					return undef unless $self->result_source->has_column($column);
896
897					my $colinfo = $self->result_source->column_info ($column);
898
899					# cache for speed (the object may *not* have a resultsource instance)
900					if (
901					! defined $colinfo->{is_numeric}
902					and
903					my $storage = try { $self->result_source->schema->storage }
904					) {
905					$colinfo->{is_numeric} =
906					$storage->is_datatype_numeric ($colinfo->{data_type})
907					? 1
908					: 0
909					;
910					}
911
912					return $colinfo->{is_numeric};
913					}
914
915					=head2 set_column
916
917					$result->set_column($col => $val);
918
919					=over
920
921					=item Arguments: $columnname, $value
922
923					=item Return Value: $value
924
925					=back
926
927					Sets a raw column value. If the new value is different from the old one,
928					the column is marked as dirty for when you next call L</update>.
929
930					If passed an object or reference as a value, this method will happily
931					attempt to store it, and a later L</insert> or L</update> will try and
932					stringify/numify as appropriate. To set an object to be deflated
933					instead, see L</set_inflated_columns>, or better yet, use L</$column_accessor>.
934
935					=cut
936
937					sub set_column {
938					my ($self, $column, $new_value) = @_;
939
940					my $had_value = $self->has_column_loaded($column);
941					my $old_value = $self->get_column($column);
942
943					$new_value = $self->store_column($column, $new_value);
944
945					my $dirty =
946					$self->{_dirty_columns}{$column}
947					||
948					( $self->in_storage # no point tracking dirtyness on uninserted data
949					? ! $self->_eq_column_values ($column, $old_value, $new_value)
950					: 1
951					)
952					;
953
954					if ($dirty) {
955					# FIXME sadly the update code just checks for keys, not for their value
956					$self->{_dirty_columns}{$column} = 1;
957
958					# Clear out the relation/inflation cache related to this column
959					#
960					# FIXME - this is a quick *largely incorrect* hack, pending a more
961					# serious rework during the merge of single and filter rels
962					my $rel_names = $self->result_source->{_relationships};
963					for my $rel_name (keys %$rel_names) {
964
965					my $acc = $rel_names->{$rel_name}{attrs}{accessor} || '';
966
967					if ( $acc eq 'single' and $rel_names->{$rel_name}{attrs}{fk_columns}{$column} ) {
968					delete $self->{related_resultsets}{$rel_name};
969					delete $self->{_relationship_data}{$rel_name};
970					#delete $self->{_inflated_column}{$rel_name};
971					}
972					elsif ( $acc eq 'filter' and $rel_name eq $column) {
973					delete $self->{related_resultsets}{$rel_name};
974					#delete $self->{_relationship_data}{$rel_name};
975					delete $self->{_inflated_column}{$rel_name};
976					}
977					}
978
979					if (
980					# value change from something (even if NULL)
981					$had_value
982					and
983					$self->in_storage
984
985					and
986					! exists $self->{_column_data_in_storage}{$column}
987
988					and
989					$self->_track_storage_value($column)
990					) {
991					$self->{_column_data_in_storage}{$column} = $old_value;
992					}
993					}
994
995					return $new_value;
996					}
997
998					sub _eq_column_values {
999					my ($self, $col, $old, $new) = @_;
1000
1001					if (defined $old xor defined $new) {
1002					return 0;
1003					}
1004					elsif (not defined $old) { # both undef
1005					return 1;
1006					}
1007					elsif (
1008					is_literal_value $old
1009					or
1010					is_literal_value $new
1011					) {
1012					return 0;
1013					}
1014					elsif ($old eq $new) {
1015					return 1;
1016					}
1017					elsif ($self->_is_column_numeric($col)) { # do a numeric comparison if datatype allows it
1018					return $old == $new;
1019					}
1020					else {
1021					return 0;
1022					}
1023					}
1024
1025					# returns a boolean indicating if the passed column should have its original
1026					# value tracked between column changes and commitment to storage
1027					sub _track_storage_value {
1028					my ($self, $col) = @_;
1029					return defined first { $col eq $_ } ($self->result_source->primary_columns);
1030					}
1031
1032					=head2 set_columns
1033
1034					$result->set_columns({ $col => $val, ... });
1035
1036					=over
1037
1038					=item Arguments: \%columndata
1039
1040					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1041
1042					=back
1043
1044					Sets multiple column, raw value pairs at once.
1045
1046					Works as L</set_column>.
1047
1048					=cut
1049
1050					sub set_columns {
1051					my ($self, $values) = @_;
1052					$self->set_column( $_, $values->{$_} ) for keys %$values;
1053					return $self;
1054					}
1055
1056					=head2 set_inflated_columns
1057
1058					$result->set_inflated_columns({ $col => $val, $rel_name => $obj, ... });
1059
1060					=over
1061
1062					=item Arguments: \%columndata
1063
1064					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1065
1066					=back
1067
1068					Sets more than one column value at once. Any inflated values are
1069					deflated and the raw values stored.
1070
1071					Any related values passed as Result objects, using the relation name as a
1072					key, are reduced to the appropriate foreign key values and stored. If
1073					instead of related result objects, a hashref of column, value data is
1074					passed, will create the related object first then store.
1075
1076					Will even accept arrayrefs of data as a value to a
1077					L<DBIx::Class::Relationship/has_many> key, and create the related
1078					objects if necessary.
1079
1080					Be aware that the input hashref might be edited in place, so don't rely
1081					on it being the same after a call to C<set_inflated_columns>. If you
1082					need to preserve the hashref, it is sufficient to pass a shallow copy
1083					to C<set_inflated_columns>, e.g. ( { %{ $href } } )
1084
1085					See also L<DBIx::Class::Relationship::Base/set_from_related>.
1086
1087					=cut
1088
1089					sub set_inflated_columns {
1090					my ( $self, $upd ) = @_;
1091					my $rsrc;
1092					foreach my $key (keys %$upd) {
1093					if (ref $upd->{$key}) {
1094					$rsrc ||= $self->result_source;
1095					my $info = $rsrc->relationship_info($key);
1096					my $acc_type = $info->{attrs}{accessor} || '';
1097
1098					if ($acc_type eq 'single') {
1099					my $rel_obj = delete $upd->{$key};
1100					$self->set_from_related($key => $rel_obj);
1101					$self->{_relationship_data}{$key} = $rel_obj;
1102					}
1103					elsif ($acc_type eq 'multi') {
1104					$self->throw_exception(
1105					"Recursive update is not supported over relationships of type '$acc_type' ($key)"
1106					);
1107					}
1108					elsif (
1109					$rsrc->has_column($key)
1110					and
1111					exists $rsrc->column_info($key)->{_inflate_info}
1112					) {
1113					$self->set_inflated_column($key, delete $upd->{$key});
1114					}
1115					}
1116					}
1117					$self->set_columns($upd);
1118					}
1119
1120					=head2 copy
1121
1122					my $copy = $orig->copy({ change => $to, ... });
1123
1124					=over
1125
1126					=item Arguments: \%replacementdata
1127
1128					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> copy
1129
1130					=back
1131
1132					Inserts a new row into the database, as a copy of the original
1133					object. If a hashref of replacement data is supplied, these will take
1134					precedence over data in the original. Also any columns which have
1135					the L<column info attribute|DBIx::Class::ResultSource/add_columns>
1136					C<< is_auto_increment => 1 >> are explicitly removed before the copy,
1137					so that the database can insert its own autoincremented values into
1138					the new object.
1139
1140					Relationships will be followed by the copy procedure B<only> if the
1141					relationship specifies a true value for its
1142					L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
1143					is set by default on C<has_many> relationships and unset on all others.
1144
1145					=cut
1146
1147					sub copy {
1148					my ($self, $changes) = @_;
1149					$changes ||= {};
1150					my $col_data = { $self->get_columns };
1151
1152					my $rsrc = $self->result_source;
1153
1154					my $colinfo = $rsrc->columns_info;
1155					foreach my $col (keys %$col_data) {
1156					delete $col_data->{$col}
1157					if ( ! $colinfo->{$col} or $colinfo->{$col}{is_auto_increment} );
1158					}
1159
1160					my $new = { _column_data => $col_data };
1161					bless $new, ref $self;
1162
1163					$new->result_source($rsrc);
1164					$new->set_inflated_columns($changes);
1165					$new->insert;
1166
1167					# Its possible we'll have 2 relations to the same Source. We need to make
1168					# sure we don't try to insert the same row twice else we'll violate unique
1169					# constraints
1170					my $rel_names_copied = {};
1171
1172					foreach my $rel_name ($rsrc->relationships) {
1173					my $rel_info = $rsrc->relationship_info($rel_name);
1174
1175					next unless $rel_info->{attrs}{cascade_copy};
1176
1177					my $resolved = $rsrc->_resolve_condition(
1178					$rel_info->{cond}, $rel_name, $new, $rel_name
1179					);
1180
1181					my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
1182					foreach my $related ($self->search_related($rel_name)->all) {
1183					$related->copy($resolved)
1184					unless $copied->{$related->ID}++;
1185					}
1186
1187					}
1188					return $new;
1189					}
1190
1191					=head2 store_column
1192
1193					$result->store_column($col => $val);
1194
1195					=over
1196
1197					=item Arguments: $columnname, $value
1198
1199					=item Return Value: The value sent to storage
1200
1201					=back
1202
1203					Set a raw value for a column without marking it as changed. This
1204					method is used internally by L</set_column> which you should probably
1205					be using.
1206
1207					This is the lowest level at which data is set on a result object,
1208					extend this method to catch all data setting methods.
1209
1210					=cut
1211
1212					sub store_column {
1213					my ($self, $column, $value) = @_;
1214					$self->throw_exception( "No such column '${column}' on " . ref $self )
1215					unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
1216					$self->throw_exception( "set_column called for ${column} without value" )
1217					if @_ < 3;
1218					return $self->{_column_data}{$column} = $value;
1219					}
1220
1221					=head2 inflate_result
1222
1223					Class->inflate_result($result_source, \%me, \%prefetch?)
1224
1225					=over
1226
1227					=item Arguments: L<$result_source|DBIx::Class::ResultSource>, \%columndata, \%prefetcheddata
1228
1229					=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1230
1231					=back
1232
1233					All L<DBIx::Class::ResultSet> methods that retrieve data from the
1234					database and turn it into result objects call this method.
1235
1236					Extend this method in your Result classes to hook into this process,
1237					for example to rebless the result into a different class.
1238
1239					Reblessing can also be done more easily by setting C<result_class> in
1240					your Result class. See L<DBIx::Class::ResultSource/result_class>.
1241
1242					Different types of results can also be created from a particular
1243					L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1244
1245					=cut
1246
1247					# spent 884µs (742+142) within DBIx::Class::Row::inflate_result which was called 87 times, avg 10µs/call: # 87 times (742µs+142µs) by DBIx::Class::ResultSet::_construct_results at line 1409 of DBIx/Class/ResultSet.pm, avg 10µs/call sub inflate_result {
1248	87	54µs			my ($class, $rsrc, $me, $prefetch) = @_;
1249
1250	87	267µs			my $new = bless
1251					{ _column_data => $me, _result_source => $rsrc },
1252					ref $class || $class
1253					;
1254
1255	87	25µs			if ($prefetch) {
1256					for my $rel_name ( keys %$prefetch ) {
1257
1258					my $relinfo = $rsrc->relationship_info($rel_name) or do {
1259					my $err = sprintf
1260					"Inflation into non-existent relationship '%s' of '%s' requested",
1261					$rel_name,
1262					$rsrc->source_name,
1263					;
1264					if (my ($colname) = sort { length($a) <=> length ($b) } keys %{$prefetch->{$rel_name}[0] || {}} ) {
1265					$err .= sprintf ", check the inflation specification (columns/as) ending in '...%s.%s'",
1266					$rel_name,
1267					$colname,
1268					}
1269
1270					$rsrc->throw_exception($err);
1271					};
1272
1273					$class->throw_exception("No accessor type declared for prefetched relationship '$rel_name'")
1274					unless $relinfo->{attrs}{accessor};
1275
1276					my $rel_rs = $new->related_resultset($rel_name);
1277
1278					my @rel_objects;
1279					if (
1280					@{ $prefetch->{$rel_name} || [] }
1281					and
1282					ref($prefetch->{$rel_name}) ne $DBIx::Class::ResultSource::RowParser::Util::null_branch_class
1283					) {
1284
1285					if (ref $prefetch->{$rel_name}[0] eq 'ARRAY') {
1286					my $rel_rsrc = $rel_rs->result_source;
1287					my $rel_class = $rel_rs->result_class;
1288					my $rel_inflator = $rel_class->can('inflate_result');
1289					@rel_objects = map
1290					{ $rel_class->$rel_inflator ( $rel_rsrc, @$_ ) }
1291					@{$prefetch->{$rel_name}}
1292					;
1293					}
1294					else {
1295					@rel_objects = $rel_rs->result_class->inflate_result(
1296					$rel_rs->result_source, @{$prefetch->{$rel_name}}
1297					);
1298					}
1299					}
1300
1301					if ($relinfo->{attrs}{accessor} eq 'single') {
1302					$new->{_relationship_data}{$rel_name} = $rel_objects[0];
1303					}
1304					elsif ($relinfo->{attrs}{accessor} eq 'filter') {
1305					$new->{_inflated_column}{$rel_name} = $rel_objects[0];
1306					}
1307
1308					$rel_rs->set_cache(\@rel_objects);
1309					}
1310					}
1311
1312	87	162µs	2	142µs	$new->in_storage (1); # spent 140µs making 1 call to DBIx::Class::Row::in_storage # spent 1µs making 1 call to Koha::Schema::Result::Systempreference::in_storage
1313	87	223µs			return $new;
1314					}
1315
1316					=head2 update_or_insert
1317
1318					$result->update_or_insert
1319
1320					=over
1321
1322					=item Arguments: none
1323
1324					=item Return Value: Result of update or insert operation
1325
1326					=back
1327
1328					L</update>s the object if it's already in the database, according to
1329					L</in_storage>, else L</insert>s it.
1330
1331					=head2 insert_or_update
1332
1333					$obj->insert_or_update
1334
1335					Alias for L</update_or_insert>
1336
1337					=cut
1338
1339					sub insert_or_update { shift->update_or_insert(@_) }
1340
1341					sub update_or_insert {
1342					my $self = shift;
1343					return ($self->in_storage ? $self->update : $self->insert);
1344					}
1345
1346					=head2 is_changed
1347
1348					my @changed_col_names = $result->is_changed();
1349					if ($result->is_changed()) { ... }
1350
1351					=over
1352
1353					=item Arguments: none
1354
1355					=item Return Value: 0|1 or @columnnames
1356
1357					=back
1358
1359					In list context returns a list of columns with uncommited changes, or
1360					in scalar context returns a true value if there are uncommitted
1361					changes.
1362
1363					=cut
1364
1365					sub is_changed {
1366					return keys %{shift->{_dirty_columns} || {}};
1367					}
1368
1369					=head2 is_column_changed
1370
1371					if ($result->is_column_changed('col')) { ... }
1372
1373					=over
1374
1375					=item Arguments: $columname
1376
1377					=item Return Value: 0|1
1378
1379					=back
1380
1381					Returns a true value if the column has uncommitted changes.
1382
1383					=cut
1384
1385					sub is_column_changed {
1386					my( $self, $col ) = @_;
1387					return exists $self->{_dirty_columns}->{$col};
1388					}
1389
1390					=head2 result_source
1391
1392					my $resultsource = $result->result_source;
1393
1394					=over
1395
1396					=item Arguments: L<$result_source?|DBIx::Class::ResultSource>
1397
1398					=item Return Value: L<$result_source|DBIx::Class::ResultSource>
1399
1400					=back
1401
1402					Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1403
1404					=cut
1405
1406					sub result_source {
1407	87	48µs			$_[0]->throw_exception( 'result_source can be called on instances only' )
1408					unless ref $_[0];
1409
1410					@_ > 1
1411					? $_[0]->{_result_source} = $_[1]
1412
1413					# note this is a || not a ||=, the difference is important
1414	87	120µs			: $_[0]->{_result_source} || do {
1415					my $class = ref $_[0];
1416					$_[0]->can('result_source_instance')
1417					? $_[0]->result_source_instance
1418					: $_[0]->throw_exception(
1419					"No result source instance registered for $class, did you forget to call $class->table(...) ?"
1420					)
1421					}
1422					;
1423					}
1424
1425					=head2 register_column
1426
1427					$column_info = { .... };
1428					$class->register_column($column_name, $column_info);
1429
1430					=over
1431
1432					=item Arguments: $columnname, \%columninfo
1433
1434					=item Return Value: not defined
1435
1436					=back
1437
1438					Registers a column on the class. If the column_info has an 'accessor'
1439					key, creates an accessor named after the value if defined; if there is
1440					no such key, creates an accessor with the same name as the column
1441
1442					The column_info attributes are described in
1443					L<DBIx::Class::ResultSource/add_columns>
1444
1445					=cut
1446
1447					# spent 628ms (16.5+612) within DBIx::Class::Row::register_column which was called 1602 times, avg 392µs/call: # 1602 times (16.5ms+612ms) by DBIx::Class::ResultSourceProxy::add_columns at line 35 of DBIx/Class/ResultSourceProxy.pm, avg 392µs/call sub register_column {
1448	1602	642µs			my ($class, $col, $info) = @_;
1449	1602	296µs			my $acc = $col;
1450	1602	597µs			if (exists $info->{accessor}) {
1451	45	19µs			return unless defined $info->{accessor};
1452	42	42µs			$acc = [ $info->{accessor}, $col ];
1453					}
1454	1599	13.4ms	1599	612ms	$class->mk_group_accessors('column' => $acc); # spent 612ms making 1599 calls to Class::Accessor::Grouped::mk_group_accessors, avg 383µs/call
1455					}
1456
1457					=head2 get_from_storage
1458
1459					my $copy = $result->get_from_storage($attrs)
1460
1461					=over
1462
1463					=item Arguments: \%attrs
1464
1465					=item Return Value: A Result object
1466
1467					=back
1468
1469					Fetches a fresh copy of the Result object from the database and returns it.
1470					Throws an exception if a proper WHERE clause identifying the database row
1471					can not be constructed (i.e. if the original object does not contain its
1472					entire
1473					L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
1474					). If passed the \%attrs argument, will first apply these attributes to
1475					the resultset used to find the row.
1476
1477					This copy can then be used to compare to an existing result object, to
1478					determine if any changes have been made in the database since it was
1479					created.
1480
1481					To just update your Result object with any latest changes from the
1482					database, use L</discard_changes> instead.
1483
1484					The \%attrs argument should be compatible with
1485					L<DBIx::Class::ResultSet/ATTRIBUTES>.
1486
1487					=cut
1488
1489					sub get_from_storage {
1490					my $self = shift @_;
1491					my $attrs = shift @_;
1492					my $resultset = $self->result_source->resultset;
1493
1494					if(defined $attrs) {
1495					$resultset = $resultset->search(undef, $attrs);
1496					}
1497
1498					return $resultset->find($self->_storage_ident_condition);
1499					}
1500
1501					=head2 discard_changes
1502
1503					$result->discard_changes
1504
1505					=over
1506
1507					=item Arguments: none or $attrs
1508
1509					=item Return Value: self (updates object in-place)
1510
1511					=back
1512
1513					Re-selects the row from the database, losing any changes that had
1514					been made. Throws an exception if a proper C<WHERE> clause identifying
1515					the database row can not be constructed (i.e. if the original object
1516					does not contain its entire
1517					L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>).
1518
1519					This method can also be used to refresh from storage, retrieving any
1520					changes made since the row was last read from storage.
1521
1522					$attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the
1523					second argument to C<< $resultset->search($cond, $attrs) >>;
1524
1525					Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1526					storage, a default of
1527					L<< C<< { force_pool => 'master' } >>
1528					|DBIx::Class::Storage::DBI::Replicated/SYNOPSIS >> is automatically set for
1529					you. Prior to C<< DBIx::Class 0.08109 >> (before 2010) one would have been
1530					required to explicitly wrap the entire operation in a transaction to guarantee
1531					that up-to-date results are read from the master database.
1532
1533					=cut
1534
1535					sub discard_changes {
1536					my ($self, $attrs) = @_;
1537					return unless $self->in_storage; # Don't reload if we aren't real!
1538
1539					# add a replication default to read from the master only
1540					$attrs = { force_pool => 'master', %{$attrs||{}} };
1541
1542					if( my $current_storage = $self->get_from_storage($attrs)) {
1543
1544					# Set $self to the current.
1545					%$self = %$current_storage;
1546
1547					# Avoid a possible infinite loop with
1548					# sub DESTROY { $_[0]->discard_changes }
1549					bless $current_storage, 'Do::Not::Exist';
1550
1551					return $self;
1552					}
1553					else {
1554					$self->in_storage(0);
1555					return $self;
1556					}
1557					}
1558
1559					=head2 throw_exception
1560
1561					See L<DBIx::Class::Schema/throw_exception>.
1562
1563					=cut
1564
1565					sub throw_exception {
1566					my $self=shift;
1567
1568					if (ref $self && ref (my $rsrc = try { $self->result_source_instance } ) ) {
1569					$rsrc->throw_exception(@_)
1570					}
1571					else {
1572					DBIx::Class::Exception->throw(@_);
1573					}
1574					}
1575
1576					=head2 id
1577
1578					my @pk = $result->id;
1579
1580					=over
1581
1582					=item Arguments: none
1583
1584					=item Returns: A list of primary key values
1585
1586					=back
1587
1588					Returns the primary key(s) for a row. Can't be called as a class method.
1589					Actually implemented in L<DBIx::Class::PK>
1590
1591					=head1 FURTHER QUESTIONS?
1592
1593					Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1594
1595					=head1 COPYRIGHT AND LICENSE
1596
1597					This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1598					by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1599					redistribute it and/or modify it under the same terms as the
1600					L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1601
1602					=cut
1603
1604	1	4µs	1	268µs	1; # spent 268µs making 1 call to B::Hooks::EndOfScope::XS::__ANON__