← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:36 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Row.pm
StatementsExecuted 238656 statements in 729ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
471711104ms148msDBIx::Class::Row::::inflate_resultDBIx::Class::Row::inflate_result
8771196.0ms80.7sDBIx::Class::Row::::updateDBIx::Class::Row::update
11395587.7ms286msDBIx::Class::Row::::set_columnDBIx::Class::Row::set_column
17802161668.4ms68.4msDBIx::Class::Row::::get_columnDBIx::Class::Row::get_column
4496366.6ms53.6sDBIx::Class::Row::::insertDBIx::Class::Row::insert
1389415747.1ms47.1msDBIx::Class::Row::::result_sourceDBIx::Class::Row::result_source
4491141.0ms226msDBIx::Class::Row::::newDBIx::Class::Row::new
33874136.0ms137msDBIx::Class::Row::::store_columnDBIx::Class::Row::store_column
63242234.6ms34.6msDBIx::Class::Row::::has_column_loadedDBIx::Class::Row::has_column_loaded
75995133.5ms33.5msDBIx::Class::Row::::in_storageDBIx::Class::Row::in_storage
9921117.8ms75.2msDBIx::Class::Row::::_track_storage_valueDBIx::Class::Row::_track_storage_value
11391111.4ms89.7msDBIx::Class::Row::::_eq_column_valuesDBIx::Class::Row::_eq_column_values
698119.37ms78.3msDBIx::Class::Row::::_is_column_numericDBIx::Class::Row::_is_column_numeric
877116.95ms6.95msDBIx::Class::Row::::get_dirty_columnsDBIx::Class::Row::get_dirty_columns
449116.00ms82.4msDBIx::Class::Row::::get_columnsDBIx::Class::Row::get_columns
250221.02ms27.2msDBIx::Class::Row::::register_columnDBIx::Class::Row::register_column
111290µs371µsDBIx::Class::Row::::BEGIN@8DBIx::Class::Row::BEGIN@8
31157µs152µsDBIx::Class::Row::::__ANON__[:797]DBIx::Class::Row::__ANON__[:797]
11111µs13µsDBIx::Class::Row::::BEGIN@3DBIx::Class::Row::BEGIN@3
11111µs29µsDBIx::Class::Row::::BEGIN@343DBIx::Class::Row::BEGIN@343
11110µs18µsDBIx::Class::Row::::BEGIN@4DBIx::Class::Row::BEGIN@4
11110µs28µsDBIx::Class::Row::::BEGIN@10DBIx::Class::Row::BEGIN@10
1118µs48µsDBIx::Class::Row::::BEGIN@9DBIx::Class::Row::BEGIN@9
1118µs220µsDBIx::Class::Row::::BEGIN@24DBIx::Class::Row::BEGIN@24
1117µs39µsDBIx::Class::Row::::BEGIN@11DBIx::Class::Row::BEGIN@11
1117µs74µsDBIx::Class::Row::::BEGIN@6DBIx::Class::Row::BEGIN@6
1116µs6µsDBIx::Class::Row::::BEGIN@17DBIx::Class::Row::BEGIN@17
0000s0sDBIx::Class::Row::::__ANON__[:1153]DBIx::Class::Row::__ANON__[:1153]
0000s0sDBIx::Class::Row::::__ANON__[:1165]DBIx::Class::Row::__ANON__[:1165]
0000s0sDBIx::Class::Row::::__ANON__[:573]DBIx::Class::Row::__ANON__[:573]
0000s0sDBIx::Class::Row::::__ANON__[:916]DBIx::Class::Row::__ANON__[:916]
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::::copyDBIx::Class::Row::copy
0000s0sDBIx::Class::Row::::deleteDBIx::Class::Row::delete
0000s0sDBIx::Class::Row::::discard_changesDBIx::Class::Row::discard_changes
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::::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::::set_columnsDBIx::Class::Row::set_columns
0000s0sDBIx::Class::Row::::set_inflated_columnsDBIx::Class::Row::set_inflated_columns
0000s0sDBIx::Class::Row::::throw_exceptionDBIx::Class::Row::throw_exception
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
3317µs215µs
# spent 13µs (11+2) within DBIx::Class::Row::BEGIN@3 which was called: # once (11µs+2µs) by base::import at line 3
use strict;
# spent 13µs making 1 call to DBIx::Class::Row::BEGIN@3 # spent 2µs making 1 call to strict::import
4325µs225µs
# spent 18µs (10+8) within DBIx::Class::Row::BEGIN@4 which was called: # once (10µs+8µs) by base::import at line 4
use warnings;
# spent 18µs making 1 call to DBIx::Class::Row::BEGIN@4 # spent 8µs making 1 call to warnings::import
5
6319µs274µs
# spent 74µs (7+67) within DBIx::Class::Row::BEGIN@6 which was called: # once (7µs+67µs) by base::import at line 6
use base qw/DBIx::Class/;
# spent 74µs making 1 call to DBIx::Class::Row::BEGIN@6 # spent 67µs making 1 call to base::import, recursion: max depth 1, sum of overlapping time 67µs
7
8373µs1371µs
# spent 371µs (290+81) within DBIx::Class::Row::BEGIN@8 which was called: # once (290µs+81µs) by base::import at line 8
use DBIx::Class::Exception;
# spent 371µs making 1 call to DBIx::Class::Row::BEGIN@8
9321µs287µs
# spent 48µs (8+40) within DBIx::Class::Row::BEGIN@9 which was called: # once (8µs+40µs) by base::import at line 9
use Scalar::Util 'blessed';
# spent 48µs making 1 call to DBIx::Class::Row::BEGIN@9 # spent 40µs making 1 call to Exporter::import
10321µs247µs
# spent 28µs (10+19) within DBIx::Class::Row::BEGIN@10 which was called: # once (10µs+19µs) by base::import at line 10
use List::Util 'first';
# spent 28µs making 1 call to DBIx::Class::Row::BEGIN@10 # spent 18µs making 1 call to Exporter::import
11353µs270µs
# spent 39µs (7+31) within DBIx::Class::Row::BEGIN@11 which was called: # once (7µs+31µs) by base::import at line 11
use Try::Tiny;
# spent 39µs making 1 call to DBIx::Class::Row::BEGIN@11 # spent 32µs making 1 call to Exporter::import
12
13###
14### Internal method
15### Do not use
16###
17
# spent 6µs within DBIx::Class::Row::BEGIN@17 which was called: # once (6µs+0s) by base::import at line 22
BEGIN {
18 *MULTICREATE_DEBUG =
19 $ENV{DBIC_MULTICREATE_DEBUG}
20 ? sub () { 1 }
2116µs : sub () { 0 };
22115µs16µs}
# spent 6µs making 1 call to DBIx::Class::Row::BEGIN@17
23
243891µs2433µs
# spent 220µs (8+212) within DBIx::Class::Row::BEGIN@24 which was called: # once (8µs+212µs) by base::import at line 24
use namespace::clean;
# spent 220µs making 1 call to DBIx::Class::Row::BEGIN@24 # spent 212µs making 1 call to namespace::clean::import
25
26=head1 NAME
27
28DBIx::Class::Row - Basic row methods
29
30=head1 SYNOPSIS
31
32=head1 DESCRIPTION
33
34This class is responsible for defining and doing basic operations on rows
35derived from L<DBIx::Class::ResultSource> objects.
36
37Row objects are returned from L<DBIx::Class::ResultSet>s using the
38L<create|DBIx::Class::ResultSet/create>, L<find|DBIx::Class::ResultSet/find>,
39L<next|DBIx::Class::ResultSet/next> and L<all|DBIx::Class::ResultSet/all> methods,
40as well as invocations of 'single' (
41L<belongs_to|DBIx::Class::Relationship/belongs_to>,
42L<has_one|DBIx::Class::Relationship/has_one> or
43L<might_have|DBIx::Class::Relationship/might_have>)
44relationship accessors of L<DBIx::Class::Row> objects.
45
46=head1 METHODS
47
48=head2 new
49
50 my $row = My::Class->new(\%attrs);
51
52 my $row = $schema->resultset('MySource')->new(\%colsandvalues);
53
54=over
55
56=item Arguments: \%attrs or \%colsandvalues
57
58=item Returns: A Row object
59
60=back
61
62While you can create a new row object by calling C<new> directly on
63this class, you are better off calling it on a
64L<DBIx::Class::ResultSet> object.
65
66When calling it directly, you will not get a complete, usable row
67object until you pass or set the C<result_source> attribute, to a
68L<DBIx::Class::ResultSource> instance that is attached to a
69L<DBIx::Class::Schema> with a valid connection.
70
71C<$attrs> is a hashref of column name, value data. It can also contain
72some other attributes such as the C<result_source>.
73
74Passing an object, or an arrayref of objects as a value will call
75L<DBIx::Class::Relationship::Base/set_from_related> for you. When
76passed a hashref or an arrayref of hashrefs as the value, these will
77be turned into objects via new_related, and treated as if you had
78passed objects.
79
80For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
81
82Please note that if a value is not passed to new, no value will be sent
83in the SQL INSERT call, and the column will therefore assume whatever
84default value was specified in your database. While DBIC will retrieve the
85value of autoincrement columns, it will never make an explicit database
86trip to retrieve default values assigned by the RDBMS. You can explicitly
87request that all values be fetched back from the database by calling
88L</discard_changes>, or you can supply an explicit C<undef> to columns
89with NULL as the default, and save yourself a SELECT.
90
91 CAVEAT:
92
93 The behavior described above will backfire if you use a foreign key column
94 with a database-defined default. If you call the relationship accessor on
95 an object that doesn't have a set value for the FK column, DBIC will throw
96 an exception, as it has no way of knowing the PK of the related object (if
97 there is one).
98
99=cut
100
101## 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().
102## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
103## When doing the later insert, we need to make sure the PKs are set.
104## using _relationship_data in new and funky ways..
105## check Relationship::CascadeActions and Relationship::Accessor for compat
106## tests!
107
108sub __new_related_find_or_new_helper {
109 my ($self, $relname, $data) = @_;
110
111 my $rsrc = $self->result_source;
112
113 # create a mock-object so all new/set_column component overrides will run:
114 my $rel_rs = $rsrc->related_source($relname)->resultset;
115 my $new_rel_obj = $rel_rs->new_result($data);
116 my $proc_data = { $new_rel_obj->get_columns };
117
118 if ($self->__their_pk_needs_us($relname)) {
119 MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
120 return $new_rel_obj;
121 }
122 elsif ($rsrc->_pk_depends_on($relname, $proc_data )) {
123 if (! keys %$proc_data) {
124 # there is nothing to search for - blind create
125 MULTICREATE_DEBUG and warn "MC $self constructing default-insert $relname";
126 }
127 else {
128 MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
129 # this is not *really* find or new, as we don't want to double-new the
130 # data (thus potentially double encoding or whatever)
131 my $exists = $rel_rs->find ($proc_data);
132 return $exists if $exists;
133 }
134 return $new_rel_obj;
135 }
136 else {
137 my $us = $rsrc->source_name;
138 $self->throw_exception (
139 "Unable to determine relationship '$relname' direction from '$us', "
140 . "possibly due to a missing reverse-relationship on '$relname' to '$us'."
141 );
142 }
143}
144
145sub __their_pk_needs_us { # this should maybe be in resultsource.
146 my ($self, $relname) = @_;
147 my $source = $self->result_source;
148 my $reverse = $source->reverse_relationship_info($relname);
149 my $rel_source = $source->related_source($relname);
150 my $us = { $self->get_columns };
151 foreach my $key (keys %$reverse) {
152 # if their primary key depends on us, then we have to
153 # just create a result and we'll fill it out afterwards
154 return 1 if $rel_source->_pk_depends_on($key, $us);
155 }
156 return 0;
157}
158
159
# spent 226ms (41.0+185) within DBIx::Class::Row::new which was called 449 times, avg 503µs/call: # 449 times (41.0ms+185ms) by DBIx::Class::ResultSet::new_result at line 2213 of DBIx/Class/ResultSet.pm, avg 503µs/call
sub new {
1601273034.6ms my ($class, $attrs) = @_;
161 $class = ref $class if ref $class;
162
163 my $new = bless { _column_data => {} }, $class;
164
165 if ($attrs) {
166 $new->throw_exception("attrs must be a hashref")
167 unless ref($attrs) eq 'HASH';
168
169 my $source = delete $attrs->{-result_source};
170 if ( my $h = delete $attrs->{-source_handle} ) {
171 $source ||= $h->resolve;
172 }
173
1744492.00ms $new->result_source($source) if $source;
# spent 2.00ms making 449 calls to DBIx::Class::Row::result_source, avg 4µs/call
175
176 if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
177 @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
178 }
179
180 my ($related,$inflated);
181
182 foreach my $key (keys %$attrs) {
183 if (ref $attrs->{$key}) {
184 ## Can we extract this lot to use with update(_or .. ) ?
185 $new->throw_exception("Can't do multi-create without result source")
186 unless $source;
187147801µs my $info = $source->relationship_info($key);
# spent 801µs making 147 calls to DBIx::Class::ResultSource::relationship_info, avg 5µs/call
188 my $acc_type = $info->{attrs}{accessor} || '';
1892946.87ms if ($acc_type eq 'single') {
# spent 4.43ms making 147 calls to DBIx::Class::ResultSourceProxy::column_info, avg 30µs/call # spent 2.44ms making 147 calls to DBIx::Class::ResultSourceProxy::has_column, avg 17µs/call
190 my $rel_obj = delete $attrs->{$key};
191 if(!blessed $rel_obj) {
192 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
193 }
194
195 if ($rel_obj->in_storage) {
196 $new->{_rel_in_storage}{$key} = 1;
197 $new->set_from_related($key, $rel_obj);
198 } else {
199 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
200 }
201
202 $related->{$key} = $rel_obj;
203 next;
204 }
205 elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
206 my $others = delete $attrs->{$key};
207 my $total = @$others;
208 my @objects;
209 foreach my $idx (0 .. $#$others) {
210 my $rel_obj = $others->[$idx];
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 $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
217 } else {
218 MULTICREATE_DEBUG and
219 warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
220 }
221 push(@objects, $rel_obj);
222 }
223 $related->{$key} = \@objects;
224 next;
225 }
226 elsif ($acc_type eq 'filter') {
227 ## 'filter' should disappear and get merged in with 'single' above!
228 my $rel_obj = delete $attrs->{$key};
229 if(!blessed $rel_obj) {
230 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
231 }
232 if ($rel_obj->in_storage) {
233 $new->{_rel_in_storage}{$key} = 1;
234 }
235 else {
236 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
237 }
238 $inflated->{$key} = $rel_obj;
239 next;
240 } elsif ($class->has_column($key)
241 && $class->column_info($key)->{_inflate_info}) {
242 $inflated->{$key} = $attrs->{$key};
243 next;
244 }
245 }
246180582.9ms $new->throw_exception("No such column $key on $class")
# spent 82.9ms making 1805 calls to DBIx::Class::ResultSourceProxy::has_column, avg 46µs/call
247 unless $class->has_column($key);
248180592.2ms $new->store_column($key => $attrs->{$key});
# spent 92.2ms making 1805 calls to DBIx::Class::Row::store_column, avg 51µs/call
249 }
250
251 $new->{_relationship_data} = $related if $related;
252 $new->{_inflated_column} = $inflated if $inflated;
253 }
254
255 return $new;
256}
257
258=head2 insert
259
260 $row->insert;
261
262=over
263
264=item Arguments: none
265
266=item Returns: The Row object
267
268=back
269
270Inserts an object previously created by L</new> into the database if
271it isn't already in there. Returns the object itself. To insert an
272entirely new row into the database, use L<DBIx::Class::ResultSet/create>.
273
274To fetch an uninserted row object, call
275L<new|DBIx::Class::ResultSet/new> on a resultset.
276
277This will also insert any uninserted, related objects held inside this
278one, see L<DBIx::Class::ResultSet/create> for more details.
279
280=cut
281
282
# spent 53.6s (66.6ms+53.5) within DBIx::Class::Row::insert which was called 449 times, avg 119ms/call: # 147 times (23.6ms+17.8s) by Tapper::Schema::TestrunDB::Result::Testrun::rerun at line 159 of Tapper/Schema/TestrunDB/Result/Testrun.pm, avg 121ms/call # 147 times (20.8ms+17.6s) by Tapper::Schema::TestrunDB::Result::Testrun::rerun at line 150 of Tapper/Schema/TestrunDB/Result/Testrun.pm, avg 120ms/call # 129 times (18.2ms+15.2s) by Tapper::Schema::TestrunDB::Result::Testrun::assign_preconditions at line 200 of Tapper/Schema/TestrunDB/Result/Testrun.pm, avg 118ms/call # 24 times (3.69ms+2.76s) by DBIx::Class::ResultSet::create at line 2545 of DBIx/Class/ResultSet.pm, avg 115ms/call # once (107µs+108ms) by main::RUNTIME at line 39 of xt/tapper-mcp-scheduler-with-db-longrun.t # once (139µs+107ms) by main::RUNTIME at line 40 of xt/tapper-mcp-scheduler-with-db-longrun.t
sub insert {
2831271454.6ms my ($self) = @_;
2844492.09ms return $self if $self->in_storage;
# spent 2.09ms making 449 calls to DBIx::Class::Row::in_storage, avg 5µs/call
2854491.56ms my $source = $self->result_source;
# spent 1.56ms making 449 calls to DBIx::Class::Row::result_source, avg 3µs/call
286 $self->throw_exception("No result_source set on this object; can't insert")
287 unless $source;
288
28944917.6ms my $storage = $source->storage;
# spent 17.6ms making 449 calls to DBIx::Class::ResultSource::storage, avg 39µs/call
290
291 my $rollback_guard;
292
293 # Check if we stored uninserted relobjs here in new()
294 my %related_stuff = (%{$self->{_relationship_data} || {}},
295 %{$self->{_inflated_column} || {}});
296
297 # insert what needs to be inserted before us
298 my %pre_insert;
299 for my $relname (keys %related_stuff) {
300 my $rel_obj = $related_stuff{$relname};
301
302 if (! $self->{_rel_in_storage}{$relname}) {
303294627µs next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
# spent 395µs making 147 calls to UNIVERSAL::isa, avg 3µs/call # spent 232µs making 147 calls to Scalar::Util::blessed, avg 2µs/call
304
305 next unless $source->_pk_depends_on(
306 $relname, { $rel_obj->get_columns }
307 );
308
309 # The guard will save us if we blow out of this scope via die
310 $rollback_guard ||= $storage->txn_scope_guard;
311
312 MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
313
314 my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns };
315 my $existing;
316
317 # if there are no keys - nothing to search for
318 if (keys %$them and $existing = $self->result_source
319 ->related_source($relname)
320 ->resultset
321 ->find($them)
322 ) {
323 %{$rel_obj} = %{$existing};
324 }
325 else {
326 $rel_obj->insert;
327 }
328
329 $self->{_rel_in_storage}{$relname} = 1;
330 }
331
332 $self->set_from_related($relname, $rel_obj);
333 delete $related_stuff{$relname};
334 }
335
336 # start a transaction here if not started yet and there is more stuff
337 # to insert after us
33814726.3ms if (keys %related_stuff) {
# spent 26.3ms making 147 calls to DBIx::Class::Storage::txn_scope_guard, avg 179µs/call
339 $rollback_guard ||= $storage->txn_scope_guard
340 }
341
342 MULTICREATE_DEBUG and do {
34333.17ms248µs
# spent 29µs (11+19) within DBIx::Class::Row::BEGIN@343 which was called: # once (11µs+19µs) by base::import at line 343
no warnings 'uninitialized';
# spent 29µs making 1 call to DBIx::Class::Row::BEGIN@343 # spent 19µs making 1 call to warnings::unimport
344 warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
345 };
346
347 # perform the insert - the storage will return everything it is asked to
348 # (autoinc primary columns and any retrieve_on_insert columns)
34944982.4ms my %current_rowdata = $self->get_columns;
# spent 82.4ms making 449 calls to DBIx::Class::Row::get_columns, avg 184µs/call
3504494.13ms my $returned_cols = $storage->insert(
# spent 4.13ms making 449 calls to DBIx::Class::Storage::DBI::insert, avg 9µs/call
351 $source,
352 { %current_rowdata }, # what to insert, copy because the storage *will* change it
353 );
354
355 for (keys %$returned_cols) {
35629630.1ms $self->store_column($_, $returned_cols->{$_})
# spent 30.1ms making 296 calls to DBIx::Class::Row::store_column, avg 102µs/call
357 # this ensures we fire store_column only once
358 # (some asshats like overriding it)
359 if (
360 (!exists $current_rowdata{$_})
361 or
362 (defined $current_rowdata{$_} xor defined $returned_cols->{$_})
363 or
364 (defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_})
365 );
366 }
367
368 delete $self->{_column_data_in_storage};
3694493.54ms $self->in_storage(1);
# spent 3.54ms making 449 calls to DBIx::Class::Row::in_storage, avg 8µs/call
370
371 $self->{_dirty_columns} = {};
372 $self->{related_resultsets} = {};
373
374 foreach my $relname (keys %related_stuff) {
375147762µs next unless $source->has_relationship ($relname);
# spent 762µs making 147 calls to DBIx::Class::ResultSource::has_relationship, avg 5µs/call
376
377 my @cands = ref $related_stuff{$relname} eq 'ARRAY'
378 ? @{$related_stuff{$relname}}
379 : $related_stuff{$relname}
380 ;
381
382 if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
383 ) {
384 my $reverse = $source->reverse_relationship_info($relname);
385 foreach my $obj (@cands) {
386 $obj->set_from_related($_, $self) for keys %$reverse;
387 if ($self->__their_pk_needs_us($relname)) {
388 if (exists $self->{_ignore_at_insert}{$relname}) {
389 MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
390 }
391 else {
392 MULTICREATE_DEBUG and warn "MC $self inserting $relname $obj";
393 $obj->insert;
394 }
395 } else {
396 MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
397 $obj->insert();
398 }
399 }
400 }
401 }
402
403 delete $self->{_ignore_at_insert};
404
40514717.2s $rollback_guard->commit if $rollback_guard;
# spent 17.2s making 147 calls to DBIx::Class::Storage::TxnScopeGuard::commit, avg 117ms/call
406
407 return $self;
408}
409
410=head2 in_storage
411
412 $row->in_storage; # Get value
413 $row->in_storage(1); # Set value
414
415=over
416
417=item Arguments: none or 1|0
418
419=item Returns: 1|0
420
421=back
422
423Indicates whether the object exists as a row in the database or
424not. This is set to true when L<DBIx::Class::ResultSet/find>,
425L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
426are used.
427
428Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
429L</delete> on one, sets it to false.
430
431=cut
432
433
# spent 33.5ms within DBIx::Class::Row::in_storage which was called 7599 times, avg 4µs/call: # 4717 times (19.8ms+0s) by DBIx::Class::Row::inflate_result at line 1204, avg 4µs/call # 1139 times (4.76ms+0s) by DBIx::Class::Row::set_column at line 835, avg 4µs/call # 845 times (3.32ms+0s) by DBIx::Class::Row::update at line 501, avg 4µs/call # 449 times (3.54ms+0s) by DBIx::Class::Row::insert at line 369, avg 8µs/call # 449 times (2.09ms+0s) by DBIx::Class::Row::insert at line 284, avg 5µs/call
sub in_storage {
4342279747.5ms my ($self, $val) = @_;
435 $self->{_in_storage} = $val if @_ > 1;
436 return $self->{_in_storage} ? 1 : 0;
437}
438
439=head2 update
440
441 $row->update(\%columns?)
442
443=over
444
445=item Arguments: none or a hashref
446
447=item Returns: The Row object
448
449=back
450
451Throws an exception if the row object is not yet in the database,
452according to L</in_storage>.
453
454This method issues an SQL UPDATE query to commit any changes to the
455object to the database if required (see L</get_dirty_columns>).
456It throws an exception if a proper WHERE clause uniquely identifying
457the database row can not be constructed (see
458L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
459for more details).
460
461Also takes an optional hashref of C<< column_name => value >> pairs
462to update on the object first. Be aware that the hashref will be
463passed to C<set_inflated_columns>, which might edit it in place, so
464don't rely on it being the same after a call to C<update>. If you
465need to preserve the hashref, it is sufficient to pass a shallow copy
466to C<update>, e.g. ( { %{ $href } } )
467
468If the values passed or any of the column values set on the object
469contain scalar references, e.g.:
470
471 $row->last_modified(\'NOW()');
472 # OR
473 $row->update({ last_modified => \'NOW()' });
474
475The update will pass the values verbatim into SQL. (See
476L<SQL::Abstract> docs). The values in your Row object will NOT change
477as a result of the update call, if you want the object to be updated
478with the actual values from the database, call L</discard_changes>
479after the update.
480
481 $row->update()->discard_changes();
482
483To determine before calling this method, which column values have
484changed and will be updated, call L</get_dirty_columns>.
485
486To check if any columns will be updated, call L</is_changed>.
487
488To force a column to be updated, call L</make_column_dirty> before
489this method.
490
491=cut
492
493
# spent 80.7s (96.0ms+80.6) within DBIx::Class::Row::update which was called 877 times, avg 92.1ms/call: # 877 times (96.0ms+80.6s) by DBIx::Class::Relationship::CascadeActions::update at line 28 of mro.pm, avg 92.1ms/call
sub update {
494854686.8ms my ($self, $upd) = @_;
495
496 $self->set_inflated_columns($upd) if $upd;
497
4988776.95ms my %to_update = $self->get_dirty_columns
# spent 6.95ms making 877 calls to DBIx::Class::Row::get_dirty_columns, avg 8µs/call
499 or return $self;
500
5018453.32ms $self->throw_exception( "Not in database" ) unless $self->in_storage;
# spent 3.32ms making 845 calls to DBIx::Class::Row::in_storage, avg 4µs/call
502
5034225186ms my $rows = $self->result_source->storage->update(
# spent 135ms making 845 calls to DBIx::Class::PK::_storage_ident_condition, avg 160µs/call # spent 38.5ms making 845 calls to DBIx::Class::ResultSource::storage, avg 46µs/call # spent 6.81ms making 845 calls to DBIx::Class::Storage::DBI::update, avg 8µs/call # spent 5.36ms making 1690 calls to DBIx::Class::Row::result_source, avg 3µs/call
504 $self->result_source, \%to_update, $self->_storage_ident_condition
505 );
506 if ($rows == 0) {
507 $self->throw_exception( "Can't update ${self}: row not found" );
508 } elsif ($rows > 1) {
509 $self->throw_exception("Can't update ${self}: updated more than one row");
510 }
511 $self->{_dirty_columns} = {};
512 $self->{related_resultsets} = {};
513 delete $self->{_column_data_in_storage};
514 return $self;
515}
516
517=head2 delete
518
519 $row->delete
520
521=over
522
523=item Arguments: none
524
525=item Returns: The Row object
526
527=back
528
529Throws an exception if the object is not in the database according to
530L</in_storage>. Also throws an exception if a proper WHERE clause
531uniquely identifying the database row can not be constructed (see
532L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
533for more details).
534
535The object is still perfectly usable, but L</in_storage> will
536now return 0 and the object must be reinserted using L</insert>
537before it can be used to L</update> the row again.
538
539If you delete an object in a class with a C<has_many> relationship, an
540attempt is made to delete all the related objects as well. To turn
541this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
542hashref of the relationship, see L<DBIx::Class::Relationship>. Any
543database-level cascade or restrict will take precedence over a
544DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
545main row first> and only then attempts to delete any remaining related
546rows.
547
548If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
549and the transaction subsequently fails, the row object will remain marked as
550not being in storage. If you know for a fact that the object is still in
551storage (i.e. by inspecting the cause of the transaction's failure), you can
552use C<< $obj->in_storage(1) >> to restore consistency between the object and
553the database. This would allow a subsequent C<< $obj->delete >> to work
554as expected.
555
556See also L<DBIx::Class::ResultSet/delete>.
557
558=cut
559
560sub delete {
561 my $self = shift;
562 if (ref $self) {
563 $self->throw_exception( "Not in database" ) unless $self->in_storage;
564
565 $self->result_source->storage->delete(
566 $self->result_source, $self->_storage_ident_condition
567 );
568
569 delete $self->{_column_data_in_storage};
570 $self->in_storage(undef);
571 }
572 else {
573 my $rsrc = try { $self->result_source_instance }
574 or $self->throw_exception("Can't do class delete without a ResultSource instance");
575
576 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
577 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
578 $rsrc->resultset->search(@_)->delete;
579 }
580 return $self;
581}
582
583=head2 get_column
584
585 my $val = $row->get_column($col);
586
587=over
588
589=item Arguments: $columnname
590
591=item Returns: The value of the column
592
593=back
594
595Throws an exception if the column name given doesn't exist according
596to L</has_column>.
597
598Returns a raw column value from the row object, if it has already
599been fetched from the database or set by an accessor.
600
601If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
602will be deflated and returned.
603
604Note that if you used the C<columns> or the C<select/as>
605L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
606which C<$row> was derived, and B<did not include> C<$columnname> in the list,
607this method will return C<undef> even if the database contains some value.
608
609To retrieve all loaded column values as a hash, use L</get_columns>.
610
611=cut
612
613
# spent 68.4ms within DBIx::Class::Row::get_column which was called 17802 times, avg 4µs/call: # 5185 times (17.7ms+0s) by DBIx::Class::ResultSource::_resolve_condition at line 1687 of DBIx/Class/ResultSource.pm, avg 3µs/call # 2896 times (7.57ms+0s) by Tapper::Schema::TestrunDB::Result::Queue::priority at line 2 of (eval 362)[Class/Accessor/Grouped.pm:807], avg 3µs/call # 2421 times (13.6ms+0s) by Tapper::Schema::TestrunDB::Result::Host::id or Tapper::Schema::TestrunDB::Result::Precondition::id or Tapper::Schema::TestrunDB::Result::Queue::id or Tapper::Schema::TestrunDB::Result::Testrun::id at line 2 of (eval 301)[Class/Accessor/Grouped.pm:807], avg 6µs/call # 1679 times (7.40ms+0s) by Tapper::Schema::TestrunDB::Result::Host::name or Tapper::Schema::TestrunDB::Result::Queue::name at line 2 of (eval 358)[Class/Accessor/Grouped.pm:807], avg 4µs/call # 1557 times (4.05ms+0s) by Tapper::Schema::TestrunDB::Result::Queue::runcount at line 2 of (eval 363)[Class/Accessor/Grouped.pm:807], avg 3µs/call # 1139 times (5.72ms+0s) by DBIx::Class::Row::set_column at line 835, avg 5µs/call # 845 times (5.00ms+0s) by DBIx::Class::PK::_ident_values at line 44 of DBIx/Class/PK.pm, avg 6µs/call # 724 times (2.07ms+0s) by Tapper::Schema::TestrunDB::Result::Queue::active at line 2 of (eval 364)[Class/Accessor/Grouped.pm:807], avg 3µs/call # 294 times (1.21ms+0s) by Tapper::Schema::TestrunDB::Result::TestrunScheduling::auto_rerun at line 2 of (eval 308)[Class/Accessor/Grouped.pm:807], avg 4µs/call # 180 times (1.50ms+0s) by Tapper::Schema::TestrunDB::Result::Host::free at line 2 of (eval 398)[Class/Accessor/Grouped.pm:807], avg 8µs/call # 147 times (723µs+0s) by Tapper::Schema::TestrunDB::Result::TestrunScheduling::queue_id at line 2 of (eval 303)[Class/Accessor/Grouped.pm:807], avg 5µs/call # 147 times (444µs+0s) by Tapper::Schema::TestrunDB::Result::Testrun::owner_user_id at line 2 of (eval 387)[Class/Accessor/Grouped.pm:807], avg 3µs/call # 147 times (435µs+0s) by Tapper::Schema::TestrunDB::Result::Testrun::notes at line 2 of (eval 377)[Class/Accessor/Grouped.pm:807], avg 3µs/call # 147 times (330µs+0s) by Tapper::Schema::TestrunDB::Result::Testrun::shortname at line 2 of (eval 353)[Class/Accessor/Grouped.pm:807], avg 2µs/call # 147 times (318µs+0s) by Tapper::Schema::TestrunDB::Result::TestrunScheduling::host_id at line 2 of (eval 304)[Class/Accessor/Grouped.pm:807], avg 2µs/call # 147 times (316µs+0s) by Tapper::Schema::TestrunDB::Result::Testrun::topic_name at line 2 of (eval 378)[Class/Accessor/Grouped.pm:807], avg 2µs/call
sub get_column {
6145340693.6ms my ($self, $column) = @_;
615 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
616 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
617 if (exists $self->{_inflated_column}{$column}) {
618 return $self->store_column($column,
619 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
620 }
621 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
622 return undef;
623}
624
625=head2 has_column_loaded
626
627 if ( $row->has_column_loaded($col) ) {
628 print "$col has been loaded from db";
629 }
630
631=over
632
633=item Arguments: $columnname
634
635=item Returns: 0|1
636
637=back
638
639Returns a true value if the column value has been loaded from the
640database (or set locally).
641
642=cut
643
644
# spent 34.6ms within DBIx::Class::Row::has_column_loaded which was called 6324 times, avg 5µs/call: # 5185 times (25.7ms+0s) by DBIx::Class::ResultSource::_resolve_condition at line 1673 of DBIx/Class/ResultSource.pm, avg 5µs/call # 1139 times (8.92ms+0s) by DBIx::Class::Row::set_column at line 834, avg 8µs/call
sub has_column_loaded {
6452529643.8ms my ($self, $column) = @_;
646 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
647 return 1 if exists $self->{_inflated_column}{$column};
648 return exists $self->{_column_data}{$column};
649}
650
651=head2 get_columns
652
653 my %data = $row->get_columns;
654
655=over
656
657=item Arguments: none
658
659=item Returns: A hash of columnname, value pairs.
660
661=back
662
663Returns all loaded column data as a hash, containing raw values. To
664get just one value for a particular column, use L</get_column>.
665
666See L</get_inflated_columns> to get the inflated values.
667
668=cut
669
670
# spent 82.4ms (6.00+76.4) within DBIx::Class::Row::get_columns which was called 449 times, avg 184µs/call: # 449 times (6.00ms+76.4ms) by DBIx::Class::Row::insert at line 349, avg 184µs/call
sub get_columns {
67114947.38ms my $self = shift;
672 if (exists $self->{_inflated_column}) {
673 foreach my $col (keys %{$self->{_inflated_column}}) {
67429476.4ms $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
# spent 71.0ms making 147 calls to DBIx::Class::InflateColumn::_deflated_column, avg 483µs/call # spent 5.36ms making 147 calls to DBIx::Class::Row::store_column, avg 36µs/call
675 unless exists $self->{_column_data}{$col};
676 }
677 }
678 return %{$self->{_column_data}};
679}
680
681=head2 get_dirty_columns
682
683 my %data = $row->get_dirty_columns;
684
685=over
686
687=item Arguments: none
688
689=item Returns: A hash of column, value pairs
690
691=back
692
693Only returns the column, value pairs for those columns that have been
694changed on this object since the last L</update> or L</insert> call.
695
696See L</get_columns> to fetch all column/value pairs.
697
698=cut
699
700
# spent 6.95ms within DBIx::Class::Row::get_dirty_columns which was called 877 times, avg 8µs/call: # 877 times (6.95ms+0s) by DBIx::Class::Row::update at line 498, avg 8µs/call
sub get_dirty_columns {
70117548.30ms my $self = shift;
702 return map { $_ => $self->{_column_data}{$_} }
703 keys %{$self->{_dirty_columns}};
704}
705
706=head2 make_column_dirty
707
708 $row->make_column_dirty($col)
709
710=over
711
712=item Arguments: $columnname
713
714=item Returns: undefined
715
716=back
717
718Throws an exception if the column does not exist.
719
720Marks a column as having been changed regardless of whether it has
721really changed.
722
723=cut
724sub make_column_dirty {
725 my ($self, $column) = @_;
726
727 $self->throw_exception( "No such column '${column}'" )
728 unless exists $self->{_column_data}{$column} || $self->has_column($column);
729
730 # the entire clean/dirty code relies on exists, not on true/false
731 return 1 if exists $self->{_dirty_columns}{$column};
732
733 $self->{_dirty_columns}{$column} = 1;
734
735 # if we are just now making the column dirty, and if there is an inflated
736 # value, force it over the deflated one
737 if (exists $self->{_inflated_column}{$column}) {
738 $self->store_column($column,
739 $self->_deflated_column(
740 $column, $self->{_inflated_column}{$column}
741 )
742 );
743 }
744}
745
746=head2 get_inflated_columns
747
748 my %inflated_data = $obj->get_inflated_columns;
749
750=over
751
752=item Arguments: none
753
754=item Returns: A hash of column, object|value pairs
755
756=back
757
758Returns a hash of all column keys and associated values. Values for any
759columns set to use inflation will be inflated and returns as objects.
760
761See L</get_columns> to get the uninflated values.
762
763See L<DBIx::Class::InflateColumn> for how to setup inflation.
764
765=cut
766
767sub get_inflated_columns {
768 my $self = shift;
769
770 my $loaded_colinfo = $self->columns_info ([
771 grep { $self->has_column_loaded($_) } $self->columns
772 ]);
773
774 my %inflated;
775 for my $col (keys %$loaded_colinfo) {
776 if (exists $loaded_colinfo->{$col}{accessor}) {
777 my $acc = $loaded_colinfo->{$col}{accessor};
778 $inflated{$col} = $self->$acc if defined $acc;
779 }
780 else {
781 $inflated{$col} = $self->$col;
782 }
783 }
784
785 # return all loaded columns with the inflations overlayed on top
786 return %{ { $self->get_columns, %inflated } };
787}
788
789
# spent 78.3ms (9.37+68.9) within DBIx::Class::Row::_is_column_numeric which was called 698 times, avg 112µs/call: # 698 times (9.37ms+68.9ms) by DBIx::Class::Row::_eq_column_values at line 895, avg 112µs/call
sub _is_column_numeric {
79027929.69ms my ($self, $column) = @_;
79169868.6ms my $colinfo = $self->column_info ($column);
# spent 68.6ms making 698 calls to DBIx::Class::ResultSourceProxy::column_info, avg 98µs/call
792
793 # cache for speed (the object may *not* have a resultsource instance)
7946318µs if (
# spent 277µs making 3 calls to Try::Tiny::try, avg 92µs/call # spent 42µs making 3 calls to DBIx::Class::Storage::DBI::is_datatype_numeric, avg 14µs/call
795 ! defined $colinfo->{is_numeric}
796 and
797344µs994µs
# spent 152µs (57+94) within DBIx::Class::Row::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Row.pm:797] which was called 3 times, avg 51µs/call: # 3 times (57µs+94µs) by Try::Tiny::try at line 71 of Try/Tiny.pm, avg 51µs/call
my $storage = try { $self->result_source->schema->storage }
# spent 65µs making 3 calls to DBIx::Class::Schema::storage, avg 22µs/call # spent 15µs making 3 calls to DBIx::Class::ResultSource::schema, avg 5µs/call # spent 14µs making 3 calls to DBIx::Class::Row::result_source, avg 5µs/call
798 ) {
799 $colinfo->{is_numeric} =
800 $storage->is_datatype_numeric ($colinfo->{data_type})
801 ? 1
802 : 0
803 ;
804 }
805
806 return $colinfo->{is_numeric};
807}
808
809=head2 set_column
810
811 $row->set_column($col => $val);
812
813=over
814
815=item Arguments: $columnname, $value
816
817=item Returns: $value
818
819=back
820
821Sets a raw column value. If the new value is different from the old one,
822the column is marked as dirty for when you next call L</update>.
823
824If passed an object or reference as a value, this method will happily
825attempt to store it, and a later L</insert> or L</update> will try and
826stringify/numify as appropriate. To set an object to be deflated
827instead, see L</set_inflated_columns>.
828
829=cut
830
831
# spent 286ms (87.7+199) within DBIx::Class::Row::set_column which was called 1139 times, avg 251µs/call: # 441 times (42.4ms+87.4ms) by DBIx::Class::InflateColumn::set_inflated_column at line 152 of DBIx/Class/InflateColumn.pm, avg 294µs/call # 295 times (23.4ms+67.1ms) by Tapper::Schema::TestrunDB::Result::Host::free at line 2 of (eval 398)[Class/Accessor/Grouped.pm:807], avg 307µs/call # 147 times (8.22ms+11.7ms) by Tapper::Schema::TestrunDB::Result::TestrunScheduling::host_id at line 2 of (eval 304)[Class/Accessor/Grouped.pm:807], avg 135µs/call # 147 times (3.93ms+3.31ms) by Tapper::Schema::TestrunDB::Result::TestrunScheduling::prioqueue_seq at line 2 of (eval 305)[Class/Accessor/Grouped.pm:807], avg 49µs/call # 109 times (9.72ms+29.2ms) by Tapper::Schema::TestrunDB::Result::Queue::runcount at line 2 of (eval 363)[Class/Accessor/Grouped.pm:807], avg 357µs/call
sub set_column {
8322090972.5ms my ($self, $column, $new_value) = @_;
833
83411398.92ms my $had_value = $self->has_column_loaded($column);
# spent 8.92ms making 1139 calls to DBIx::Class::Row::has_column_loaded, avg 8µs/call
835227810.5ms my ($old_value, $in_storage) = ($self->get_column($column), $self->in_storage)
# spent 5.72ms making 1139 calls to DBIx::Class::Row::get_column, avg 5µs/call # spent 4.76ms making 1139 calls to DBIx::Class::Row::in_storage, avg 4µs/call
836 if $had_value;
837
83811398.99ms $new_value = $self->store_column($column, $new_value);
# spent 8.99ms making 1139 calls to DBIx::Class::Row::store_column, avg 8µs/call
839
840113989.7ms my $dirty =
# spent 89.7ms making 1139 calls to DBIx::Class::Row::_eq_column_values, avg 79µs/call
841 $self->{_dirty_columns}{$column}
842 ||
843 $in_storage # no point tracking dirtyness on uninserted data
844 ? ! $self->_eq_column_values ($column, $old_value, $new_value)
845 : 1
846 ;
847
848 if ($dirty) {
849 # FIXME sadly the update code just checks for keys, not for their value
850 $self->{_dirty_columns}{$column} = 1;
851
852 # Clear out the relation/inflation cache related to this column
853 #
854 # FIXME - this is a quick *largely incorrect* hack, pending a more
855 # serious rework during the merge of single and filter rels
8569925.42ms my $rels = $self->result_source->{_relationships};
# spent 5.42ms making 992 calls to DBIx::Class::Row::result_source, avg 5µs/call
857 for my $rel (keys %$rels) {
858
859 my $acc = $rels->{$rel}{attrs}{accessor} || '';
860
861 if ( $acc eq 'single' and $rels->{$rel}{attrs}{fk_columns}{$column} ) {
862 delete $self->{related_resultsets}{$rel};
863 delete $self->{_relationship_data}{$rel};
864 #delete $self->{_inflated_column}{$rel};
865 }
866 elsif ( $acc eq 'filter' and $rel eq $column) {
867 delete $self->{related_resultsets}{$rel};
868 #delete $self->{_relationship_data}{$rel};
869 delete $self->{_inflated_column}{$rel};
870 }
871 }
872
87399275.2ms if (
# spent 75.2ms making 992 calls to DBIx::Class::Row::_track_storage_value, avg 76µs/call
874 # value change from something (even if NULL)
875 $had_value
876 and
877 # no storage - no storage-value
878 $in_storage
879 and
880 # no value already stored (multiple changes before commit to storage)
881 ! exists $self->{_column_data_in_storage}{$column}
882 and
883 $self->_track_storage_value($column)
884 ) {
885 $self->{_column_data_in_storage}{$column} = $old_value;
886 }
887 }
888
889 return $new_value;
890}
891
892
# spent 89.7ms (11.4+78.3) within DBIx::Class::Row::_eq_column_values which was called 1139 times, avg 79µs/call: # 1139 times (11.4ms+78.3ms) by DBIx::Class::Row::set_column at line 840, avg 79µs/call
sub _eq_column_values {
893257212.1ms my ($self, $col, $old, $new) = @_;
894
89569878.3ms if (defined $old xor defined $new) {
# spent 78.3ms making 698 calls to DBIx::Class::Row::_is_column_numeric, avg 112µs/call
896 return 0;
897 }
898 elsif (not defined $old) { # both undef
899 return 1;
900 }
901 elsif ($old eq $new) {
902 return 1;
903 }
904 elsif ($self->_is_column_numeric($col)) { # do a numeric comparison if datatype allows it
905 return $old == $new;
906 }
907 else {
908 return 0;
909 }
910}
911
912# returns a boolean indicating if the passed column should have its original
913# value tracked between column changes and commitment to storage
914
# spent 75.2ms (17.8+57.4) within DBIx::Class::Row::_track_storage_value which was called 992 times, avg 76µs/call: # 992 times (17.8ms+57.4ms) by DBIx::Class::Row::set_column at line 873, avg 76µs/call
sub _track_storage_value {
915198412.9ms my ($self, $col) = @_;
91699211.0ms198457.4ms return defined first { $col eq $_ } ($self->primary_columns);
# spent 51.8ms making 992 calls to DBIx::Class::ResultSourceProxy::primary_columns, avg 52µs/call # spent 5.65ms making 992 calls to List::Util::first, avg 6µs/call
917}
918
919=head2 set_columns
920
921 $row->set_columns({ $col => $val, ... });
922
923=over
924
925=item Arguments: \%columndata
926
927=item Returns: The Row object
928
929=back
930
931Sets multiple column, raw value pairs at once.
932
933Works as L</set_column>.
934
935=cut
936
937sub set_columns {
938 my ($self,$data) = @_;
939 foreach my $col (keys %$data) {
940 $self->set_column($col,$data->{$col});
941 }
942 return $self;
943}
944
945=head2 set_inflated_columns
946
947 $row->set_inflated_columns({ $col => $val, $relname => $obj, ... });
948
949=over
950
951=item Arguments: \%columndata
952
953=item Returns: The Row object
954
955=back
956
957Sets more than one column value at once. Any inflated values are
958deflated and the raw values stored.
959
960Any related values passed as Row objects, using the relation name as a
961key, are reduced to the appropriate foreign key values and stored. If
962instead of related row objects, a hashref of column, value data is
963passed, will create the related object first then store.
964
965Will even accept arrayrefs of data as a value to a
966L<DBIx::Class::Relationship/has_many> key, and create the related
967objects if necessary.
968
969Be aware that the input hashref might be edited in place, so don't rely
970on it being the same after a call to C<set_inflated_columns>. If you
971need to preserve the hashref, it is sufficient to pass a shallow copy
972to C<set_inflated_columns>, e.g. ( { %{ $href } } )
973
974See also L<DBIx::Class::Relationship::Base/set_from_related>.
975
976=cut
977
978sub set_inflated_columns {
979 my ( $self, $upd ) = @_;
980 foreach my $key (keys %$upd) {
981 if (ref $upd->{$key}) {
982 my $info = $self->relationship_info($key);
983 my $acc_type = $info->{attrs}{accessor} || '';
984 if ($acc_type eq 'single') {
985 my $rel = delete $upd->{$key};
986 $self->set_from_related($key => $rel);
987 $self->{_relationship_data}{$key} = $rel;
988 }
989 elsif ($acc_type eq 'multi') {
990 $self->throw_exception(
991 "Recursive update is not supported over relationships of type '$acc_type' ($key)"
992 );
993 }
994 elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
995 $self->set_inflated_column($key, delete $upd->{$key});
996 }
997 }
998 }
999 $self->set_columns($upd);
1000}
1001
1002=head2 copy
1003
1004 my $copy = $orig->copy({ change => $to, ... });
1005
1006=over
1007
1008=item Arguments: \%replacementdata
1009
1010=item Returns: The Row object copy
1011
1012=back
1013
1014Inserts a new row into the database, as a copy of the original
1015object. If a hashref of replacement data is supplied, these will take
1016precedence over data in the original. Also any columns which have
1017the L<column info attribute|DBIx::Class::ResultSource/add_columns>
1018C<< is_auto_increment => 1 >> are explicitly removed before the copy,
1019so that the database can insert its own autoincremented values into
1020the new object.
1021
1022Relationships will be followed by the copy procedure B<only> if the
1023relationship specifies a true value for its
1024L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
1025is set by default on C<has_many> relationships and unset on all others.
1026
1027=cut
1028
1029sub copy {
1030 my ($self, $changes) = @_;
1031 $changes ||= {};
1032 my $col_data = { %{$self->{_column_data}} };
1033
1034 my $colinfo = $self->columns_info([ keys %$col_data ]);
1035 foreach my $col (keys %$col_data) {
1036 delete $col_data->{$col}
1037 if $colinfo->{$col}{is_auto_increment};
1038 }
1039
1040 my $new = { _column_data => $col_data };
1041 bless $new, ref $self;
1042
1043 $new->result_source($self->result_source);
1044 $new->set_inflated_columns($changes);
1045 $new->insert;
1046
1047 # Its possible we'll have 2 relations to the same Source. We need to make
1048 # sure we don't try to insert the same row twice else we'll violate unique
1049 # constraints
1050 my $rels_copied = {};
1051
1052 foreach my $rel ($self->result_source->relationships) {
1053 my $rel_info = $self->result_source->relationship_info($rel);
1054
1055 next unless $rel_info->{attrs}{cascade_copy};
1056
1057 my $resolved = $self->result_source->_resolve_condition(
1058 $rel_info->{cond}, $rel, $new, $rel
1059 );
1060
1061 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
1062 foreach my $related ($self->search_related($rel)) {
1063 my $id_str = join("\0", $related->id);
1064 next if $copied->{$id_str};
1065 $copied->{$id_str} = 1;
1066 my $rel_copy = $related->copy($resolved);
1067 }
1068
1069 }
1070 return $new;
1071}
1072
1073=head2 store_column
1074
1075 $row->store_column($col => $val);
1076
1077=over
1078
1079=item Arguments: $columnname, $value
1080
1081=item Returns: The value sent to storage
1082
1083=back
1084
1085Set a raw value for a column without marking it as changed. This
1086method is used internally by L</set_column> which you should probably
1087be using.
1088
1089This is the lowest level at which data is set on a row object,
1090extend this method to catch all data setting methods.
1091
1092=cut
1093
1094
# spent 137ms (36.0+101) within DBIx::Class::Row::store_column which was called 3387 times, avg 40µs/call: # 1805 times (20.4ms+71.9ms) by DBIx::Class::Row::new at line 248, avg 51µs/call # 1139 times (8.99ms+0s) by DBIx::Class::Row::set_column at line 838, avg 8µs/call # 296 times (5.23ms+24.8ms) by DBIx::Class::Row::insert at line 356, avg 102µs/call # 147 times (1.42ms+3.94ms) by DBIx::Class::Row::get_columns at line 674, avg 36µs/call
sub store_column {
10951354836.7ms my ($self, $column, $value) = @_;
10962248101ms $self->throw_exception( "No such column '${column}'" )
# spent 101ms making 2248 calls to DBIx::Class::ResultSourceProxy::has_column, avg 45µs/call
1097 unless exists $self->{_column_data}{$column} || $self->has_column($column);
1098 $self->throw_exception( "set_column called for ${column} without value" )
1099 if @_ < 3;
1100 return $self->{_column_data}{$column} = $value;
1101}
1102
1103=head2 inflate_result
1104
1105 Class->inflate_result($result_source, \%me, \%prefetch?)
1106
1107=over
1108
1109=item Arguments: $result_source, \%columndata, \%prefetcheddata
1110
1111=item Returns: A Row object
1112
1113=back
1114
1115All L<DBIx::Class::ResultSet> methods that retrieve data from the
1116database and turn it into row objects call this method.
1117
1118Extend this method in your Result classes to hook into this process,
1119for example to rebless the result into a different class.
1120
1121Reblessing can also be done more easily by setting C<result_class> in
1122your Result class. See L<DBIx::Class::ResultSource/result_class>.
1123
1124Different types of results can also be created from a particular
1125L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1126
1127=cut
1128
1129
# spent 148ms (104+44.5) within DBIx::Class::Row::inflate_result which was called 4717 times, avg 31µs/call: # 4717 times (104ms+44.5ms) by DBIx::Class::ResultSet::_construct_object at line 1223 of DBIx/Class/ResultSet.pm, avg 31µs/call
sub inflate_result {
113028302122ms my ($class, $source, $me, $prefetch) = @_;
1131
1132471724.7ms $source = $source->resolve
# spent 24.7ms making 4717 calls to UNIVERSAL::isa, avg 5µs/call
1133 if $source->isa('DBIx::Class::ResultSourceHandle');
1134
1135 my $new = bless
1136 { _column_data => $me, _result_source => $source },
1137 ref $class || $class
1138 ;
1139
1140 foreach my $pre (keys %{$prefetch||{}}) {
1141
1142 my (@pre_vals, $is_multi);
1143 if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
1144 $is_multi = 1;
1145 @pre_vals = @{$prefetch->{$pre}};
1146 }
1147 else {
1148 @pre_vals = $prefetch->{$pre};
1149 }
1150
1151 my $pre_source = try {
1152 $source->related_source($pre)
1153 }
1154 catch {
1155 $class->throw_exception(sprintf
1156
1157 "Can't inflate manual prefetch into non-existent relationship '%s' from '%s', "
1158 . "check the inflation specification (columns/as) ending in '%s.%s'.",
1159
1160 $pre,
1161 $source->source_name,
1162 $pre,
1163 (keys %{$pre_vals[0][0]})[0] || 'something.something...',
1164 );
1165 };
1166
1167 my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
1168 or $class->throw_exception("No accessor type declared for prefetched $pre");
1169
1170 if (! $is_multi and $accessor eq 'multi') {
1171 $class->throw_exception("Manual prefetch (via select/columns) not supported with accessor 'multi'");
1172 }
1173
1174 my @pre_objects;
1175 for my $me_pref (@pre_vals) {
1176
1177 # FIXME - this should not be necessary
1178 # the collapser currently *could* return bogus elements with all
1179 # columns set to undef
1180 my $has_def;
1181 for (values %{$me_pref->[0]}) {
1182 if (defined $_) {
1183 $has_def++;
1184 last;
1185 }
1186 }
1187 next unless $has_def;
1188
1189 push @pre_objects, $pre_source->result_class->inflate_result(
1190 $pre_source, @$me_pref
1191 );
1192 }
1193
1194 if ($accessor eq 'single') {
1195 $new->{_relationship_data}{$pre} = $pre_objects[0];
1196 }
1197 elsif ($accessor eq 'filter') {
1198 $new->{_inflated_column}{$pre} = $pre_objects[0];
1199 }
1200
1201 $new->related_resultset($pre)->set_cache(\@pre_objects);
1202 }
1203
1204471719.8ms $new->in_storage (1);
# spent 19.8ms making 4717 calls to DBIx::Class::Row::in_storage, avg 4µs/call
1205 return $new;
1206}
1207
1208=head2 update_or_insert
1209
1210 $row->update_or_insert
1211
1212=over
1213
1214=item Arguments: none
1215
1216=item Returns: Result of update or insert operation
1217
1218=back
1219
1220L</Update>s the object if it's already in the database, according to
1221L</in_storage>, else L</insert>s it.
1222
1223=head2 insert_or_update
1224
1225 $obj->insert_or_update
1226
1227Alias for L</update_or_insert>
1228
1229=cut
1230
1231sub insert_or_update { shift->update_or_insert(@_) }
1232
1233sub update_or_insert {
1234 my $self = shift;
1235 return ($self->in_storage ? $self->update : $self->insert);
1236}
1237
1238=head2 is_changed
1239
1240 my @changed_col_names = $row->is_changed();
1241 if ($row->is_changed()) { ... }
1242
1243=over
1244
1245=item Arguments: none
1246
1247=item Returns: 0|1 or @columnnames
1248
1249=back
1250
1251In list context returns a list of columns with uncommited changes, or
1252in scalar context returns a true value if there are uncommitted
1253changes.
1254
1255=cut
1256
1257sub is_changed {
1258 return keys %{shift->{_dirty_columns} || {}};
1259}
1260
1261=head2 is_column_changed
1262
1263 if ($row->is_column_changed('col')) { ... }
1264
1265=over
1266
1267=item Arguments: $columname
1268
1269=item Returns: 0|1
1270
1271=back
1272
1273Returns a true value if the column has uncommitted changes.
1274
1275=cut
1276
1277sub is_column_changed {
1278 my( $self, $col ) = @_;
1279 return exists $self->{_dirty_columns}->{$col};
1280}
1281
1282=head2 result_source
1283
1284 my $resultsource = $row->result_source;
1285
1286=over
1287
1288=item Arguments: $result_source_instance
1289
1290=item Returns: a ResultSource instance
1291
1292=back
1293
1294Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1295
1296=cut
1297
1298
# spent 47.1ms within DBIx::Class::Row::result_source which was called 13894 times, avg 3µs/call: # 3531 times (10.7ms+0s) by DBIx::Class::Relationship::Base::related_resultset at line 416 of DBIx/Class/Relationship/Base.pm, avg 3µs/call # 3531 times (6.48ms+0s) by DBIx::Class::Relationship::Base::related_resultset at line 493 of DBIx/Class/Relationship/Base.pm, avg 2µs/call # 1690 times (5.36ms+0s) by DBIx::Class::Row::update at line 503, avg 3µs/call # 1654 times (7.28ms+0s) by Tapper::Schema::TestrunDB::Result::QueueHost::queue or Tapper::Schema::TestrunDB::Result::Testrun::scenario_element or Tapper::Schema::TestrunDB::Result::TestrunScheduling::host or Tapper::Schema::TestrunDB::Result::TestrunScheduling::queue or Tapper::Schema::TestrunDB::Result::TestrunScheduling::testrun at line 34 of DBIx/Class/Relationship/Accessor.pm, avg 4µs/call # 992 times (5.42ms+0s) by DBIx::Class::Row::set_column at line 856, avg 5µs/call # 877 times (3.66ms+0s) by DBIx::Class::Relationship::CascadeActions::update at line 50 of DBIx/Class/Relationship/CascadeActions.pm, avg 4µs/call # 449 times (2.00ms+0s) by DBIx::Class::Row::new at line 174, avg 4µs/call # 449 times (1.56ms+0s) by DBIx::Class::Row::insert at line 285, avg 3µs/call # 147 times (2.08ms+0s) by Tapper::Schema::TestrunDB::Result::Testrun::rerun at line 151 of Tapper/Schema/TestrunDB/Result/Testrun.pm, avg 14µs/call # 147 times (566µs+0s) by Tapper::Schema::TestrunDB::Result::Testrun::rerun at line 122 of Tapper/Schema/TestrunDB/Result/Testrun.pm, avg 4µs/call # 147 times (288µs+0s) by Tapper::Schema::TestrunDB::Result::Testrun::rerun at line 132 of Tapper/Schema/TestrunDB/Result/Testrun.pm, avg 2µs/call # 147 times (262µs+0s) by DBIx::Class::InflateColumn::DateTime::_datetime_parser at line 221 of DBIx/Class/InflateColumn/DateTime.pm, avg 2µs/call # 129 times (1.38ms+0s) by Tapper::Schema::TestrunDB::Result::Testrun::assign_preconditions at line 193 of Tapper/Schema/TestrunDB/Result/Testrun.pm, avg 11µs/call # 3 times (14µs+0s) by DBIx::Class::Row::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Row.pm:797] at line 797, avg 5µs/call # once (4µs+0s) by Tapper::Schema::TestrunDB::Result::TestrunScheduling::gen_schema_functions at line 93 of Tapper/Schema/TestrunDB/Result/TestrunScheduling.pm
sub result_source {
12992778870.8ms $_[0]->throw_exception( 'result_source can be called on instances only' )
1300 unless ref $_[0];
1301
1302 @_ > 1
1303 ? $_[0]->{_result_source} = $_[1]
1304
1305 # note this is a || not a ||=, the difference is important
1306 : $_[0]->{_result_source} || do {
1307 my $class = ref $_[0];
1308 $_[0]->can('result_source_instance')
1309 ? $_[0]->result_source_instance
1310 : $_[0]->throw_exception(
1311 "No result source instance registered for $class, did you forget to call $class->table(...) ?"
1312 )
1313 }
1314 ;
1315}
1316
1317=head2 register_column
1318
1319 $column_info = { .... };
1320 $class->register_column($column_name, $column_info);
1321
1322=over
1323
1324=item Arguments: $columnname, \%columninfo
1325
1326=item Returns: undefined
1327
1328=back
1329
1330Registers a column on the class. If the column_info has an 'accessor'
1331key, creates an accessor named after the value if defined; if there is
1332no such key, creates an accessor with the same name as the column
1333
1334The column_info attributes are described in
1335L<DBIx::Class::ResultSource/add_columns>
1336
1337=cut
1338
1339
# spent 27.2ms (1.02+26.1) within DBIx::Class::Row::register_column which was called 250 times, avg 109µs/call: # 134 times (534µs+13.1ms) by DBIx::Class::InflateColumn::DateTime::register_column or DBIx::Class::InflateColumn::Object::Enum::register_column at line 28 of mro.pm, avg 102µs/call # 116 times (487µs+13.0ms) by DBIx::Class::ResultSourceProxy::add_columns at line 34 of DBIx/Class/ResultSourceProxy.pm, avg 116µs/call
sub register_column {
134010001.01ms my ($class, $col, $info) = @_;
1341 my $acc = $col;
1342 if (exists $info->{accessor}) {
1343 return unless defined $info->{accessor};
1344 $acc = [ $info->{accessor}, $col ];
1345 }
134625026.1ms $class->mk_group_accessors('column' => $acc);
# spent 26.1ms making 250 calls to Class::Accessor::Grouped::mk_group_accessors, avg 105µs/call
1347}
1348
1349=head2 get_from_storage
1350
1351 my $copy = $row->get_from_storage($attrs)
1352
1353=over
1354
1355=item Arguments: \%attrs
1356
1357=item Returns: A Row object
1358
1359=back
1360
1361Fetches a fresh copy of the Row object from the database and returns it.
1362Throws an exception if a proper WHERE clause identifying the database row
1363can not be constructed (i.e. if the original object does not contain its
1364entire
1365 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
1366). If passed the \%attrs argument, will first apply these attributes to
1367the resultset used to find the row.
1368
1369This copy can then be used to compare to an existing row object, to
1370determine if any changes have been made in the database since it was
1371created.
1372
1373To just update your Row object with any latest changes from the
1374database, use L</discard_changes> instead.
1375
1376The \%attrs argument should be compatible with
1377L<DBIx::Class::ResultSet/ATTRIBUTES>.
1378
1379=cut
1380
1381sub get_from_storage {
1382 my $self = shift @_;
1383 my $attrs = shift @_;
1384 my $resultset = $self->result_source->resultset;
1385
1386 if(defined $attrs) {
1387 $resultset = $resultset->search(undef, $attrs);
1388 }
1389
1390 return $resultset->find($self->_storage_ident_condition);
1391}
1392
1393=head2 discard_changes ($attrs?)
1394
1395 $row->discard_changes
1396
1397=over
1398
1399=item Arguments: none or $attrs
1400
1401=item Returns: self (updates object in-place)
1402
1403=back
1404
1405Re-selects the row from the database, losing any changes that had
1406been made. Throws an exception if a proper C<WHERE> clause identifying
1407the database row can not be constructed (i.e. if the original object
1408does not contain its entire
1409L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>).
1410
1411This method can also be used to refresh from storage, retrieving any
1412changes made since the row was last read from storage.
1413
1414$attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the
1415second argument to C<< $resultset->search($cond, $attrs) >>;
1416
1417Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1418storage, please kept in mind that if you L</discard_changes> on a row that you
1419just updated or created, you should wrap the entire bit inside a transaction.
1420Otherwise you run the risk that you insert or update to the master database
1421but read from a replicant database that has not yet been updated from the
1422master. This will result in unexpected results.
1423
1424=cut
1425
1426sub discard_changes {
1427 my ($self, $attrs) = @_;
1428 return unless $self->in_storage; # Don't reload if we aren't real!
1429
1430 # add a replication default to read from the master only
1431 $attrs = { force_pool => 'master', %{$attrs||{}} };
1432
1433 if( my $current_storage = $self->get_from_storage($attrs)) {
1434
1435 # Set $self to the current.
1436 %$self = %$current_storage;
1437
1438 # Avoid a possible infinite loop with
1439 # sub DESTROY { $_[0]->discard_changes }
1440 bless $current_storage, 'Do::Not::Exist';
1441
1442 return $self;
1443 }
1444 else {
1445 $self->in_storage(0);
1446 return $self;
1447 }
1448}
1449
1450
1451=head2 throw_exception
1452
1453See L<DBIx::Class::Schema/throw_exception>.
1454
1455=cut
1456
1457sub throw_exception {
1458 my $self=shift;
1459
1460 if (ref $self && ref $self->result_source ) {
1461 $self->result_source->throw_exception(@_)
1462 }
1463 else {
1464 DBIx::Class::Exception->throw(@_);
1465 }
1466}
1467
1468=head2 id
1469
1470 my @pk = $row->id;
1471
1472=over
1473
1474=item Arguments: none
1475
1476=item Returns: A list of primary key values
1477
1478=back
1479
1480Returns the primary key(s) for a row. Can't be called as a class method.
1481Actually implemented in L<DBIx::Class::PK>
1482
1483=head1 AUTHORS
1484
1485Matt S. Trout <mst@shadowcatsystems.co.uk>
1486
1487=head1 LICENSE
1488
1489You may distribute this code under the same terms as Perl itself.
1490
1491=cut
1492
1493124µs1409µs1;