Profile: /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/ResultSet.pm

File	/wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/ResultSet.pm
Statements Executed	4272128
Total Time	12.4746950003311 seconds

Subroutines — ordered by exclusive time
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
55476	1	1	7.38632	7.38632	DBIx::Class::ResultSet::	_collapse_result
55476	1	1	1.28916	18.15234	DBIx::Class::ResultSet::	_construct_object
55477	2	2	1.28712	203.87491	DBIx::Class::ResultSet::	next
55480	3	1	0.78152	1.08246	DBIx::Class::ResultSet::	cursor
55535	6	2	0.48802	4.75453	DBIx::Class::ResultSet::	result_source
55482	2	1	0.29996	0.30038	DBIx::Class::ResultSet::	_resolved_attrs
55479	2	1	0.23854	0.23854	DBIx::Class::ResultSet::	get_cache
6	3	2	0.00046	0.00171	DBIx::Class::ResultSet::	new
2	1	1	0.00025	382.60646	DBIx::Class::ResultSet::	_count
2	2	1	8.2e-5	382.60656	DBIx::Class::ResultSet::	count
1	1	1	5.1e-5	0.00031	DBIx::Class::ResultSet::	search_rs
1	1	1	1.6e-5	0.00055	DBIx::Class::ResultSet::	reset
1	1	1	1.2e-5	0.02601	DBIx::Class::ResultSet::	first
1	1	1	1.0e-5	0.00032	DBIx::Class::ResultSet::	search
0	0	0	0	0	DBIx::Class::ResultSet::	BEGIN
0	0	0	0	0	DBIx::Class::ResultSet::	__ANON__[:186]
0	0	0	0	0	DBIx::Class::ResultSet::	__ANON__[:7]
0	0	0	0	0	DBIx::Class::ResultSet::	_add_alias
0	0	0	0	0	DBIx::Class::ResultSet::	_build_unique_query
0	0	0	0	0	DBIx::Class::ResultSet::	_calculate_score
0	0	0	0	0	DBIx::Class::ResultSet::	_collapse_cond
0	0	0	0	0	DBIx::Class::ResultSet::	_collapse_query
0	0	0	0	0	DBIx::Class::ResultSet::	_cond_for_update_delete
0	0	0	0	0	DBIx::Class::ResultSet::	_is_unique_query
0	0	0	0	0	DBIx::Class::ResultSet::	_merge_attr
0	0	0	0	0	DBIx::Class::ResultSet::	_remove_alias
0	0	0	0	0	DBIx::Class::ResultSet::	_resolve_from
0	0	0	0	0	DBIx::Class::ResultSet::	_rollout_array
0	0	0	0	0	DBIx::Class::ResultSet::	_rollout_attr
0	0	0	0	0	DBIx::Class::ResultSet::	_rollout_hash
0	0	0	0	0	DBIx::Class::ResultSet::	_unique_queries
0	0	0	0	0	DBIx::Class::ResultSet::	all
0	0	0	0	0	DBIx::Class::ResultSet::	clear_cache
0	0	0	0	0	DBIx::Class::ResultSet::	count_literal
0	0	0	0	0	DBIx::Class::ResultSet::	create
0	0	0	0	0	DBIx::Class::ResultSet::	delete
0	0	0	0	0	DBIx::Class::ResultSet::	delete_all
0	0	0	0	0	DBIx::Class::ResultSet::	find
0	0	0	0	0	DBIx::Class::ResultSet::	find_or_create
0	0	0	0	0	DBIx::Class::ResultSet::	find_or_new
0	0	0	0	0	DBIx::Class::ResultSet::	get_column
0	0	0	0	0	DBIx::Class::ResultSet::	new_result
0	0	0	0	0	DBIx::Class::ResultSet::	page
0	0	0	0	0	DBIx::Class::ResultSet::	pager
0	0	0	0	0	DBIx::Class::ResultSet::	populate
0	0	0	0	0	DBIx::Class::ResultSet::	related_resultset
0	0	0	0	0	DBIx::Class::ResultSet::	search_like
0	0	0	0	0	DBIx::Class::ResultSet::	search_literal
0	0	0	0	0	DBIx::Class::ResultSet::	search_related
0	0	0	0	0	DBIx::Class::ResultSet::	set_cache
0	0	0	0	0	DBIx::Class::ResultSet::	single
0	0	0	0	0	DBIx::Class::ResultSet::	slice
0	0	0	0	0	DBIx::Class::ResultSet::	throw_exception
0	0	0	0	0	DBIx::Class::ResultSet::	update
0	0	0	0	0	DBIx::Class::ResultSet::	update_all
0	0	0	0	0	DBIx::Class::ResultSet::	update_or_create

Line	Stmts.	Exclusive Time	Avg.	Code
1				package DBIx::Class::ResultSet;
2
3	3	3.5e-5	1.2e-5	use strict; # spent 10µs making 1 call to strict::import
4	3	7.0e-5	2.3e-5	use warnings; # spent 30µs making 1 call to warnings::import
5				use overload
6				'0+' => \&count,
7				'bool' => sub { 1; },
8	3	5.2e-5	1.7e-5	fallback => 1; # spent 77µs making 1 call to overload::import
9	3	3.2e-5	1.1e-5	use Carp::Clan qw/^DBIx::Class/; # spent 101µs making 1 call to Carp::Clan::import
10	3	0.00060	0.00020	use Data::Page; # spent 4µs making 1 call to import
11	3	0.00028	9.2e-5	use Storable; # spent 68µs making 1 call to Exporter::import
12	3	0.00072	0.00024	use DBIx::Class::ResultSetColumn; # spent 4µs making 1 call to import
13	3	0.00062	0.00021	use DBIx::Class::ResultSourceHandle; # spent 4µs making 1 call to import
14	3	2.2e-5	7.3e-6	use List::Util ();
15	3	0.00726	0.00242	use base qw/DBIx::Class/; # spent 83µs making 1 call to base::import, max recursion depth 1
16
17	1	1.9e-5	1.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
21				DBIx::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
30				The resultset is also known as an iterator. It is responsible for handling
31				queries that may return an arbitrary number of rows, e.g. via L</search>
32				or a C<has_many> relationship.
33
34				In 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
66				The resultset constructor. Takes a source object (usually a
67				L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
68				L</ATTRIBUTES> below). Does not perform any queries -- these are
69				executed as needed by the other methods.
70
71				Generally you won't need to construct a resultset manually. You'll
72				automatically get one from e.g. a L</search> called in scalar context:
73
74				my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
75
76				IMPORTANT: If called on an object, proxies to new_result instead so
77
78				my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
79
80				will 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 {
85	60	0.00057	9.5e-6	my $class = shift;
86				return $class->new_result(@_) if ref $class;
87
88				my ($source, $attrs) = @_;
89				$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');
91				$attrs = { %{$attrs\|\|{}} };
92
93				if ($attrs->{page}) {
94				$attrs->{rows} \|\|= 10;
95				}
96
97				$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
101				my $self = { # spent 465µs making 6 calls to DBIx::Class::ResultSourceHandle::resolve, avg 78µs/call # spent 182µs making 6 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 30µs/call
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
110				bless $self, $class;
111
112				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
131				If you need to pass in additional attributes but no additional condition,
132				call 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
139				For a list of attributes that can be passed to C<search>, see
140				L</ATTRIBUTES>. For more examples of using this function, see
141				L<Searching\|DBIx::Class::Manual::Cookbook/Searching>. For a complete
142				documentation for the first argument, see L<SQL::Abstract>.
143
144				For 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 {
149	3	9.0e-6	3.0e-6	my $self = shift;
150				my $rs = $self->search_rs( @_ ); # spent 309µs making 1 call to DBIx::Class::ResultSet::search_rs
151				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
164				This method does the same exact thing as search() except it will
165				always 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 {
170	20	5.6e-5	2.8e-6	my $self = shift;
171
172				my $attrs = {};
173				$attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
174				my $our_attrs = { %{$self->{attrs}} };
175				my $having = delete $our_attrs->{having};
176				my $where = delete $our_attrs->{where};
177
178				my $rows;
179
180				my %safe = (alias => 1, cache => 1);
181
182				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
192				my $new_attrs = { %{$our_attrs}, %{$attrs} };
193
194				# merge new attrs into inherited
195				foreach my $key (qw/join prefetch/) {
196				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				? (
206				(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
221				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
233				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
245				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
257				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
258				if ($rows) {
259				$rs->set_cache($rows);
260				}
261				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
277				Pass a literal chunk of SQL to be added to the conditional part of the
278				resultset query.
279
280				CAVEAT: C<search_literal> is provided for Class::DBI compatibility and should
281				only be used in that context. There are known problems using C<search_literal>
282				in chained queries; it can result in bind values in the wrong order. See
283				L<DBIx::Class::Manual::Cookbook/Searching> and
284				L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
285				require C<search_literal>.
286
287				=cut
288
289				sub 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
306				Finds a row based on its primary key or unique constraint. For example, to find
307				a row by its primary key:
308
309				my $cd = $schema->resultset('CD')->find(5);
310
311				You can also find a row by a specific unique constraint using the C<key>
312				attribute. For example:
313
314				my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', {
315				key => 'cd_artist_title'
316				});
317
318				Additionally, 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
328				If the C<key> is specified as C<primary>, it searches only on the primary key.
329
330				If no C<key> is specified, it searches on all unique constraints defined on the
331				source, including the primary key.
332
333				If your table does not have a primary key, you B<must> provide a value for the
334				C<key> attribute matching one of the unique constraints on the source.
335
336				See also L</find_or_create> and L</update_or_create>. For information on how to
337				declare unique constraints, see
338				L<DBIx::Class::ResultSource/add_unique_constraint>.
339
340				=cut
341
342				sub 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
414				sub _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
429				sub _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
462				sub _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
486				Searches the specified relationship, optionally specifying a condition and
487				attributes for matching records. See L</ATTRIBUTES> for more information.
488
489				=cut
490
491				sub 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
505				Returns a storage-driven cursor to the given resultset. See
506				L<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 {
511	166440	0.76577	4.6e-6	my ($self) = @_;
512
513				my $attrs = { %{$self->_resolved_attrs} }; # spent 300ms making 55480 calls to DBIx::Class::ResultSet::_resolved_attrs, avg 5µs/call
514				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
531				Inflates the first result without creating a cursor if the resultset has
532				any records in it; if not returns nothing. Used by L</find> as an optimisation.
533
534				Can optionally take an additional condition only - this is a fast-code-path
535				method; 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
540				sub 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
574				sub _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
605				sub _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
648				Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
649
650				=cut
651
652				sub 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
671				Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
672				that this is simply a convenience method. You most likely want to use
673				L</search> with specific operators.
674
675				For more information, see L<DBIx::Class::Manual::Cookbook>.
676
677				=cut
678
679				sub 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
697				Returns a resultset or object list representing a subset of elements from the
698				resultset slice is called on. Indexes are from 0, i.e., to get the first
699				three records, call:
700
701				my ($one, $two, $three) = $rs->slice(0, 2);
702
703				=cut
704
705				sub 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
726				Returns the next element in the resultset (C<undef> is there is none).
727
728				Can 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
735				Note that you need to store the resultset object, and call C<next> on it.
736				Calling C<< resultset('Table')->next >> repeatedly will always return the
737				first 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 {
742	499290	1.72822	3.5e-6	my ($self) = @_;
743				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				}
747				if ($self->{attrs}{cache}) {
748				$self->{all_cache_position} = 1;
749				return ($self->all)[0];
750				}
751				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}
758				? @{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				);
761				return undef unless (@row);
762				my ($row, @more) = $self->_construct_object(@row); # spent 18.2s making 55476 calls to DBIx::Class::ResultSet::_construct_object, avg 327µs/call
763				$self->{stashed_objects} = \@more if @more;
764				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 {
768	277380	1.78660	6.4e-6	my ($self, @row) = @_;
769				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
770				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
771				@new = $self->{_attrs}{record_filter}->(@new)
772				if exists $self->{_attrs}{record_filter};
773				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 {
777	2995682	7.23720	2.4e-6	my ($self, $as_proto, $row) = @_;
778
779				my @copy = @$row;
780
781				# 'foo' => [ undef, 'foo' ]
782				# 'foo.bar' => [ 'foo', 'bar' ]
783				# 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
784
785				my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
786
787				my %collapse = %{$self->{_attrs}{collapse}\|\|{}};
788
789				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
802				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
815				my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
816
817				my @const_rows;
818
819				do { # no need to check anything at the front, we always want the first row
820
821				my %const;
822
823				foreach my $this_as (@construct_as) {
824				$const{$this_as->[0]\|\|''}{$this_as->[1]} = shift(@copy);
825				}
826
827				push(@const_rows, \%const);
828
829				} until ( # no pri_index => no collapse => drop straight out
830				!@pri_index
831				or
832				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
849				my $alias = $self->{attrs}{alias};
850				my $info = [];
851
852				my %collapse_pos;
853
854				my @const_keys;
855
856				foreach my $const (@const_rows) {
857				scalar @const_keys or do {
858				@const_keys = sort { length($a) <=> length($b) } keys %$const;
859				};
860				foreach my $key (@const_keys) {
861				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 {
889				$info->[0] = $const->{$key};
890				}
891				}
892				}
893
894				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
907				An accessor for the primary ResultSource object from which this ResultSet
908				is 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
920				An accessor for the class to use when creating row objects. Defaults to
921				C<< result_source->result_class >> - which in most cases is the name of the
922				L<"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
937				Performs an SQL C<COUNT> with the same query as the resultset was built
938				with to find the number of elements. If passed arguments, does a search
939				on the resultset and counts the results of that.
940
941				Note: When using C<count> with C<group_by>, L<DBIx::Class> emulates C<GROUP BY>
942				using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
943				not support C<DISTINCT> with multiple columns. If you are using such a
944				database, you should only use columns from the main table in your C<group_by>
945				clause.
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 {
950	18	6.8e-5	3.8e-6	my $self = shift;
951				return $self->search(@_)->count if @_ and defined $_[0];
952				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
953	1	5.4e-5	5.4e-5	my $count = $self->_count; # spent 383s making 2 calls to DBIx::Class::ResultSet::_count, avg 191s/call
954				return 0 unless $count;
955
956				# need to take offset from resolved attrs
957
958				$count -= $self->{_attrs}{offset} if $self->{_attrs}{offset};
959				$count = $self->{attrs}{rows} if
960				$self->{attrs}{rows} and $self->{attrs}{rows} < $count;
961				$count = 0 if ($count < 0);
962				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
966	22	0.00019	8.5e-6	my $self = shift;
967				my $select = { count => '*' };
968
969				my $attrs = { %{$self->_resolved_attrs} }; # spent 442µs making 2 calls to DBIx::Class::ResultSet::_resolved_attrs, avg 221µs/call
970				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
988				$attrs->{select} = $select;
989				$attrs->{as} = [qw/count/];
990
991				# offset, order by and page are not needed to count. record_filter is cdbi
992				delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
993
994				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
995				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
996				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
1009				Counts the results in a literal query. Equivalent to calling L</search_literal>
1010				with the passed arguments, then L</count>.
1011
1012				=cut
1013
1014				sub 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
1026				Returns all elements in the resultset. Called implicitly if the resultset
1027				is returned in list context.
1028
1029				=cut
1030
1031				sub 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
1069				Resets 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 {
1074	5	2.2e-5	4.4e-6	my ($self) = @_;
1075				delete $self->{_attrs} if exists $self->{_attrs};
1076				$self->{all_cache_position} = 0;
1077				$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
1078				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
1091				Resets the resultset and returns an object for the first result (if the
1092				resultset 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 {
1097	1	1.6e-5	1.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
1106				sub _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
1173				Sets the specified columns in the resultset to the supplied values in a
1174				single query. Return value will be true if the update succeeded or false
1175				if no records were updated; exact type of success value is storage-dependent.
1176
1177				=cut
1178
1179				sub 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
1201				Fetches all objects and updates them one at a time. Note that C<update_all>
1202				will run DBIC cascade triggers, while L</update> will not.
1203
1204				=cut
1205
1206				sub 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
1226				Deletes the contents of the resultset from its result source. Note that this
1227				will not run DBIC cascade triggers. See L</delete_all> if you need triggers
1228				to run. See also L<DBIx::Class::Row/delete>.
1229
1230				=cut
1231
1232				sub 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
1251				Fetches all objects and deletes them one at a time. Note that C<delete_all>
1252				will run DBIC cascade triggers, while L</delete> will not.
1253
1254				=cut
1255
1256				sub 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
1270				Pass an arrayref of hashrefs. Each hashref should be a structure suitable for
1271				submitting to a $resultset->create(...) method.
1272
1273				In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
1274				to insert the data, as this is a faster method.
1275
1276				Otherwise, each set of data is inserted into the database using
1277				L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
1278				objects is returned.
1279
1280				Example: 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
1312				Please note an important effect on your data when choosing between void and
1313				wantarray context. Since void context goes straight to C<insert_bulk> in
1314				L<DBIx::Class::Storage::DBI> this will skip any component that is overriding
1315				c<insert>. So if you are using something like L<DBIx-Class-UUIDColumns> to
1316				create primary keys for you, you will find that your PKs are empty. In this
1317				case you will have to use the wantarray context in order to create those
1318				values.
1319
1320				=cut
1321
1322				sub 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
1407				Return Value a L<Data::Page> object for the current resultset. Only makes
1408				sense for queries with a C<page> attribute.
1409
1410				=cut
1411
1412				sub 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
1432				Returns a resultset for the $page_number page of the resultset on which page
1433				is called, where each page contains a number of rows equal to the 'rows'
1434				attribute set on the resultset (10 by default).
1435
1436				=cut
1437
1438				sub 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
1453				Creates a new row object in the resultset's result class and returns
1454				it. The row is not inserted into the database at this point, call
1455				L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
1456				will tell you whether the row object has been inserted or not.
1457
1458				Passes the hashref of input on to L<DBIx::Class::Row/new>.
1459
1460				=cut
1461
1462				sub 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
1489				sub _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
1525				sub _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
1553				Find an existing record from this resultset. If none exists, instantiate a new
1554				result object and return it. The object will not be saved into your storage
1555				until you call L<DBIx::Class::Row/insert> on it.
1556
1557				If you want objects to be saved immediately, use L</find_or_create> instead.
1558
1559				=cut
1560
1561				sub 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
1579				Attempt to create a single new row or a row with multiple related rows
1580				in the table represented by the resultset (and related tables). This
1581				will not check for duplicate rows before inserting, use
1582				L</find_or_create> to do that.
1583
1584				To create one row for this resultset, pass a hashref of key/value
1585				pairs representing the columns of the table and the values you wish to
1586				store. If the appropriate relationships are set up, foreign key fields
1587				can also be passed an object representing the foreign row, and the
1588				value will be set to it's primary key.
1589
1590				To create related objects, pass a hashref for the value if the related
1591				item is a foreign key relationship (L<DBIx::Class::Relationship/belongs_to>),
1592				and use the name of the relationship as the key. (NOT the name of the field,
1593				necessarily). For C<has_many> and C<has_one> relationships, pass an arrayref
1594				of hashrefs containing the data for each of the rows to create in the foreign
1595				tables, again using the relationship name as the key.
1596
1597				Instead of hashrefs of plain related data (key/value pairs), you may
1598				also pass new or inserted objects. New objects (not inserted yet, see
1599				L</new>), will be inserted into their appropriate tables.
1600
1601				Effectively a shortcut for C<< ->new_result(\%vals)->insert >>.
1602
1603				Example of creating a new row.
1604
1605				$person_rs->create({
1606				name=>"Some Person",
1607				email=>"somebody@someplace.com"
1608				});
1609
1610				Example of creating a new row and also creating rows in a related C<has_many>
1611				or 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
1621				Example of creating a new row and also creating a row in a related
1622				C<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
1634				sub 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
1653				Tries to find a record based on its primary key or unique constraint; if none
1654				is 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
1663				Also takes an optional C<key> attribute, to search by a specific key or unique
1664				constraint. 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
1674				See also L</find> and L</update_or_create>. For information on how to declare
1675				unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1676
1677				=cut
1678
1679				sub 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
1699				First, 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
1701				found, updates it with the other given column values. Otherwise, creates a new
1702				row.
1703
1704				Takes an optional C<key> attribute to search on a specific unique constraint.
1705				For 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
1717				If no C<key> is specified, it searches on all unique constraints defined on the
1718				source, including the primary key.
1719
1720				If the C<key> is specified as C<primary>, it searches only on the primary key.
1721
1722				See also L</find> and L</find_or_create>. For information on how to declare
1723				unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
1724
1725				=cut
1726
1727				sub 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
1751				Gets 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 {
1756	55479	0.12198	2.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
1769				Sets the contents of the cache for the resultset. Expects an arrayref
1770				of objects of the same class as those produced by the resultset. Note that
1771				if the cache is set the resultset will return the cached objects rather
1772				than re-querying the database even if the cache attr is not set.
1773
1774				=cut
1775
1776				sub 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
1793				Clears the cache for the resultset.
1794
1795				=cut
1796
1797				sub 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
1811				Returns a related resultset for the supplied relationship name.
1812
1813				$artist_rs = $schema->resultset('CD')->related_resultset('Artist');
1814
1815				=cut
1816
1817				sub 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
1878				sub _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 {
1905	111090	0.17618	1.6e-6	my $self = shift;
1906				return $self->{_attrs} if $self->{_attrs};
1907
1908				my $attrs = { %{$self->{attrs}\|\|{}} };
1909				my $source = $self->result_source; # spent 356µs making 4 calls to DBIx::Class::ResultSet::result_source, avg 89µs/call
1910				my $alias = $attrs->{alias};
1911
1912				$attrs->{columns} \|\|= delete $attrs->{cols} if exists $attrs->{cols};
1913				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'
1922				? [ @{$attrs->{select}} ]
1923				: [ $attrs->{select} ])
1924				: [ map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} ]
1925				);
1926				$attrs->{as} =
1927				($attrs->{as}
1928				? (ref $attrs->{as} eq 'ARRAY'
1929				? [ @{$attrs->{as}} ]
1930				: [ $attrs->{as} ])
1931				: [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} ]
1932				);
1933
1934				my $adds;
1935				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				}
1940				if ($adds = delete $attrs->{'+select'}) {
1941				$adds = [$adds] unless ref $adds eq 'ARRAY';
1942				push(@{$attrs->{select}},
1943				map { /\./ \|\| ref $_ ? $_ : "${alias}.$_" } @$adds);
1944				}
1945				if (my $adds = delete $attrs->{'+as'}) {
1946				$adds = [$adds] unless ref $adds eq 'ARRAY';
1947				push(@{$attrs->{as}}, @$adds);
1948				}
1949
1950				$attrs->{from} \|\|= [ { 'me' => $source->from } ]; # spent 56µs making 2 calls to DBIx::Class::ResultSource::Table::from, avg 28µs/call
1951
1952				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
1970				$attrs->{group_by} \|\|= $attrs->{select} if delete $attrs->{distinct};
1971				if ($attrs->{order_by}) {
1972				$attrs->{order_by} = (ref($attrs->{order_by}) eq 'ARRAY'
1973				? [ @{$attrs->{order_by}} ]
1974				: [ $attrs->{order_by} ]);
1975				} else {
1976				$attrs->{order_by} = [];
1977				}
1978
1979				my $collapse = $attrs->{collapse} \|\| {};
1980				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				}
1994				$attrs->{collapse} = $collapse;
1995
1996				if ($attrs->{page}) {
1997				$attrs->{offset} \|\|= 0;
1998				$attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
1999				}
2000
2001				return $self->{_attrs} = $attrs;
2002				}
2003
2004				sub _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
2016				sub _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
2033				sub _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
2043				sub _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
2068				sub _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 {
2110	166605	0.64807	3.9e-6	my $self = shift;
2111
2112				if (@_) {
2113				$self->_source_handle($_[0]->handle);
2114				} else {
2115				$self->_source_handle->resolve; # spent 3.59s making 55535 calls to DBIx::Class::ResultSourceHandle::resolve, avg 65µs/call # spent 674ms making 55535 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 12µs/call
2116				}
2117				}
2118
2119				=head2 throw_exception
2120
2121				See L<DBIx::Class::Schema/throw_exception> for details.
2122
2123				=cut
2124
2125				sub 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
2134				The resultset takes various attributes that modify its behavior. Here's an
2135				overview of them:
2136
2137				=head2 order_by
2138
2139				=over 4
2140
2141				=item Value: ($order_by \| \@order_by)
2142
2143				=back
2144
2145				Which column(s) to order the results by. This is currently passed
2146				through directly to SQL, so you can give e.g. C<year DESC> for a
2147				descending order on the column `year'.
2148
2149				Please note that if you have C<quote_char> enabled (see
2150				L<DBIx::Class::Storage::DBI/connect_info>) you will need to do C<\'year DESC' > to
2151				specify an order. (The scalar ref causes it to be passed as raw sql to the DB,
2152				so 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
2162				Shortcut to request a particular set of columns to be retrieved. Adds
2163				C<me.> onto the start of any column without a C<.> in it and sets C<select>
2164				from that, then auto-populates C<as> from C<select> as normal. (You may also
2165				use 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
2175				Shortcut 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
2182				would return all CDs and include a 'name' column to the information
2183				passed to object inflation. Note that the 'artist' is the name of the
2184				column (or relationship) accessor, and 'name' is the name of the column
2185				accessor in the related table.
2186
2187				=head2 select
2188
2189				=over 4
2190
2191				=item Value: \@select_columns
2192
2193				=back
2194
2195				Indicates which columns should be selected from the storage. You can use
2196				column names, or in the case of RDBMS back ends, function or stored procedure
2197				names:
2198
2199				$rs = $schema->resultset('Employee')->search(undef, {
2200				select => [
2201				'name',
2202				{ count => 'employeeid' },
2203				{ sum => 'salary' }
2204				]
2205				});
2206
2207				When you use function/stored procedure names and do not supply an C<as>
2208				attribute, the column names returned are storage-dependent. E.g. MySQL would
2209				return a column named C<count(employeeid)> in the above example.
2210
2211				=head2 +select
2212
2213				=over 4
2214
2215				Indicates additional columns to be selected from storage. Works the same as
2216				L</select> but adds columns to the selection.
2217
2218				=back
2219
2220				=head2 +as
2221
2222				=over 4
2223
2224				Indicates 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
2236				Indicates column names for object inflation. That is, C<as>
2237				indicates the name that the column can be accessed as via the
2238				C<get_column> method (or via the object accessor, B<if one already
2239				exists>). It has nothing to do with the SQL code C<SELECT foo AS bar>.
2240
2241				The C<as> attribute is used in conjunction with C<select>,
2242				usually when C<select> contains one or more function or stored
2243				procedure 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
2255				If the object against which the search is performed already has an accessor
2256				matching a column name specified in C<as>, the value can be retrieved using
2257				the accessor as normal:
2258
2259				my $name = $employee->name();
2260
2261				If on the other hand an accessor does not exist in the object, you need to
2262				use C<get_column> instead:
2263
2264				my $employee_count = $employee->get_column('employee_count');
2265
2266				You can create your own accessors if required - see
2267				L<DBIx::Class::Manual::Cookbook> for details.
2268
2269				Please note: This will NOT insert an C<AS employee_count> into the SQL
2270				statement produced, it is used for internal access only. Thus
2271				attempting to use the accessor in an C<order_by> clause or similar
2272				will fail miserably.
2273
2274				To get around this limitation, you can supply literal SQL to your
2275				C<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
2287				Contains a list of relationships that should be joined for this query. For
2288				example:
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
2296				Can also contain a hash reference to refer to the other relation's relations.
2297				For 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
2316				You need to use the relationship (not the table) name in conditions,
2317				because they are aliased as such. The current table is aliased as "me", so
2318				you 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
2329				If the same join is supplied twice, it will be aliased to <rel>_2 (and
2330				similarly 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
2339				will return a set of all artists that have both a cd with title 'Down
2340				to Earth' and a cd with title 'Popular'.
2341
2342				If you want to fetch related objects from other tables as well, see C<prefetch>
2343				below.
2344
2345				For 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
2355				Contains one or more relationships that should be fetched along with
2356				the main query (when they are accessed afterwards the data will
2357				already be available, without extra queries to the database). This is
2358				useful for when you know you will need the related objects, because it
2359				saves at least one query:
2360
2361				my $rs = $schema->resultset('Tag')->search(
2362				undef,
2363				{
2364				prefetch => {
2365				cd => 'artist'
2366				}
2367				}
2368				);
2369
2370				The 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
2376				L<DBIx::Class> has no need to go back to the database when we access the
2377				C<cd> or C<artist> relationships, which saves us two SQL statements in this
2378				case.
2379
2380				Simple prefetches will be joined automatically, so there is no need
2381				for a C<join> attribute in the above search. If you're prefetching to
2382				depth (e.g. { cd => { artist => 'label' } or similar), you'll need to
2383				specify the join as well.
2384
2385				C<prefetch> can be used with the following relationship types: C<belongs_to>,
2386				C<has_one> (or if you're using C<add_relationship>, any relationship declared
2387				with an accessor type of 'single' or 'filter').
2388
2389				=head2 page
2390
2391				=over 4
2392
2393				=item Value: $page
2394
2395				=back
2396
2397				Makes the resultset paged and specifies the page to retrieve. Effectively
2398				identical to creating a non-pages resultset and then calling ->page($page)
2399				on it.
2400
2401				If 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
2411				Specifes the maximum number of rows for direct retrieval or the number of
2412				rows 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
2422				Specifies the (zero-based) row number for the first row to be returned, or the
2423				of 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
2433				A 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
2445				HAVING is a select statement attribute that is applied between GROUP BY and
2446				ORDER BY. It is applied to the after the grouping calculations have been
2447				done.
2448
2449				having => { 'count(employee)' => { '>=', 100 } }
2450
2451				=head2 distinct
2452
2453				=over 4
2454
2455				=item Value: (0 \| 1)
2456
2457				=back
2458
2459				Set to 1 to group by all columns.
2460
2461				=head2 where
2462
2463				=over 4
2464
2465				Adds to the WHERE clause.
2466
2467				# only return rows WHERE deleted IS NULL for all searches
2468				__PACKAGE__->resultset_attributes({ where => { deleted => undef } }); )
2469
2470				Can be overridden by passing C<{ where => undef }> as an attribute
2471				to a resulset.
2472
2473				=back
2474
2475				=head2 cache
2476
2477				Set to 1 to cache search results. This prevents extra SQL queries if you
2478				revisit 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
2488				By default, searches are not cached.
2489
2490				For more examples of using these attributes, see
2491				L<DBIx::Class::Manual::Cookbook>.
2492
2493				=head2 from
2494
2495				=over 4
2496
2497				=item Value: \@from_clause
2498
2499				=back
2500
2501				The C<from> attribute gives you manual control over the C<FROM> clause of SQL
2502				statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
2503				clauses.
2504
2505				NOTE: Use this on your own risk. This allows you to shoot off your foot!
2506
2507				C<join> will usually do what you need and it is strongly recommended that you
2508				avoid using C<from> unless you cannot achieve the desired result using C<join>.
2509				And we really do mean "cannot", not just tried and failed. Attempting to use
2510				this because you're having problems with C<join> is like trying to use x86
2511				ASM because you've got a syntax error in your C. Trust us on this.
2512
2513				Now, if you're still really, really sure you need to use this (and if you're
2514				not 100% sure, ask the mailing list first), here's an explanation of how this
2515				works.
2516
2517				The 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
2536				An 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
2541				The following examples utilize a "person" table in a family tree application.
2542				In 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
2547				C<from> can be used to nest joins. Here we return all children with a father,
2548				then 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
2579				The type of any join can be controlled manually. To search against only people
2580				with 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
2602	1	4.0e-6	4.0e-6	1;