← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:47 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/ResultSet.pm
Statements Executed4272127
Total Time12.4746949999571 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
55476117.386327.38632DBIx::Class::ResultSet::_collapse_result
55476111.2891618.15234DBIx::Class::ResultSet::_construct_object
55477221.28712203.87491DBIx::Class::ResultSet::next
55480310.781521.08246DBIx::Class::ResultSet::cursor
55535620.488024.75453DBIx::Class::ResultSet::result_source
55482210.299960.30038DBIx::Class::ResultSet::_resolved_attrs
55479210.238540.23854DBIx::Class::ResultSet::get_cache
6320.000460.00171DBIx::Class::ResultSet::new
2110.00025382.60646DBIx::Class::ResultSet::_count
2218.2e-5382.60656DBIx::Class::ResultSet::count
1115.1e-50.00031DBIx::Class::ResultSet::search_rs
1111.6e-50.00055DBIx::Class::ResultSet::reset
1111.2e-50.02601DBIx::Class::ResultSet::first
1111.0e-50.00032DBIx::Class::ResultSet::search
00000DBIx::Class::ResultSet::BEGIN
00000DBIx::Class::ResultSet::__ANON__[:186]
00000DBIx::Class::ResultSet::__ANON__[:7]
00000DBIx::Class::ResultSet::_add_alias
00000DBIx::Class::ResultSet::_build_unique_query
00000DBIx::Class::ResultSet::_calculate_score
00000DBIx::Class::ResultSet::_collapse_cond
00000DBIx::Class::ResultSet::_collapse_query
00000DBIx::Class::ResultSet::_cond_for_update_delete
00000DBIx::Class::ResultSet::_is_unique_query
00000DBIx::Class::ResultSet::_merge_attr
00000DBIx::Class::ResultSet::_remove_alias
00000DBIx::Class::ResultSet::_resolve_from
00000DBIx::Class::ResultSet::_rollout_array
00000DBIx::Class::ResultSet::_rollout_attr
00000DBIx::Class::ResultSet::_rollout_hash
00000DBIx::Class::ResultSet::_unique_queries
00000DBIx::Class::ResultSet::all
00000DBIx::Class::ResultSet::clear_cache
00000DBIx::Class::ResultSet::count_literal
00000DBIx::Class::ResultSet::create
00000DBIx::Class::ResultSet::delete
00000DBIx::Class::ResultSet::delete_all
00000DBIx::Class::ResultSet::find
00000DBIx::Class::ResultSet::find_or_create
00000DBIx::Class::ResultSet::find_or_new
00000DBIx::Class::ResultSet::get_column
00000DBIx::Class::ResultSet::new_result
00000DBIx::Class::ResultSet::page
00000DBIx::Class::ResultSet::pager
00000DBIx::Class::ResultSet::populate
00000DBIx::Class::ResultSet::related_resultset
00000DBIx::Class::ResultSet::search_like
00000DBIx::Class::ResultSet::search_literal
00000DBIx::Class::ResultSet::search_related
00000DBIx::Class::ResultSet::set_cache
00000DBIx::Class::ResultSet::single
00000DBIx::Class::ResultSet::slice
00000DBIx::Class::ResultSet::throw_exception
00000DBIx::Class::ResultSet::update
00000DBIx::Class::ResultSet::update_all
00000DBIx::Class::ResultSet::update_or_create

LineStmts.Exclusive
Time
Avg.Code
1package DBIx::Class::ResultSet;
2
333.5e-51.2e-5use strict;
# spent 10µs making 1 call to strict::import
437.0e-52.3e-5use warnings;
# spent 30µs making 1 call to warnings::import
5use overload
6 '0+' => \&count,
7 'bool' => sub { 1; },
835.2e-51.7e-5 fallback => 1;
# spent 77µs making 1 call to overload::import
933.2e-51.1e-5use Carp::Clan qw/^DBIx::Class/;
# spent 101µs making 1 call to Carp::Clan::import
1030.000600.00020use Data::Page;
# spent 4µs making 1 call to import
1130.000289.2e-5use Storable;
# spent 68µs making 1 call to Exporter::import
1230.000720.00024use DBIx::Class::ResultSetColumn;
# spent 4µs making 1 call to import
1330.000620.00021use DBIx::Class::ResultSourceHandle;
# spent 4µs making 1 call to import
1432.2e-57.3e-6use List::Util ();
1530.007260.00242use base qw/DBIx::Class/;
# spent 83µs making 1 call to base::import, max recursion depth 1
16
1711.9e-51.9e-5__PACKAGE__->mk_group_accessors('simple' => qw/result_class _source_handle/);
# spent 253µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
18
19=head1 NAME
20
21DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
22
23=head1 SYNOPSIS
24
25 my $rs = $schema->resultset('User')->search(registered => 1);
26 my @rows = $schema->resultset('CD')->search(year => 2005);
27
28=head1 DESCRIPTION
29
30The resultset is also known as an iterator. It is responsible for handling
31queries that may return an arbitrary number of rows, e.g. via L</search>
32or a C<has_many> relationship.
33
34In the examples below, the following table classes are used:
35
36 package MyApp::Schema::Artist;
37 use base qw/DBIx::Class/;
38 __PACKAGE__->load_components(qw/Core/);
39 __PACKAGE__->table('artist');
40 __PACKAGE__->add_columns(qw/artistid name/);
41 __PACKAGE__->set_primary_key('artistid');
42 __PACKAGE__->has_many(cds => 'MyApp::Schema::CD');
43 1;
44
45 package MyApp::Schema::CD;
46 use base qw/DBIx::Class/;
47 __PACKAGE__->load_components(qw/Core/);
48 __PACKAGE__->table('cd');
49 __PACKAGE__->add_columns(qw/cdid artist title year/);
50 __PACKAGE__->set_primary_key('cdid');
51 __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
52 1;
53
54=head1 METHODS
55
56=head2 new
57
58=over 4
59
60=item Arguments: $source, \%$attrs
61
62=item Return Value: $rs
63
64=back
65
66The resultset constructor. Takes a source object (usually a
67L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
68L</ATTRIBUTES> below). Does not perform any queries -- these are
69executed as needed by the other methods.
70
71Generally you won't need to construct a resultset manually. You'll
72automatically get one from e.g. a L</search> called in scalar context:
73
74 my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
75
76IMPORTANT: If called on an object, proxies to new_result instead so
77
78 my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
79
80will return a CD object, not a ResultSet.
81
82=cut
83
84
# spent 1.71ms (457µs+1.26) within DBIx::Class::ResultSet::new which was called 6 times, avg 286µs/call: # 3 times (360µs+816µs) by DBIx::Class::ResultSource::resultset at line 1008 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/ResultSource.pm, avg 392µs/call # 2 times (72µs+310µs) by DBIx::Class::ResultSet::_count at line 994, avg 191µs/call # once (25µs+130µs) by DBIx::Class::ResultSet::search_rs at line 257
sub new {
8561.9e-53.2e-6 my $class = shift;
8665.0e-68.3e-7 return $class->new_result(@_) if ref $class;
87
8861.1e-51.8e-6 my ($source, $attrs) = @_;
8960.000122.1e-5 $source = $source->handle
# spent 537µs making 6 calls to DBIx::Class::ResultSource::handle, avg 90µs/call # spent 72µs making 6 calls to UNIVERSAL::isa, avg 12µs/call
90 unless $source->isa('DBIx::Class::ResultSourceHandle');
9163.0e-55.0e-6 $attrs = { %{$attrs||{}} };
92
9364.0e-66.7e-7 if ($attrs->{page}) {
94 $attrs->{rows} ||= 10;
95 }
96
9767.0e-61.2e-6 $attrs->{alias} ||= 'me';
98
99 # Creation of {} and bless separated to mitigate RH perl bug
100 # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
10160.000111.8e-5 my $self = {
102 _source_handle => $source,
103 result_class => $attrs->{result_class} || $source->resolve->result_class,
104 cond => $attrs->{where},
105 count => undef,
106 pager => undef,
107 attrs => $attrs
108 };
109
11060.000254.2e-5 bless $self, $class;
111
11261.0e-51.7e-6 return $self;
113}
114
115=head2 search
116
117=over 4
118
119=item Arguments: $cond, \%attrs?
120
121=item Return Value: $resultset (scalar context), @row_objs (list context)
122
123=back
124
125 my @cds = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
126 my $new_rs = $cd_rs->search({ year => 2005 });
127
128 my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
129 # year = 2005 OR year = 2004
130
131If you need to pass in additional attributes but no additional condition,
132call it as C<search(undef, \%attrs)>.
133
134 # "SELECT name, artistid FROM $artist_table"
135 my @all_artists = $schema->resultset('Artist')->search(undef, {
136 columns => [qw/name artistid/],
137 });
138
139For a list of attributes that can be passed to C<search>, see
140L</ATTRIBUTES>. For more examples of using this function, see
141L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
142documentation for the first argument, see L<SQL::Abstract>.
143
144For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
145
146=cut
147
148
# spent 319µs (10+309) within DBIx::Class::ResultSet::search which was called # once (10µs+309µs) by WISE::DB::FrameIndex::search at line 488 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex.pm
sub search {
14911.0e-61.0e-6 my $self = shift;
15017.0e-67.0e-6 my $rs = $self->search_rs( @_ );
# spent 309µs making 1 call to DBIx::Class::ResultSet::search_rs
15111.0e-61.0e-6 return (wantarray ? $rs->all : $rs);
152}
153
154=head2 search_rs
155
156=over 4
157
158=item Arguments: $cond, \%attrs?
159
160=item Return Value: $resultset
161
162=back
163
164This method does the same exact thing as search() except it will
165always return a resultset, even in list context.
166
167=cut
168
169
# spent 309µs (51+258) within DBIx::Class::ResultSet::search_rs which was called # once (51µs+258µs) by DBIx::Class::ResultSet::search at line 150
sub search_rs {
17011.0e-61.0e-6 my $self = shift;
171
17211.0e-61.0e-6 my $attrs = {};
17316.0e-66.0e-6 $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
17414.0e-64.0e-6 my $our_attrs = { %{$self->{attrs}} };
17511.0e-61.0e-6 my $having = delete $our_attrs->{having};
176100 my $where = delete $our_attrs->{where};
177
178100 my $rows;
179
18013.0e-63.0e-6 my %safe = (alias => 1, cache => 1);
181
18211.0e-61.0e-6 unless (
183 (@_ && defined($_[0])) # @_ == () or (undef)
184 ||
185 (keys %$attrs # empty attrs or only 'safe' attrs
186 && List::Util::first { !$safe{$_} } keys %$attrs)
187 ) {
188 # no search, effectively just a clone
189 $rows = $self->get_cache;
190 }
191
19215.0e-65.0e-6 my $new_attrs = { %{$our_attrs}, %{$attrs} };
193
194 # merge new attrs into inherited
19513.0e-63.0e-6 foreach my $key (qw/join prefetch/) {
19623.0e-61.5e-6 next unless exists $attrs->{$key};
197 $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
198 }
199
200 my $cond = (@_
201 ? (
202 (@_ == 1 || ref $_[0] eq "HASH")
203 ? (
204 (ref $_[0] eq 'HASH')
205 ? (
20614.0e-64.0e-6 (keys %{ $_[0] } > 0)
207 ? shift
208 : undef
209 )
210 : shift
211 )
212 : (
213 (@_ % 2)
214 ? $self->throw_exception("Odd number of arguments to search")
215 : {@_}
216 )
217 )
218 : undef
219 );
220
22111.0e-61.0e-6 if (defined $where) {
222 $new_attrs->{where} = (
223 defined $new_attrs->{where}
224 ? { '-and' => [
225 map {
226 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
227 } $where, $new_attrs->{where}
228 ]
229 }
230 : $where);
231 }
232
23312.0e-62.0e-6 if (defined $cond) {
234 $new_attrs->{where} = (
235 defined $new_attrs->{where}
236 ? { '-and' => [
237 map {
238 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
239 } $cond, $new_attrs->{where}
240 ]
241 }
242 : $cond);
243 }
244
24511.0e-61.0e-6 if (defined $having) {
246 $new_attrs->{having} = (
247 defined $new_attrs->{having}
248 ? { '-and' => [
249 map {
250 ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
251 } $having, $new_attrs->{having}
252 ]
253 }
254 : $having);
255 }
256
25711.5e-51.5e-5 my $rs = (ref $self)->new($self->result_source, $new_attrs);
# spent 155µs making 1 call to DBIx::Class::ResultSet::new # spent 103µs making 1 call to DBIx::Class::ResultSet::result_source
25811.0e-61.0e-6 if ($rows) {
259 $rs->set_cache($rows);
260 }
26114.0e-64.0e-6 return $rs;
262}
263
264=head2 search_literal
265
266=over 4
267
268=item Arguments: $sql_fragment, @bind_values
269
270=item Return Value: $resultset (scalar context), @row_objs (list context)
271
272=back
273
274 my @cds = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
275 my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
276
277Pass a literal chunk of SQL to be added to the conditional part of the
278resultset query.
279
280CAVEAT: C<search_literal> is provided for Class::DBI compatibility and should
281only be used in that context. There are known problems using C<search_literal>
282in chained queries; it can result in bind values in the wrong order. See
283L<DBIx::Class::Manual::Cookbook/Searching> and
284L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
285require C<search_literal>.
286
287=cut
288
289sub search_literal {
290 my ($self, $cond, @vals) = @_;
291 my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
292 $attrs->{bind} = [ @{$self->{attrs}{bind}||[]}, @vals ];
293 return $self->search(\$cond, $attrs);
294}
295
296=head2 find
297
298=over 4
299
300=item Arguments: @values | \%cols, \%attrs?
301
302=item Return Value: $row_object
303
304=back
305
306Finds a row based on its primary key or unique constraint. For example, to find
307a row by its primary key:
308
309 my $cd = $schema->resultset('CD')->find(5);
310
311You can also find a row by a specific unique constraint using the C<key>
312attribute. For example:
313
314 my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', {
315 key => 'cd_artist_title'
316 });
317
318Additionally, you can specify the columns explicitly by name:
319
320 my $cd = $schema->resultset('CD')->find(
321 {
322 artist => 'Massive Attack',
323 title => 'Mezzanine',
324 },
325 { key => 'cd_artist_title' }
326 );
327
328If the C<key> is specified as C<primary>, it searches only on the primary key.
329
330If no C<key> is specified, it searches on all unique constraints defined on the
331source, including the primary key.
332
333If your table does not have a primary key, you B<must> provide a value for the
334C<key> attribute matching one of the unique constraints on the source.
335
336See also L</find_or_create> and L</update_or_create>. For information on how to
337declare unique constraints, see
338L<DBIx::Class::ResultSource/add_unique_constraint>.
339
340=cut
341
342sub find {
343 my $self = shift;
344 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
345
346 # Default to the primary key, but allow a specific key
347 my @cols = exists $attrs->{key}
348 ? $self->result_source->unique_constraint_columns($attrs->{key})
349 : $self->result_source->primary_columns;
350 $self->throw_exception(
351 "Can't find unless a primary key is defined or unique constraint is specified"
352 ) unless @cols;
353
354 # Parse out a hashref from input
355 my $input_query;
356 if (ref $_[0] eq 'HASH') {
357 $input_query = { %{$_[0]} };
358 }
359 elsif (@_ == @cols) {
360 $input_query = {};
361 @{$input_query}{@cols} = @_;
362 }
363 else {
364 # Compatibility: Allow e.g. find(id => $value)
365 carp "Find by key => value deprecated; please use a hashref instead";
366 $input_query = {@_};
367 }
368
369 my (%related, $info);
370
371 KEY: foreach my $key (keys %$input_query) {
372 if (ref($input_query->{$key})
373 && ($info = $self->result_source->relationship_info($key))) {
374 my $val = delete $input_query->{$key};
375 next KEY if (ref($val) eq 'ARRAY'); # has_many for multi_create
376 my $rel_q = $self->result_source->resolve_condition(
377 $info->{cond}, $val, $key
378 );
379 die "Can't handle OR join condition in find" if ref($rel_q) eq 'ARRAY';
380 @related{keys %$rel_q} = values %$rel_q;
381 }
382 }
383 if (my @keys = keys %related) {
384 @{$input_query}{@keys} = values %related;
385 }
386
387 my @unique_queries = $self->_unique_queries($input_query, $attrs);
388
389 # Build the final query: Default to the disjunction of the unique queries,
390 # but allow the input query in case the ResultSet defines the query or the
391 # user is abusing find
392 my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
393 my $query = @unique_queries
394 ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
395 : $self->_add_alias($input_query, $alias);
396
397 # Run the query
398 if (keys %$attrs) {
399 my $rs = $self->search($query, $attrs);
400 return keys %{$rs->_resolved_attrs->{collapse}} ? $rs->next : $rs->single;
401 }
402 else {
403 return keys %{$self->_resolved_attrs->{collapse}}
404 ? $self->search($query)->next
405 : $self->single($query);
406 }
407}
408
409# _add_alias
410#
411# Add the specified alias to the specified query hash. A copy is made so the
412# original query is not modified.
413
414sub _add_alias {
415 my ($self, $query, $alias) = @_;
416
417 my %aliased = %$query;
418 foreach my $col (grep { ! m/\./ } keys %aliased) {
419 $aliased{"$alias.$col"} = delete $aliased{$col};
420 }
421
422 return \%aliased;
423}
424
425# _unique_queries
426#
427# Build a list of queries which satisfy unique constraints.
428
429sub _unique_queries {
430 my ($self, $query, $attrs) = @_;
431
432 my @constraint_names = exists $attrs->{key}
433 ? ($attrs->{key})
434 : $self->result_source->unique_constraint_names;
435
436 my $where = $self->_collapse_cond($self->{attrs}{where} || {});
437 my $num_where = scalar keys %$where;
438
439 my @unique_queries;
440 foreach my $name (@constraint_names) {
441 my @unique_cols = $self->result_source->unique_constraint_columns($name);
442 my $unique_query = $self->_build_unique_query($query, \@unique_cols);
443
444 my $num_cols = scalar @unique_cols;
445 my $num_query = scalar keys %$unique_query;
446
447 my $total = $num_query + $num_where;
448 if ($num_query && ($num_query == $num_cols || $total == $num_cols)) {
449 # The query is either unique on its own or is unique in combination with
450 # the existing where clause
451 push @unique_queries, $unique_query;
452 }
453 }
454
455 return @unique_queries;
456}
457
458# _build_unique_query
459#
460# Constrain the specified query hash based on the specified column names.
461
462sub _build_unique_query {
463 my ($self, $query, $unique_cols) = @_;
464
465 return {
466 map { $_ => $query->{$_} }
467 grep { exists $query->{$_} }
468 @$unique_cols
469 };
470}
471
472=head2 search_related
473
474=over 4
475
476=item Arguments: $rel, $cond, \%attrs?
477
478=item Return Value: $new_resultset
479
480=back
481
482 $new_rs = $cd_rs->search_related('artist', {
483 name => 'Emo-R-Us',
484 });
485
486Searches the specified relationship, optionally specifying a condition and
487attributes for matching records. See L</ATTRIBUTES> for more information.
488
489=cut
490
491sub search_related {
492 return shift->related_resultset(shift)->search(@_);
493}
494
495=head2 cursor
496
497=over 4
498
499=item Arguments: none
500
501=item Return Value: $cursor
502
503=back
504
505Returns a storage-driven cursor to the given resultset. See
506L<DBIx::Class::Cursor> for more information.
507
508=cut
509
510
# spent 1.08s (782ms+301ms) within DBIx::Class::ResultSet::cursor which was called 55480 times, avg 20µs/call: # 55477 times (781ms+300ms) by DBIx::Class::ResultSet::next at line 758, avg 19µs/call # 2 times (69µs+753µs) by DBIx::Class::ResultSet::_count at line 995, avg 411µs/call # once (27µs+485µs) by DBIx::Class::ResultSet::reset at line 1077
sub cursor {
511554800.057801.0e-6 my ($self) = @_;
512
513554800.538109.7e-6 my $attrs = { %{$self->_resolved_attrs} };
# spent 300ms making 55480 calls to DBIx::Class::ResultSet::_resolved_attrs, avg 5µs/call
514554800.169873.1e-6 return $self->{cursor}
# spent 383µs making 4 calls to DBIx::Class::ResultSet::result_source, avg 96µs/call # spent 371µs making 4 calls to DBIx::Class::Storage::DBI::select, avg 93µs/call # spent 248µs making 4 calls to DBIx::Class::ResultSource::storage, avg 62µs/call
515 ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
516 $attrs->{where},$attrs);
517}
518
519=head2 single
520
521=over 4
522
523=item Arguments: $cond?
524
525=item Return Value: $row_object?
526
527=back
528
529 my $cd = $schema->resultset('CD')->single({ year => 2001 });
530
531Inflates the first result without creating a cursor if the resultset has
532any records in it; if not returns nothing. Used by L</find> as an optimisation.
533
534Can optionally take an additional condition *only* - this is a fast-code-path
535method; if you need to add extra joins or similar call ->search and then
536->single without a condition on the $rs returned from that.
537
538=cut
539
540sub single {
541 my ($self, $where) = @_;
542 my $attrs = { %{$self->_resolved_attrs} };
543 if ($where) {
544 if (defined $attrs->{where}) {
545 $attrs->{where} = {
546 '-and' =>
547 [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
548 $where, delete $attrs->{where} ]
549 };
550 } else {
551 $attrs->{where} = $where;
552 }
553 }
554
555# XXX: Disabled since it doesn't infer uniqueness in all cases
556# unless ($self->_is_unique_query($attrs->{where})) {
557# carp "Query not guaranteed to return a single row"
558# . "; please declare your unique constraints or use search instead";
559# }
560
561 my @data = $self->result_source->storage->select_single(
562 $attrs->{from}, $attrs->{select},
563 $attrs->{where}, $attrs
564 );
565
566 return (@data ? ($self->_construct_object(@data))[0] : undef);
567}
568
569# _is_unique_query
570#
571# Try to determine if the specified query is guaranteed to be unique, based on
572# the declared unique constraints.
573
574sub _is_unique_query {
575 my ($self, $query) = @_;
576
577 my $collapsed = $self->_collapse_query($query);
578 my $alias = $self->{attrs}{alias};
579
580 foreach my $name ($self->result_source->unique_constraint_names) {
581 my @unique_cols = map {
582 "$alias.$_"
583 } $self->result_source->unique_constraint_columns($name);
584
585 # Count the values for each unique column
586 my %seen = map { $_ => 0 } @unique_cols;
587
588 foreach my $key (keys %$collapsed) {
589 my $aliased = $key =~ /\./ ? $key : "$alias.$key";
590 next unless exists $seen{$aliased}; # Additional constraints are okay
591 $seen{$aliased} = scalar keys %{ $collapsed->{$key} };
592 }
593
594 # If we get 0 or more than 1 value for a column, it's not necessarily unique
595 return 1 unless grep { $_ != 1 } values %seen;
596 }
597
598 return 0;
599}
600
601# _collapse_query
602#
603# Recursively collapse the query, accumulating values for each column.
604
605sub _collapse_query {
606 my ($self, $query, $collapsed) = @_;
607
608 $collapsed ||= {};
609
610 if (ref $query eq 'ARRAY') {
611 foreach my $subquery (@$query) {
612 next unless ref $subquery; # -or
613# warn "ARRAY: " . Dumper $subquery;
614 $collapsed = $self->_collapse_query($subquery, $collapsed);
615 }
616 }
617 elsif (ref $query eq 'HASH') {
618 if (keys %$query and (keys %$query)[0] eq '-and') {
619 foreach my $subquery (@{$query->{-and}}) {
620# warn "HASH: " . Dumper $subquery;
621 $collapsed = $self->_collapse_query($subquery, $collapsed);
622 }
623 }
624 else {
625# warn "LEAF: " . Dumper $query;
626 foreach my $col (keys %$query) {
627 my $value = $query->{$col};
628 $collapsed->{$col}{$value}++;
629 }
630 }
631 }
632
633 return $collapsed;
634}
635
636=head2 get_column
637
638=over 4
639
640=item Arguments: $cond?
641
642=item Return Value: $resultsetcolumn
643
644=back
645
646 my $max_length = $rs->get_column('length')->max;
647
648Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
649
650=cut
651
652sub get_column {
653 my ($self, $column) = @_;
654 my $new = DBIx::Class::ResultSetColumn->new($self, $column);
655 return $new;
656}
657
658=head2 search_like
659
660=over 4
661
662=item Arguments: $cond, \%attrs?
663
664=item Return Value: $resultset (scalar context), @row_objs (list context)
665
666=back
667
668 # WHERE title LIKE '%blue%'
669 $cd_rs = $rs->search_like({ title => '%blue%'});
670
671Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
672that this is simply a convenience method. You most likely want to use
673L</search> with specific operators.
674
675For more information, see L<DBIx::Class::Manual::Cookbook>.
676
677=cut
678
679sub search_like {
680 my $class = shift;
681 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
682 my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
683 $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
684 return $class->search($query, { %$attrs });
685}
686
687=head2 slice
688
689=over 4
690
691=item Arguments: $first, $last
692
693=item Return Value: $resultset (scalar context), @row_objs (list context)
694
695=back
696
697Returns a resultset or object list representing a subset of elements from the
698resultset slice is called on. Indexes are from 0, i.e., to get the first
699three records, call:
700
701 my ($one, $two, $three) = $rs->slice(0, 2);
702
703=cut
704
705sub slice {
706 my ($self, $min, $max) = @_;
707 my $attrs = {}; # = { %{ $self->{attrs} || {} } };
708 $attrs->{offset} = $self->{attrs}{offset} || 0;
709 $attrs->{offset} += $min;
710 $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
711 return $self->search(undef(), $attrs);
712 #my $slice = (ref $self)->new($self->result_source, $attrs);
713 #return (wantarray ? $slice->all : $slice);
714}
715
716=head2 next
717
718=over 4
719
720=item Arguments: none
721
722=item Return Value: $result?
723
724=back
725
726Returns the next element in the resultset (C<undef> is there is none).
727
728Can be used to efficiently iterate over records in the resultset:
729
730 my $rs = $schema->resultset('CD')->search;
731 while (my $cd = $rs->next) {
732 print $cd->title;
733 }
734
735Note that you need to store the resultset object, and call C<next> on it.
736Calling C<< resultset('Table')->next >> repeatedly will always return the
737first record from the resultset.
738
739=cut
740
741
# spent 204s (1.29+203) within DBIx::Class::ResultSet::next which was called 55477 times, avg 3.67ms/call: # 55476 times (1.29s+203s) at line 780 of /wise/base/deliv/dev/bin/getfix, avg 3.67ms/call # once (26µs+25.4ms) by DBIx::Class::ResultSet::first at line 1097
sub next {
742554770.065891.2e-6 my ($self) = @_;
743554770.242814.4e-6 if (my $cache = $self->get_cache) {
# spent 239ms making 55477 calls to DBIx::Class::ResultSet::get_cache, avg 4µs/call
744 $self->{all_cache_position} ||= 0;
745 return $cache->[$self->{all_cache_position}++];
746 }
747554770.062461.1e-6 if ($self->{attrs}{cache}) {
748 $self->{all_cache_position} = 1;
749 return ($self->all)[0];
750 }
751554770.036996.7e-7 if ($self->{stashed_objects}) {
752 my $obj = shift(@{$self->{stashed_objects}});
753 delete $self->{stashed_objects} unless @{$self->{stashed_objects}};
754 return $obj;
755 }
756 my @row = (
757 exists $self->{stashed_row}
758554770.769941.4e-5 ? @{delete $self->{stashed_row}}
# spent 183s making 55477 calls to DBIx::Class::Storage::DBI::Cursor::next, avg 3.30ms/call # spent 1.08s making 55477 calls to DBIx::Class::ResultSet::cursor, avg 19µs/call
759 : $self->cursor->next
760 );
761554770.038707.0e-7 return undef unless (@row);
762554760.358996.5e-6 my ($row, @more) = $self->_construct_object(@row);
# spent 18.2s making 55476 calls to DBIx::Class::ResultSet::_construct_object, avg 327µs/call
763554760.033996.1e-7 $self->{stashed_objects} = \@more if @more;
764554760.118452.1e-6 return $row;
765}
766
767
# spent 18.2s (1.29+16.9) within DBIx::Class::ResultSet::_construct_object which was called 55476 times, avg 327µs/call: # 55476 times (1.29s+16.9s) by DBIx::Class::ResultSet::next at line 762, avg 327µs/call
sub _construct_object {
768554760.295855.3e-6 my ($self, @row) = @_;
769554760.347406.3e-6 my $info = $self->_collapse_result($self->{_attrs}{as}, \@row);
# spent 7.39s making 55476 calls to DBIx::Class::ResultSet::_collapse_result, avg 133µs/call
770554760.915211.6e-5 my @new = $self->result_class->inflate_result($self->result_source, @$info);
# spent 4.75s making 55476 calls to DBIx::Class::ResultSet::result_source, avg 86µs/call # spent 3.92s making 55476 calls to DBIx::Class::Row::inflate_result, avg 71µs/call # spent 810ms making 55476 calls to Class::Accessor::Grouped::__ANON__[(eval 0)[/wise/base/static/lib/perl5/site_perl/5.10.0/Class/Accessor/Grouped.pm:156]:8], avg 15µs/call
771554760.077151.4e-6 @new = $self->{_attrs}{record_filter}->(@new)
772 if exists $self->{_attrs}{record_filter};
773554760.150992.7e-6 return @new;
774}
775
776
# spent 7.39s within DBIx::Class::ResultSet::_collapse_result which was called 55476 times, avg 133µs/call: # 55476 times (7.39s+0) by DBIx::Class::ResultSet::_construct_object at line 769, avg 133µs/call
sub _collapse_result {
777554760.082981.5e-6 my ($self, $as_proto, $row) = @_;
778
779554760.268264.8e-6 my @copy = @$row;
780
781 # 'foo' => [ undef, 'foo' ]
782 # 'foo.bar' => [ 'foo', 'bar' ]
783 # 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
784
7859430813.469623.7e-6 my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
786
787554760.118012.1e-6 my %collapse = %{$self->{_attrs}{collapse}||{}};
788
789554760.027635.0e-7 my @pri_index;
790
791 # if we're doing collapsing (has_many prefetch) we need to grab records
792 # until the PK changes, so fill @pri_index. if not, we leave it empty so
793 # we know we don't have to bother.
794
795 # the reason for not using the collapse stuff directly is because if you
796 # had for e.g. two artists in a row with no cds, the collapse info for
797 # both would be NULL (undef) so you'd lose the second artist
798
799 # store just the index so we can check the array positions from the row
800 # without having to contruct the full hash
801
802554760.052489.5e-7 if (keys %collapse) {
803 my %pri = map { ($_ => 1) } $self->result_source->primary_columns;
804 foreach my $i (0 .. $#construct_as) {
805 next if defined($construct_as[$i][0]); # only self table
806 if (delete $pri{$construct_as[$i][1]}) {
807 push(@pri_index, $i);
808 }
809 last unless keys %pri; # short circuit (Johnny Five Is Alive!)
810 }
811 }
812
813 # no need to do an if, it'll be empty if @pri_index is empty anyway
814
815554760.043677.9e-7 my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
816
817554760.024474.4e-7 my @const_rows;
818
819 do { # no need to check anything at the front, we always want the first row
820
821554760.025234.5e-7 my %const;
822
823554760.095391.7e-6 foreach my $this_as (@construct_as) {
8248876051.580761.8e-6 $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy);
825 }
826
827554760.064761.2e-6 push(@const_rows, \%const);
828
829 } until ( # no pri_index => no collapse => drop straight out
830 !@pri_index
831 or
832554760.135112.4e-6 do { # get another row, stash it, drop out if different PK
833
834 @copy = $self->cursor->next;
835 $self->{stashed_row} = \@copy;
836
837 # last thing in do block, counts as true if anything doesn't match
838
839 # check xor defined first for NULL vs. NOT NULL then if one is
840 # defined the other must be so check string equality
841
842 grep {
843 (defined $pri_vals{$_} ^ defined $copy[$_])
844 || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_]))
845 } @pri_index;
846 }
847 );
848
849554760.071391.3e-6 my $alias = $self->{attrs}{alias};
850554760.046918.5e-7 my $info = [];
851
852554760.027825.0e-7 my %collapse_pos;
853
854554760.024364.4e-7 my @const_keys;
855
856554760.076911.4e-6 foreach my $const (@const_rows) {
857554760.263614.8e-6 scalar @const_keys or do {
858 @const_keys = sort { length($a) <=> length($b) } keys %$const;
859 };
860554760.115992.1e-6 foreach my $key (@const_keys) {
861554760.118362.1e-6 if (length $key) {
862 my $target = $info;
863 my @parts = split(/\./, $key);
864 my $cur = '';
865 my $data = $const->{$key};
866 foreach my $p (@parts) {
867 $target = $target->[1]->{$p} ||= [];
868 $cur .= ".${p}";
869 if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) {
870 # collapsing at this point and on final part
871 my $pos = $collapse_pos{$cur};
872 CK: foreach my $ck (@ckey) {
873 if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) {
874 $collapse_pos{$cur} = $data;
875 delete @collapse_pos{ # clear all positioning for sub-entries
876 grep { m/^\Q${cur}.\E/ } keys %collapse_pos
877 };
878 push(@$target, []);
879 last CK;
880 }
881 }
882 }
883 if (exists $collapse{$cur}) {
884 $target = $target->[-1];
885 }
886 }
887 $target->[0] = $data;
888 } else {
889554760.081821.5e-6 $info->[0] = $const->{$key};
890 }
891 }
892 }
893
894554760.421707.6e-6 return $info;
895}
896
897=head2 result_source
898
899=over 4
900
901=item Arguments: $result_source?
902
903=item Return Value: $result_source
904
905=back
906
907An accessor for the primary ResultSource object from which this ResultSet
908is derived.
909
910=head2 result_class
911
912=over 4
913
914=item Arguments: $result_class?
915
916=item Return Value: $result_class
917
918=back
919
920An accessor for the class to use when creating row objects. Defaults to
921C<< result_source->result_class >> - which in most cases is the name of the
922L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
923
924=cut
925
926
927=head2 count
928
929=over 4
930
931=item Arguments: $cond, \%attrs??
932
933=item Return Value: $count
934
935=back
936
937Performs an SQL C<COUNT> with the same query as the resultset was built
938with to find the number of elements. If passed arguments, does a search
939on the resultset and counts the results of that.
940
941Note: When using C<count> with C<group_by>, L<DBIx::Class> emulates C<GROUP BY>
942using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
943not support C<DISTINCT> with multiple columns. If you are using such a
944database, you should only use columns from the main table in your C<group_by>
945clause.
946
947=cut
948
949
# spent 383s (82µs+383) within DBIx::Class::ResultSet::count which was called 2 times, avg 191s/call: # once (56µs+200s) at line 765 of /wise/base/deliv/dev/bin/getfix # once (26µs+182s) at line 688 of /wise/base/deliv/dev/bin/getfix
sub count {
95023.0e-61.5e-6 my $self = shift;
95122.0e-61.0e-6 return $self->search(@_)->count if @_ and defined $_[0];
95222.4e-51.2e-5 return scalar @{ $self->get_cache } if $self->get_cache;
# spent 14µs making 2 calls to DBIx::Class::ResultSet::get_cache, avg 7µs/call
95327.0e-53.5e-5 my $count = $self->_count;
# spent 383s making 2 calls to DBIx::Class::ResultSet::_count, avg 191s/call
95422.0e-61.0e-6 return 0 unless $count;
955
956 # need to take offset from resolved attrs
957
95827.0e-63.5e-6 $count -= $self->{_attrs}{offset} if $self->{_attrs}{offset};
95928.0e-64.0e-6 $count = $self->{attrs}{rows} if
960 $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
96121.0e-65.0e-7 $count = 0 if ($count < 0);
96225.0e-62.5e-6 return $count;
963}
964
965
# spent 383s (247µs+383) within DBIx::Class::ResultSet::_count which was called 2 times, avg 191s/call: # 2 times (247µs+383s) by DBIx::Class::ResultSet::count at line 953, avg 191s/call
sub _count { # Separated out so pager can get the full count
96622.0e-61.0e-6 my $self = shift;
96726.0e-63.0e-6 my $select = { count => '*' };
968
96923.4e-51.7e-5 my $attrs = { %{$self->_resolved_attrs} };
# spent 442µs making 2 calls to DBIx::Class::ResultSet::_resolved_attrs, avg 221µs/call
97023.0e-61.5e-6 if (my $group_by = delete $attrs->{group_by}) {
971 delete $attrs->{having};
972 my @distinct = (ref $group_by ? @$group_by : ($group_by));
973 # todo: try CONCAT for multi-column pk
974 my @pk = $self->result_source->primary_columns;
975 if (@pk == 1) {
976 my $alias = $attrs->{alias};
977 foreach my $column (@distinct) {
978 if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) {
979 @distinct = ($column);
980 last;
981 }
982 }
983 }
984
985 $select = { count => { distinct => \@distinct } };
986 }
987
98824.0e-62.0e-6 $attrs->{select} = $select;
98923.0e-61.5e-6 $attrs->{as} = [qw/count/];
990
991 # offset, order by and page are not needed to count. record_filter is cdbi
99242.9e-57.3e-6 delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
993
99423.1e-51.6e-5 my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
# spent 382µs making 2 calls to DBIx::Class::ResultSet::new, avg 191µs/call # spent 266µs making 2 calls to DBIx::Class::ResultSet::result_source, avg 133µs/call
99523.8e-51.9e-5 my ($count) = $tmp_rs->cursor->next;
# spent 383s making 2 calls to DBIx::Class::Storage::DBI::Cursor::next, avg 191s/call # spent 822µs making 2 calls to DBIx::Class::ResultSet::cursor, avg 411µs/call
99623.6e-51.8e-5 return $count;
997}
998
999=head2 count_literal
1000
1001=over 4
1002
1003=item Arguments: $sql_fragment, @bind_values
1004
1005=item Return Value: $count
1006
1007=back
1008
1009Counts the results in a literal query. Equivalent to calling L</search_literal>
1010with the passed arguments, then L</count>.
1011
1012=cut
1013
1014sub count_literal { shift->search_literal(@_)->count; }
1015
1016=head2 all
1017
1018=over 4
1019
1020=item Arguments: none
1021
1022=item Return Value: @objects
1023
1024=back
1025
1026Returns all elements in the resultset. Called implicitly if the resultset
1027is returned in list context.
1028
1029=cut
1030
1031sub all {
1032 my ($self) = @_;
1033 return @{ $self->get_cache } if $self->get_cache;
1034
1035 my @obj;
1036
1037 # TODO: don't call resolve here
1038 if (keys %{$self->_resolved_attrs->{collapse}}) {
1039# if ($self->{attrs}{prefetch}) {
1040 # Using $self->cursor->all is really just an optimisation.
1041 # If we're collapsing has_many prefetches it probably makes
1042 # very little difference, and this is cleaner than hacking
1043 # _construct_object to survive the approach
1044 my @row = $self->cursor->next;
1045 while (@row) {
1046 push(@obj, $self->_construct_object(@row));
1047 @row = (exists $self->{stashed_row}
1048 ? @{delete $self->{stashed_row}}
1049 : $self->cursor->next);
1050 }
1051 } else {
1052 @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
1053 }
1054
1055 $self->set_cache(\@obj) if $self->{attrs}{cache};
1056 return @obj;
1057}
1058
1059=head2 reset
1060
1061=over 4
1062
1063=item Arguments: none
1064
1065=item Return Value: $self
1066
1067=back
1068
1069Resets the resultset's cursor, so you can iterate through the elements again.
1070
1071=cut
1072
1073
# spent 550µs (16+534) within DBIx::Class::ResultSet::reset which was called # once (16µs+534µs) by DBIx::Class::ResultSet::first at line 1097
sub reset {
107412.0e-62.0e-6 my ($self) = @_;
107512.0e-62.0e-6 delete $self->{_attrs} if exists $self->{_attrs};
107611.0e-61.0e-6 $self->{all_cache_position} = 0;
107711.5e-51.5e-5 $self->cursor->reset;
# spent 512µs making 1 call to DBIx::Class::ResultSet::cursor # spent 22µs making 1 call to DBIx::Class::Storage::DBI::Cursor::reset
107812.0e-62.0e-6 return $self;
1079}
1080
1081=head2 first
1082
1083=over 4
1084
1085=item Arguments: none
1086
1087=item Return Value: $object?
1088
1089=back
1090
1091Resets the resultset and returns an object for the first result (if the
1092resultset returns anything).
1093
1094=cut
1095
1096
# spent 26.0ms (12µs+26.0) within DBIx::Class::ResultSet::first which was called # once (12µs+26.0ms) by WISE::DB::FrameIndex::_neighbor_hp at line 502 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex.pm
sub first {
109711.6e-51.6e-5 return $_[0]->reset->next;
# spent 25.4ms making 1 call to DBIx::Class::ResultSet::next # spent 550µs making 1 call to DBIx::Class::ResultSet::reset
1098}
1099
1100# _cond_for_update_delete
1101#
1102# update/delete require the condition to be modified to handle
1103# the differing SQL syntax available. This transforms the $self->{cond}
1104# appropriately, returning the new condition.
1105
1106sub _cond_for_update_delete {
1107 my ($self, $full_cond) = @_;
1108 my $cond = {};
1109
1110 $full_cond ||= $self->{cond};
1111 # No-op. No condition, we're updating/deleting everything
1112 return $cond unless ref $full_cond;
1113
1114 if (ref $full_cond eq 'ARRAY') {
1115 $cond = [
1116 map {
1117 my %hash;
1118 foreach my $key (keys %{$_}) {
1119 $key =~ /([^.]+)$/;
1120 $hash{$1} = $_->{$key};
1121 }
1122 \%hash;
1123 } @{$full_cond}
1124 ];
1125 }
1126 elsif (ref $full_cond eq 'HASH') {
1127 if ((keys %{$full_cond})[0] eq '-and') {
1128 $cond->{-and} = [];
1129
1130 my @cond = @{$full_cond->{-and}};
1131 for (my $i = 0; $i < @cond; $i++) {
1132 my $entry = $cond[$i];
1133
1134 my $hash;
1135 if (ref $entry eq 'HASH') {
1136 $hash = $self->_cond_for_update_delete($entry);
1137 }
1138 else {
1139 $entry =~ /([^.]+)$/;
1140 $hash->{$1} = $cond[++$i];
1141 }
1142
1143 push @{$cond->{-and}}, $hash;
1144 }
1145 }
1146 else {
1147 foreach my $key (keys %{$full_cond}) {
1148 $key =~ /([^.]+)$/;
1149 $cond->{$1} = $full_cond->{$key};
1150 }
1151 }
1152 }
1153 else {
1154 $self->throw_exception(
1155 "Can't update/delete on resultset with condition unless hash or array"
1156 );
1157 }
1158
1159 return $cond;
1160}
1161
1162
1163=head2 update
1164
1165=over 4
1166
1167=item Arguments: \%values
1168
1169=item Return Value: $storage_rv
1170
1171=back
1172
1173Sets the specified columns in the resultset to the supplied values in a
1174single query. Return value will be true if the update succeeded or false
1175if no records were updated; exact type of success value is storage-dependent.
1176
1177=cut
1178
1179sub update {
1180 my ($self, $values) = @_;
1181 $self->throw_exception("Values for update must be a hash")
1182 unless ref $values eq 'HASH';
1183
1184 my $cond = $self->_cond_for_update_delete;
1185
1186 return $self->result_source->storage->update(
1187 $self->result_source, $values, $cond
1188 );
1189}
1190
1191=head2 update_all
1192
1193=over 4
1194
1195=item Arguments: \%values
1196
1197=item Return Value: 1
1198
1199=back
1200
1201Fetches all objects and updates them one at a time. Note that C<update_all>
1202will run DBIC cascade triggers, while L</update> will not.
1203
1204=cut
1205
1206sub update_all {
1207 my ($self, $values) = @_;
1208 $self->throw_exception("Values for update must be a hash")
1209 unless ref $values eq 'HASH';
1210 foreach my $obj ($self->all) {
1211 $obj->set_columns($values)->update;
1212 }
1213 return 1;
1214}
1215
1216=head2 delete
1217
1218=over 4
1219
1220=item Arguments: none
1221
1222=item Return Value: 1
1223
1224=back
1225
1226Deletes the contents of the resultset from its result source. Note that this
1227will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1228to run. See also L<DBIx::Class::Row/delete>.
1229
1230=cut
1231
1232sub delete {
1233 my ($self) = @_;
1234
1235 my $cond = $self->_cond_for_update_delete;
1236
1237 $self->result_source->storage->delete($self->result_source, $cond);
1238 return 1;
1239}
1240
1241=head2 delete_all
1242
1243=over 4
1244
1245=item Arguments: none
1246
1247=item Return Value: 1
1248
1249=back
1250
1251Fetches all objects and deletes them one at a time. Note that C<delete_all>
1252will run DBIC cascade triggers, while L</delete> will not.
1253
1254=cut
1255
1256sub delete_all {
1257 my ($self) = @_;
1258 $_->delete for $self->all;
1259 return 1;
1260}
1261
1262=head2 populate
1263
1264=over 4
1265
1266=item Arguments: \@data;
1267
1268=back
1269
1270Pass an arrayref of hashrefs. Each hashref should be a structure suitable for
1271submitting to a $resultset->create(...) method.
1272
1273In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
1274to insert the data, as this is a faster method.
1275
1276Otherwise, each set of data is inserted into the database using
1277L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
1278objects is returned.
1279
1280Example: Assuming an Artist Class that has many CDs Classes relating:
1281
1282 my $Artist_rs = $schema->resultset("Artist");
1283
1284 ## Void Context Example
1285 $Artist_rs->populate([
1286 { artistid => 4, name => 'Manufactured Crap', cds => [
1287 { title => 'My First CD', year => 2006 },
1288 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1289 ],
1290 },
1291 { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
1292 { title => 'My parents sold me to a record company' ,year => 2005 },
1293 { title => 'Why Am I So Ugly?', year => 2006 },
1294 { title => 'I Got Surgery and am now Popular', year => 2007 }
1295 ],
1296 },
1297 ]);
1298
1299 ## Array Context Example
1300 my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
1301 { name => "Artist One"},
1302 { name => "Artist Two"},
1303 { name => "Artist Three", cds=> [
1304 { title => "First CD", year => 2007},
1305 { title => "Second CD", year => 2008},
1306 ]}
1307 ]);
1308
1309 print $ArtistOne->name; ## response is 'Artist One'
1310 print $ArtistThree->cds->count ## reponse is '2'
1311
1312Please note an important effect on your data when choosing between void and
1313wantarray context. Since void context goes straight to C<insert_bulk> in
1314L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
1315c<insert>. So if you are using something like L<DBIx-Class-UUIDColumns> to
1316create primary keys for you, you will find that your PKs are empty. In this
1317case you will have to use the wantarray context in order to create those
1318values.
1319
1320=cut
1321
1322sub populate {
1323 my ($self, $data) = @_;
1324
1325 if(defined wantarray) {
1326 my @created;
1327 foreach my $item (@$data) {
1328 push(@created, $self->create($item));
1329 }
1330 return @created;
1331 } else {
1332 my ($first, @rest) = @$data;
1333
1334 my @names = grep {!ref $first->{$_}} keys %$first;
1335 my @rels = grep { $self->result_source->has_relationship($_) } keys %$first;
1336 my @pks = $self->result_source->primary_columns;
1337
1338 ## do the belongs_to relationships
1339 foreach my $index (0..$#$data) {
1340 if( grep { !defined $data->[$index]->{$_} } @pks ) {
1341 my @ret = $self->populate($data);
1342 return;
1343 }
1344
1345 foreach my $rel (@rels) {
1346 next unless $data->[$index]->{$rel} && ref $data->[$index]->{$rel} eq "HASH";
1347 my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
1348 my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
1349 my $related = $result->result_source->resolve_condition(
1350 $result->result_source->relationship_info($reverse)->{cond},
1351 $self,
1352 $result,
1353 );
1354
1355 delete $data->[$index]->{$rel};
1356 $data->[$index] = {%{$data->[$index]}, %$related};
1357
1358 push @names, keys %$related if $index == 0;
1359 }
1360 }
1361
1362 ## do bulk insert on current row
1363 my @values = map { [ @$_{@names} ] } @$data;
1364
1365 $self->result_source->storage->insert_bulk(
1366 $self->result_source,
1367 \@names,
1368 \@values,
1369 );
1370
1371 ## do the has_many relationships
1372 foreach my $item (@$data) {
1373
1374 foreach my $rel (@rels) {
1375 next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY";
1376
1377 my $parent = $self->find(map {{$_=>$item->{$_}} } @pks)
1378 || $self->throw_exception('Cannot find the relating object.');
1379
1380 my $child = $parent->$rel;
1381
1382 my $related = $child->result_source->resolve_condition(
1383 $parent->result_source->relationship_info($rel)->{cond},
1384 $child,
1385 $parent,
1386 );
1387
1388 my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
1389 my @populate = map { {%$_, %$related} } @rows_to_add;
1390
1391 $child->populate( \@populate );
1392 }
1393 }
1394 }
1395}
1396
1397=head2 pager
1398
1399=over 4
1400
1401=item Arguments: none
1402
1403=item Return Value: $pager
1404
1405=back
1406
1407Return Value a L<Data::Page> object for the current resultset. Only makes
1408sense for queries with a C<page> attribute.
1409
1410=cut
1411
1412sub pager {
1413 my ($self) = @_;
1414 my $attrs = $self->{attrs};
1415 $self->throw_exception("Can't create pager for non-paged rs")
1416 unless $self->{attrs}{page};
1417 $attrs->{rows} ||= 10;
1418 return $self->{pager} ||= Data::Page->new(
1419 $self->_count, $attrs->{rows}, $self->{attrs}{page});
1420}
1421
1422=head2 page
1423
1424=over 4
1425
1426=item Arguments: $page_number
1427
1428=item Return Value: $rs
1429
1430=back
1431
1432Returns a resultset for the $page_number page of the resultset on which page
1433is called, where each page contains a number of rows equal to the 'rows'
1434attribute set on the resultset (10 by default).
1435
1436=cut
1437
1438sub page {
1439 my ($self, $page) = @_;
1440 return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
1441}
1442
1443=head2 new_result
1444
1445=over 4
1446
1447=item Arguments: \%vals
1448
1449=item Return Value: $object
1450
1451=back
1452
1453Creates a new row object in the resultset's result class and returns
1454it. The row is not inserted into the database at this point, call
1455L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
1456will tell you whether the row object has been inserted or not.
1457
1458Passes the hashref of input on to L<DBIx::Class::Row/new>.
1459
1460=cut
1461
1462sub new_result {
1463 my ($self, $values) = @_;
1464 $self->throw_exception( "new_result needs a hash" )
1465 unless (ref $values eq 'HASH');
1466 $self->throw_exception(
1467 "Can't abstract implicit construct, condition not a hash"
1468 ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
1469
1470 my $alias = $self->{attrs}{alias};
1471 my $collapsed_cond = $self->{cond} ? $self->_collapse_cond($self->{cond}) : {};
1472
1473 # precendence must be given to passed values over values inherited from the cond,
1474 # so the order here is important.
1475 my %new = (
1476 %{ $self->_remove_alias($collapsed_cond, $alias) },
1477 %{ $self->_remove_alias($values, $alias) },
1478 -source_handle => $self->_source_handle,
1479 -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
1480 );
1481
1482 return $self->result_class->new(\%new);
1483}
1484
1485# _collapse_cond
1486#
1487# Recursively collapse the condition.
1488
1489sub _collapse_cond {
1490 my ($self, $cond, $collapsed) = @_;
1491
1492 $collapsed ||= {};
1493
1494 if (ref $cond eq 'ARRAY') {
1495 foreach my $subcond (@$cond) {
1496 next unless ref $subcond; # -or
1497# warn "ARRAY: " . Dumper $subcond;
1498 $collapsed = $self->_collapse_cond($subcond, $collapsed);
1499 }
1500 }
1501 elsif (ref $cond eq 'HASH') {
1502 if (keys %$cond and (keys %$cond)[0] eq '-and') {
1503 foreach my $subcond (@{$cond->{-and}}) {
1504# warn "HASH: " . Dumper $subcond;
1505 $collapsed = $self->_collapse_cond($subcond, $collapsed);
1506 }
1507 }
1508 else {
1509# warn "LEAF: " . Dumper $cond;
1510 foreach my $col (keys %$cond) {
1511 my $value = $cond->{$col};
1512 $collapsed->{$col} = $value;
1513 }
1514 }
1515 }
1516
1517 return $collapsed;
1518}
1519
1520# _remove_alias
1521#
1522# Remove the specified alias from the specified query hash. A copy is made so
1523# the original query is not modified.
1524
1525sub _remove_alias {
1526 my ($self, $query, $alias) = @_;
1527
1528 my %orig = %{ $query || {} };
1529 my %unaliased;
1530
1531 foreach my $key (keys %orig) {
1532 if ($key !~ /\./) {
1533 $unaliased{$key} = $orig{$key};
1534 next;
1535 }
1536 $unaliased{$1} = $orig{$key}
1537 if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
1538 }
1539
1540 return \%unaliased;
1541}
1542
1543=head2 find_or_new
1544
1545=over 4
1546
1547=item Arguments: \%vals, \%attrs?
1548
1549=item Return Value: $object
1550
1551=back
1552
1553Find an existing record from this resultset. If none exists, instantiate a new
1554result object and return it. The object will not be saved into your storage
1555until you call L<DBIx::Class::Row/insert> on it.
1556
1557If you want objects to be saved immediately, use L</find_or_create> instead.
1558
1559=cut
1560
1561sub find_or_new {
1562 my $self = shift;
1563 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1564 my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
1565 my $exists = $self->find($hash, $attrs);
1566 return defined $exists ? $exists : $self->new_result($hash);
1567}
1568
1569=head2 create
1570
1571=over 4
1572
1573=item Arguments: \%vals
1574
1575=item Return Value: a L<DBIx::Class::Row> $object
1576
1577=back
1578
1579Attempt to create a single new row or a row with multiple related rows
1580in the table represented by the resultset (and related tables). This
1581will not check for duplicate rows before inserting, use
1582L</find_or_create> to do that.
1583
1584To create one row for this resultset, pass a hashref of key/value
1585pairs representing the columns of the table and the values you wish to
1586store. If the appropriate relationships are set up, foreign key fields
1587can also be passed an object representing the foreign row, and the
1588value will be set to it's primary key.
1589
1590To create related objects, pass a hashref for the value if the related
1591item is a foreign key relationship (L<DBIx::Class::Relationship/belongs_to>),
1592and use the name of the relationship as the key. (NOT the name of the field,
1593necessarily). For C<has_many> and C<has_one> relationships, pass an arrayref
1594of hashrefs containing the data for each of the rows to create in the foreign
1595tables, again using the relationship name as the key.
1596
1597Instead of hashrefs of plain related data (key/value pairs), you may
1598also pass new or inserted objects. New objects (not inserted yet, see
1599L</new>), will be inserted into their appropriate tables.
1600
1601Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1602
1603Example of creating a new row.
1604
1605 $person_rs->create({
1606 name=>"Some Person",
1607 email=>"somebody@someplace.com"
1608 });
1609
1610Example of creating a new row and also creating rows in a related C<has_many>
1611or C<has_one> resultset. Note Arrayref.
1612
1613 $artist_rs->create(
1614 { artistid => 4, name => 'Manufactured Crap', cds => [
1615 { title => 'My First CD', year => 2006 },
1616 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
1617 ],
1618 },
1619 );
1620
1621Example of creating a new row and also creating a row in a related
1622C<belongs_to>resultset. Note Hashref.
1623
1624 $cd_rs->create({
1625 title=>"Music for Silly Walks",
1626 year=>2000,
1627 artist => {
1628 name=>"Silly Musician",
1629 }
1630 });
1631
1632=cut
1633
1634sub create {
1635 my ($self, $attrs) = @_;
1636 $self->throw_exception( "create needs a hashref" )
1637 unless ref $attrs eq 'HASH';
1638 return $self->new_result($attrs)->insert;
1639}
1640
1641=head2 find_or_create
1642
1643=over 4
1644
1645=item Arguments: \%vals, \%attrs?
1646
1647=item Return Value: $object
1648
1649=back
1650
1651 $class->find_or_create({ key => $val, ... });
1652
1653Tries to find a record based on its primary key or unique constraint; if none
1654is found, creates one and returns that instead.
1655
1656 my $cd = $schema->resultset('CD')->find_or_create({
1657 cdid => 5,
1658 artist => 'Massive Attack',
1659 title => 'Mezzanine',
1660 year => 2005,
1661 });
1662
1663Also takes an optional C<key> attribute, to search by a specific key or unique
1664constraint. For example:
1665
1666 my $cd = $schema->resultset('CD')->find_or_create(
1667 {
1668 artist => 'Massive Attack',
1669 title => 'Mezzanine',
1670 },
1671 { key => 'cd_artist_title' }
1672 );
1673
1674See also L</find> and L</update_or_create>. For information on how to declare
1675unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1676
1677=cut
1678
1679sub find_or_create {
1680 my $self = shift;
1681 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1682 my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
1683 my $exists = $self->find($hash, $attrs);
1684 return defined $exists ? $exists : $self->create($hash);
1685}
1686
1687=head2 update_or_create
1688
1689=over 4
1690
1691=item Arguments: \%col_values, { key => $unique_constraint }?
1692
1693=item Return Value: $object
1694
1695=back
1696
1697 $class->update_or_create({ col => $val, ... });
1698
1699First, searches for an existing row matching one of the unique constraints
1700(including the primary key) on the source of this resultset. If a row is
1701found, updates it with the other given column values. Otherwise, creates a new
1702row.
1703
1704Takes an optional C<key> attribute to search on a specific unique constraint.
1705For example:
1706
1707 # In your application
1708 my $cd = $schema->resultset('CD')->update_or_create(
1709 {
1710 artist => 'Massive Attack',
1711 title => 'Mezzanine',
1712 year => 1998,
1713 },
1714 { key => 'cd_artist_title' }
1715 );
1716
1717If no C<key> is specified, it searches on all unique constraints defined on the
1718source, including the primary key.
1719
1720If the C<key> is specified as C<primary>, it searches only on the primary key.
1721
1722See also L</find> and L</find_or_create>. For information on how to declare
1723unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1724
1725=cut
1726
1727sub update_or_create {
1728 my $self = shift;
1729 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1730 my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
1731
1732 my $row = $self->find($cond, $attrs);
1733 if (defined $row) {
1734 $row->update($cond);
1735 return $row;
1736 }
1737
1738 return $self->create($cond);
1739}
1740
1741=head2 get_cache
1742
1743=over 4
1744
1745=item Arguments: none
1746
1747=item Return Value: \@cache_objects?
1748
1749=back
1750
1751Gets the contents of the cache for the resultset, if the cache is set.
1752
1753=cut
1754
1755
# spent 239ms within DBIx::Class::ResultSet::get_cache which was called 55479 times, avg 4µs/call: # 55477 times (239ms+0) by DBIx::Class::ResultSet::next at line 743, avg 4µs/call # 2 times (14µs+0) by DBIx::Class::ResultSet::count at line 952, avg 7µs/call
sub get_cache {
1756554790.121982.2e-6 shift->{all_cache};
1757}
1758
1759=head2 set_cache
1760
1761=over 4
1762
1763=item Arguments: \@cache_objects
1764
1765=item Return Value: \@cache_objects
1766
1767=back
1768
1769Sets the contents of the cache for the resultset. Expects an arrayref
1770of objects of the same class as those produced by the resultset. Note that
1771if the cache is set the resultset will return the cached objects rather
1772than re-querying the database even if the cache attr is not set.
1773
1774=cut
1775
1776sub set_cache {
1777 my ( $self, $data ) = @_;
1778 $self->throw_exception("set_cache requires an arrayref")
1779 if defined($data) && (ref $data ne 'ARRAY');
1780 $self->{all_cache} = $data;
1781}
1782
1783=head2 clear_cache
1784
1785=over 4
1786
1787=item Arguments: none
1788
1789=item Return Value: []
1790
1791=back
1792
1793Clears the cache for the resultset.
1794
1795=cut
1796
1797sub clear_cache {
1798 shift->set_cache(undef);
1799}
1800
1801=head2 related_resultset
1802
1803=over 4
1804
1805=item Arguments: $relationship_name
1806
1807=item Return Value: $resultset
1808
1809=back
1810
1811Returns a related resultset for the supplied relationship name.
1812
1813 $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
1814
1815=cut
1816
1817sub related_resultset {
1818 my ($self, $rel) = @_;
1819
1820 $self->{related_resultsets} ||= {};
1821 return $self->{related_resultsets}{$rel} ||= do {
1822 my $rel_obj = $self->result_source->relationship_info($rel);
1823
1824 $self->throw_exception(
1825 "search_related: result source '" . $self->result_source->source_name .
1826 "' has no such relationship $rel")
1827 unless $rel_obj;
1828
1829 my ($from,$seen) = $self->_resolve_from($rel);
1830
1831 my $join_count = $seen->{$rel};
1832 my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
1833
1834 #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
1835 my %attrs = %{$self->{attrs}||{}};
1836 delete @attrs{qw(result_class alias)};
1837
1838 my $new_cache;
1839
1840 if (my $cache = $self->get_cache) {
1841 if ($cache->[0] && $cache->[0]->related_resultset($rel)->get_cache) {
1842 $new_cache = [ map { @{$_->related_resultset($rel)->get_cache} }
1843 @$cache ];
1844 }
1845 }
1846
1847 my $rel_source = $self->result_source->related_source($rel);
1848
1849 my $new = do {
1850
1851 # The reason we do this now instead of passing the alias to the
1852 # search_rs below is that if you wrap/overload resultset on the
1853 # source you need to know what alias it's -going- to have for things
1854 # to work sanely (e.g. RestrictWithObject wants to be able to add
1855 # extra query restrictions, and these may need to be $alias.)
1856
1857 my $attrs = $rel_source->resultset_attributes;
1858 local $attrs->{alias} = $alias;
1859
1860 $rel_source->resultset
1861 ->search_rs(
1862 undef, {
1863 %attrs,
1864 join => undef,
1865 prefetch => undef,
1866 select => undef,
1867 as => undef,
1868 where => $self->{cond},
1869 seen_join => $seen,
1870 from => $from,
1871 });
1872 };
1873 $new->set_cache($new_cache) if $new_cache;
1874 $new;
1875 };
1876}
1877
1878sub _resolve_from {
1879 my ($self, $extra_join) = @_;
1880 my $source = $self->result_source;
1881 my $attrs = $self->{attrs};
1882
1883 my $from = $attrs->{from}
1884 || [ { $attrs->{alias} => $source->from } ];
1885
1886 my $seen = { %{$attrs->{seen_join}||{}} };
1887
1888 my $join = ($attrs->{join}
1889 ? [ $attrs->{join}, $extra_join ]
1890 : $extra_join);
1891
1892 # we need to take the prefetch the attrs into account before we
1893 # ->resolve_join as otherwise they get lost - captainL
1894 my $merged = $self->_merge_attr( $join, $attrs->{prefetch} );
1895
1896 $from = [
1897 @$from,
1898 ($join ? $source->resolve_join($merged, $attrs->{alias}, $seen) : ()),
1899 ];
1900
1901 return ($from,$seen);
1902}
1903
1904
# spent 300ms (300+422µs) within DBIx::Class::ResultSet::_resolved_attrs which was called 55482 times, avg 5µs/call: # 55480 times (300ms+302µs) by DBIx::Class::ResultSet::cursor at line 513, avg 5µs/call # 2 times (322µs+120µs) by DBIx::Class::ResultSet::_count at line 969, avg 221µs/call
sub _resolved_attrs {
1905554820.040167.2e-7 my $self = shift;
1906554820.135462.4e-6 return $self->{_attrs} if $self->{_attrs};
1907
190841.8e-54.5e-6 my $attrs = { %{$self->{attrs}||{}} };
190942.3e-55.8e-6 my $source = $self->result_source;
# spent 356µs making 4 calls to DBIx::Class::ResultSet::result_source, avg 89µs/call
191044.0e-61.0e-6 my $alias = $attrs->{alias};
1911
191245.0e-61.2e-6 $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
191342.1e-55.3e-6 if ($attrs->{columns}) {
# spent 10µs making 1 call to DBIx::Class::ResultSource::columns
1914 delete $attrs->{as};
1915 } elsif (!$attrs->{select}) {
1916 $attrs->{columns} = [ $source->columns ];
1917 }
1918
1919 $attrs->{select} =
1920 ($attrs->{select}
1921 ? (ref $attrs->{select} eq 'ARRAY'
1922212.4e-51.1e-6 ? [ @{$attrs->{select}} ]
1923 : [ $attrs->{select} ])
192444.9e-51.2e-5 : [ map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} ]
1925 );
1926 $attrs->{as} =
1927 ($attrs->{as}
1928 ? (ref $attrs->{as} eq 'ARRAY'
1929219.9e-54.7e-6 ? [ @{$attrs->{as}} ]
1930 : [ $attrs->{as} ])
193140.000194.8e-5 : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} ]
1932 );
1933
193443.0e-67.5e-7 my $adds;
193541.5e-53.7e-6 if ($adds = delete $attrs->{include_columns}) {
1936 $adds = [$adds] unless ref $adds eq 'ARRAY';
1937 push(@{$attrs->{select}}, @$adds);
1938 push(@{$attrs->{as}}, map { m/([^.]+)$/; $1 } @$adds);
1939 }
194043.0e-67.5e-7 if ($adds = delete $attrs->{'+select'}) {
1941 $adds = [$adds] unless ref $adds eq 'ARRAY';
1942 push(@{$attrs->{select}},
1943 map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds);
1944 }
194546.0e-61.5e-6 if (my $adds = delete $attrs->{'+as'}) {
1946 $adds = [$adds] unless ref $adds eq 'ARRAY';
1947 push(@{$attrs->{as}}, @$adds);
1948 }
1949
195043.6e-59.0e-6 $attrs->{from} ||= [ { 'me' => $source->from } ];
# spent 56µs making 2 calls to DBIx::Class::ResultSource::Table::from, avg 28µs/call
1951
195245.0e-61.2e-6 if (exists $attrs->{join} || exists $attrs->{prefetch}) {
1953 my $join = delete $attrs->{join} || {};
1954
1955 if (defined $attrs->{prefetch}) {
1956 $join = $self->_merge_attr(
1957 $join, $attrs->{prefetch}
1958 );
1959
1960 }
1961
1962 $attrs->{from} = # have to copy here to avoid corrupting the original
1963 [
1964 @{$attrs->{from}},
1965 $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} })
1966 ];
1967
1968 }
1969
197045.0e-61.2e-6 $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
197141.4e-53.5e-6 if ($attrs->{order_by}) {
1972 $attrs->{order_by} = (ref($attrs->{order_by}) eq 'ARRAY'
1973 ? [ @{$attrs->{order_by}} ]
1974 : [ $attrs->{order_by} ]);
1975 } else {
197646.0e-61.5e-6 $attrs->{order_by} = [];
1977 }
1978
197944.0e-61.0e-6 my $collapse = $attrs->{collapse} || {};
198044.0e-61.0e-6 if (my $prefetch = delete $attrs->{prefetch}) {
1981 $prefetch = $self->_merge_attr({}, $prefetch);
1982 my @pre_order;
1983 my $seen = $attrs->{seen_join} || {};
1984 foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
1985 # bring joins back to level of current class
1986 my @prefetch = $source->resolve_prefetch(
1987 $p, $alias, $seen, \@pre_order, $collapse
1988 );
1989 push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
1990 push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
1991 }
1992 push(@{$attrs->{order_by}}, @pre_order);
1993 }
199446.0e-61.5e-6 $attrs->{collapse} = $collapse;
1995
199644.0e-61.0e-6 if ($attrs->{page}) {
1997 $attrs->{offset} ||= 0;
1998 $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
1999 }
2000
200141.1e-52.7e-6 return $self->{_attrs} = $attrs;
2002}
2003
2004sub _rollout_attr {
2005 my ($self, $attr) = @_;
2006
2007 if (ref $attr eq 'HASH') {
2008 return $self->_rollout_hash($attr);
2009 } elsif (ref $attr eq 'ARRAY') {
2010 return $self->_rollout_array($attr);
2011 } else {
2012 return [$attr];
2013 }
2014}
2015
2016sub _rollout_array {
2017 my ($self, $attr) = @_;
2018
2019 my @rolled_array;
2020 foreach my $element (@{$attr}) {
2021 if (ref $element eq 'HASH') {
2022 push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
2023 } elsif (ref $element eq 'ARRAY') {
2024 # XXX - should probably recurse here
2025 push( @rolled_array, @{$self->_rollout_array($element)} );
2026 } else {
2027 push( @rolled_array, $element );
2028 }
2029 }
2030 return \@rolled_array;
2031}
2032
2033sub _rollout_hash {
2034 my ($self, $attr) = @_;
2035
2036 my @rolled_array;
2037 foreach my $key (keys %{$attr}) {
2038 push( @rolled_array, { $key => $attr->{$key} } );
2039 }
2040 return \@rolled_array;
2041}
2042
2043sub _calculate_score {
2044 my ($self, $a, $b) = @_;
2045
2046 if (ref $b eq 'HASH') {
2047 my ($b_key) = keys %{$b};
2048 if (ref $a eq 'HASH') {
2049 my ($a_key) = keys %{$a};
2050 if ($a_key eq $b_key) {
2051 return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
2052 } else {
2053 return 0;
2054 }
2055 } else {
2056 return ($a eq $b_key) ? 1 : 0;
2057 }
2058 } else {
2059 if (ref $a eq 'HASH') {
2060 my ($a_key) = keys %{$a};
2061 return ($b eq $a_key) ? 1 : 0;
2062 } else {
2063 return ($b eq $a) ? 1 : 0;
2064 }
2065 }
2066}
2067
2068sub _merge_attr {
2069 my ($self, $a, $b) = @_;
2070
2071 return $b unless defined($a);
2072 return $a unless defined($b);
2073
2074 $a = $self->_rollout_attr($a);
2075 $b = $self->_rollout_attr($b);
2076
2077 my $seen_keys;
2078 foreach my $b_element ( @{$b} ) {
2079 # find best candidate from $a to merge $b_element into
2080 my $best_candidate = { position => undef, score => 0 }; my $position = 0;
2081 foreach my $a_element ( @{$a} ) {
2082 my $score = $self->_calculate_score( $a_element, $b_element );
2083 if ($score > $best_candidate->{score}) {
2084 $best_candidate->{position} = $position;
2085 $best_candidate->{score} = $score;
2086 }
2087 $position++;
2088 }
2089 my ($b_key) = ( ref $b_element eq 'HASH' ) ? keys %{$b_element} : ($b_element);
2090
2091 if ($best_candidate->{score} == 0 || exists $seen_keys->{$b_key}) {
2092 push( @{$a}, $b_element );
2093 } else {
2094 my $a_best = $a->[$best_candidate->{position}];
2095 # merge a_best and b_element together and replace original with merged
2096 if (ref $a_best ne 'HASH') {
2097 $a->[$best_candidate->{position}] = $b_element;
2098 } elsif (ref $b_element eq 'HASH') {
2099 my ($key) = keys %{$a_best};
2100 $a->[$best_candidate->{position}] = { $key => $self->_merge_attr($a_best->{$key}, $b_element->{$key}) };
2101 }
2102 }
2103 $seen_keys->{$b_key} = 1; # don't merge the same key twice
2104 }
2105
2106 return $a;
2107}
2108
2109
# spent 4.75s (488ms+4.27) within DBIx::Class::ResultSet::result_source which was called 55535 times, avg 86µs/call: # 55476 times (488ms+4.26s) by DBIx::Class::ResultSet::_construct_object at line 770, avg 86µs/call # 48 times (391µs+4.44ms) at line 523 of /wise/base/deliv/dev/bin/getfix, avg 101µs/call # 4 times (42µs+341µs) by DBIx::Class::ResultSet::cursor at line 514, avg 96µs/call # 4 times (39µs+317µs) by DBIx::Class::ResultSet::_resolved_attrs at line 1909, avg 89µs/call # 2 times (22µs+244µs) by DBIx::Class::ResultSet::_count at line 994, avg 133µs/call # once (12µs+91µs) by DBIx::Class::ResultSet::search_rs at line 257
sub result_source {
2110555350.047798.6e-7 my $self = shift;
2111
2112555350.103061.9e-6 if (@_) {
2113 $self->_source_handle($_[0]->handle);
2114 } else {
2115555350.497239.0e-6 $self->_source_handle->resolve;
2116 }
2117}
2118
2119=head2 throw_exception
2120
2121See L<DBIx::Class::Schema/throw_exception> for details.
2122
2123=cut
2124
2125sub throw_exception {
2126 my $self=shift;
2127 $self->_source_handle->schema->throw_exception(@_);
2128}
2129
2130# XXX: FIXME: Attributes docs need clearing up
2131
2132=head1 ATTRIBUTES
2133
2134The resultset takes various attributes that modify its behavior. Here's an
2135overview of them:
2136
2137=head2 order_by
2138
2139=over 4
2140
2141=item Value: ($order_by | \@order_by)
2142
2143=back
2144
2145Which column(s) to order the results by. This is currently passed
2146through directly to SQL, so you can give e.g. C<year DESC> for a
2147descending order on the column `year'.
2148
2149Please note that if you have C<quote_char> enabled (see
2150L<DBIx::Class::Storage::DBI/connect_info>) you will need to do C<\'year DESC' > to
2151specify an order. (The scalar ref causes it to be passed as raw sql to the DB,
2152so you will need to manually quote things as appropriate.)
2153
2154=head2 columns
2155
2156=over 4
2157
2158=item Value: \@columns
2159
2160=back
2161
2162Shortcut to request a particular set of columns to be retrieved. Adds
2163C<me.> onto the start of any column without a C<.> in it and sets C<select>
2164from that, then auto-populates C<as> from C<select> as normal. (You may also
2165use the C<cols> attribute, as in earlier versions of DBIC.)
2166
2167=head2 include_columns
2168
2169=over 4
2170
2171=item Value: \@columns
2172
2173=back
2174
2175Shortcut to include additional columns in the returned results - for example
2176
2177 $schema->resultset('CD')->search(undef, {
2178 include_columns => ['artist.name'],
2179 join => ['artist']
2180 });
2181
2182would return all CDs and include a 'name' column to the information
2183passed to object inflation. Note that the 'artist' is the name of the
2184column (or relationship) accessor, and 'name' is the name of the column
2185accessor in the related table.
2186
2187=head2 select
2188
2189=over 4
2190
2191=item Value: \@select_columns
2192
2193=back
2194
2195Indicates which columns should be selected from the storage. You can use
2196column names, or in the case of RDBMS back ends, function or stored procedure
2197names:
2198
2199 $rs = $schema->resultset('Employee')->search(undef, {
2200 select => [
2201 'name',
2202 { count => 'employeeid' },
2203 { sum => 'salary' }
2204 ]
2205 });
2206
2207When you use function/stored procedure names and do not supply an C<as>
2208attribute, the column names returned are storage-dependent. E.g. MySQL would
2209return a column named C<count(employeeid)> in the above example.
2210
2211=head2 +select
2212
2213=over 4
2214
2215Indicates additional columns to be selected from storage. Works the same as
2216L</select> but adds columns to the selection.
2217
2218=back
2219
2220=head2 +as
2221
2222=over 4
2223
2224Indicates additional column names for those added via L</+select>.
2225
2226=back
2227
2228=head2 as
2229
2230=over 4
2231
2232=item Value: \@inflation_names
2233
2234=back
2235
2236Indicates column names for object inflation. That is, C<as>
2237indicates the name that the column can be accessed as via the
2238C<get_column> method (or via the object accessor, B<if one already
2239exists>). It has nothing to do with the SQL code C<SELECT foo AS bar>.
2240
2241The C<as> attribute is used in conjunction with C<select>,
2242usually when C<select> contains one or more function or stored
2243procedure names:
2244
2245 $rs = $schema->resultset('Employee')->search(undef, {
2246 select => [
2247 'name',
2248 { count => 'employeeid' }
2249 ],
2250 as => ['name', 'employee_count'],
2251 });
2252
2253 my $employee = $rs->first(); # get the first Employee
2254
2255If the object against which the search is performed already has an accessor
2256matching a column name specified in C<as>, the value can be retrieved using
2257the accessor as normal:
2258
2259 my $name = $employee->name();
2260
2261If on the other hand an accessor does not exist in the object, you need to
2262use C<get_column> instead:
2263
2264 my $employee_count = $employee->get_column('employee_count');
2265
2266You can create your own accessors if required - see
2267L<DBIx::Class::Manual::Cookbook> for details.
2268
2269Please note: This will NOT insert an C<AS employee_count> into the SQL
2270statement produced, it is used for internal access only. Thus
2271attempting to use the accessor in an C<order_by> clause or similar
2272will fail miserably.
2273
2274To get around this limitation, you can supply literal SQL to your
2275C<select> attibute that contains the C<AS alias> text, eg:
2276
2277 select => [\'myfield AS alias']
2278
2279=head2 join
2280
2281=over 4
2282
2283=item Value: ($rel_name | \@rel_names | \%rel_names)
2284
2285=back
2286
2287Contains a list of relationships that should be joined for this query. For
2288example:
2289
2290 # Get CDs by Nine Inch Nails
2291 my $rs = $schema->resultset('CD')->search(
2292 { 'artist.name' => 'Nine Inch Nails' },
2293 { join => 'artist' }
2294 );
2295
2296Can also contain a hash reference to refer to the other relation's relations.
2297For example:
2298
2299 package MyApp::Schema::Track;
2300 use base qw/DBIx::Class/;
2301 __PACKAGE__->table('track');
2302 __PACKAGE__->add_columns(qw/trackid cd position title/);
2303 __PACKAGE__->set_primary_key('trackid');
2304 __PACKAGE__->belongs_to(cd => 'MyApp::Schema::CD');
2305 1;
2306
2307 # In your application
2308 my $rs = $schema->resultset('Artist')->search(
2309 { 'track.title' => 'Teardrop' },
2310 {
2311 join => { cd => 'track' },
2312 order_by => 'artist.name',
2313 }
2314 );
2315
2316You need to use the relationship (not the table) name in conditions,
2317because they are aliased as such. The current table is aliased as "me", so
2318you need to use me.column_name in order to avoid ambiguity. For example:
2319
2320 # Get CDs from 1984 with a 'Foo' track
2321 my $rs = $schema->resultset('CD')->search(
2322 {
2323 'me.year' => 1984,
2324 'tracks.name' => 'Foo'
2325 },
2326 { join => 'tracks' }
2327 );
2328
2329If the same join is supplied twice, it will be aliased to <rel>_2 (and
2330similarly for a third time). For e.g.
2331
2332 my $rs = $schema->resultset('Artist')->search({
2333 'cds.title' => 'Down to Earth',
2334 'cds_2.title' => 'Popular',
2335 }, {
2336 join => [ qw/cds cds/ ],
2337 });
2338
2339will return a set of all artists that have both a cd with title 'Down
2340to Earth' and a cd with title 'Popular'.
2341
2342If you want to fetch related objects from other tables as well, see C<prefetch>
2343below.
2344
2345For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
2346
2347=head2 prefetch
2348
2349=over 4
2350
2351=item Value: ($rel_name | \@rel_names | \%rel_names)
2352
2353=back
2354
2355Contains one or more relationships that should be fetched along with
2356the main query (when they are accessed afterwards the data will
2357already be available, without extra queries to the database). This is
2358useful for when you know you will need the related objects, because it
2359saves at least one query:
2360
2361 my $rs = $schema->resultset('Tag')->search(
2362 undef,
2363 {
2364 prefetch => {
2365 cd => 'artist'
2366 }
2367 }
2368 );
2369
2370The initial search results in SQL like the following:
2371
2372 SELECT tag.*, cd.*, artist.* FROM tag
2373 JOIN cd ON tag.cd = cd.cdid
2374 JOIN artist ON cd.artist = artist.artistid
2375
2376L<DBIx::Class> has no need to go back to the database when we access the
2377C<cd> or C<artist> relationships, which saves us two SQL statements in this
2378case.
2379
2380Simple prefetches will be joined automatically, so there is no need
2381for a C<join> attribute in the above search. If you're prefetching to
2382depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
2383specify the join as well.
2384
2385C<prefetch> can be used with the following relationship types: C<belongs_to>,
2386C<has_one> (or if you're using C<add_relationship>, any relationship declared
2387with an accessor type of 'single' or 'filter').
2388
2389=head2 page
2390
2391=over 4
2392
2393=item Value: $page
2394
2395=back
2396
2397Makes the resultset paged and specifies the page to retrieve. Effectively
2398identical to creating a non-pages resultset and then calling ->page($page)
2399on it.
2400
2401If L<rows> attribute is not specified it defualts to 10 rows per page.
2402
2403=head2 rows
2404
2405=over 4
2406
2407=item Value: $rows
2408
2409=back
2410
2411Specifes the maximum number of rows for direct retrieval or the number of
2412rows per page if the page attribute or method is used.
2413
2414=head2 offset
2415
2416=over 4
2417
2418=item Value: $offset
2419
2420=back
2421
2422Specifies the (zero-based) row number for the first row to be returned, or the
2423of the first row of the first page if paging is used.
2424
2425=head2 group_by
2426
2427=over 4
2428
2429=item Value: \@columns
2430
2431=back
2432
2433A arrayref of columns to group by. Can include columns of joined tables.
2434
2435 group_by => [qw/ column1 column2 ... /]
2436
2437=head2 having
2438
2439=over 4
2440
2441=item Value: $condition
2442
2443=back
2444
2445HAVING is a select statement attribute that is applied between GROUP BY and
2446ORDER BY. It is applied to the after the grouping calculations have been
2447done.
2448
2449 having => { 'count(employee)' => { '>=', 100 } }
2450
2451=head2 distinct
2452
2453=over 4
2454
2455=item Value: (0 | 1)
2456
2457=back
2458
2459Set to 1 to group by all columns.
2460
2461=head2 where
2462
2463=over 4
2464
2465Adds to the WHERE clause.
2466
2467 # only return rows WHERE deleted IS NULL for all searches
2468 __PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
2469
2470Can be overridden by passing C<{ where => undef }> as an attribute
2471to a resulset.
2472
2473=back
2474
2475=head2 cache
2476
2477Set to 1 to cache search results. This prevents extra SQL queries if you
2478revisit rows in your ResultSet:
2479
2480 my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
2481
2482 while( my $artist = $resultset->next ) {
2483 ... do stuff ...
2484 }
2485
2486 $rs->first; # without cache, this would issue a query
2487
2488By default, searches are not cached.
2489
2490For more examples of using these attributes, see
2491L<DBIx::Class::Manual::Cookbook>.
2492
2493=head2 from
2494
2495=over 4
2496
2497=item Value: \@from_clause
2498
2499=back
2500
2501The C<from> attribute gives you manual control over the C<FROM> clause of SQL
2502statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
2503clauses.
2504
2505NOTE: Use this on your own risk. This allows you to shoot off your foot!
2506
2507C<join> will usually do what you need and it is strongly recommended that you
2508avoid using C<from> unless you cannot achieve the desired result using C<join>.
2509And we really do mean "cannot", not just tried and failed. Attempting to use
2510this because you're having problems with C<join> is like trying to use x86
2511ASM because you've got a syntax error in your C. Trust us on this.
2512
2513Now, if you're still really, really sure you need to use this (and if you're
2514not 100% sure, ask the mailing list first), here's an explanation of how this
2515works.
2516
2517The syntax is as follows -
2518
2519 [
2520 { <alias1> => <table1> },
2521 [
2522 { <alias2> => <table2>, -join_type => 'inner|left|right' },
2523 [], # nested JOIN (optional)
2524 { <table1.column1> => <table2.column2>, ... (more conditions) },
2525 ],
2526 # More of the above [ ] may follow for additional joins
2527 ]
2528
2529 <table1> <alias1>
2530 JOIN
2531 <table2> <alias2>
2532 [JOIN ...]
2533 ON <table1.column1> = <table2.column2>
2534 <more joins may follow>
2535
2536An easy way to follow the examples below is to remember the following:
2537
2538 Anything inside "[]" is a JOIN
2539 Anything inside "{}" is a condition for the enclosing JOIN
2540
2541The following examples utilize a "person" table in a family tree application.
2542In order to express parent->child relationships, this table is self-joined:
2543
2544 # Person->belongs_to('father' => 'Person');
2545 # Person->belongs_to('mother' => 'Person');
2546
2547C<from> can be used to nest joins. Here we return all children with a father,
2548then search against all mothers of those children:
2549
2550 $rs = $schema->resultset('Person')->search(
2551 undef,
2552 {
2553 alias => 'mother', # alias columns in accordance with "from"
2554 from => [
2555 { mother => 'person' },
2556 [
2557 [
2558 { child => 'person' },
2559 [
2560 { father => 'person' },
2561 { 'father.person_id' => 'child.father_id' }
2562 ]
2563 ],
2564 { 'mother.person_id' => 'child.mother_id' }
2565 ],
2566 ]
2567 },
2568 );
2569
2570 # Equivalent SQL:
2571 # SELECT mother.* FROM person mother
2572 # JOIN (
2573 # person child
2574 # JOIN person father
2575 # ON ( father.person_id = child.father_id )
2576 # )
2577 # ON ( mother.person_id = child.mother_id )
2578
2579The type of any join can be controlled manually. To search against only people
2580with a father in the person table, we could explicitly use C<INNER JOIN>:
2581
2582 $rs = $schema->resultset('Person')->search(
2583 undef,
2584 {
2585 alias => 'child', # alias columns in accordance with "from"
2586 from => [
2587 { child => 'person' },
2588 [
2589 { father => 'person', -join_type => 'inner' },
2590 { 'father.id' => 'child.father_id' }
2591 ],
2592 ]
2593 },
2594 );
2595
2596 # Equivalent SQL:
2597 # SELECT child.* FROM person child
2598 # INNER JOIN person father ON child.father_id = father.id
2599
2600=cut
2601
260214.0e-64.0e-61;