← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 13:01:18 2016
Reported on Fri Jan 8 13:01:35 2016

Filename/usr/share/perl5/DBIx/Class/Row.pm
StatementsExecuted 6545 statements in 20.8ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
16021112.1ms580msDBIx::Class::Row::::register_columnDBIx::Class::Row::register_column
1119.00ms9.21msDBIx::Class::Row::::BEGIN@12DBIx::Class::Row::BEGIN@12
31143µs163µsDBIx::Class::Row::::inflate_resultDBIx::Class::Row::inflate_result
11127µs38µsDBIx::Class::Row::::BEGIN@9DBIx::Class::Row::BEGIN@9
11114µs21µsDBIx::Class::Row::::BEGIN@3DBIx::Class::Row::BEGIN@3
11113µs32µsDBIx::Class::Row::::BEGIN@401DBIx::Class::Row::BEGIN@401
11112µs17µsDBIx::Class::Row::::BEGIN@4DBIx::Class::Row::BEGIN@4
11111µs44µsDBIx::Class::Row::::BEGIN@8DBIx::Class::Row::BEGIN@8
11111µs65µsDBIx::Class::Row::::BEGIN@11DBIx::Class::Row::BEGIN@11
11110µs32µsDBIx::Class::Row::::BEGIN@10DBIx::Class::Row::BEGIN@10
11110µs195µsDBIx::Class::Row::::BEGIN@25DBIx::Class::Row::BEGIN@25
1119µs60µsDBIx::Class::Row::::BEGIN@6DBIx::Class::Row::BEGIN@6
1117µs7µsDBIx::Class::Row::::BEGIN@18DBIx::Class::Row::BEGIN@18
0000s0sDBIx::Class::Row::::__ANON__[:1029]DBIx::Class::Row::__ANON__[:1029]
0000s0sDBIx::Class::Row::::__ANON__[:1568]DBIx::Class::Row::__ANON__[:1568]
0000s0sDBIx::Class::Row::::__ANON__[:624]DBIx::Class::Row::__ANON__[:624]
0000s0sDBIx::Class::Row::::__ANON__[:903]DBIx::Class::Row::__ANON__[:903]
0000s0sDBIx::Class::Row::::__new_related_find_or_new_helperDBIx::Class::Row::__new_related_find_or_new_helper
0000s0sDBIx::Class::Row::::__their_pk_needs_usDBIx::Class::Row::__their_pk_needs_us
0000s0sDBIx::Class::Row::::_eq_column_valuesDBIx::Class::Row::_eq_column_values
0000s0sDBIx::Class::Row::::_is_column_numericDBIx::Class::Row::_is_column_numeric
0000s0sDBIx::Class::Row::::_track_storage_valueDBIx::Class::Row::_track_storage_value
0000s0sDBIx::Class::Row::::copyDBIx::Class::Row::copy
0000s0sDBIx::Class::Row::::deleteDBIx::Class::Row::delete
0000s0sDBIx::Class::Row::::discard_changesDBIx::Class::Row::discard_changes
0000s0sDBIx::Class::Row::::get_columnDBIx::Class::Row::get_column
0000s0sDBIx::Class::Row::::get_columnsDBIx::Class::Row::get_columns
0000s0sDBIx::Class::Row::::get_dirty_columnsDBIx::Class::Row::get_dirty_columns
0000s0sDBIx::Class::Row::::get_from_storageDBIx::Class::Row::get_from_storage
0000s0sDBIx::Class::Row::::get_inflated_columnsDBIx::Class::Row::get_inflated_columns
0000s0sDBIx::Class::Row::::has_column_loadedDBIx::Class::Row::has_column_loaded
0000s0sDBIx::Class::Row::::insertDBIx::Class::Row::insert
0000s0sDBIx::Class::Row::::insert_or_updateDBIx::Class::Row::insert_or_update
0000s0sDBIx::Class::Row::::is_changedDBIx::Class::Row::is_changed
0000s0sDBIx::Class::Row::::is_column_changedDBIx::Class::Row::is_column_changed
0000s0sDBIx::Class::Row::::make_column_dirtyDBIx::Class::Row::make_column_dirty
0000s0sDBIx::Class::Row::::newDBIx::Class::Row::new
0000s0sDBIx::Class::Row::::result_sourceDBIx::Class::Row::result_source
0000s0sDBIx::Class::Row::::set_columnDBIx::Class::Row::set_column
0000s0sDBIx::Class::Row::::set_columnsDBIx::Class::Row::set_columns
0000s0sDBIx::Class::Row::::set_inflated_columnsDBIx::Class::Row::set_inflated_columns
0000s0sDBIx::Class::Row::::store_columnDBIx::Class::Row::store_column
0000s0sDBIx::Class::Row::::throw_exceptionDBIx::Class::Row::throw_exception
0000s0sDBIx::Class::Row::::updateDBIx::Class::Row::update
0000s0sDBIx::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
1package DBIx::Class::Row;
2
3236µs228µs
# spent 21µ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 21µs making 1 call to DBIx::Class::Row::BEGIN@3 # spent 7µs making 1 call to strict::import
4240µs222µs
# spent 17µs (12+5) within DBIx::Class::Row::BEGIN@4 which was called: # once (12µs+5µs) by base::import at line 4
use warnings;
# spent 17µs making 1 call to DBIx::Class::Row::BEGIN@4 # spent 5µs making 1 call to warnings::import
5
6289µs260µs
# spent 60µs (9+51) within DBIx::Class::Row::BEGIN@6 which was called: # once (9µs+51µs) by base::import at line 6
use base qw/DBIx::Class/;
# spent 60µs making 1 call to DBIx::Class::Row::BEGIN@6 # spent 51µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 51µs
7
8264µs277µs
# spent 44µs (11+33) within DBIx::Class::Row::BEGIN@8 which was called: # once (11µs+33µs) by base::import at line 8
use Scalar::Util 'blessed';
# spent 44µs making 1 call to DBIx::Class::Row::BEGIN@8 # spent 33µs making 1 call to Exporter::import
9260µs250µs
# spent 38µs (27+11) within DBIx::Class::Row::BEGIN@9 which was called: # once (27µs+11µs) by base::import at line 9
use List::Util 'first';
# spent 38µs making 1 call to DBIx::Class::Row::BEGIN@9 # spent 12µs making 1 call to List::Util::import
10249µs254µs
# spent 32µs (10+22) within DBIx::Class::Row::BEGIN@10 which was called: # once (10µs+22µs) by base::import at line 10
use Try::Tiny;
# spent 32µs making 1 call to DBIx::Class::Row::BEGIN@10 # spent 22µs making 1 call to Exporter::import
11228µs2119µs
# spent 65µs (11+54) within DBIx::Class::Row::BEGIN@11 which was called: # once (11µs+54µs) by base::import at line 11
use DBIx::Class::Carp;
# spent 65µs making 1 call to DBIx::Class::Row::BEGIN@11 # spent 54µs making 1 call to DBIx::Class::Carp::import
122291µs29.26ms
# spent 9.21ms (9.00+212µs) within DBIx::Class::Row::BEGIN@12 which was called: # once (9.00ms+212µs) by base::import at line 12
use SQL::Abstract 'is_literal_value';
# spent 9.21ms making 1 call to DBIx::Class::Row::BEGIN@12 # spent 47µs making 1 call to Exporter::import
13
14###
15### Internal method
16### Do not use
17###
18
# spent 7µs within DBIx::Class::Row::BEGIN@18 which was called: # once (7µs+0s) by base::import at line 23
BEGIN {
19 *MULTICREATE_DEBUG =
20 $ENV{DBIC_MULTICREATE_DEBUG}
21 ? sub () { 1 }
2217µs : sub () { 0 };
23122µs17µs}
# spent 7µs making 1 call to DBIx::Class::Row::BEGIN@18
24
2521.34ms2381µs
# spent 195µs (10+186) within DBIx::Class::Row::BEGIN@25 which was called: # once (10µs+186µs) by base::import at line 25
use namespace::clean;
# spent 195µs making 1 call to DBIx::Class::Row::BEGIN@25 # spent 186µs making 1 call to namespace::clean::import
26
27116µs1107µs__PACKAGE__->mk_group_accessors ( simple => [ in_storage => '_in_storage' ] );
# spent 107µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
28
29=head1 NAME
30
31DBIx::Class::Row - Basic row methods
32
33=head1 SYNOPSIS
34
35=head1 DESCRIPTION
36
37This class is responsible for defining and doing basic operations on rows
38derived from L<DBIx::Class::ResultSource> objects.
39
40Result objects are returned from L<DBIx::Class::ResultSet>s using the
41L<create|DBIx::Class::ResultSet/create>, L<find|DBIx::Class::ResultSet/find>,
42L<next|DBIx::Class::ResultSet/next> and L<all|DBIx::Class::ResultSet/all> methods,
43as well as invocations of 'single' (
44L<belongs_to|DBIx::Class::Relationship/belongs_to>,
45L<has_one|DBIx::Class::Relationship/has_one> or
46L<might_have|DBIx::Class::Relationship/might_have>)
47relationship accessors of L<Result|DBIx::Class::Manual::ResultClass> objects.
48
49=head1 NOTE
50
51All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
52object (such as a typical C<< L<search|DBIx::Class::ResultSet/search>->
53L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
54instances, based on your application's
55L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
56
57L<DBIx::Class::Row> implements most of the row-based communication with the
58underlying storage, but a Result class B<should not inherit from it directly>.
59Usually, Result classes inherit from L<DBIx::Class::Core>, which in turn
60combines the methods from several classes, one of them being
61L<DBIx::Class::Row>. Therefore, while many of the methods available to a
62L<DBIx::Class::Core>-derived Result class are described in the following
63documentation, it does not detail all of the methods available to Result
64objects. 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
82While you can create a new result object by calling C<new> directly on
83this class, you are better off calling it on a
84L<DBIx::Class::ResultSet> object.
85
86When calling it directly, you will not get a complete, usable row
87object until you pass or set the C<result_source> attribute, to a
88L<DBIx::Class::ResultSource> instance that is attached to a
89L<DBIx::Class::Schema> with a valid connection.
90
91C<$attrs> is a hashref of column name, value data. It can also contain
92some other attributes such as the C<result_source>.
93
94Passing an object, or an arrayref of objects as a value will call
95L<DBIx::Class::Relationship::Base/set_from_related> for you. When
96passed a hashref or an arrayref of hashrefs as the value, these will
97be turned into objects via new_related, and treated as if you had
98passed objects.
99
100For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
101
102Please note that if a value is not passed to new, no value will be sent
103in the SQL INSERT call, and the column will therefore assume whatever
104default value was specified in your database. While DBIC will retrieve the
105value of autoincrement columns, it will never make an explicit database
106trip to retrieve default values assigned by the RDBMS. You can explicitly
107request that all values be fetched back from the database by calling
108L</discard_changes>, or you can supply an explicit C<undef> to columns
109with 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
128sub __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
165sub __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
179sub 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
306A column accessor method is created for each column, which is used for
307getting/setting the value for that column.
308
309The actual method name is based on the
310L<accessor|DBIx::Class::ResultSource/accessor> name given during the
311L<Result Class|DBIx::Class::Manual::ResultClass> L<column definition
312|DBIx::Class::ResultSource/add_columns>. Like L</set_column>, this
313will not store the data in the database until L</insert> or L</update>
314is 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
328Inserts an object previously created by L</new> into the database if
329it isn't already in there. Returns the object itself. To insert an
330entirely new row into the database, use L<DBIx::Class::ResultSet/create>.
331
332To fetch an uninserted result object, call
333L<new_result|DBIx::Class::ResultSet/new_result> on a resultset.
334
335This will also insert any uninserted, related objects held inside this
336one, see L<DBIx::Class::ResultSet/create> for more details.
337
338=cut
339
340sub 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 {
40123.42ms251µs
# spent 32µs (13+19) within DBIx::Class::Row::BEGIN@401 which was called: # once (13µs+19µs) by base::import at line 401
no warnings 'uninitialized';
# spent 32µs making 1 call to DBIx::Class::Row::BEGIN@401 # spent 19µ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
481Indicates whether the object exists as a row in the database or
482not. This is set to true when L<DBIx::Class::ResultSet/find>,
483L<DBIx::Class::ResultSet/create> or L<DBIx::Class::Row/insert>
484are invoked.
485
486Creating a result object using L<DBIx::Class::ResultSet/new_result>, or
487calling 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
502Throws an exception if the result object is not yet in the database,
503according to L</in_storage>. Returns the object itself.
504
505This method issues an SQL UPDATE query to commit any changes to the
506object to the database if required (see L</get_dirty_columns>).
507It throws an exception if a proper WHERE clause uniquely identifying
508the database row can not be constructed (see
509L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
510for more details).
511
512Also takes an optional hashref of C<< column_name => value >> pairs
513to update on the object first. Be aware that the hashref will be
514passed to C<set_inflated_columns>, which might edit it in place, so
515don't rely on it being the same after a call to C<update>. If you
516need to preserve the hashref, it is sufficient to pass a shallow copy
517to C<update>, e.g. ( { %{ $href } } )
518
519If the values passed or any of the column values set on the object
520contain scalar references, e.g.:
521
522 $result->last_modified(\'NOW()')->update();
523 # OR
524 $result->update({ last_modified => \'NOW()' });
525
526The update will pass the values verbatim into SQL. (See
527L<SQL::Abstract> docs). The values in your Result object will NOT change
528as a result of the update call, if you want the object to be updated
529with the actual values from the database, call L</discard_changes>
530after the update.
531
532 $result->update()->discard_changes();
533
534To determine before calling this method, which column values have
535changed and will be updated, call L</get_dirty_columns>.
536
537To check if any columns will be updated, call L</is_changed>.
538
539To force a column to be updated, call L</make_column_dirty> before
540this method.
541
542=cut
543
544sub 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
580Throws an exception if the object is not in the database according to
581L</in_storage>. Also throws an exception if a proper WHERE clause
582uniquely identifying the database row can not be constructed (see
583L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
584for more details).
585
586The object is still perfectly usable, but L</in_storage> will
587now return 0 and the object must be reinserted using L</insert>
588before it can be used to L</update> the row again.
589
590If you delete an object in a class with a C<has_many> relationship, an
591attempt is made to delete all the related objects as well. To turn
592this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
593hashref of the relationship, see L<DBIx::Class::Relationship>. Any
594database-level cascade or restrict will take precedence over a
595DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
596main row first> and only then attempts to delete any remaining related
597rows.
598
599If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
600and the transaction subsequently fails, the result object will remain marked as
601not being in storage. If you know for a fact that the object is still in
602storage (i.e. by inspecting the cause of the transaction's failure), you can
603use C<< $obj->in_storage(1) >> to restore consistency between the object and
604the database. This would allow a subsequent C<< $obj->delete >> to work
605as expected.
606
607See also L<DBIx::Class::ResultSet/delete>.
608
609=cut
610
611sub 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
646Throws an exception if the column name given doesn't exist according
647to L<has_column|DBIx::Class::ResultSource/has_column>.
648
649Returns a raw column value from the result object, if it has already
650been fetched from the database or set by an accessor.
651
652If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
653will be deflated and returned.
654
655Note that if you used the C<columns> or the C<select/as>
656L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
657which C<$result> was derived, and B<did not include> C<$columnname> in the list,
658this method will return C<undef> even if the database contains some value.
659
660To retrieve all loaded column values as a hash, use L</get_columns>.
661
662=cut
663
664sub get_column {
66531µs my ($self, $column) = @_;
66632µs $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
667
66835µ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
698Returns a true value if the column value has been loaded from the
699database (or set locally).
700
701=cut
702
703sub 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
726Returns all loaded column data as a hash, containing raw values. To
727get just one value for a particular column, use L</get_column>.
728
729See L</get_inflated_columns> to get the inflated values.
730
731=cut
732
733sub 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
771Only returns the column, value pairs for those columns that have been
772changed on this object since the last L</update> or L</insert> call.
773
774See L</get_columns> to fetch all column/value pairs.
775
776=cut
777
778sub 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
796Throws an exception if the column does not exist.
797
798Marks a column as having been changed regardless of whether it has
799really changed.
800
801=cut
802
803sub 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
837Returns a hash of all column keys and associated values. Values for any
838columns set to use inflation will be inflated and returns as objects.
839
840See L</get_columns> to get the uninflated values.
841
842See L<DBIx::Class::InflateColumn> for how to setup inflation.
843
844=cut
845
846sub 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
892sub _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
927Sets a raw column value. If the new value is different from the old one,
928the column is marked as dirty for when you next call L</update>.
929
930If passed an object or reference as a value, this method will happily
931attempt to store it, and a later L</insert> or L</update> will try and
932stringify/numify as appropriate. To set an object to be deflated
933instead, see L</set_inflated_columns>, or better yet, use L</$column_accessor>.
934
935=cut
936
937sub 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
998sub _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
1027sub _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
1044Sets multiple column, raw value pairs at once.
1045
1046Works as L</set_column>.
1047
1048=cut
1049
1050sub 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
1068Sets more than one column value at once. Any inflated values are
1069deflated and the raw values stored.
1070
1071Any related values passed as Result objects, using the relation name as a
1072key, are reduced to the appropriate foreign key values and stored. If
1073instead of related result objects, a hashref of column, value data is
1074passed, will create the related object first then store.
1075
1076Will even accept arrayrefs of data as a value to a
1077L<DBIx::Class::Relationship/has_many> key, and create the related
1078objects if necessary.
1079
1080Be aware that the input hashref might be edited in place, so don't rely
1081on it being the same after a call to C<set_inflated_columns>. If you
1082need to preserve the hashref, it is sufficient to pass a shallow copy
1083to C<set_inflated_columns>, e.g. ( { %{ $href } } )
1084
1085See also L<DBIx::Class::Relationship::Base/set_from_related>.
1086
1087=cut
1088
1089sub 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
1132Inserts a new row into the database, as a copy of the original
1133object. If a hashref of replacement data is supplied, these will take
1134precedence over data in the original. Also any columns which have
1135the L<column info attribute|DBIx::Class::ResultSource/add_columns>
1136C<< is_auto_increment => 1 >> are explicitly removed before the copy,
1137so that the database can insert its own autoincremented values into
1138the new object.
1139
1140Relationships will be followed by the copy procedure B<only> if the
1141relationship specifies a true value for its
1142L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
1143is set by default on C<has_many> relationships and unset on all others.
1144
1145=cut
1146
1147sub 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
1203Set a raw value for a column without marking it as changed. This
1204method is used internally by L</set_column> which you should probably
1205be using.
1206
1207This is the lowest level at which data is set on a result object,
1208extend this method to catch all data setting methods.
1209
1210=cut
1211
1212sub 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
1233All L<DBIx::Class::ResultSet> methods that retrieve data from the
1234database and turn it into result objects call this method.
1235
1236Extend this method in your Result classes to hook into this process,
1237for example to rebless the result into a different class.
1238
1239Reblessing can also be done more easily by setting C<result_class> in
1240your Result class. See L<DBIx::Class::ResultSource/result_class>.
1241
1242Different types of results can also be created from a particular
1243L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1244
1245=cut
1246
1247
# spent 163µs (43+120) within DBIx::Class::Row::inflate_result which was called 3 times, avg 54µs/call: # 3 times (43µs+120µs) by DBIx::Class::ResultSet::_construct_results at line 1409 of DBIx/Class/ResultSet.pm, avg 54µs/call
sub inflate_result {
124832µs my ($class, $rsrc, $me, $prefetch) = @_;
1249
125038µs my $new = bless
1251 { _column_data => $me, _result_source => $rsrc },
1252 ref $class || $class
1253 ;
1254
12553700ns 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
1312319µs2119µs $new->in_storage (1);
# spent 119µs making 1 call to DBIx::Class::Row::in_storage # spent 900ns making 1 call to Koha::Schema::Result::Branch::in_storage
131338µ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
1328L</update>s the object if it's already in the database, according to
1329L</in_storage>, else L</insert>s it.
1330
1331=head2 insert_or_update
1332
1333 $obj->insert_or_update
1334
1335Alias for L</update_or_insert>
1336
1337=cut
1338
1339sub insert_or_update { shift->update_or_insert(@_) }
1340
1341sub 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
1359In list context returns a list of columns with uncommited changes, or
1360in scalar context returns a true value if there are uncommitted
1361changes.
1362
1363=cut
1364
1365sub 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
1381Returns a true value if the column has uncommitted changes.
1382
1383=cut
1384
1385sub 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
1402Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1403
1404=cut
1405
1406sub result_source {
140732µ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
141435µ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
1438Registers a column on the class. If the column_info has an 'accessor'
1439key, creates an accessor named after the value if defined; if there is
1440no such key, creates an accessor with the same name as the column
1441
1442The column_info attributes are described in
1443L<DBIx::Class::ResultSource/add_columns>
1444
1445=cut
1446
1447
# spent 580ms (12.1+568) within DBIx::Class::Row::register_column which was called 1602 times, avg 362µs/call: # 1602 times (12.1ms+568ms) by DBIx::Class::ResultSourceProxy::add_columns at line 35 of DBIx/Class/ResultSourceProxy.pm, avg 362µs/call
sub register_column {
14481602695µs my ($class, $col, $info) = @_;
14491602343µs my $acc = $col;
14501602651µs if (exists $info->{accessor}) {
14514520µs return unless defined $info->{accessor};
14524242µs $acc = [ $info->{accessor}, $col ];
1453 }
1454159913.6ms1599568ms $class->mk_group_accessors('column' => $acc);
# spent 568ms making 1599 calls to Class::Accessor::Grouped::mk_group_accessors, avg 355µ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
1469Fetches a fresh copy of the Result object from the database and returns it.
1470Throws an exception if a proper WHERE clause identifying the database row
1471can not be constructed (i.e. if the original object does not contain its
1472entire
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
1475the resultset used to find the row.
1476
1477This copy can then be used to compare to an existing result object, to
1478determine if any changes have been made in the database since it was
1479created.
1480
1481To just update your Result object with any latest changes from the
1482database, use L</discard_changes> instead.
1483
1484The \%attrs argument should be compatible with
1485L<DBIx::Class::ResultSet/ATTRIBUTES>.
1486
1487=cut
1488
1489sub 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
1513Re-selects the row from the database, losing any changes that had
1514been made. Throws an exception if a proper C<WHERE> clause identifying
1515the database row can not be constructed (i.e. if the original object
1516does not contain its entire
1517L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>).
1518
1519This method can also be used to refresh from storage, retrieving any
1520changes 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
1523second argument to C<< $resultset->search($cond, $attrs) >>;
1524
1525Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1526storage, a default of
1527L<< C<< { force_pool => 'master' } >>
1528|DBIx::Class::Storage::DBI::Replicated/SYNOPSIS >> is automatically set for
1529you. Prior to C<< DBIx::Class 0.08109 >> (before 2010) one would have been
1530required to explicitly wrap the entire operation in a transaction to guarantee
1531that up-to-date results are read from the master database.
1532
1533=cut
1534
1535sub 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
1561See L<DBIx::Class::Schema/throw_exception>.
1562
1563=cut
1564
1565sub 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
1588Returns the primary key(s) for a row. Can't be called as a class method.
1589Actually implemented in L<DBIx::Class::PK>
1590
1591=head1 FURTHER QUESTIONS?
1592
1593Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1594
1595=head1 COPYRIGHT AND LICENSE
1596
1597This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1598by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1599redistribute it and/or modify it under the same terms as the
1600L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1601
1602=cut
1603
160413µs1259µs1;
# spent 259µs making 1 call to B::Hooks::EndOfScope::XS::__ANON__
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.