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

Filename/usr/share/perl5/DBIx/Class/ResultSet.pm
StatementsExecuted 113 statements in 199µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
92111.1ms11.1msDBIx::Class::ResultSet::::get_cacheDBIx::Class::ResultSet::get_cache
1111.54ms1.94msDBIx::Class::ResultSet::::BEGIN@7DBIx::Class::ResultSet::BEGIN@7
611362µs983µsDBIx::Class::ResultSet::::result_classDBIx::Class::ResultSet::result_class
622236µs1.49msDBIx::Class::ResultSet::::newDBIx::Class::ResultSet::new
311226µs11.6msDBIx::Class::ResultSet::::search_rsDBIx::Class::ResultSet::search_rs
611114µs114µsDBIx::Class::ResultSet::::_normalize_selectionDBIx::Class::ResultSet::_normalize_selection
11112µs18µsDBIx::Class::ResultSet::::BEGIN@3DBIx::Class::ResultSet::BEGIN@3
11111µs46µsDBIx::Class::ResultSet::::BEGIN@26DBIx::Class::ResultSet::BEGIN@26
11111µs38µsDBIx::Class::ResultSet::::BEGIN@8DBIx::Class::ResultSet::BEGIN@8
11110µs58µsDBIx::Class::ResultSet::::BEGIN@5DBIx::Class::ResultSet::BEGIN@5
1119µs30µsDBIx::Class::ResultSet::::BEGIN@12DBIx::Class::ResultSet::BEGIN@12
1119µs178µsDBIx::Class::ResultSet::::BEGIN@23DBIx::Class::ResultSet::BEGIN@23
1119µs57µsDBIx::Class::ResultSet::::BEGIN@6DBIx::Class::ResultSet::BEGIN@6
1118µs29µsDBIx::Class::ResultSet::::BEGIN@9DBIx::Class::ResultSet::BEGIN@9
1117µs11µsDBIx::Class::ResultSet::::BEGIN@4DBIx::Class::ResultSet::BEGIN@4
1113µs3µsDBIx::Class::ResultSet::::BEGIN@17DBIx::Class::ResultSet::BEGIN@17
1113µs3µsDBIx::Class::ResultSet::::BEGIN@15DBIx::Class::ResultSet::BEGIN@15
0000s0sDBIx::Class::ResultSet::::STORABLE_freezeDBIx::Class::ResultSet::STORABLE_freeze
0000s0sDBIx::Class::ResultSet::::STORABLE_thawDBIx::Class::ResultSet::STORABLE_thaw
0000s0sDBIx::Class::ResultSet::::__ANON__[:1487]DBIx::Class::ResultSet::__ANON__[:1487]
0000s0sDBIx::Class::ResultSet::::__ANON__[:1909]DBIx::Class::ResultSet::__ANON__[:1909]
0000s0sDBIx::Class::ResultSet::::__ANON__[:2536]DBIx::Class::ResultSet::__ANON__[:2536]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3524]DBIx::Class::ResultSet::__ANON__[:3524]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3712]DBIx::Class::ResultSet::__ANON__[:3712]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3908]DBIx::Class::ResultSet::__ANON__[:3908]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3911]DBIx::Class::ResultSet::__ANON__[:3911]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3913]DBIx::Class::ResultSet::__ANON__[:3913]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3919]DBIx::Class::ResultSet::__ANON__[:3919]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3924]DBIx::Class::ResultSet::__ANON__[:3924]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3926]DBIx::Class::ResultSet::__ANON__[:3926]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3933]DBIx::Class::ResultSet::__ANON__[:3933]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3937]DBIx::Class::ResultSet::__ANON__[:3937]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3939]DBIx::Class::ResultSet::__ANON__[:3939]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3947]DBIx::Class::ResultSet::__ANON__[:3947]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3952]DBIx::Class::ResultSet::__ANON__[:3952]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3954]DBIx::Class::ResultSet::__ANON__[:3954]
0000s0sDBIx::Class::ResultSet::::__ANON__[:3961]DBIx::Class::ResultSet::__ANON__[:3961]
0000s0sDBIx::Class::ResultSet::::__ANON__[:467]DBIx::Class::ResultSet::__ANON__[:467]
0000s0sDBIx::Class::ResultSet::::__ANON__[:491]DBIx::Class::ResultSet::__ANON__[:491]
0000s0sDBIx::Class::ResultSet::::__ANON__[:889]DBIx::Class::ResultSet::__ANON__[:889]
0000s0sDBIx::Class::ResultSet::::__ANON__[:892]DBIx::Class::ResultSet::__ANON__[:892]
0000s0sDBIx::Class::ResultSet::::_build_unique_condDBIx::Class::ResultSet::_build_unique_cond
0000s0sDBIx::Class::ResultSet::::_calculate_scoreDBIx::Class::ResultSet::_calculate_score
0000s0sDBIx::Class::ResultSet::::_chain_relationshipDBIx::Class::ResultSet::_chain_relationship
0000s0sDBIx::Class::ResultSet::::_construct_resultsDBIx::Class::ResultSet::_construct_results
0000s0sDBIx::Class::ResultSet::::_count_rsDBIx::Class::ResultSet::_count_rs
0000s0sDBIx::Class::ResultSet::::_count_subq_rsDBIx::Class::ResultSet::_count_subq_rs
0000s0sDBIx::Class::ResultSet::::_has_resolved_attrDBIx::Class::ResultSet::_has_resolved_attr
0000s0sDBIx::Class::ResultSet::::_merge_attrDBIx::Class::ResultSet::_merge_attr
0000s0sDBIx::Class::ResultSet::::_merge_joinpref_attrDBIx::Class::ResultSet::_merge_joinpref_attr
0000s0sDBIx::Class::ResultSet::::_merge_with_rscondDBIx::Class::ResultSet::_merge_with_rscond
0000s0sDBIx::Class::ResultSet::::_non_unique_find_fallbackDBIx::Class::ResultSet::_non_unique_find_fallback
0000s0sDBIx::Class::ResultSet::::_qualify_cond_columnsDBIx::Class::ResultSet::_qualify_cond_columns
0000s0sDBIx::Class::ResultSet::::_remove_aliasDBIx::Class::ResultSet::_remove_alias
0000s0sDBIx::Class::ResultSet::::_resolved_attrsDBIx::Class::ResultSet::_resolved_attrs
0000s0sDBIx::Class::ResultSet::::_rollout_arrayDBIx::Class::ResultSet::_rollout_array
0000s0sDBIx::Class::ResultSet::::_rollout_attrDBIx::Class::ResultSet::_rollout_attr
0000s0sDBIx::Class::ResultSet::::_rollout_hashDBIx::Class::ResultSet::_rollout_hash
0000s0sDBIx::Class::ResultSet::::_rs_update_deleteDBIx::Class::ResultSet::_rs_update_delete
0000s0sDBIx::Class::ResultSet::::_stack_condDBIx::Class::ResultSet::_stack_cond
0000s0sDBIx::Class::ResultSet::::allDBIx::Class::ResultSet::all
0000s0sDBIx::Class::ResultSet::::as_queryDBIx::Class::ResultSet::as_query
0000s0sDBIx::Class::ResultSet::::as_subselect_rsDBIx::Class::ResultSet::as_subselect_rs
0000s0sDBIx::Class::ResultSet::::clear_cacheDBIx::Class::ResultSet::clear_cache
0000s0sDBIx::Class::ResultSet::::countDBIx::Class::ResultSet::count
0000s0sDBIx::Class::ResultSet::::count_literalDBIx::Class::ResultSet::count_literal
0000s0sDBIx::Class::ResultSet::::count_rsDBIx::Class::ResultSet::count_rs
0000s0sDBIx::Class::ResultSet::::createDBIx::Class::ResultSet::create
0000s0sDBIx::Class::ResultSet::::current_source_aliasDBIx::Class::ResultSet::current_source_alias
0000s0sDBIx::Class::ResultSet::::cursorDBIx::Class::ResultSet::cursor
0000s0sDBIx::Class::ResultSet::::deleteDBIx::Class::ResultSet::delete
0000s0sDBIx::Class::ResultSet::::delete_allDBIx::Class::ResultSet::delete_all
0000s0sDBIx::Class::ResultSet::::findDBIx::Class::ResultSet::find
0000s0sDBIx::Class::ResultSet::::find_or_createDBIx::Class::ResultSet::find_or_create
0000s0sDBIx::Class::ResultSet::::find_or_newDBIx::Class::ResultSet::find_or_new
0000s0sDBIx::Class::ResultSet::::firstDBIx::Class::ResultSet::first
0000s0sDBIx::Class::ResultSet::::get_columnDBIx::Class::ResultSet::get_column
0000s0sDBIx::Class::ResultSet::::is_orderedDBIx::Class::ResultSet::is_ordered
0000s0sDBIx::Class::ResultSet::::is_pagedDBIx::Class::ResultSet::is_paged
0000s0sDBIx::Class::ResultSet::::new_resultDBIx::Class::ResultSet::new_result
0000s0sDBIx::Class::ResultSet::::nextDBIx::Class::ResultSet::next
0000s0sDBIx::Class::ResultSet::::pageDBIx::Class::ResultSet::page
0000s0sDBIx::Class::ResultSet::::pagerDBIx::Class::ResultSet::pager
0000s0sDBIx::Class::ResultSet::::populateDBIx::Class::ResultSet::populate
0000s0sDBIx::Class::ResultSet::::related_resultsetDBIx::Class::ResultSet::related_resultset
0000s0sDBIx::Class::ResultSet::::resetDBIx::Class::ResultSet::reset
0000s0sDBIx::Class::ResultSet::::searchDBIx::Class::ResultSet::search
0000s0sDBIx::Class::ResultSet::::search_likeDBIx::Class::ResultSet::search_like
0000s0sDBIx::Class::ResultSet::::search_literalDBIx::Class::ResultSet::search_literal
0000s0sDBIx::Class::ResultSet::::search_relatedDBIx::Class::ResultSet::search_related
0000s0sDBIx::Class::ResultSet::::search_related_rsDBIx::Class::ResultSet::search_related_rs
0000s0sDBIx::Class::ResultSet::::set_cacheDBIx::Class::ResultSet::set_cache
0000s0sDBIx::Class::ResultSet::::singleDBIx::Class::ResultSet::single
0000s0sDBIx::Class::ResultSet::::sliceDBIx::Class::ResultSet::slice
0000s0sDBIx::Class::ResultSet::::throw_exceptionDBIx::Class::ResultSet::throw_exception
0000s0sDBIx::Class::ResultSet::::updateDBIx::Class::ResultSet::update
0000s0sDBIx::Class::ResultSet::::update_allDBIx::Class::ResultSet::update_all
0000s0sDBIx::Class::ResultSet::::update_or_createDBIx::Class::ResultSet::update_or_create
0000s0sDBIx::Class::ResultSet::::update_or_newDBIx::Class::ResultSet::update_or_new
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package DBIx::Class::ResultSet;
2
3224µs
# spent 18µs (12+6) within DBIx::Class::ResultSet::BEGIN@3 which was called: # once (12µs+6µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 3
use strict;
# spent 18µs making 1 call to DBIx::Class::ResultSet::BEGIN@3 # spent 6µs making 1 call to strict::import
4214µs
# spent 11µs (7+4) within DBIx::Class::ResultSet::BEGIN@4 which was called: # once (7µs+4µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 4
use warnings;
# spent 11µs making 1 call to DBIx::Class::ResultSet::BEGIN@4 # spent 4µs making 1 call to warnings::import
5258µs
# spent 58µs (10+48) within DBIx::Class::ResultSet::BEGIN@5 which was called: # once (10µs+48µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 5
use base qw/DBIx::Class/;
# spent 58µs making 1 call to DBIx::Class::ResultSet::BEGIN@5 # spent 48µs making 1 call to base::import, recursion: max depth 1, sum of overlapping time 48µs
62105µs
# spent 57µs (9+48) within DBIx::Class::ResultSet::BEGIN@6 which was called: # once (9µs+48µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 6
use DBIx::Class::Carp;
# spent 57µs making 1 call to DBIx::Class::ResultSet::BEGIN@6 # spent 48µs making 1 call to DBIx::Class::Carp::import
711.94ms
# spent 1.94ms (1.54+403µs) within DBIx::Class::ResultSet::BEGIN@7 which was called: # once (1.54ms+403µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 7
use DBIx::Class::ResultSetColumn;
# spent 1.94ms making 1 call to DBIx::Class::ResultSet::BEGIN@7
8265µs
# spent 38µs (11+27) within DBIx::Class::ResultSet::BEGIN@8 which was called: # once (11µs+27µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 8
use Scalar::Util qw/blessed weaken reftype/;
# spent 38µs making 1 call to DBIx::Class::ResultSet::BEGIN@8 # spent 27µs making 1 call to Exporter::import
9121µs
# spent 29µs (8+21) within DBIx::Class::ResultSet::BEGIN@9 which was called: # once (8µs+21µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 11
use DBIx::Class::_Util qw(
# spent 21µs making 1 call to Exporter::import
10 fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION
11129µs);
# spent 29µs making 1 call to DBIx::Class::ResultSet::BEGIN@9
12252µs
# spent 30µs (9+21) within DBIx::Class::ResultSet::BEGIN@12 which was called: # once (9µs+21µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 12
use Try::Tiny;
# spent 30µs making 1 call to DBIx::Class::ResultSet::BEGIN@12 # spent 21µs making 1 call to Exporter::import
13
14# not importing first() as it will clash with our own method
1513µs
# spent 3µs within DBIx::Class::ResultSet::BEGIN@15 which was called: # once (3µs+0s) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 15
use List::Util ();
# spent 3µs making 1 call to DBIx::Class::ResultSet::BEGIN@15
16
17
# spent 3µs within DBIx::Class::ResultSet::BEGIN@17 which was called: # once (3µs+0s) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 21
BEGIN {
18 # De-duplication in _merge_attr() is disabled, but left in for reference
19 # (the merger is used for other things that ought not to be de-duped)
20 *__HM_DEDUP = sub () { 0 };
2113µs}
# spent 3µs making 1 call to DBIx::Class::ResultSet::BEGIN@17
22
232346µs
# spent 178µs (9+169) within DBIx::Class::ResultSet::BEGIN@23 which was called: # once (9µs+169µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 23
use namespace::clean;
# spent 178µs making 1 call to DBIx::Class::ResultSet::BEGIN@23 # spent 169µs making 1 call to namespace::clean::import
24
25use overload
26136µs
# spent 46µs (11+36) within DBIx::Class::ResultSet::BEGIN@26 which was called: # once (11µs+36µs) by DBIx::Class::ResultSource::Table::BEGIN@6 at line 28
'0+' => "count",
# spent 36µs making 1 call to overload::import
27 'bool' => "_bool",
28146µs fallback => 1;
# spent 46µs making 1 call to DBIx::Class::ResultSet::BEGIN@26
29
30# this is real - CDBICompat overrides it with insanity
31# yes, prototype won't matter, but that's for now ;)
32sub _bool () { 1 }
33
341165µs__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
# spent 165µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
35
36=head1 NAME
37
38DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
39
40=head1 SYNOPSIS
41
42 my $users_rs = $schema->resultset('User');
43 while( $user = $users_rs->next) {
44 print $user->username;
45 }
46
47 my $registered_users_rs = $schema->resultset('User')->search({ registered => 1 });
48 my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
49
50=head1 DESCRIPTION
51
52A ResultSet is an object which stores a set of conditions representing
53a query. It is the backbone of DBIx::Class (i.e. the really
54important/useful bit).
55
56No SQL is executed on the database when a ResultSet is created, it
57just stores all the conditions needed to create the query.
58
59A basic ResultSet representing the data of an entire table is returned
60by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
61L<Source|DBIx::Class::Manual::Glossary/ResultSource> name.
62
63 my $users_rs = $schema->resultset('User');
64
65A new ResultSet is returned from calling L</search> on an existing
66ResultSet. The new one will contain all the conditions of the
67original, plus any new conditions added in the C<search> call.
68
69A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
70can be used to walk through all the L<DBIx::Class::Row>s the ResultSet
71represents.
72
73The query that the ResultSet represents is B<only> executed against
74the database when these methods are called:
75L</find>, L</next>, L</all>, L</first>, L</single>, L</count>.
76
77If a resultset is used in a numeric context it returns the L</count>.
78However, if it is used in a boolean context it is B<always> true. So if
79you want to check if a resultset has any results, you must use C<if $rs
80!= 0>.
81
82=head1 EXAMPLES
83
84=head2 Chaining resultsets
85
86Let's say you've got a query that needs to be run to return some data
87to the user. But, you have an authorization system in place that
88prevents certain users from seeing certain information. So, you want
89to construct the basic query in one method, but add constraints to it in
90another.
91
92 sub get_data {
93 my $self = shift;
94 my $request = $self->get_request; # Get a request object somehow.
95 my $schema = $self->result_source->schema;
96
97 my $cd_rs = $schema->resultset('CD')->search({
98 title => $request->param('title'),
99 year => $request->param('year'),
100 });
101
102 $cd_rs = $self->apply_security_policy( $cd_rs );
103
104 return $cd_rs->all();
105 }
106
107 sub apply_security_policy {
108 my $self = shift;
109 my ($rs) = @_;
110
111 return $rs->search({
112 subversive => 0,
113 });
114 }
115
116=head3 Resolving conditions and attributes
117
118When a resultset is chained from another resultset (e.g.:
119C<< my $new_rs = $old_rs->search(\%extra_cond, \%attrs) >>), conditions
120and attributes with the same keys need resolving.
121
122If any of L</columns>, L</select>, L</as> are present, they reset the
123original selection, and start the selection "clean".
124
125The L</join>, L</prefetch>, L</+columns>, L</+select>, L</+as> attributes
126are merged into the existing ones from the original resultset.
127
128The L</where> and L</having> attributes, and any search conditions, are
129merged with an SQL C<AND> to the existing condition from the original
130resultset.
131
132All other attributes are overridden by any new ones supplied in the
133search attributes.
134
135=head2 Multiple queries
136
137Since a resultset just defines a query, you can do all sorts of
138things with it with the same object.
139
140 # Don't hit the DB yet.
141 my $cd_rs = $schema->resultset('CD')->search({
142 title => 'something',
143 year => 2009,
144 });
145
146 # Each of these hits the DB individually.
147 my $count = $cd_rs->count;
148 my $most_recent = $cd_rs->get_column('date_released')->max();
149 my @records = $cd_rs->all;
150
151And it's not just limited to SELECT statements.
152
153 $cd_rs->delete();
154
155This is even cooler:
156
157 $cd_rs->create({ artist => 'Fred' });
158
159Which is the same as:
160
161 $schema->resultset('CD')->create({
162 title => 'something',
163 year => 2009,
164 artist => 'Fred'
165 });
166
167See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
168
169=head2 Custom ResultSet classes
170
171To add methods to your resultsets, you can subclass L<DBIx::Class::ResultSet>, similar to:
172
173 package MyApp::Schema::ResultSet::User;
174
175 use strict;
176 use warnings;
177
178 use base 'DBIx::Class::ResultSet';
179
180 sub active {
181 my $self = shift;
182 $self->search({ $self->current_source_alias . '.active' => 1 });
183 }
184
185 sub unverified {
186 my $self = shift;
187 $self->search({ $self->current_source_alias . '.verified' => 0 });
188 }
189
190 sub created_n_days_ago {
191 my ($self, $days_ago) = @_;
192 $self->search({
193 $self->current_source_alias . '.create_date' => {
194 '<=',
195 $self->result_source->schema->storage->datetime_parser->format_datetime(
196 DateTime->now( time_zone => 'UTC' )->subtract( days => $days_ago )
197 )}
198 });
199 }
200
201 sub users_to_warn { shift->active->unverified->created_n_days_ago(7) }
202
203 1;
204
205See L<DBIx::Class::Schema/load_namespaces> on how DBIC can discover and
206automatically attach L<Result|DBIx::Class::Manual::ResultClass>-specific
207L<ResulSet|DBIx::Class::ResultSet> classes.
208
209=head3 ResultSet subclassing with Moose and similar constructor-providers
210
211Using L<Moose> or L<Moo> in your ResultSet classes is usually overkill, but
212you may find it useful if your ResultSets contain a lot of business logic
213(e.g. C<has xml_parser>, C<has json>, etc) or if you just prefer to organize
214your code via roles.
215
216In order to write custom ResultSet classes with L<Moo> you need to use the
217following template. The L<BUILDARGS|Moo/BUILDARGS> is necessary due to the
218unusual signature of the L<constructor provided by DBIC
219|DBIx::Class::ResultSet/new> C<< ->new($source, \%args) >>.
220
221 use Moo;
222 extends 'DBIx::Class::ResultSet';
223 sub BUILDARGS { $_[2] } # ::RS::new() expects my ($class, $rsrc, $args) = @_
224
225 ...your code...
226
227 1;
228
229If you want to build your custom ResultSet classes with L<Moose>, you need
230a similar, though a little more elaborate template in order to interface the
231inlining of the L<Moose>-provided
232L<object constructor|Moose::Manual::Construction/WHERE'S THE CONSTRUCTOR?>,
233with the DBIC one.
234
235 package MyApp::Schema::ResultSet::User;
236
237 use Moose;
238 use MooseX::NonMoose;
239 extends 'DBIx::Class::ResultSet';
240
241 sub BUILDARGS { $_[2] } # ::RS::new() expects my ($class, $rsrc, $args) = @_
242
243 ...your code...
244
245 __PACKAGE__->meta->make_immutable;
246
247 1;
248
249The L<MooseX::NonMoose> is necessary so that the L<Moose> constructor does not
250entirely overwrite the DBIC one (in contrast L<Moo> does this automatically).
251Alternatively, you can skip L<MooseX::NonMoose> and get by with just L<Moose>
252instead by doing:
253
254 __PACKAGE__->meta->make_immutable(inline_constructor => 0);
255
256=head1 METHODS
257
258=head2 new
259
260=over 4
261
262=item Arguments: L<$source|DBIx::Class::ResultSource>, L<\%attrs?|/ATTRIBUTES>
263
264=item Return Value: L<$resultset|/search>
265
266=back
267
268The resultset constructor. Takes a source object (usually a
269L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
270L</ATTRIBUTES> below). Does not perform any queries -- these are
271executed as needed by the other methods.
272
273Generally you never construct a resultset manually. Instead you get one
274from e.g. a
275C<< $schema->L<resultset|DBIx::Class::Schema/resultset>('$source_name') >>
276or C<< $another_resultset->L<search|/search>(...) >> (the later called in
277scalar context):
278
279 my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
280
281=over
282
283=item WARNING
284
285If called on an object, proxies to L</new_result> instead, so
286
287 my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
288
289will return a CD object, not a ResultSet, and is equivalent to:
290
291 my $cd = $schema->resultset('CD')->new_result({ title => 'Spoon' });
292
293Please also keep in mind that many internals call L</new_result> directly,
294so overloading this method with the idea of intercepting new result object
295creation B<will not work>. See also warning pertaining to L</create>.
296
297=back
298
299=cut
300
301
# spent 1.49ms (236µs+1.25) within DBIx::Class::ResultSet::new which was called 6 times, avg 248µs/call: # 3 times (155µs+1.09ms) by DBIx::Class::ResultSource::resultset at line 1129 of DBIx/Class/ResultSource.pm, avg 414µs/call # 3 times (82µs+167µs) by DBIx::Class::ResultSet::search_rs at line 548, avg 83µs/call
sub new {
3022600ns my $class = shift;
303
3042400ns if (ref $class) {
305 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
306 return $class->new_result(@_);
307 }
308
3092800ns my ($source, $attrs) = @_;
310217µs628µs $source = $source->resolve
# spent 28µs making 6 calls to UNIVERSAL::isa, avg 5µs/call
311 if $source->isa('DBIx::Class::ResultSourceHandle');
312
31324µs $attrs = { %{$attrs||{}} };
31422µs delete @{$attrs}{qw(_last_sqlmaker_alias_map _simple_passthrough_construction)};
315
31621µs if ($attrs->{page}) {
317 $attrs->{rows} ||= 10;
318 }
319
32023µs $attrs->{alias} ||= 'me';
321
322213µs my $self = bless {
323 result_source => $source,
324 cond => $attrs->{where},
325 pager => undef,
326 attrs => $attrs,
327 }, $class;
328
329 # if there is a dark selector, this means we are already in a
330 # chain and the cleanup/sanification was taken care of by
331 # _search_rs already
33227µs6114µs $self->_normalize_selection($attrs)
# spent 114µs making 6 calls to DBIx::Class::ResultSet::_normalize_selection, avg 19µs/call
333 unless $attrs->{_dark_selector};
334
335211µs121.11ms $self->result_class(
# spent 983µs making 6 calls to DBIx::Class::ResultSet::result_class, avg 164µs/call # spent 129µs making 6 calls to DBIx::Class::ResultSource::result_class, avg 21µs/call
336 $attrs->{result_class} || $source->result_class
337 );
338
339210µs $self;
340}
341
342=head2 search
343
344=over 4
345
346=item Arguments: L<$cond|DBIx::Class::SQLMaker> | undef, L<\%attrs?|/ATTRIBUTES>
347
348=item Return Value: $resultset (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
349
350=back
351
352 my @cds = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
353 my $new_rs = $cd_rs->search({ year => 2005 });
354
355 my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
356 # year = 2005 OR year = 2004
357
358In list context, C<< ->all() >> is called implicitly on the resultset, thus
359returning a list of L<result|DBIx::Class::Manual::ResultClass> objects instead.
360To avoid that, use L</search_rs>.
361
362If you need to pass in additional attributes but no additional condition,
363call it as C<search(undef, \%attrs)>.
364
365 # "SELECT name, artistid FROM $artist_table"
366 my @all_artists = $schema->resultset('Artist')->search(undef, {
367 columns => [qw/name artistid/],
368 });
369
370For a list of attributes that can be passed to C<search>, see
371L</ATTRIBUTES>. For more examples of using this function, see
372L<Searching|DBIx::Class::Manual::Cookbook/SEARCHING>. For a complete
373documentation for the first argument, see L<SQL::Abstract/"WHERE CLAUSES">
374and its extension L<DBIx::Class::SQLMaker>.
375
376For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
377
378=head3 CAVEAT
379
380Note that L</search> does not process/deflate any of the values passed in the
381L<SQL::Abstract>-compatible search condition structure. This is unlike other
382condition-bound methods L</new_result>, L</create> and L</find>. The user must ensure
383manually that any value passed to this method will stringify to something the
384RDBMS knows how to deal with. A notable example is the handling of L<DateTime>
385objects, for more info see:
386L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
387
388=cut
389
390sub search {
3911400ns my $self = shift;
39214µs311.6ms my $rs = $self->search_rs( @_ );
# spent 11.6ms making 3 calls to DBIx::Class::ResultSet::search_rs, avg 3.85ms/call
393
39411µs if (wantarray) {
395 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
396 return $rs->all;
397 }
398 elsif (defined wantarray) {
399 return $rs;
400 }
401 else {
402 # we can be called by a relationship helper, which in
403 # turn may be called in void context due to some braindead
404 # overload or whatever else the user decided to be clever
405 # at this particular day. Thus limit the exception to
406 # external code calls only
407 $self->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense')
408 if (caller)[0] !~ /^\QDBIx::Class::/;
409
410 return ();
411 }
412}
413
414=head2 search_rs
415
416=over 4
417
418=item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
419
420=item Return Value: L<$resultset|/search>
421
422=back
423
424This method does the same exact thing as search() except it will
425always return a resultset, even in list context.
426
427=cut
428
429
# spent 11.6ms (226µs+11.3) within DBIx::Class::ResultSet::search_rs which was called 3 times, avg 3.85ms/call: # 3 times (226µs+11.3ms) by Koha::Objects::search at line 392, avg 3.85ms/call
sub search_rs {
4301300ns my $self = shift;
431
43212µs1239µs my $rsrc = $self->result_source;
# spent 239µs making 1 call to DBIx::Class::ResultSet::result_source
4331500ns my ($call_cond, $call_attrs);
434
435 # Special-case handling for (undef, undef) or (undef)
436 # Note that (foo => undef) is valid deprecated syntax
43713µs @_ = () if not scalar grep { defined $_ } @_;
438
439 # just a cond
44012µs if (@_ == 1) {
441 $call_cond = shift;
442 }
443 # fish out attrs in the ($condref, $attr) case
444 elsif (@_ == 2 and ( ! defined $_[0] or (ref $_[0]) ne '') ) {
445 ($call_cond, $call_attrs) = @_;
446 }
447 elsif (@_ % 2) {
448 $self->throw_exception('Odd number of arguments to search')
449 }
450 # legacy search
451 elsif (@_) {
452 carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead'
453 unless $rsrc->result_class->isa('DBIx::Class::CDBICompat');
454
455 for my $i (0 .. $#_) {
456 next if $i % 2;
457 $self->throw_exception ('All keys in condition key/value pairs must be plain scalars')
458 if (! defined $_[$i] or ref $_[$i] ne '');
459 }
460
461 $call_cond = { @_ };
462 }
463
464 # see if we can keep the cache (no $rs changes)
46511µs my $cache;
46615µs my %safe = (alias => 1, cache => 1);
467120µs610.8ms if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
# spent 10.8ms making 3 calls to DBIx::Class::ResultSet::get_cache, avg 3.61ms/call # spent 8µs making 3 calls to List::Util::first, avg 3µs/call
468 ! defined $call_cond
469 or
470 ref $call_cond eq 'HASH' && ! keys %$call_cond
471 or
472 ref $call_cond eq 'ARRAY' && ! @$call_cond
473 )) {
474 $cache = $self->get_cache;
475 }
476
47714µs my $old_attrs = { %{$self->{attrs}} };
47811µs my ($old_having, $old_where) = delete @{$old_attrs}{qw(having where)};
479
48011µs my $new_attrs = { %$old_attrs };
481
482 # take care of call attrs (only if anything is changing)
4831900ns if ($call_attrs and keys %$call_attrs) {
484
485 # copy for _normalize_selection
486 $call_attrs = { %$call_attrs };
487
488 my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
489
490 # reset the current selector list if new selectors are supplied
491 if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
492 delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
493 }
494
495 # Normalize the new selector list (operates on the passed-in attr structure)
496 # Need to do it on every chain instead of only once on _resolved_attrs, in
497 # order to allow detection of empty vs partial 'as'
498 $call_attrs->{_dark_selector} = $old_attrs->{_dark_selector}
499 if $old_attrs->{_dark_selector};
500 $self->_normalize_selection ($call_attrs);
501
502 # start with blind overwriting merge, exclude selector attrs
503 $new_attrs = { %{$old_attrs}, %{$call_attrs} };
504 delete @{$new_attrs}{@selector_attrs};
505
506 for (@selector_attrs) {
507 $new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_})
508 if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} );
509 }
510
511 # older deprecated name, use only if {columns} is not there
512 if (my $c = delete $new_attrs->{cols}) {
513 carp_unique( "Resultset attribute 'cols' is deprecated, use 'columns' instead" );
514 if ($new_attrs->{columns}) {
515 carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'";
516 }
517 else {
518 $new_attrs->{columns} = $c;
519 }
520 }
521
522
523 # join/prefetch use their own crazy merging heuristics
524 foreach my $key (qw/join prefetch/) {
525 $new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key})
526 if exists $call_attrs->{$key};
527 }
528
529 # stack binds together
530 $new_attrs->{bind} = [ @{ $old_attrs->{bind} || [] }, @{ $call_attrs->{bind} || [] } ];
531 }
532
533
53411µs for ($old_where, $call_cond) {
53521µs if (defined $_) {
536 $new_attrs->{where} = $self->_stack_cond (
537 $_, $new_attrs->{where}
538 );
539 }
540 }
541
5421300ns if (defined $old_having) {
543 $new_attrs->{having} = $self->_stack_cond (
544 $old_having, $new_attrs->{having}
545 )
546 }
547
54812µs3249µs my $rs = (ref $self)->new($rsrc, $new_attrs);
# spent 249µs making 3 calls to DBIx::Class::ResultSet::new, avg 83µs/call
549
5501200ns $rs->set_cache($cache) if ($cache);
551
55217µs return $rs;
553}
554
555my $dark_sel_dumper;
556
# spent 114µs within DBIx::Class::ResultSet::_normalize_selection which was called 6 times, avg 19µs/call: # 6 times (114µs+0s) by DBIx::Class::ResultSet::new at line 332, avg 19µs/call
sub _normalize_selection {
5572700ns my ($self, $attrs) = @_;
558
559 # legacy syntax
56021µs if ( exists $attrs->{include_columns} ) {
561 carp_unique( "Resultset attribute 'include_columns' is deprecated, use '+columns' instead" );
562 $attrs->{'+columns'} = $self->_merge_attr(
563 $attrs->{'+columns'}, delete $attrs->{include_columns}
564 );
565 }
566
567 # columns are always placed first, however
568
569 # Keep the X vs +X separation until _resolved_attrs time - this allows to
570 # delay the decision on whether to use a default select list ($rsrc->columns)
571 # allowing stuff like the remove_columns helper to work
572 #
573 # select/as +select/+as pairs need special handling - the amount of select/as
574 # elements in each pair does *not* have to be equal (think multicolumn
575 # selectors like distinct(foo, bar) ). If the selector is bare (no 'as'
576 # supplied at all) - try to infer the alias, either from the -as parameter
577 # of the selector spec, or use the parameter whole if it looks like a column
578 # name (ugly legacy heuristic). If all fails - leave the selector bare (which
579 # is ok as well), but make sure no more additions to the 'as' chain take place
58029µs for my $pref ('', '+') {
581
58284µs my ($sel, $as) = map {
58345µs my $key = "${pref}${_}";
584
585 my $val = [ ref $attrs->{$key} eq 'ARRAY'
58687µs ? @{$attrs->{$key}}
587 : $attrs->{$key} || ()
588 ];
58981µs delete $attrs->{$key};
59082µs $val;
591 } qw/select as/;
592
59342µs if (! @$as and ! @$sel ) {
59442µs next;
595 }
596 elsif (@$as and ! @$sel) {
597 $self->throw_exception(
598 "Unable to handle ${pref}as specification (@$as) without a corresponding ${pref}select"
599 );
600 }
601 elsif( ! @$as ) {
602 # no as part supplied at all - try to deduce (unless explicit end of named selection is declared)
603 # if any @$as has been supplied we assume the user knows what (s)he is doing
604 # and blindly keep stacking up pieces
605 unless ($attrs->{_dark_selector}) {
606 SELECTOR:
607 for (@$sel) {
608 if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
609 push @$as, $_->{-as};
610 }
611 # assume any plain no-space, no-parenthesis string to be a column spec
612 # FIXME - this is retarded but is necessary to support shit like 'count(foo)'
613 elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
614 push @$as, $_;
615 }
616 # if all else fails - raise a flag that no more aliasing will be allowed
617 else {
618 $attrs->{_dark_selector} = {
619 plus_stage => $pref,
620 string => ($dark_sel_dumper ||= do {
621 require Data::Dumper::Concise;
622 Data::Dumper::Concise::DumperObject()->Indent(0);
623 })->Values([$_])->Dump
624 ,
625 };
626 last SELECTOR;
627 }
628 }
629 }
630 }
631 elsif (@$as < @$sel) {
632 $self->throw_exception(
633 "Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select"
634 );
635 }
636 elsif ($pref and $attrs->{_dark_selector}) {
637 $self->throw_exception(
638 "Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}"
639 );
640 }
641
642
643 # merge result
644 $attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
645 $attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
646 }
647}
648
649sub _stack_cond {
650 my ($self, $left, $right) = @_;
651
652 (
653 (ref $_ eq 'ARRAY' and !@$_)
654 or
655 (ref $_ eq 'HASH' and ! keys %$_)
656 ) and $_ = undef for ($left, $right);
657
658 # either one of the two undef
659 if ( (defined $left) xor (defined $right) ) {
660 return defined $left ? $left : $right;
661 }
662 # both undef
663 elsif ( ! defined $left ) {
664 return undef
665 }
666 else {
667 return $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] });
668 }
669}
670
671=head2 search_literal
672
673B<CAVEAT>: C<search_literal> is provided for Class::DBI compatibility and
674should only be used in that context. C<search_literal> is a convenience
675method. It is equivalent to calling C<< $schema->search(\[]) >>, but if you
676want to ensure columns are bound correctly, use L</search>.
677
678See L<DBIx::Class::Manual::Cookbook/SEARCHING> and
679L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
680require C<search_literal>.
681
682=over 4
683
684=item Arguments: $sql_fragment, @standalone_bind_values
685
686=item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
687
688=back
689
690 my @cds = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
691 my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
692
693Pass a literal chunk of SQL to be added to the conditional part of the
694resultset query.
695
696Example of how to use C<search> instead of C<search_literal>
697
698 my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2));
699 my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]);
700
701=cut
702
703sub search_literal {
704 my ($self, $sql, @bind) = @_;
705 my $attr;
706 if ( @bind && ref($bind[-1]) eq 'HASH' ) {
707 $attr = pop @bind;
708 }
709 return $self->search(\[ $sql, map [ {} => $_ ], @bind ], ($attr || () ));
710}
711
712=head2 find
713
714=over 4
715
716=item Arguments: \%columns_values | @pk_values, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
717
718=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
719
720=back
721
722Finds and returns a single row based on supplied criteria. Takes either a
723hashref with the same format as L</create> (including inference of foreign
724keys from related objects), or a list of primary key values in the same
725order as the L<primary columns|DBIx::Class::ResultSource/primary_columns>
726declaration on the L</result_source>.
727
728In either case an attempt is made to combine conditions already existing on
729the resultset with the condition passed to this method.
730
731To aid with preparing the correct query for the storage you may supply the
732C<key> attribute, which is the name of a
733L<unique constraint|DBIx::Class::ResultSource/add_unique_constraint> (the
734unique constraint corresponding to the
735L<primary columns|DBIx::Class::ResultSource/primary_columns> is always named
736C<primary>). If the C<key> attribute has been supplied, and DBIC is unable
737to construct a query that satisfies the named unique constraint fully (
738non-NULL values for each column member of the constraint) an exception is
739thrown.
740
741If no C<key> is specified, the search is carried over all unique constraints
742which are fully defined by the available condition.
743
744If no such constraint is found, C<find> currently defaults to a simple
745C<< search->(\%column_values) >> which may or may not do what you expect.
746Note that this fallback behavior may be deprecated in further versions. If
747you need to search with arbitrary conditions - use L</search>. If the query
748resulting from this fallback produces more than one row, a warning to the
749effect is issued, though only the first row is constructed and returned as
750C<$result_object>.
751
752In addition to C<key>, L</find> recognizes and applies standard
753L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
754
755Note that if you have extra concerns about the correctness of the resulting
756query you need to specify the C<key> attribute and supply the entire condition
757as an argument to find (since it is not always possible to perform the
758combination of the resultset condition with the supplied one, especially if
759the resultset condition contains literal sql).
760
761For example, to find a row by its primary key:
762
763 my $cd = $schema->resultset('CD')->find(5);
764
765You can also find a row by a specific unique constraint:
766
767 my $cd = $schema->resultset('CD')->find(
768 {
769 artist => 'Massive Attack',
770 title => 'Mezzanine',
771 },
772 { key => 'cd_artist_title' }
773 );
774
775See also L</find_or_create> and L</update_or_create>.
776
777=cut
778
779sub find {
780 my $self = shift;
781 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
782
783 my $rsrc = $self->result_source;
784
785 my $constraint_name;
786 if (exists $attrs->{key}) {
787 $constraint_name = defined $attrs->{key}
788 ? $attrs->{key}
789 : $self->throw_exception("An undefined 'key' resultset attribute makes no sense")
790 ;
791 }
792
793 # Parse out the condition from input
794 my $call_cond;
795
796 if (ref $_[0] eq 'HASH') {
797 $call_cond = { %{$_[0]} };
798 }
799 else {
800 # if only values are supplied we need to default to 'primary'
801 $constraint_name = 'primary' unless defined $constraint_name;
802
803 my @c_cols = $rsrc->unique_constraint_columns($constraint_name);
804
805 $self->throw_exception(
806 "No constraint columns, maybe a malformed '$constraint_name' constraint?"
807 ) unless @c_cols;
808
809 $self->throw_exception (
810 'find() expects either a column/value hashref, or a list of values '
811 . "corresponding to the columns of the specified unique constraint '$constraint_name'"
812 ) unless @c_cols == @_;
813
814 @{$call_cond}{@c_cols} = @_;
815 }
816
817 # process relationship data if any
818 for my $key (keys %$call_cond) {
819 if (
820 length ref($call_cond->{$key})
821 and
822 my $relinfo = $rsrc->relationship_info($key)
823 and
824 (ref (my $val = delete $call_cond->{$key}) ne 'ARRAY' )
825
826 ) {
827 my ($rel_cond, $crosstable) = $rsrc->_resolve_condition(
828 $relinfo->{cond}, $val, $key, $key
829 );
830
831 $self->throw_exception("Complex condition via relationship '$key' is unsupported in find()")
832 if $crosstable or ref($rel_cond) ne 'HASH';
833
834 # supplement condition
835 # relationship conditions take precedence (?)
836 @{$call_cond}{keys %$rel_cond} = values %$rel_cond;
837 }
838 }
839
840 my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
841 my $final_cond;
842 if (defined $constraint_name) {
843 $final_cond = $self->_qualify_cond_columns (
844
845 $self->result_source->_minimal_valueset_satisfying_constraint(
846 constraint_name => $constraint_name,
847 values => ($self->_merge_with_rscond($call_cond))[0],
848 carp_on_nulls => 1,
849 ),
850
851 $alias,
852 );
853 }
854 elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
855 # This means that we got here after a merger of relationship conditions
856 # in ::Relationship::Base::search_related (the row method), and furthermore
857 # the relationship is of the 'single' type. This means that the condition
858 # provided by the relationship (already attached to $self) is sufficient,
859 # as there can be only one row in the database that would satisfy the
860 # relationship
861 }
862 else {
863 my (@unique_queries, %seen_column_combinations, $ci, @fc_exceptions);
864
865 # no key was specified - fall down to heuristics mode:
866 # run through all unique queries registered on the resultset, and
867 # 'OR' all qualifying queries together
868 #
869 # always start from 'primary' if it exists at all
870 for my $c_name ( sort {
871 $a eq 'primary' ? -1
872 : $b eq 'primary' ? 1
873 : $a cmp $b
874 } $rsrc->unique_constraint_names) {
875
876 next if $seen_column_combinations{
877 join "\x00", sort $rsrc->unique_constraint_columns($c_name)
878 }++;
879
880 try {
881 push @unique_queries, $self->_qualify_cond_columns(
882 $self->result_source->_minimal_valueset_satisfying_constraint(
883 constraint_name => $c_name,
884 values => ($self->_merge_with_rscond($call_cond))[0],
885 columns_info => ($ci ||= $self->result_source->columns_info),
886 ),
887 $alias
888 );
889 }
890 catch {
891 push @fc_exceptions, $_ if $_ =~ /\bFilterColumn\b/;
892 };
893 }
894
895 $final_cond =
896 @unique_queries ? \@unique_queries
897 : @fc_exceptions ? $self->throw_exception(join "; ", map { $_ =~ /(.*) at .+ line \d+$/s } @fc_exceptions )
898 : $self->_non_unique_find_fallback ($call_cond, $attrs)
899 ;
900 }
901
902 # Run the query, passing the result_class since it should propagate for find
903 my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs});
904 if ($rs->_resolved_attrs->{collapse}) {
905 my $row = $rs->next;
906 carp "Query returned more than one row" if $rs->next;
907 return $row;
908 }
909 else {
910 return $rs->single;
911 }
912}
913
914# This is a stop-gap method as agreed during the discussion on find() cleanup:
915# http://lists.scsys.co.uk/pipermail/dbix-class/2010-October/009535.html
916#
917# It is invoked when find() is called in legacy-mode with insufficiently-unique
918# condition. It is provided for overrides until a saner way forward is devised
919#
920# *NOTE* This is not a public method, and it's *GUARANTEED* to disappear down
921# the road. Please adjust your tests accordingly to catch this situation early
922# DBIx::Class::ResultSet->can('_non_unique_find_fallback') is reasonable
923#
924# The method will not be removed without an adequately complete replacement
925# for strict-mode enforcement
926sub _non_unique_find_fallback {
927 my ($self, $cond, $attrs) = @_;
928
929 return $self->_qualify_cond_columns(
930 $cond,
931 exists $attrs->{alias}
932 ? $attrs->{alias}
933 : $self->{attrs}{alias}
934 );
935}
936
937
938sub _qualify_cond_columns {
939 my ($self, $cond, $alias) = @_;
940
941 my %aliased = %$cond;
942 for (keys %aliased) {
943 $aliased{"$alias.$_"} = delete $aliased{$_}
944 if $_ !~ /\./;
945 }
946
947 return \%aliased;
948}
949
950sub _build_unique_cond {
951 carp_unique sprintf
952 '_build_unique_cond is a private method, and moreover is about to go '
953 . 'away. Please contact the development team at %s if you believe you '
954 . 'have a genuine use for this method, in order to discuss alternatives.',
955 DBIx::Class::_ENV_::HELP_URL,
956 ;
957
958 my ($self, $constraint_name, $cond, $croak_on_null) = @_;
959
960 $self->result_source->_minimal_valueset_satisfying_constraint(
961 constraint_name => $constraint_name,
962 values => $cond,
963 carp_on_nulls => !$croak_on_null
964 );
965}
966
967=head2 search_related
968
969=over 4
970
971=item Arguments: $rel_name, $cond?, L<\%attrs?|/ATTRIBUTES>
972
973=item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
974
975=back
976
977 $new_rs = $cd_rs->search_related('artist', {
978 name => 'Emo-R-Us',
979 });
980
981Searches the specified relationship, optionally specifying a condition and
982attributes for matching records. See L</ATTRIBUTES> for more information.
983
984In list context, C<< ->all() >> is called implicitly on the resultset, thus
985returning a list of result objects instead. To avoid that, use L</search_related_rs>.
986
987See also L</search_related_rs>.
988
989=cut
990
991sub search_related {
992 return shift->related_resultset(shift)->search(@_);
993}
994
995=head2 search_related_rs
996
997This method works exactly the same as search_related, except that
998it guarantees a resultset, even in list context.
999
1000=cut
1001
1002sub search_related_rs {
1003 return shift->related_resultset(shift)->search_rs(@_);
1004}
1005
1006=head2 cursor
1007
1008=over 4
1009
1010=item Arguments: none
1011
1012=item Return Value: L<$cursor|DBIx::Class::Cursor>
1013
1014=back
1015
1016Returns a storage-driven cursor to the given resultset. See
1017L<DBIx::Class::Cursor> for more information.
1018
1019=cut
1020
1021sub cursor {
1022 my $self = shift;
1023
1024 return $self->{cursor} ||= do {
1025 my $attrs = $self->_resolved_attrs;
1026 $self->result_source->storage->select(
1027 $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
1028 );
1029 };
1030}
1031
1032=head2 single
1033
1034=over 4
1035
1036=item Arguments: L<$cond?|DBIx::Class::SQLMaker>
1037
1038=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
1039
1040=back
1041
1042 my $cd = $schema->resultset('CD')->single({ year => 2001 });
1043
1044Inflates the first result without creating a cursor if the resultset has
1045any records in it; if not returns C<undef>. Used by L</find> as a lean version
1046of L</search>.
1047
1048While this method can take an optional search condition (just like L</search>)
1049being a fast-code-path it does not recognize search attributes. If you need to
1050add extra joins or similar, call L</search> and then chain-call L</single> on the
1051L<DBIx::Class::ResultSet> returned.
1052
1053=over
1054
1055=item B<Note>
1056
1057As of 0.08100, this method enforces the assumption that the preceding
1058query returns only one row. If more than one row is returned, you will receive
1059a warning:
1060
1061 Query returned more than one row
1062
1063In this case, you should be using L</next> or L</find> instead, or if you really
1064know what you are doing, use the L</rows> attribute to explicitly limit the size
1065of the resultset.
1066
1067This method will also throw an exception if it is called on a resultset prefetching
1068has_many, as such a prefetch implies fetching multiple rows from the database in
1069order to assemble the resulting object.
1070
1071=back
1072
1073=cut
1074
1075sub single {
1076 my ($self, $where) = @_;
1077 if(@_ > 2) {
1078 $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
1079 }
1080
1081 my $attrs = { %{$self->_resolved_attrs} };
1082
1083 $self->throw_exception(
1084 'single() can not be used on resultsets collapsing a has_many. Use find( \%cond ) or next() instead'
1085 ) if $attrs->{collapse};
1086
1087 if ($where) {
1088 if (defined $attrs->{where}) {
1089 $attrs->{where} = {
1090 '-and' =>
1091 [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
1092 $where, delete $attrs->{where} ]
1093 };
1094 } else {
1095 $attrs->{where} = $where;
1096 }
1097 }
1098
1099 my $data = [ $self->result_source->storage->select_single(
1100 $attrs->{from}, $attrs->{select},
1101 $attrs->{where}, $attrs
1102 )];
1103
1104 return undef unless @$data;
1105 $self->{_stashed_rows} = [ $data ];
1106 $self->_construct_results->[0];
1107}
1108
1109=head2 get_column
1110
1111=over 4
1112
1113=item Arguments: L<$cond?|DBIx::Class::SQLMaker>
1114
1115=item Return Value: L<$resultsetcolumn|DBIx::Class::ResultSetColumn>
1116
1117=back
1118
1119 my $max_length = $rs->get_column('length')->max;
1120
1121Returns a L<DBIx::Class::ResultSetColumn> instance for a column of the ResultSet.
1122
1123=cut
1124
1125sub get_column {
1126 my ($self, $column) = @_;
1127 my $new = DBIx::Class::ResultSetColumn->new($self, $column);
1128 return $new;
1129}
1130
1131=head2 search_like
1132
1133=over 4
1134
1135=item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
1136
1137=item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
1138
1139=back
1140
1141 # WHERE title LIKE '%blue%'
1142 $cd_rs = $rs->search_like({ title => '%blue%'});
1143
1144Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
1145that this is simply a convenience method retained for ex Class::DBI users.
1146You most likely want to use L</search> with specific operators.
1147
1148For more information, see L<DBIx::Class::Manual::Cookbook>.
1149
1150This method is deprecated and will be removed in 0.09. Use L<search()|/search>
1151instead. An example conversion is:
1152
1153 ->search_like({ foo => 'bar' });
1154
1155 # Becomes
1156
1157 ->search({ foo => { like => 'bar' } });
1158
1159=cut
1160
1161sub search_like {
1162 my $class = shift;
1163 carp_unique (
1164 'search_like() is deprecated and will be removed in DBIC version 0.09.'
1165 .' Instead use ->search({ x => { -like => "y%" } })'
1166 .' (note the outer pair of {}s - they are important!)'
1167 );
1168 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
1169 my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
1170 $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
1171 return $class->search($query, { %$attrs });
1172}
1173
1174=head2 slice
1175
1176=over 4
1177
1178=item Arguments: $first, $last
1179
1180=item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
1181
1182=back
1183
1184Returns a resultset or object list representing a subset of elements from the
1185resultset slice is called on. Indexes are from 0, i.e., to get the first
1186three records, call:
1187
1188 my ($one, $two, $three) = $rs->slice(0, 2);
1189
1190=cut
1191
1192sub slice {
1193 my ($self, $min, $max) = @_;
1194 my $attrs = {}; # = { %{ $self->{attrs} || {} } };
1195 $attrs->{offset} = $self->{attrs}{offset} || 0;
1196 $attrs->{offset} += $min;
1197 $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
1198 return $self->search(undef, $attrs);
1199}
1200
1201=head2 next
1202
1203=over 4
1204
1205=item Arguments: none
1206
1207=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
1208
1209=back
1210
1211Returns the next element in the resultset (C<undef> is there is none).
1212
1213Can be used to efficiently iterate over records in the resultset:
1214
1215 my $rs = $schema->resultset('CD')->search;
1216 while (my $cd = $rs->next) {
1217 print $cd->title;
1218 }
1219
1220Note that you need to store the resultset object, and call C<next> on it.
1221Calling C<< resultset('Table')->next >> repeatedly will always return the
1222first record from the resultset.
1223
1224=cut
1225
1226sub next {
1227 my ($self) = @_;
1228
1229 if (my $cache = $self->get_cache) {
1230 $self->{all_cache_position} ||= 0;
1231 return $cache->[$self->{all_cache_position}++];
1232 }
1233
1234 if ($self->{attrs}{cache}) {
1235 delete $self->{pager};
1236 $self->{all_cache_position} = 1;
1237 return ($self->all)[0];
1238 }
1239
1240 return shift(@{$self->{_stashed_results}}) if @{ $self->{_stashed_results}||[] };
1241
1242 $self->{_stashed_results} = $self->_construct_results
1243 or return undef;
1244
1245 return shift @{$self->{_stashed_results}};
1246}
1247
1248# Constructs as many results as it can in one pass while respecting
1249# cursor laziness. Several modes of operation:
1250#
1251# * Always builds everything present in @{$self->{_stashed_rows}}
1252# * If called with $fetch_all true - pulls everything off the cursor and
1253# builds all result structures (or objects) in one pass
1254# * If $self->_resolved_attrs->{collapse} is true, checks the order_by
1255# and if the resultset is ordered properly by the left side:
1256# * Fetches stuff off the cursor until the "master object" changes,
1257# and saves the last extra row (if any) in @{$self->{_stashed_rows}}
1258# OR
1259# * Just fetches, and collapses/constructs everything as if $fetch_all
1260# was requested (there is no other way to collapse except for an
1261# eager cursor)
1262# * If no collapse is requested - just get the next row, construct and
1263# return
1264sub _construct_results {
1265 my ($self, $fetch_all) = @_;
1266
1267 my $rsrc = $self->result_source;
1268 my $attrs = $self->_resolved_attrs;
1269
1270 if (
1271 ! $fetch_all
1272 and
1273 ! $attrs->{order_by}
1274 and
1275 $attrs->{collapse}
1276 and
1277 my @pcols = $rsrc->primary_columns
1278 ) {
1279 # default order for collapsing unless the user asked for something
1280 $attrs->{order_by} = [ map { join '.', $attrs->{alias}, $_} @pcols ];
1281 $attrs->{_ordered_for_collapse} = 1;
1282 $attrs->{_order_is_artificial} = 1;
1283 }
1284
1285 # this will be used as both initial raw-row collector AND as a RV of
1286 # _construct_results. Not regrowing the array twice matters a lot...
1287 # a surprising amount actually
1288 my $rows = delete $self->{_stashed_rows};
1289
1290 my $cursor; # we may not need one at all
1291
1292 my $did_fetch_all = $fetch_all;
1293
1294 if ($fetch_all) {
1295 # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1296 $rows = [ ($rows ? @$rows : ()), $self->cursor->all ];
1297 }
1298 elsif( $attrs->{collapse} ) {
1299
1300 # a cursor will need to be closed over in case of collapse
1301 $cursor = $self->cursor;
1302
1303 $attrs->{_ordered_for_collapse} = (
1304 (
1305 $attrs->{order_by}
1306 and
1307 $rsrc->schema
1308 ->storage
1309 ->_extract_colinfo_of_stable_main_source_order_by_portion($attrs)
1310 ) ? 1 : 0
1311 ) unless defined $attrs->{_ordered_for_collapse};
1312
1313 if (! $attrs->{_ordered_for_collapse}) {
1314 $did_fetch_all = 1;
1315
1316 # instead of looping over ->next, use ->all in stealth mode
1317 # *without* calling a ->reset afterwards
1318 # FIXME ENCAPSULATION - encapsulation breach, cursor method additions pending
1319 if (! $cursor->{_done}) {
1320 $rows = [ ($rows ? @$rows : ()), $cursor->all ];
1321 $cursor->{_done} = 1;
1322 }
1323 }
1324 }
1325
1326 if (! $did_fetch_all and ! @{$rows||[]} ) {
1327 # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1328 $cursor ||= $self->cursor;
1329 if (scalar (my @r = $cursor->next) ) {
1330 $rows = [ \@r ];
1331 }
1332 }
1333
1334 return undef unless @{$rows||[]};
1335
1336 # sanity check - people are too clever for their own good
1337 if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) {
1338
1339 my $multiplied_selectors;
1340 for my $sel_alias ( grep { $_ ne $attrs->{alias} } keys %{ $aliastypes->{selecting} } ) {
1341 if (
1342 $aliastypes->{multiplying}{$sel_alias}
1343 or
1344 $aliastypes->{premultiplied}{$sel_alias}
1345 ) {
1346 $multiplied_selectors->{$_} = 1 for values %{$aliastypes->{selecting}{$sel_alias}{-seen_columns}}
1347 }
1348 }
1349
1350 for my $i (0 .. $#{$attrs->{as}} ) {
1351 my $sel = $attrs->{select}[$i];
1352
1353 if (ref $sel eq 'SCALAR') {
1354 $sel = $$sel;
1355 }
1356 elsif( ref $sel eq 'REF' and ref $$sel eq 'ARRAY' ) {
1357 $sel = $$sel->[0];
1358 }
1359
1360 $self->throw_exception(
1361 'Result collapse not possible - selection from a has_many source redirected to the main object'
1362 ) if ($multiplied_selectors->{$sel} and $attrs->{as}[$i] !~ /\./);
1363 }
1364 }
1365
1366 # hotspot - skip the setter
1367 my $res_class = $self->_result_class;
1368
1369 my $inflator_cref = $self->{_result_inflator}{cref} ||= do {
1370 $res_class->can ('inflate_result')
1371 or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method");
1372 };
1373
1374 my $infmap = $attrs->{as};
1375
1376 $self->{_result_inflator}{is_core_row} = ( (
1377 $inflator_cref
1378 ==
1379 ( \&DBIx::Class::Row::inflate_result || die "No ::Row::inflate_result() - can't happen" )
1380 ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_core_row};
1381
1382 $self->{_result_inflator}{is_hri} = ( (
1383 ! $self->{_result_inflator}{is_core_row}
1384 and
1385 $inflator_cref == (
1386 require DBIx::Class::ResultClass::HashRefInflator
1387 &&
1388 DBIx::Class::ResultClass::HashRefInflator->can('inflate_result')
1389 )
1390 ) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_hri};
1391
1392
1393 if ($attrs->{_simple_passthrough_construction}) {
1394 # construct a much simpler array->hash folder for the one-table HRI cases right here
1395 if ($self->{_result_inflator}{is_hri}) {
1396 for my $r (@$rows) {
1397 $r = { map { $infmap->[$_] => $r->[$_] } 0..$#$infmap };
1398 }
1399 }
1400 # FIXME SUBOPTIMAL this is a very very very hot spot
1401 # while rather optimal we can *still* do much better, by
1402 # building a smarter Row::inflate_result(), and
1403 # switch to feeding it data via a much leaner interface
1404 #
1405 # crude unscientific benchmarking indicated the shortcut eval is not worth it for
1406 # this particular resultset size
1407 elsif ( $self->{_result_inflator}{is_core_row} and @$rows < 60 ) {
1408 for my $r (@$rows) {
1409 $r = $inflator_cref->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } (0..$#$infmap) } );
1410 }
1411 }
1412 else {
1413 eval sprintf (
1414 ( $self->{_result_inflator}{is_core_row}
1415 ? '$_ = $inflator_cref->($res_class, $rsrc, { %s }) for @$rows'
1416 # a custom inflator may be a multiplier/reductor - put it in direct list ctx
1417 : '@$rows = map { $inflator_cref->($res_class, $rsrc, { %s } ) } @$rows'
1418 ),
1419 ( join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) )
1420 );
1421 }
1422 }
1423 else {
1424 my $parser_type =
1425 $self->{_result_inflator}{is_hri} ? 'hri'
1426 : $self->{_result_inflator}{is_core_row} ? 'classic_pruning'
1427 : 'classic_nonpruning'
1428 ;
1429
1430 # $args and $attrs to _mk_row_parser are separated to delineate what is
1431 # core collapser stuff and what is dbic $rs specific
1432 @{$self->{_row_parser}{$parser_type}}{qw(cref nullcheck)} = $rsrc->_mk_row_parser({
1433 eval => 1,
1434 inflate_map => $infmap,
1435 collapse => $attrs->{collapse},
1436 premultiplied => $attrs->{_main_source_premultiplied},
1437 hri_style => $self->{_result_inflator}{is_hri},
1438 prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row},
1439 }, $attrs) unless $self->{_row_parser}{$parser_type}{cref};
1440
1441 # column_info metadata historically hasn't been too reliable.
1442 # We need to start fixing this somehow (the collapse resolver
1443 # can't work without it). Add an explicit check for the *main*
1444 # result, hopefully this will gradually weed out such errors
1445 #
1446 # FIXME - this is a temporary kludge that reduces performance
1447 # It is however necessary for the time being
1448 my ($unrolled_non_null_cols_to_check, $err);
1449
1450 if (my $check_non_null_cols = $self->{_row_parser}{$parser_type}{nullcheck} ) {
1451
1452 $err =
1453 'Collapse aborted due to invalid ResultSource metadata - the following '
1454 . 'selections are declared non-nullable but NULLs were retrieved: '
1455 ;
1456
1457 my @violating_idx;
1458 COL: for my $i (@$check_non_null_cols) {
1459 ! defined $_->[$i] and push @violating_idx, $i and next COL for @$rows;
1460 }
1461
1462 $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) )
1463 if @violating_idx;
1464
1465 $unrolled_non_null_cols_to_check = join (',', @$check_non_null_cols);
1466
1467 utf8::upgrade($unrolled_non_null_cols_to_check)
1468 if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE;
1469 }
1470
1471 my $next_cref =
1472 ($did_fetch_all or ! $attrs->{collapse}) ? undef
1473 : defined $unrolled_non_null_cols_to_check ? eval sprintf <<'EOS', $unrolled_non_null_cols_to_check
1474sub {
1475 # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1476 my @r = $cursor->next or return;
1477 if (my @violating_idx = grep { ! defined $r[$_] } (%s) ) {
1478 $self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) )
1479 }
1480 \@r
1481}
1482EOS
1483 : sub {
1484 # FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref
1485 my @r = $cursor->next or return;
1486 \@r
1487 }
1488 ;
1489
1490 $self->{_row_parser}{$parser_type}{cref}->(
1491 $rows,
1492 $next_cref ? ( $next_cref, $self->{_stashed_rows} = [] ) : (),
1493 );
1494
1495 # simple in-place substitution, does not regrow $rows
1496 if ($self->{_result_inflator}{is_core_row}) {
1497 $_ = $inflator_cref->($res_class, $rsrc, @$_) for @$rows
1498 }
1499 # Special-case multi-object HRI - there is no $inflator_cref pass at all
1500 elsif ( ! $self->{_result_inflator}{is_hri} ) {
1501 # the inflator may be a multiplier/reductor - put it in list ctx
1502 @$rows = map { $inflator_cref->($res_class, $rsrc, @$_) } @$rows;
1503 }
1504 }
1505
1506 # The @$rows check seems odd at first - why wouldn't we want to warn
1507 # regardless? The issue is things like find() etc, where the user
1508 # *knows* only one result will come back. In these cases the ->all
1509 # is not a pessimization, but rather something we actually want
1510 carp_unique(
1511 'Unable to properly collapse has_many results in iterator mode due '
1512 . 'to order criteria - performed an eager cursor slurp underneath. '
1513 . 'Consider using ->all() instead'
1514 ) if ( ! $fetch_all and @$rows > 1 );
1515
1516 return $rows;
1517}
1518
1519=head2 result_source
1520
1521=over 4
1522
1523=item Arguments: L<$result_source?|DBIx::Class::ResultSource>
1524
1525=item Return Value: L<$result_source|DBIx::Class::ResultSource>
1526
1527=back
1528
1529An accessor for the primary ResultSource object from which this ResultSet
1530is derived.
1531
1532=head2 result_class
1533
1534=over 4
1535
1536=item Arguments: $result_class?
1537
1538=item Return Value: $result_class
1539
1540=back
1541
1542An accessor for the class to use when creating result objects. Defaults to
1543C<< result_source->result_class >> - which in most cases is the name of the
1544L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
1545
1546Note that changing the result_class will also remove any components
1547that were originally loaded in the source class via
1548L<load_components|Class::C3::Componentised/load_components( @comps )>.
1549Any overloaded methods in the original source class will not run.
1550
1551=cut
1552
1553
# spent 983µs (362+621) within DBIx::Class::ResultSet::result_class which was called 6 times, avg 164µs/call: # 6 times (362µs+621µs) by DBIx::Class::ResultSet::new at line 335, avg 164µs/call
sub result_class {
15542900ns my ($self, $result_class) = @_;
15552800ns if ($result_class) {
1556
1557 # don't fire this for an object
155827µs666µs $self->ensure_class_loaded($result_class)
# spent 66µs making 6 calls to Class::C3::Componentised::ensure_class_loaded, avg 11µs/call
1559 unless ref($result_class);
1560
156127µs6247µs if ($self->get_cache) {
# spent 247µs making 6 calls to DBIx::Class::ResultSet::get_cache, avg 41µs/call
1562 carp_unique('Changing the result_class of a ResultSet instance with cached results is a noop - the cache contents will not be altered');
1563 }
1564 # FIXME ENCAPSULATION - encapsulation breach, cursor method additions pending
1565 elsif ($self->{cursor} && $self->{cursor}{_pos}) {
1566 $self->throw_exception('Changing the result_class of a ResultSet instance with an active cursor is not supported');
1567 }
1568
156926µs2303µs $self->_result_class($result_class);
# spent 303µs making 2 calls to DBIx::Class::ResultSet::_result_class, avg 152µs/call
1570
157122µs delete $self->{_result_inflator};
1572 }
157326µs13µs $self->_result_class;
# spent 3µs making 1 call to DBIx::Class::ResultSet::_result_class
1574}
1575
1576=head2 count
1577
1578=over 4
1579
1580=item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
1581
1582=item Return Value: $count
1583
1584=back
1585
1586Performs an SQL C<COUNT> with the same query as the resultset was built
1587with to find the number of elements. Passing arguments is equivalent to
1588C<< $rs->search ($cond, \%attrs)->count >>
1589
1590=cut
1591
1592sub count {
1593 my $self = shift;
1594 return $self->search(@_)->count if @_ and defined $_[0];
1595 return scalar @{ $self->get_cache } if $self->get_cache;
1596
1597 my $attrs = { %{ $self->_resolved_attrs } };
1598
1599 # this is a little optimization - it is faster to do the limit
1600 # adjustments in software, instead of a subquery
1601 my ($rows, $offset) = delete @{$attrs}{qw/rows offset/};
1602
1603 my $crs;
1604 if ($self->_has_resolved_attr (qw/collapse group_by/)) {
1605 $crs = $self->_count_subq_rs ($attrs);
1606 }
1607 else {
1608 $crs = $self->_count_rs ($attrs);
1609 }
1610 my $count = $crs->next;
1611
1612 $count -= $offset if $offset;
1613 $count = $rows if $rows and $rows < $count;
1614 $count = 0 if ($count < 0);
1615
1616 return $count;
1617}
1618
1619=head2 count_rs
1620
1621=over 4
1622
1623=item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
1624
1625=item Return Value: L<$count_rs|DBIx::Class::ResultSetColumn>
1626
1627=back
1628
1629Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
1630This can be very handy for subqueries:
1631
1632 ->search( { amount => $some_rs->count_rs->as_query } )
1633
1634As with regular resultsets the SQL query will be executed only after
1635the resultset is accessed via L</next> or L</all>. That would return
1636the same single value obtainable via L</count>.
1637
1638=cut
1639
1640sub count_rs {
1641 my $self = shift;
1642 return $self->search(@_)->count_rs if @_;
1643
1644 # this may look like a lack of abstraction (count() does about the same)
1645 # but in fact an _rs *must* use a subquery for the limits, as the
1646 # software based limiting can not be ported if this $rs is to be used
1647 # in a subquery itself (i.e. ->as_query)
1648 if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
1649 return $self->_count_subq_rs($self->{_attrs});
1650 }
1651 else {
1652 return $self->_count_rs($self->{_attrs});
1653 }
1654}
1655
1656#
1657# returns a ResultSetColumn object tied to the count query
1658#
1659sub _count_rs {
1660 my ($self, $attrs) = @_;
1661
1662 my $rsrc = $self->result_source;
1663
1664 my $tmp_attrs = { %$attrs };
1665 # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count
1666 delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/};
1667
1668 # overwrite the selector (supplied by the storage)
1669 $rsrc->resultset_class->new($rsrc, {
1670 %$tmp_attrs,
1671 select => $rsrc->storage->_count_select ($rsrc, $attrs),
1672 as => 'count',
1673 })->get_column ('count');
1674}
1675
1676#
1677# same as above but uses a subquery
1678#
1679sub _count_subq_rs {
1680 my ($self, $attrs) = @_;
1681
1682 my $rsrc = $self->result_source;
1683
1684 my $sub_attrs = { %$attrs };
1685 # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it
1686 delete @{$sub_attrs}{qw/collapse columns as select order_by for/};
1687
1688 # if we multi-prefetch we group_by something unique, as this is what we would
1689 # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
1690 if ( $attrs->{collapse} ) {
1691 $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{
1692 $rsrc->_identifying_column_set || $self->throw_exception(
1693 'Unable to construct a unique group_by criteria properly collapsing the '
1694 . 'has_many prefetch before count()'
1695 );
1696 } ]
1697 }
1698
1699 # Calculate subquery selector
1700 if (my $g = $sub_attrs->{group_by}) {
1701
1702 my $sql_maker = $rsrc->storage->sql_maker;
1703
1704 # necessary as the group_by may refer to aliased functions
1705 my $sel_index;
1706 for my $sel (@{$attrs->{select}}) {
1707 $sel_index->{$sel->{-as}} = $sel
1708 if (ref $sel eq 'HASH' and $sel->{-as});
1709 }
1710
1711 # anything from the original select mentioned on the group-by needs to make it to the inner selector
1712 # also look for named aggregates referred in the having clause
1713 # having often contains scalarrefs - thus parse it out entirely
1714 my @parts = @$g;
1715 if ($attrs->{having}) {
1716 local $sql_maker->{having_bind};
1717 local $sql_maker->{quote_char} = $sql_maker->{quote_char};
1718 local $sql_maker->{name_sep} = $sql_maker->{name_sep};
1719 unless (defined $sql_maker->{quote_char} and length $sql_maker->{quote_char}) {
1720 $sql_maker->{quote_char} = [ "\x00", "\xFF" ];
1721 # if we don't unset it we screw up retarded but unfortunately working
1722 # 'MAX(foo.bar)' => { '>', 3 }
1723 $sql_maker->{name_sep} = '';
1724 }
1725
1726 my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep);
1727
1728 my $having_sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} });
1729 my %seen_having;
1730
1731 # search for both a proper quoted qualified string, for a naive unquoted scalarref
1732 # and if all fails for an utterly naive quoted scalar-with-function
1733 while ($having_sql =~ /
1734 $rquote $sep $lquote (.+?) $rquote
1735 |
1736 [\s,] \w+ \. (\w+) [\s,]
1737 |
1738 [\s,] $lquote (.+?) $rquote [\s,]
1739 /gx) {
1740 my $part = $1 || $2 || $3; # one of them matched if we got here
1741 unless ($seen_having{$part}++) {
1742 push @parts, $part;
1743 }
1744 }
1745 }
1746
1747 for (@parts) {
1748 my $colpiece = $sel_index->{$_} || $_;
1749
1750 # unqualify join-based group_by's. Arcane but possible query
1751 # also horrible horrible hack to alias a column (not a func.)
1752 # (probably need to introduce SQLA syntax)
1753 if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) {
1754 my $as = $colpiece;
1755 $as =~ s/\./__/;
1756 $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) );
1757 }
1758 push @{$sub_attrs->{select}}, $colpiece;
1759 }
1760 }
1761 else {
1762 my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns);
1763 $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ];
1764 }
1765
1766 return $rsrc->resultset_class
1767 ->new ($rsrc, $sub_attrs)
1768 ->as_subselect_rs
1769 ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
1770 ->get_column ('count');
1771}
1772
1773
1774=head2 count_literal
1775
1776B<CAVEAT>: C<count_literal> is provided for Class::DBI compatibility and
1777should only be used in that context. See L</search_literal> for further info.
1778
1779=over 4
1780
1781=item Arguments: $sql_fragment, @standalone_bind_values
1782
1783=item Return Value: $count
1784
1785=back
1786
1787Counts the results in a literal query. Equivalent to calling L</search_literal>
1788with the passed arguments, then L</count>.
1789
1790=cut
1791
1792sub count_literal { shift->search_literal(@_)->count; }
1793
1794=head2 all
1795
1796=over 4
1797
1798=item Arguments: none
1799
1800=item Return Value: L<@result_objs|DBIx::Class::Manual::ResultClass>
1801
1802=back
1803
1804Returns all elements in the resultset.
1805
1806=cut
1807
1808sub all {
1809 my $self = shift;
1810 if(@_) {
1811 $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
1812 }
1813
1814 delete @{$self}{qw/_stashed_rows _stashed_results/};
1815
1816 if (my $c = $self->get_cache) {
1817 return @$c;
1818 }
1819
1820 $self->cursor->reset;
1821
1822 my $objs = $self->_construct_results('fetch_all') || [];
1823
1824 $self->set_cache($objs) if $self->{attrs}{cache};
1825
1826 return @$objs;
1827}
1828
1829=head2 reset
1830
1831=over 4
1832
1833=item Arguments: none
1834
1835=item Return Value: $self
1836
1837=back
1838
1839Resets the resultset's cursor, so you can iterate through the elements again.
1840Implicitly resets the storage cursor, so a subsequent L</next> will trigger
1841another query.
1842
1843=cut
1844
1845sub reset {
1846 my ($self) = @_;
1847
1848 delete @{$self}{qw/_stashed_rows _stashed_results/};
1849 $self->{all_cache_position} = 0;
1850 $self->cursor->reset;
1851 return $self;
1852}
1853
1854=head2 first
1855
1856=over 4
1857
1858=item Arguments: none
1859
1860=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
1861
1862=back
1863
1864L<Resets|/reset> the resultset (causing a fresh query to storage) and returns
1865an object for the first result (or C<undef> if the resultset is empty).
1866
1867=cut
1868
1869sub first {
1870 return $_[0]->reset->next;
1871}
1872
1873
1874# _rs_update_delete
1875#
1876# Determines whether and what type of subquery is required for the $rs operation.
1877# If grouping is necessary either supplies its own, or verifies the current one
1878# After all is done delegates to the proper storage method.
1879
1880sub _rs_update_delete {
1881 my ($self, $op, $values) = @_;
1882
1883 my $rsrc = $self->result_source;
1884 my $storage = $rsrc->schema->storage;
1885
1886 my $attrs = { %{$self->_resolved_attrs} };
1887
1888 my $join_classifications;
1889 my ($existing_group_by) = delete @{$attrs}{qw(group_by _grouped_by_distinct)};
1890
1891 # do we need a subquery for any reason?
1892 my $needs_subq = (
1893 defined $existing_group_by
1894 or
1895 ref($attrs->{from}) ne 'ARRAY'
1896
1897 or
1898 $self->_has_resolved_attr(qw/rows offset/)
1899
1900 );
1901
1902 # simplify the joinmap, so we can further decide if a subq is necessary
1903 if (!$needs_subq and @{$attrs->{from}} > 1) {
1904
1905 ($attrs->{from}, $join_classifications) =
1906 $storage->_prune_unused_joins ($attrs);
1907
1908 # any non-pruneable non-local restricting joins imply subq
1909 $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} };
1910 }
1911
1912 # check if the head is composite (by now all joins are thrown out unless $needs_subq)
1913 $needs_subq ||= (
1914 (ref $attrs->{from}[0]) ne 'HASH'
1915 or
1916 ref $attrs->{from}[0]{ $attrs->{from}[0]{-alias} }
1917 );
1918
1919 my ($cond, $guard);
1920 # do we need anything like a subquery?
1921 if (! $needs_subq) {
1922 # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
1923 # a condition containing 'me' or other table prefixes will not work
1924 # at all. Tell SQLMaker to dequalify idents via a gross hack.
1925 $cond = do {
1926 my $sqla = $rsrc->storage->sql_maker;
1927 local $sqla->{_dequalify_idents} = 1;
1928 \[ $sqla->_recurse_where($self->{cond}) ];
1929 };
1930 }
1931 else {
1932 # we got this far - means it is time to wrap a subquery
1933 my $idcols = $rsrc->_identifying_column_set || $self->throw_exception(
1934 sprintf(
1935 "Unable to perform complex resultset %s() without an identifying set of columns on source '%s'",
1936 $op,
1937 $rsrc->source_name,
1938 )
1939 );
1940
1941 # make a new $rs selecting only the PKs (that's all we really need for the subq)
1942 delete $attrs->{$_} for qw/select as collapse/;
1943 $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ];
1944
1945 # this will be consumed by the pruner waaaaay down the stack
1946 $attrs->{_force_prune_multiplying_joins} = 1;
1947
1948 my $subrs = (ref $self)->new($rsrc, $attrs);
1949
1950 if (@$idcols == 1) {
1951 $cond = { $idcols->[0] => { -in => $subrs->as_query } };
1952 }
1953 elsif ($storage->_use_multicolumn_in) {
1954 # no syntax for calling this properly yet
1955 # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
1956 $cond = $storage->sql_maker->_where_op_multicolumn_in (
1957 $idcols, # how do I convey a list of idents...? can binds reside on lhs?
1958 $subrs->as_query
1959 ),
1960 }
1961 else {
1962 # if all else fails - get all primary keys and operate over a ORed set
1963 # wrap in a transaction for consistency
1964 # this is where the group_by/multiplication starts to matter
1965 if (
1966 $existing_group_by
1967 or
1968 keys %{ $join_classifications->{multiplying} || {} }
1969
1970
1971 ) {
1972 # make sure if there is a supplied group_by it matches the columns compiled above
1973 # perfectly. Anything else can not be sanely executed on most databases so croak
1974 # right then and there
1975 if ($existing_group_by) {
1976 my @current_group_by = map
1977 { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
1978 @$existing_group_by
1979 ;
1980
1981 if (
1982 join ("\x00", sort @current_group_by)
1983 ne
1984 join ("\x00", sort @{$attrs->{columns}} )
1985 ) {
1986 $self->throw_exception (
1987 "You have just attempted a $op operation on a resultset which does group_by"
1988 . ' on columns other than the primary keys, while DBIC internally needs to retrieve'
1989 . ' the primary keys in a subselect. All sane RDBMS engines do not support this'
1990 . ' kind of queries. Please retry the operation with a modified group_by or'
1991 . ' without using one at all.'
1992 );
1993 }
1994 }
1995
1996 $subrs = $subrs->search({}, { group_by => $attrs->{columns} });
1997 }
1998
1999 $guard = $storage->txn_scope_guard;
2000
2001 for my $row ($subrs->cursor->all) {
2002 push @$cond, { map
2003 { $idcols->[$_] => $row->[$_] }
2004 (0 .. $#$idcols)
2005 };
2006 }
2007 }
2008 }
2009
2010 my $res = $cond ? $storage->$op (
2011 $rsrc,
2012 $op eq 'update' ? $values : (),
2013 $cond,
2014 ) : '0E0';
2015
2016 $guard->commit if $guard;
2017
2018 return $res;
2019}
2020
2021=head2 update
2022
2023=over 4
2024
2025=item Arguments: \%values
2026
2027=item Return Value: $underlying_storage_rv
2028
2029=back
2030
2031Sets the specified columns in the resultset to the supplied values in a
2032single query. Note that this will not run any accessor/set_column/update
2033triggers, nor will it update any result object instances derived from this
2034resultset (this includes the contents of the L<resultset cache|/set_cache>
2035if any). See L</update_all> if you need to execute any on-update
2036triggers or cascades defined either by you or a
2037L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
2038
2039The return value is a pass through of what the underlying
2040storage backend returned, and may vary. See L<DBI/execute> for the most
2041common case.
2042
2043=head3 CAVEAT
2044
2045Note that L</update> does not process/deflate any of the values passed in.
2046This is unlike the corresponding L<DBIx::Class::Row/update>. The user must
2047ensure manually that any value passed to this method will stringify to
2048something the RDBMS knows how to deal with. A notable example is the
2049handling of L<DateTime> objects, for more info see:
2050L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
2051
2052=cut
2053
2054sub update {
2055 my ($self, $values) = @_;
2056 $self->throw_exception('Values for update must be a hash')
2057 unless ref $values eq 'HASH';
2058
2059 return $self->_rs_update_delete ('update', $values);
2060}
2061
2062=head2 update_all
2063
2064=over 4
2065
2066=item Arguments: \%values
2067
2068=item Return Value: 1
2069
2070=back
2071
2072Fetches all objects and updates them one at a time via
2073L<DBIx::Class::Row/update>. Note that C<update_all> will run DBIC defined
2074triggers, while L</update> will not.
2075
2076=cut
2077
2078sub update_all {
2079 my ($self, $values) = @_;
2080 $self->throw_exception('Values for update_all must be a hash')
2081 unless ref $values eq 'HASH';
2082
2083 my $guard = $self->result_source->schema->txn_scope_guard;
2084 $_->update({%$values}) for $self->all; # shallow copy - update will mangle it
2085 $guard->commit;
2086 return 1;
2087}
2088
2089=head2 delete
2090
2091=over 4
2092
2093=item Arguments: none
2094
2095=item Return Value: $underlying_storage_rv
2096
2097=back
2098
2099Deletes the rows matching this resultset in a single query. Note that this
2100will not run any delete triggers, nor will it alter the
2101L<in_storage|DBIx::Class::Row/in_storage> status of any result object instances
2102derived from this resultset (this includes the contents of the
2103L<resultset cache|/set_cache> if any). See L</delete_all> if you need to
2104execute any on-delete triggers or cascades defined either by you or a
2105L<result component|DBIx::Class::Manual::Component/WHAT IS A COMPONENT>.
2106
2107The return value is a pass through of what the underlying storage backend
2108returned, and may vary. See L<DBI/execute> for the most common case.
2109
2110=cut
2111
2112sub delete {
2113 my $self = shift;
2114 $self->throw_exception('delete does not accept any arguments')
2115 if @_;
2116
2117 return $self->_rs_update_delete ('delete');
2118}
2119
2120=head2 delete_all
2121
2122=over 4
2123
2124=item Arguments: none
2125
2126=item Return Value: 1
2127
2128=back
2129
2130Fetches all objects and deletes them one at a time via
2131L<DBIx::Class::Row/delete>. Note that C<delete_all> will run DBIC defined
2132triggers, while L</delete> will not.
2133
2134=cut
2135
2136sub delete_all {
2137 my $self = shift;
2138 $self->throw_exception('delete_all does not accept any arguments')
2139 if @_;
2140
2141 my $guard = $self->result_source->schema->txn_scope_guard;
2142 $_->delete for $self->all;
2143 $guard->commit;
2144 return 1;
2145}
2146
2147=head2 populate
2148
2149=over 4
2150
2151=item Arguments: [ \@column_list, \@row_values+ ] | [ \%col_data+ ]
2152
2153=item Return Value: L<\@result_objects|DBIx::Class::Manual::ResultClass> (scalar context) | L<@result_objects|DBIx::Class::Manual::ResultClass> (list context)
2154
2155=back
2156
2157Accepts either an arrayref of hashrefs or alternatively an arrayref of
2158arrayrefs.
2159
2160=over
2161
2162=item NOTE
2163
2164The context of this method call has an important effect on what is
2165submitted to storage. In void context data is fed directly to fastpath
2166insertion routines provided by the underlying storage (most often
2167L<DBI/execute_for_fetch>), bypassing the L<new|DBIx::Class::Row/new> and
2168L<insert|DBIx::Class::Row/insert> calls on the
2169L<Result|DBIx::Class::Manual::ResultClass> class, including any
2170augmentation of these methods provided by components. For example if you
2171are using something like L<DBIx::Class::UUIDColumns> to create primary
2172keys for you, you will find that your PKs are empty. In this case you
2173will have to explicitly force scalar or list context in order to create
2174those values.
2175
2176=back
2177
2178In non-void (scalar or list) context, this method is simply a wrapper
2179for L</create>. Depending on list or scalar context either a list of
2180L<Result|DBIx::Class::Manual::ResultClass> objects or an arrayref
2181containing these objects is returned.
2182
2183When supplying data in "arrayref of arrayrefs" invocation style, the
2184first element should be a list of column names and each subsequent
2185element should be a data value in the earlier specified column order.
2186For example:
2187
2188 $schema->resultset("Artist")->populate([
2189 [ qw( artistid name ) ],
2190 [ 100, 'A Formally Unknown Singer' ],
2191 [ 101, 'A singer that jumped the shark two albums ago' ],
2192 [ 102, 'An actually cool singer' ],
2193 ]);
2194
2195For the arrayref of hashrefs style each hashref should be a structure
2196suitable for passing to L</create>. Multi-create is also permitted with
2197this syntax.
2198
2199 $schema->resultset("Artist")->populate([
2200 { artistid => 4, name => 'Manufactured Crap', cds => [
2201 { title => 'My First CD', year => 2006 },
2202 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2203 ],
2204 },
2205 { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
2206 { title => 'My parents sold me to a record company', year => 2005 },
2207 { title => 'Why Am I So Ugly?', year => 2006 },
2208 { title => 'I Got Surgery and am now Popular', year => 2007 }
2209 ],
2210 },
2211 ]);
2212
2213If you attempt a void-context multi-create as in the example above (each
2214Artist also has the related list of CDs), and B<do not> supply the
2215necessary autoinc foreign key information, this method will proxy to the
2216less efficient L</create>, and then throw the Result objects away. In this
2217case there are obviously no benefits to using this method over L</create>.
2218
2219=cut
2220
2221sub populate {
2222 my $self = shift;
2223
2224 # this is naive and just a quick check
2225 # the types will need to be checked more thoroughly when the
2226 # multi-source populate gets added
2227 my $data = (
2228 ref $_[0] eq 'ARRAY'
2229 and
2230 ( @{$_[0]} or return )
2231 and
2232 ( ref $_[0][0] eq 'HASH' or ref $_[0][0] eq 'ARRAY' )
2233 and
2234 $_[0]
2235 ) or $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
2236
2237 # FIXME - no cref handling
2238 # At this point assume either hashes or arrays
2239
2240 if(defined wantarray) {
2241 my (@results, $guard);
2242
2243 if (ref $data->[0] eq 'ARRAY') {
2244 # column names only, nothing to do
2245 return if @$data == 1;
2246
2247 $guard = $self->result_source->schema->storage->txn_scope_guard
2248 if @$data > 2;
2249
2250 @results = map
2251 { my $vals = $_; $self->new_result({ map { $data->[0][$_] => $vals->[$_] } 0..$#{$data->[0]} })->insert }
2252 @{$data}[1 .. $#$data]
2253 ;
2254 }
2255 else {
2256
2257 $guard = $self->result_source->schema->storage->txn_scope_guard
2258 if @$data > 1;
2259
2260 @results = map { $self->new_result($_)->insert } @$data;
2261 }
2262
2263 $guard->commit if $guard;
2264 return wantarray ? @results : \@results;
2265 }
2266
2267 # we have to deal with *possibly incomplete* related data
2268 # this means we have to walk the data structure twice
2269 # whether we want this or not
2270 # jnap, I hate you ;)
2271 my $rsrc = $self->result_source;
2272 my $rel_info = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
2273
2274 my ($colinfo, $colnames, $slices_with_rels);
2275 my $data_start = 0;
2276
2277 DATA_SLICE:
2278 for my $i (0 .. $#$data) {
2279
2280 my $current_slice_seen_rel_infos;
2281
2282### Determine/Supplement collists
2283### BEWARE - This is a hot piece of code, a lot of weird idioms were used
2284 if( ref $data->[$i] eq 'ARRAY' ) {
2285
2286 # positional(!) explicit column list
2287 if ($i == 0) {
2288 # column names only, nothing to do
2289 return if @$data == 1;
2290
2291 $colinfo->{$data->[0][$_]} = { pos => $_, name => $data->[0][$_] } and push @$colnames, $data->[0][$_]
2292 for 0 .. $#{$data->[0]};
2293
2294 $data_start = 1;
2295
2296 next DATA_SLICE;
2297 }
2298 else {
2299 for (values %$colinfo) {
2300 if ($_->{is_rel} ||= (
2301 $rel_info->{$_->{name}}
2302 and
2303 (
2304 ref $data->[$i][$_->{pos}] eq 'ARRAY'
2305 or
2306 ref $data->[$i][$_->{pos}] eq 'HASH'
2307 or
2308 ( defined blessed $data->[$i][$_->{pos}] and $data->[$i][$_->{pos}]->isa('DBIx::Class::Row') )
2309 )
2310 and
2311 1
2312 )) {
2313
2314 # moar sanity check... sigh
2315 for ( ref $data->[$i][$_->{pos}] eq 'ARRAY' ? @{$data->[$i][$_->{pos}]} : $data->[$i][$_->{pos}] ) {
2316 if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
2317 carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
2318 return my $throwaway = $self->populate(@_);
2319 }
2320 }
2321
2322 push @$current_slice_seen_rel_infos, $rel_info->{$_->{name}};
2323 }
2324 }
2325 }
2326
2327 if ($current_slice_seen_rel_infos) {
2328 push @$slices_with_rels, { map { $colnames->[$_] => $data->[$i][$_] } 0 .. $#$colnames };
2329
2330 # this is needed further down to decide whether or not to fallback to create()
2331 $colinfo->{$colnames->[$_]}{seen_null} ||= ! defined $data->[$i][$_]
2332 for 0 .. $#$colnames;
2333 }
2334 }
2335 elsif( ref $data->[$i] eq 'HASH' ) {
2336
2337 for ( sort keys %{$data->[$i]} ) {
2338
2339 $colinfo->{$_} ||= do {
2340
2341 $self->throw_exception("Column '$_' must be present in supplied explicit column list")
2342 if $data_start; # it will be 0 on AoH, 1 on AoA
2343
2344 push @$colnames, $_;
2345
2346 # RV
2347 { pos => $#$colnames, name => $_ }
2348 };
2349
2350 if ($colinfo->{$_}{is_rel} ||= (
2351 $rel_info->{$_}
2352 and
2353 (
2354 ref $data->[$i]{$_} eq 'ARRAY'
2355 or
2356 ref $data->[$i]{$_} eq 'HASH'
2357 or
2358 ( defined blessed $data->[$i]{$_} and $data->[$i]{$_}->isa('DBIx::Class::Row') )
2359 )
2360 and
2361 1
2362 )) {
2363
2364 # moar sanity check... sigh
2365 for ( ref $data->[$i]{$_} eq 'ARRAY' ? @{$data->[$i]{$_}} : $data->[$i]{$_} ) {
2366 if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) {
2367 carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
2368 return my $throwaway = $self->populate(@_);
2369 }
2370 }
2371
2372 push @$current_slice_seen_rel_infos, $rel_info->{$_};
2373 }
2374 }
2375
2376 if ($current_slice_seen_rel_infos) {
2377 push @$slices_with_rels, $data->[$i];
2378
2379 # this is needed further down to decide whether or not to fallback to create()
2380 $colinfo->{$_}{seen_null} ||= ! defined $data->[$i]{$_}
2381 for keys %{$data->[$i]};
2382 }
2383 }
2384 else {
2385 $self->throw_exception('Unexpected populate() data structure member type: ' . ref $data->[$i] );
2386 }
2387
2388 if ( grep
2389 { $_->{attrs}{is_depends_on} }
2390 @{ $current_slice_seen_rel_infos || [] }
2391 ) {
2392 carp_unique("Fast-path populate() of belongs_to relationship data is not possible - falling back to regular create()");
2393 return my $throwaway = $self->populate(@_);
2394 }
2395 }
2396
2397 if( $slices_with_rels ) {
2398
2399 # need to exclude the rel "columns"
2400 $colnames = [ grep { ! $colinfo->{$_}{is_rel} } @$colnames ];
2401
2402 # extra sanity check - ensure the main source is in fact identifiable
2403 # the localizing of nullability is insane, but oh well... the use-case is legit
2404 my $ci = $rsrc->columns_info($colnames);
2405
2406 $ci->{$_} = { %{$ci->{$_}}, is_nullable => 0 }
2407 for grep { ! $colinfo->{$_}{seen_null} } keys %$ci;
2408
2409 unless( $rsrc->_identifying_column_set($ci) ) {
2410 carp_unique("Fast-path populate() of non-uniquely identifiable rows with related data is not possible - falling back to regular create()");
2411 return my $throwaway = $self->populate(@_);
2412 }
2413 }
2414
2415### inherit the data locked in the conditions of the resultset
2416 my ($rs_data) = $self->_merge_with_rscond({});
2417 delete @{$rs_data}{@$colnames}; # passed-in stuff takes precedence
2418
2419 # if anything left - decompose rs_data
2420 my $rs_data_vals;
2421 if (keys %$rs_data) {
2422 push @$rs_data_vals, $rs_data->{$_}
2423 for sort keys %$rs_data;
2424 }
2425
2426### start work
2427 my $guard;
2428 $guard = $rsrc->schema->storage->txn_scope_guard
2429 if $slices_with_rels;
2430
2431### main source data
2432 # FIXME - need to switch entirely to a coderef-based thing,
2433 # so that large sets aren't copied several times... I think
2434 $rsrc->storage->_insert_bulk(
2435 $rsrc,
2436 [ @$colnames, sort keys %$rs_data ],
2437 [ map {
2438 ref $data->[$_] eq 'ARRAY'
2439 ? (
2440 $slices_with_rels ? [ @{$data->[$_]}[0..$#$colnames], @{$rs_data_vals||[]} ] # the collist changed
2441 : $rs_data_vals ? [ @{$data->[$_]}, @$rs_data_vals ]
2442 : $data->[$_]
2443 )
2444 : [ @{$data->[$_]}{@$colnames}, @{$rs_data_vals||[]} ]
2445 } $data_start .. $#$data ],
2446 );
2447
2448### do the children relationships
2449 if ( $slices_with_rels ) {
2450 my @rels = grep { $colinfo->{$_}{is_rel} } keys %$colinfo
2451 or die 'wtf... please report a bug with DBIC_TRACE=1 output (stacktrace)';
2452
2453 for my $sl (@$slices_with_rels) {
2454
2455 my ($main_proto, $main_proto_rs);
2456 for my $rel (@rels) {
2457 next unless defined $sl->{$rel};
2458
2459 $main_proto ||= {
2460 %$rs_data,
2461 (map { $_ => $sl->{$_} } @$colnames),
2462 };
2463
2464 unless (defined $colinfo->{$rel}{rs}) {
2465
2466 $colinfo->{$rel}{rs} = $rsrc->related_source($rel)->resultset;
2467
2468 $colinfo->{$rel}{fk_map} = { reverse %{ $rsrc->_resolve_relationship_condition(
2469 rel_name => $rel,
2470 self_alias => "\xFE", # irrelevant
2471 foreign_alias => "\xFF", # irrelevant
2472 )->{identity_map} || {} } };
2473
2474 }
2475
2476 $colinfo->{$rel}{rs}->search({ map # only so that we inherit them values properly, no actual search
2477 {
2478 $_ => { '=' =>
2479 ( $main_proto_rs ||= $rsrc->resultset->search($main_proto) )
2480 ->get_column( $colinfo->{$rel}{fk_map}{$_} )
2481 ->as_query
2482 }
2483 }
2484 keys %{$colinfo->{$rel}{fk_map}}
2485 })->populate( ref $sl->{$rel} eq 'ARRAY' ? $sl->{$rel} : [ $sl->{$rel} ] );
2486
2487 1;
2488 }
2489 }
2490 }
2491
2492 $guard->commit if $guard;
2493}
2494
2495=head2 pager
2496
2497=over 4
2498
2499=item Arguments: none
2500
2501=item Return Value: L<$pager|Data::Page>
2502
2503=back
2504
2505Returns a L<Data::Page> object for the current resultset. Only makes
2506sense for queries with a C<page> attribute.
2507
2508To get the full count of entries for a paged resultset, call
2509C<total_entries> on the L<Data::Page> object.
2510
2511=cut
2512
2513sub pager {
2514 my ($self) = @_;
2515
2516 return $self->{pager} if $self->{pager};
2517
2518 my $attrs = $self->{attrs};
2519 if (!defined $attrs->{page}) {
2520 $self->throw_exception("Can't create pager for non-paged rs");
2521 }
2522 elsif ($attrs->{page} <= 0) {
2523 $self->throw_exception('Invalid page number (page-numbers are 1-based)');
2524 }
2525 $attrs->{rows} ||= 10;
2526
2527 # throw away the paging flags and re-run the count (possibly
2528 # with a subselect) to get the real total count
2529 my $count_attrs = { %$attrs };
2530 delete @{$count_attrs}{qw/rows offset page pager/};
2531
2532 my $total_rs = (ref $self)->new($self->result_source, $count_attrs);
2533
2534 require DBIx::Class::ResultSet::Pager;
2535 return $self->{pager} = DBIx::Class::ResultSet::Pager->new(
2536 sub { $total_rs->count }, #lazy-get the total
2537 $attrs->{rows},
2538 $self->{attrs}{page},
2539 );
2540}
2541
2542=head2 page
2543
2544=over 4
2545
2546=item Arguments: $page_number
2547
2548=item Return Value: L<$resultset|/search>
2549
2550=back
2551
2552Returns a resultset for the $page_number page of the resultset on which page
2553is called, where each page contains a number of rows equal to the 'rows'
2554attribute set on the resultset (10 by default).
2555
2556=cut
2557
2558sub page {
2559 my ($self, $page) = @_;
2560 return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
2561}
2562
2563=head2 new_result
2564
2565=over 4
2566
2567=item Arguments: \%col_data
2568
2569=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2570
2571=back
2572
2573Creates a new result object in the resultset's result class and returns
2574it. The row is not inserted into the database at this point, call
2575L<DBIx::Class::Row/insert> to do that. Calling L<DBIx::Class::Row/in_storage>
2576will tell you whether the result object has been inserted or not.
2577
2578Passes the hashref of input on to L<DBIx::Class::Row/new>.
2579
2580=cut
2581
2582sub new_result {
2583 my ($self, $values) = @_;
2584
2585 $self->throw_exception( "new_result takes only one argument - a hashref of values" )
2586 if @_ > 2;
2587
2588 $self->throw_exception( "Result object instantiation requires a hashref as argument" )
2589 unless (ref $values eq 'HASH');
2590
2591 my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
2592
2593 my $new = $self->result_class->new({
2594 %$merged_cond,
2595 ( @$cols_from_relations
2596 ? (-cols_from_relations => $cols_from_relations)
2597 : ()
2598 ),
2599 -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
2600 });
2601
2602 if (
2603 reftype($new) eq 'HASH'
2604 and
2605 ! keys %$new
2606 and
2607 blessed($new)
2608 ) {
2609 carp_unique (sprintf (
2610 "%s->new returned a blessed empty hashref - a strong indicator something is wrong with its inheritance chain",
2611 $self->result_class,
2612 ));
2613 }
2614
2615 $new;
2616}
2617
2618# _merge_with_rscond
2619#
2620# Takes a simple hash of K/V data and returns its copy merged with the
2621# condition already present on the resultset. Additionally returns an
2622# arrayref of value/condition names, which were inferred from related
2623# objects (this is needed for in-memory related objects)
2624sub _merge_with_rscond {
2625 my ($self, $data) = @_;
2626
2627 my ($implied_data, @cols_from_relations);
2628
2629 my $alias = $self->{attrs}{alias};
2630
2631 if (! defined $self->{cond}) {
2632 # just massage $data below
2633 }
2634 elsif ($self->{cond} eq UNRESOLVABLE_CONDITION) {
2635 $implied_data = $self->{attrs}{related_objects}; # nothing might have been inserted yet
2636 @cols_from_relations = keys %{ $implied_data || {} };
2637 }
2638 else {
2639 my $eqs = $self->result_source->schema->storage->_extract_fixed_condition_columns($self->{cond}, 'consider_nulls');
2640 $implied_data = { map {
2641 ( ($eqs->{$_}||'') eq UNRESOLVABLE_CONDITION ) ? () : ( $_ => $eqs->{$_} )
2642 } keys %$eqs };
2643 }
2644
2645 return (
2646 { map
2647 { %{ $self->_remove_alias($_, $alias) } }
2648 # precedence must be given to passed values over values inherited from
2649 # the cond, so the order here is important.
2650 ( $implied_data||(), $data)
2651 },
2652 \@cols_from_relations
2653 );
2654}
2655
2656# _has_resolved_attr
2657#
2658# determines if the resultset defines at least one
2659# of the attributes supplied
2660#
2661# used to determine if a subquery is necessary
2662#
2663# supports some virtual attributes:
2664# -join
2665# This will scan for any joins being present on the resultset.
2666# It is not a mere key-search but a deep inspection of {from}
2667#
2668
2669sub _has_resolved_attr {
2670 my ($self, @attr_names) = @_;
2671
2672 my $attrs = $self->_resolved_attrs;
2673
2674 my %extra_checks;
2675
2676 for my $n (@attr_names) {
2677 if (grep { $n eq $_ } (qw/-join/) ) {
2678 $extra_checks{$n}++;
2679 next;
2680 }
2681
2682 my $attr = $attrs->{$n};
2683
2684 next if not defined $attr;
2685
2686 if (ref $attr eq 'HASH') {
2687 return 1 if keys %$attr;
2688 }
2689 elsif (ref $attr eq 'ARRAY') {
2690 return 1 if @$attr;
2691 }
2692 else {
2693 return 1 if $attr;
2694 }
2695 }
2696
2697 # a resolved join is expressed as a multi-level from
2698 return 1 if (
2699 $extra_checks{-join}
2700 and
2701 ref $attrs->{from} eq 'ARRAY'
2702 and
2703 @{$attrs->{from}} > 1
2704 );
2705
2706 return 0;
2707}
2708
2709# _remove_alias
2710#
2711# Remove the specified alias from the specified query hash. A copy is made so
2712# the original query is not modified.
2713
2714sub _remove_alias {
2715 my ($self, $query, $alias) = @_;
2716
2717 my %orig = %{ $query || {} };
2718 my %unaliased;
2719
2720 foreach my $key (keys %orig) {
2721 if ($key !~ /\./) {
2722 $unaliased{$key} = $orig{$key};
2723 next;
2724 }
2725 $unaliased{$1} = $orig{$key}
2726 if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/;
2727 }
2728
2729 return \%unaliased;
2730}
2731
2732=head2 as_query
2733
2734=over 4
2735
2736=item Arguments: none
2737
2738=item Return Value: \[ $sql, L<@bind_values|/DBIC BIND VALUES> ]
2739
2740=back
2741
2742Returns the SQL query and bind vars associated with the invocant.
2743
2744This is generally used as the RHS for a subquery.
2745
2746=cut
2747
2748sub as_query {
2749 my $self = shift;
2750
2751 my $attrs = { %{ $self->_resolved_attrs } };
2752
2753 my $aq = $self->result_source->storage->_select_args_to_query (
2754 $attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
2755 );
2756
2757 $aq;
2758}
2759
2760=head2 find_or_new
2761
2762=over 4
2763
2764=item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
2765
2766=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2767
2768=back
2769
2770 my $artist = $schema->resultset('Artist')->find_or_new(
2771 { artist => 'fred' }, { key => 'artists' });
2772
2773 $cd->cd_to_producer->find_or_new({ producer => $producer },
2774 { key => 'primary' });
2775
2776Find an existing record from this resultset using L</find>. if none exists,
2777instantiate a new result object and return it. The object will not be saved
2778into your storage until you call L<DBIx::Class::Row/insert> on it.
2779
2780You most likely want this method when looking for existing rows using a unique
2781constraint that is not the primary key, or looking for related rows.
2782
2783If you want objects to be saved immediately, use L</find_or_create> instead.
2784
2785B<Note>: Make sure to read the documentation of L</find> and understand the
2786significance of the C<key> attribute, as its lack may skew your search, and
2787subsequently result in spurious new objects.
2788
2789B<Note>: Take care when using C<find_or_new> with a table having
2790columns with default values that you intend to be automatically
2791supplied by the database (e.g. an auto_increment primary key column).
2792In normal usage, the value of such columns should NOT be included at
2793all in the call to C<find_or_new>, even when set to C<undef>.
2794
2795=cut
2796
2797sub find_or_new {
2798 my $self = shift;
2799 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2800 my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
2801 if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2802 return $row;
2803 }
2804 return $self->new_result($hash);
2805}
2806
2807=head2 create
2808
2809=over 4
2810
2811=item Arguments: \%col_data
2812
2813=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2814
2815=back
2816
2817Attempt to create a single new row or a row with multiple related rows
2818in the table represented by the resultset (and related tables). This
2819will not check for duplicate rows before inserting, use
2820L</find_or_create> to do that.
2821
2822To create one row for this resultset, pass a hashref of key/value
2823pairs representing the columns of the table and the values you wish to
2824store. If the appropriate relationships are set up, foreign key fields
2825can also be passed an object representing the foreign row, and the
2826value will be set to its primary key.
2827
2828To create related objects, pass a hashref of related-object column values
2829B<keyed on the relationship name>. If the relationship is of type C<multi>
2830(L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
2831The process will correctly identify columns holding foreign keys, and will
2832transparently populate them from the keys of the corresponding relation.
2833This can be applied recursively, and will work correctly for a structure
2834with an arbitrary depth and width, as long as the relationships actually
2835exists and the correct column data has been supplied.
2836
2837Instead of hashrefs of plain related data (key/value pairs), you may
2838also pass new or inserted objects. New objects (not inserted yet, see
2839L</new_result>), will be inserted into their appropriate tables.
2840
2841Effectively a shortcut for C<< ->new_result(\%col_data)->insert >>.
2842
2843Example of creating a new row.
2844
2845 $person_rs->create({
2846 name=>"Some Person",
2847 email=>"somebody@someplace.com"
2848 });
2849
2850Example of creating a new row and also creating rows in a related C<has_many>
2851or C<has_one> resultset. Note Arrayref.
2852
2853 $artist_rs->create(
2854 { artistid => 4, name => 'Manufactured Crap', cds => [
2855 { title => 'My First CD', year => 2006 },
2856 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
2857 ],
2858 },
2859 );
2860
2861Example of creating a new row and also creating a row in a related
2862C<belongs_to> resultset. Note Hashref.
2863
2864 $cd_rs->create({
2865 title=>"Music for Silly Walks",
2866 year=>2000,
2867 artist => {
2868 name=>"Silly Musician",
2869 }
2870 });
2871
2872=over
2873
2874=item WARNING
2875
2876When subclassing ResultSet never attempt to override this method. Since
2877it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
2878lot of the internals simply never call it, so your override will be
2879bypassed more often than not. Override either L<DBIx::Class::Row/new>
2880or L<DBIx::Class::Row/insert> depending on how early in the
2881L</create> process you need to intervene. See also warning pertaining to
2882L</new>.
2883
2884=back
2885
2886=cut
2887
2888sub create {
2889 #my ($self, $col_data) = @_;
2890 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
2891 return shift->new_result(shift)->insert;
2892}
2893
2894=head2 find_or_create
2895
2896=over 4
2897
2898=item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
2899
2900=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2901
2902=back
2903
2904 $cd->cd_to_producer->find_or_create({ producer => $producer },
2905 { key => 'primary' });
2906
2907Tries to find a record based on its primary key or unique constraints; if none
2908is found, creates one and returns that instead.
2909
2910 my $cd = $schema->resultset('CD')->find_or_create({
2911 cdid => 5,
2912 artist => 'Massive Attack',
2913 title => 'Mezzanine',
2914 year => 2005,
2915 });
2916
2917Also takes an optional C<key> attribute, to search by a specific key or unique
2918constraint. For example:
2919
2920 my $cd = $schema->resultset('CD')->find_or_create(
2921 {
2922 artist => 'Massive Attack',
2923 title => 'Mezzanine',
2924 },
2925 { key => 'cd_artist_title' }
2926 );
2927
2928B<Note>: Make sure to read the documentation of L</find> and understand the
2929significance of the C<key> attribute, as its lack may skew your search, and
2930subsequently result in spurious row creation.
2931
2932B<Note>: Because find_or_create() reads from the database and then
2933possibly inserts based on the result, this method is subject to a race
2934condition. Another process could create a record in the table after
2935the find has completed and before the create has started. To avoid
2936this problem, use find_or_create() inside a transaction.
2937
2938B<Note>: Take care when using C<find_or_create> with a table having
2939columns with default values that you intend to be automatically
2940supplied by the database (e.g. an auto_increment primary key column).
2941In normal usage, the value of such columns should NOT be included at
2942all in the call to C<find_or_create>, even when set to C<undef>.
2943
2944See also L</find> and L</update_or_create>. For information on how to declare
2945unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
2946
2947If you need to know if an existing row was found or a new one created use
2948L</find_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
2949to call L<DBIx::Class::Row/insert> to save the newly created row to the
2950database!
2951
2952 my $cd = $schema->resultset('CD')->find_or_new({
2953 cdid => 5,
2954 artist => 'Massive Attack',
2955 title => 'Mezzanine',
2956 year => 2005,
2957 });
2958
2959 if( !$cd->in_storage ) {
2960 # do some stuff
2961 $cd->insert;
2962 }
2963
2964=cut
2965
2966sub find_or_create {
2967 my $self = shift;
2968 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
2969 my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
2970 if (keys %$hash and my $row = $self->find($hash, $attrs) ) {
2971 return $row;
2972 }
2973 return $self->new_result($hash)->insert;
2974}
2975
2976=head2 update_or_create
2977
2978=over 4
2979
2980=item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
2981
2982=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
2983
2984=back
2985
2986 $resultset->update_or_create({ col => $val, ... });
2987
2988Like L</find_or_create>, but if a row is found it is immediately updated via
2989C<< $found_row->update (\%col_data) >>.
2990
2991
2992Takes an optional C<key> attribute to search on a specific unique constraint.
2993For example:
2994
2995 # In your application
2996 my $cd = $schema->resultset('CD')->update_or_create(
2997 {
2998 artist => 'Massive Attack',
2999 title => 'Mezzanine',
3000 year => 1998,
3001 },
3002 { key => 'cd_artist_title' }
3003 );
3004
3005 $cd->cd_to_producer->update_or_create({
3006 producer => $producer,
3007 name => 'harry',
3008 }, {
3009 key => 'primary',
3010 });
3011
3012B<Note>: Make sure to read the documentation of L</find> and understand the
3013significance of the C<key> attribute, as its lack may skew your search, and
3014subsequently result in spurious row creation.
3015
3016B<Note>: Take care when using C<update_or_create> with a table having
3017columns with default values that you intend to be automatically
3018supplied by the database (e.g. an auto_increment primary key column).
3019In normal usage, the value of such columns should NOT be included at
3020all in the call to C<update_or_create>, even when set to C<undef>.
3021
3022See also L</find> and L</find_or_create>. For information on how to declare
3023unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
3024
3025If you need to know if an existing row was updated or a new one created use
3026L</update_or_new> and L<DBIx::Class::Row/in_storage> instead. Don't forget
3027to call L<DBIx::Class::Row/insert> to save the newly created row to the
3028database!
3029
3030=cut
3031
3032sub update_or_create {
3033 my $self = shift;
3034 my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
3035 my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
3036
3037 my $row = $self->find($cond, $attrs);
3038 if (defined $row) {
3039 $row->update($cond);
3040 return $row;
3041 }
3042
3043 return $self->new_result($cond)->insert;
3044}
3045
3046=head2 update_or_new
3047
3048=over 4
3049
3050=item Arguments: \%col_data, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
3051
3052=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
3053
3054=back
3055
3056 $resultset->update_or_new({ col => $val, ... });
3057
3058Like L</find_or_new> but if a row is found it is immediately updated via
3059C<< $found_row->update (\%col_data) >>.
3060
3061For example:
3062
3063 # In your application
3064 my $cd = $schema->resultset('CD')->update_or_new(
3065 {
3066 artist => 'Massive Attack',
3067 title => 'Mezzanine',
3068 year => 1998,
3069 },
3070 { key => 'cd_artist_title' }
3071 );
3072
3073 if ($cd->in_storage) {
3074 # the cd was updated
3075 }
3076 else {
3077 # the cd is not yet in the database, let's insert it
3078 $cd->insert;
3079 }
3080
3081B<Note>: Make sure to read the documentation of L</find> and understand the
3082significance of the C<key> attribute, as its lack may skew your search, and
3083subsequently result in spurious new objects.
3084
3085B<Note>: Take care when using C<update_or_new> with a table having
3086columns with default values that you intend to be automatically
3087supplied by the database (e.g. an auto_increment primary key column).
3088In normal usage, the value of such columns should NOT be included at
3089all in the call to C<update_or_new>, even when set to C<undef>.
3090
3091See also L</find>, L</find_or_create> and L</find_or_new>.
3092
3093=cut
3094
3095sub update_or_new {
3096 my $self = shift;
3097 my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} );
3098 my $cond = ref $_[0] eq 'HASH' ? shift : {@_};
3099
3100 my $row = $self->find( $cond, $attrs );
3101 if ( defined $row ) {
3102 $row->update($cond);
3103 return $row;
3104 }
3105
3106 return $self->new_result($cond);
3107}
3108
3109=head2 get_cache
3110
3111=over 4
3112
3113=item Arguments: none
3114
3115=item Return Value: L<\@result_objs|DBIx::Class::Manual::ResultClass> | undef
3116
3117=back
3118
3119Gets the contents of the cache for the resultset, if the cache is set.
3120
3121The cache is populated either by using the L</prefetch> attribute to
3122L</search> or by calling L</set_cache>.
3123
3124=cut
3125
3126
# spent 11.1ms within DBIx::Class::ResultSet::get_cache which was called 9 times, avg 1.23ms/call: # 6 times (247µs+0s) by DBIx::Class::ResultSet::result_class at line 1561, avg 41µs/call # 3 times (10.8ms+0s) by DBIx::Class::ResultSet::search_rs at line 467, avg 3.61ms/call
sub get_cache {
3127311µs shift->{all_cache};
3128}
3129
3130=head2 set_cache
3131
3132=over 4
3133
3134=item Arguments: L<\@result_objs|DBIx::Class::Manual::ResultClass>
3135
3136=item Return Value: L<\@result_objs|DBIx::Class::Manual::ResultClass>
3137
3138=back
3139
3140Sets the contents of the cache for the resultset. Expects an arrayref
3141of objects of the same class as those produced by the resultset. Note that
3142if the cache is set, the resultset will return the cached objects rather
3143than re-querying the database even if the cache attr is not set.
3144
3145The contents of the cache can also be populated by using the
3146L</prefetch> attribute to L</search>.
3147
3148=cut
3149
3150sub set_cache {
3151 my ( $self, $data ) = @_;
3152 $self->throw_exception("set_cache requires an arrayref")
3153 if defined($data) && (ref $data ne 'ARRAY');
3154 $self->{all_cache} = $data;
3155}
3156
3157=head2 clear_cache
3158
3159=over 4
3160
3161=item Arguments: none
3162
3163=item Return Value: undef
3164
3165=back
3166
3167Clears the cache for the resultset.
3168
3169=cut
3170
3171sub clear_cache {
3172 shift->set_cache(undef);
3173}
3174
3175=head2 is_paged
3176
3177=over 4
3178
3179=item Arguments: none
3180
3181=item Return Value: true, if the resultset has been paginated
3182
3183=back
3184
3185=cut
3186
3187sub is_paged {
3188 my ($self) = @_;
3189 return !!$self->{attrs}{page};
3190}
3191
3192=head2 is_ordered
3193
3194=over 4
3195
3196=item Arguments: none
3197
3198=item Return Value: true, if the resultset has been ordered with C<order_by>.
3199
3200=back
3201
3202=cut
3203
3204sub is_ordered {
3205 my ($self) = @_;
3206 return scalar $self->result_source->storage->_extract_order_criteria($self->{attrs}{order_by});
3207}
3208
3209=head2 related_resultset
3210
3211=over 4
3212
3213=item Arguments: $rel_name
3214
3215=item Return Value: L<$resultset|/search>
3216
3217=back
3218
3219Returns a related resultset for the supplied relationship name.
3220
3221 $artist_rs = $schema->resultset('CD')->related_resultset('Artist');
3222
3223=cut
3224
3225sub related_resultset {
3226 my ($self, $rel) = @_;
3227
3228 return $self->{related_resultsets}{$rel}
3229 if defined $self->{related_resultsets}{$rel};
3230
3231 return $self->{related_resultsets}{$rel} = do {
3232 my $rsrc = $self->result_source;
3233 my $rel_info = $rsrc->relationship_info($rel);
3234
3235 $self->throw_exception(
3236 "search_related: result source '" . $rsrc->source_name .
3237 "' has no such relationship $rel")
3238 unless $rel_info;
3239
3240 my $attrs = $self->_chain_relationship($rel);
3241
3242 my $join_count = $attrs->{seen_join}{$rel};
3243
3244 my $alias = $self->result_source->storage
3245 ->relname_to_table_alias($rel, $join_count);
3246
3247 # since this is search_related, and we already slid the select window inwards
3248 # (the select/as attrs were deleted in the beginning), we need to flip all
3249 # left joins to inner, so we get the expected results
3250 # read the comment on top of the actual function to see what this does
3251 $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);
3252
3253
3254 #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
3255 delete @{$attrs}{qw(result_class alias)};
3256
3257 my $rel_source = $rsrc->related_source($rel);
3258
3259 my $new = do {
3260
3261 # The reason we do this now instead of passing the alias to the
3262 # search_rs below is that if you wrap/overload resultset on the
3263 # source you need to know what alias it's -going- to have for things
3264 # to work sanely (e.g. RestrictWithObject wants to be able to add
3265 # extra query restrictions, and these may need to be $alias.)
3266
3267 my $rel_attrs = $rel_source->resultset_attributes;
3268 local $rel_attrs->{alias} = $alias;
3269
3270 $rel_source->resultset
3271 ->search_rs(
3272 undef, {
3273 %$attrs,
3274 where => $attrs->{where},
3275 });
3276 };
3277
3278 if (my $cache = $self->get_cache) {
3279 my @related_cache = map
3280 { $_->related_resultset($rel)->get_cache || () }
3281 @$cache
3282 ;
3283
3284 $new->set_cache([ map @$_, @related_cache ]) if @related_cache == @$cache;
3285 }
3286
3287 $new;
3288 };
3289}
3290
3291=head2 current_source_alias
3292
3293=over 4
3294
3295=item Arguments: none
3296
3297=item Return Value: $source_alias
3298
3299=back
3300
3301Returns the current table alias for the result source this resultset is built
3302on, that will be used in the SQL query. Usually it is C<me>.
3303
3304Currently the source alias that refers to the result set returned by a
3305L</search>/L</find> family method depends on how you got to the resultset: it's
3306C<me> by default, but eg. L</search_related> aliases it to the related result
3307source name (and keeps C<me> referring to the original result set). The long
3308term goal is to make L<DBIx::Class> always alias the current resultset as C<me>
3309(and make this method unnecessary).
3310
3311Thus it's currently necessary to use this method in predefined queries (see
3312L<DBIx::Class::Manual::Cookbook/Predefined searches>) when referring to the
3313source alias of the current result set:
3314
3315 # in a result set class
3316 sub modified_by {
3317 my ($self, $user) = @_;
3318
3319 my $me = $self->current_source_alias;
3320
3321 return $self->search({
3322 "$me.modified" => $user->id,
3323 });
3324 }
3325
3326=cut
3327
3328sub current_source_alias {
3329 return (shift->{attrs} || {})->{alias} || 'me';
3330}
3331
3332=head2 as_subselect_rs
3333
3334=over 4
3335
3336=item Arguments: none
3337
3338=item Return Value: L<$resultset|/search>
3339
3340=back
3341
3342Act as a barrier to SQL symbols. The resultset provided will be made into a
3343"virtual view" by including it as a subquery within the from clause. From this
3344point on, any joined tables are inaccessible to ->search on the resultset (as if
3345it were simply where-filtered without joins). For example:
3346
3347 my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
3348
3349 # 'x' now pollutes the query namespace
3350
3351 # So the following works as expected
3352 my $ok_rs = $rs->search({'x.other' => 1});
3353
3354 # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
3355 # def) we look for one row with contradictory terms and join in another table
3356 # (aliased 'x_2') which we never use
3357 my $broken_rs = $rs->search({'x.name' => 'def'});
3358
3359 my $rs2 = $rs->as_subselect_rs;
3360
3361 # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
3362 my $not_joined_rs = $rs2->search({'x.other' => 1});
3363
3364 # works as expected: finds a 'table' row related to two x rows (abc and def)
3365 my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
3366
3367Another example of when one might use this would be to select a subset of
3368columns in a group by clause:
3369
3370 my $rs = $schema->resultset('Bar')->search(undef, {
3371 group_by => [qw{ id foo_id baz_id }],
3372 })->as_subselect_rs->search(undef, {
3373 columns => [qw{ id foo_id }]
3374 });
3375
3376In the above example normally columns would have to be equal to the group by,
3377but because we isolated the group by into a subselect the above works.
3378
3379=cut
3380
3381sub as_subselect_rs {
3382 my $self = shift;
3383
3384 my $attrs = $self->_resolved_attrs;
3385
3386 my $fresh_rs = (ref $self)->new (
3387 $self->result_source
3388 );
3389
3390 # these pieces will be locked in the subquery
3391 delete $fresh_rs->{cond};
3392 delete @{$fresh_rs->{attrs}}{qw/where bind/};
3393
3394 return $fresh_rs->search( {}, {
3395 from => [{
3396 $attrs->{alias} => $self->as_query,
3397 -alias => $attrs->{alias},
3398 -rsrc => $self->result_source,
3399 }],
3400 alias => $attrs->{alias},
3401 });
3402}
3403
3404# This code is called by search_related, and makes sure there
3405# is clear separation between the joins before, during, and
3406# after the relationship. This information is needed later
3407# in order to properly resolve prefetch aliases (any alias
3408# with a relation_chain_depth less than the depth of the
3409# current prefetch is not considered)
3410#
3411# The increments happen twice per join. An even number means a
3412# relationship specified via a search_related, whereas an odd
3413# number indicates a join/prefetch added via attributes
3414#
3415# Also this code will wrap the current resultset (the one we
3416# chain to) in a subselect IFF it contains limiting attributes
3417sub _chain_relationship {
3418 my ($self, $rel) = @_;
3419 my $source = $self->result_source;
3420 my $attrs = { %{$self->{attrs}||{}} };
3421
3422 # we need to take the prefetch the attrs into account before we
3423 # ->_resolve_join as otherwise they get lost - captainL
3424 my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );
3425
3426 delete @{$attrs}{qw/join prefetch collapse group_by distinct _grouped_by_distinct select as columns +select +as +columns/};
3427
3428 my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
3429
3430 my $from;
3431 my @force_subq_attrs = qw/offset rows group_by having/;
3432
3433 if (
3434 ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
3435 ||
3436 $self->_has_resolved_attr (@force_subq_attrs)
3437 ) {
3438 # Nuke the prefetch (if any) before the new $rs attrs
3439 # are resolved (prefetch is useless - we are wrapping
3440 # a subquery anyway).
3441 my $rs_copy = $self->search;
3442 $rs_copy->{attrs}{join} = $self->_merge_joinpref_attr (
3443 $rs_copy->{attrs}{join},
3444 delete $rs_copy->{attrs}{prefetch},
3445 );
3446
3447 $from = [{
3448 -rsrc => $source,
3449 -alias => $attrs->{alias},
3450 $attrs->{alias} => $rs_copy->as_query,
3451 }];
3452 delete @{$attrs}{@force_subq_attrs, qw/where bind/};
3453 $seen->{-relation_chain_depth} = 0;
3454 }
3455 elsif ($attrs->{from}) { #shallow copy suffices
3456 $from = [ @{$attrs->{from}} ];
3457 }
3458 else {
3459 $from = [{
3460 -rsrc => $source,
3461 -alias => $attrs->{alias},
3462 $attrs->{alias} => $source->from,
3463 }];
3464 }
3465
3466 my $jpath = ($seen->{-relation_chain_depth})
3467 ? $from->[-1][0]{-join_path}
3468 : [];
3469
3470 my @requested_joins = $source->_resolve_join(
3471 $join,
3472 $attrs->{alias},
3473 $seen,
3474 $jpath,
3475 );
3476
3477 push @$from, @requested_joins;
3478
3479 $seen->{-relation_chain_depth}++;
3480
3481 # if $self already had a join/prefetch specified on it, the requested
3482 # $rel might very well be already included. What we do in this case
3483 # is effectively a no-op (except that we bump up the chain_depth on
3484 # the join in question so we could tell it *is* the search_related)
3485 my $already_joined;
3486
3487 # we consider the last one thus reverse
3488 for my $j (reverse @requested_joins) {
3489 my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
3490 if ($rel eq $last_j) {
3491 $j->[0]{-relation_chain_depth}++;
3492 $already_joined++;
3493 last;
3494 }
3495 }
3496
3497 unless ($already_joined) {
3498 push @$from, $source->_resolve_join(
3499 $rel,
3500 $attrs->{alias},
3501 $seen,
3502 $jpath,
3503 );
3504 }
3505
3506 $seen->{-relation_chain_depth}++;
3507
3508 return {%$attrs, from => $from, seen_join => $seen};
3509}
3510
3511sub _resolved_attrs {
3512 my $self = shift;
3513 return $self->{_attrs} if $self->{_attrs};
3514
3515 my $attrs = { %{ $self->{attrs} || {} } };
3516 my $source = $attrs->{result_source} = $self->result_source;
3517 my $alias = $attrs->{alias};
3518
3519 $self->throw_exception("Specifying distinct => 1 in conjunction with collapse => 1 is unsupported")
3520 if $attrs->{collapse} and $attrs->{distinct};
3521
3522 # default selection list
3523 $attrs->{columns} = [ $source->columns ]
3524 unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
3525
3526 # merge selectors together
3527 for (qw/columns select as/) {
3528 $attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"})
3529 if $attrs->{$_} or $attrs->{"+$_"};
3530 }
3531
3532 # disassemble columns
3533 my (@sel, @as);
3534 if (my $cols = delete $attrs->{columns}) {
3535 for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) {
3536 if (ref $c eq 'HASH') {
3537 for my $as (sort keys %$c) {
3538 push @sel, $c->{$as};
3539 push @as, $as;
3540 }
3541 }
3542 else {
3543 push @sel, $c;
3544 push @as, $c;
3545 }
3546 }
3547 }
3548
3549 # when trying to weed off duplicates later do not go past this point -
3550 # everything added from here on is unbalanced "anyone's guess" stuff
3551 my $dedup_stop_idx = $#as;
3552
3553 push @as, @{ ref $attrs->{as} eq 'ARRAY' ? $attrs->{as} : [ $attrs->{as} ] }
3554 if $attrs->{as};
3555 push @sel, @{ ref $attrs->{select} eq 'ARRAY' ? $attrs->{select} : [ $attrs->{select} ] }
3556 if $attrs->{select};
3557
3558 # assume all unqualified selectors to apply to the current alias (legacy stuff)
3559 $_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" for @sel;
3560
3561 # disqualify all $alias.col as-bits (inflate-map mandated)
3562 $_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_ for @as;
3563
3564 # de-duplicate the result (remove *identical* select/as pairs)
3565 # and also die on duplicate {as} pointing to different {select}s
3566 # not using a c-style for as the condition is prone to shrinkage
3567 my $seen;
3568 my $i = 0;
3569 while ($i <= $dedup_stop_idx) {
3570 if ($seen->{"$sel[$i] \x00\x00 $as[$i]"}++) {
3571 splice @sel, $i, 1;
3572 splice @as, $i, 1;
3573 $dedup_stop_idx--;
3574 }
3575 elsif ($seen->{$as[$i]}++) {
3576 $self->throw_exception(
3577 "inflate_result() alias '$as[$i]' specified twice with different SQL-side {select}-ors"
3578 );
3579 }
3580 else {
3581 $i++;
3582 }
3583 }
3584
3585 $attrs->{select} = \@sel;
3586 $attrs->{as} = \@as;
3587
3588 $attrs->{from} ||= [{
3589 -rsrc => $source,
3590 -alias => $self->{attrs}{alias},
3591 $self->{attrs}{alias} => $source->from,
3592 }];
3593
3594 if ( $attrs->{join} || $attrs->{prefetch} ) {
3595
3596 $self->throw_exception ('join/prefetch can not be used with a custom {from}')
3597 if ref $attrs->{from} ne 'ARRAY';
3598
3599 my $join = (delete $attrs->{join}) || {};
3600
3601 if ( defined $attrs->{prefetch} ) {
3602 $join = $self->_merge_joinpref_attr( $join, $attrs->{prefetch} );
3603 }
3604
3605 $attrs->{from} = # have to copy here to avoid corrupting the original
3606 [
3607 @{ $attrs->{from} },
3608 $source->_resolve_join(
3609 $join,
3610 $alias,
3611 { %{ $attrs->{seen_join} || {} } },
3612 ( $attrs->{seen_join} && keys %{$attrs->{seen_join}})
3613 ? $attrs->{from}[-1][0]{-join_path}
3614 : []
3615 ,
3616 )
3617 ];
3618 }
3619
3620 for my $attr (qw(order_by group_by)) {
3621
3622 if ( defined $attrs->{$attr} ) {
3623 $attrs->{$attr} = (
3624 ref( $attrs->{$attr} ) eq 'ARRAY'
3625 ? [ @{ $attrs->{$attr} } ]
3626 : [ $attrs->{$attr} || () ]
3627 );
3628
3629 delete $attrs->{$attr} unless @{$attrs->{$attr}};
3630 }
3631 }
3632
3633 # generate selections based on the prefetch helper
3634 my ($prefetch, @prefetch_select, @prefetch_as);
3635 $prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} )
3636 if defined $attrs->{prefetch};
3637
3638 if ($prefetch) {
3639
3640 $self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}")
3641 if $attrs->{_dark_selector};
3642
3643 $self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported")
3644 if defined $attrs->{collapse} and ! $attrs->{collapse};
3645
3646 $attrs->{collapse} = 1;
3647
3648 # this is a separate structure (we don't look in {from} directly)
3649 # as the resolver needs to shift things off the lists to work
3650 # properly (identical-prefetches on different branches)
3651 my $join_map = {};
3652 if (ref $attrs->{from} eq 'ARRAY') {
3653
3654 my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
3655
3656 for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
3657 next unless $j->[0]{-alias};
3658 next unless $j->[0]{-join_path};
3659 next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
3660
3661 my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
3662
3663 my $p = $join_map;
3664 $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
3665 push @{$p->{-join_aliases} }, $j->[0]{-alias};
3666 }
3667 }
3668
3669 my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map );
3670
3671 # save these for after distinct resolution
3672 @prefetch_select = map { $_->[0] } @prefetch;
3673 @prefetch_as = map { $_->[1] } @prefetch;
3674 }
3675
3676 # run through the resulting joinstructure (starting from our current slot)
3677 # and unset collapse if proven unnecessary
3678 #
3679 # also while we are at it find out if the current root source has
3680 # been premultiplied by previous related_source chaining
3681 #
3682 # this allows to predict whether a root object with all other relation
3683 # data set to NULL is in fact unique
3684 if ($attrs->{collapse}) {
3685
3686 if (ref $attrs->{from} eq 'ARRAY') {
3687
3688 if (@{$attrs->{from}} == 1) {
3689 # no joins - no collapse
3690 $attrs->{collapse} = 0;
3691 }
3692 else {
3693 # find where our table-spec starts
3694 my @fromlist = @{$attrs->{from}};
3695 while (@fromlist) {
3696 my $t = shift @fromlist;
3697
3698 my $is_multi;
3699 # me vs join from-spec distinction - a ref means non-root
3700 if (ref $t eq 'ARRAY') {
3701 $t = $t->[0];
3702 $is_multi ||= ! $t->{-is_single};
3703 }
3704 last if ($t->{-alias} && $t->{-alias} eq $alias);
3705 $attrs->{_main_source_premultiplied} ||= $is_multi;
3706 }
3707
3708 # no non-singles remaining, nor any premultiplication - nothing to collapse
3709 if (
3710 ! $attrs->{_main_source_premultiplied}
3711 and
3712 ! List::Util::first { ! $_->[0]{-is_single} } @fromlist
3713 ) {
3714 $attrs->{collapse} = 0;
3715 }
3716 }
3717 }
3718
3719 else {
3720 # if we can not analyze the from - err on the side of safety
3721 $attrs->{_main_source_premultiplied} = 1;
3722 }
3723 }
3724
3725 # generate the distinct induced group_by before injecting the prefetched select/as parts
3726 if (delete $attrs->{distinct}) {
3727 if ($attrs->{group_by}) {
3728 carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
3729 }
3730 else {
3731 $attrs->{_grouped_by_distinct} = 1;
3732 # distinct affects only the main selection part, not what prefetch may add below
3733 ($attrs->{group_by}, my $new_order) = $source->storage->_group_over_selection($attrs);
3734
3735 # FIXME possibly ignore a rewritten order_by (may turn out to be an issue)
3736 # The thinking is: if we are collapsing the subquerying prefetch engine will
3737 # rip stuff apart for us anyway, and we do not want to have a potentially
3738 # function-converted external order_by
3739 # ( there is an explicit if ( collapse && _grouped_by_distinct ) check in DBIHacks )
3740 $attrs->{order_by} = $new_order unless $attrs->{collapse};
3741 }
3742 }
3743
3744 # inject prefetch-bound selection (if any)
3745 push @{$attrs->{select}}, @prefetch_select;
3746 push @{$attrs->{as}}, @prefetch_as;
3747
3748 $attrs->{_simple_passthrough_construction} = !(
3749 $attrs->{collapse}
3750 or
3751 grep { $_ =~ /\./ } @{$attrs->{as}}
3752 );
3753
3754 # if both page and offset are specified, produce a combined offset
3755 # even though it doesn't make much sense, this is what pre 081xx has
3756 # been doing
3757 if (my $page = delete $attrs->{page}) {
3758 $attrs->{offset} =
3759 ($attrs->{rows} * ($page - 1))
3760 +
3761 ($attrs->{offset} || 0)
3762 ;
3763 }
3764
3765 return $self->{_attrs} = $attrs;
3766}
3767
3768sub _rollout_attr {
3769 my ($self, $attr) = @_;
3770
3771 if (ref $attr eq 'HASH') {
3772 return $self->_rollout_hash($attr);
3773 } elsif (ref $attr eq 'ARRAY') {
3774 return $self->_rollout_array($attr);
3775 } else {
3776 return [$attr];
3777 }
3778}
3779
3780sub _rollout_array {
3781 my ($self, $attr) = @_;
3782
3783 my @rolled_array;
3784 foreach my $element (@{$attr}) {
3785 if (ref $element eq 'HASH') {
3786 push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
3787 } elsif (ref $element eq 'ARRAY') {
3788 # XXX - should probably recurse here
3789 push( @rolled_array, @{$self->_rollout_array($element)} );
3790 } else {
3791 push( @rolled_array, $element );
3792 }
3793 }
3794 return \@rolled_array;
3795}
3796
3797sub _rollout_hash {
3798 my ($self, $attr) = @_;
3799
3800 my @rolled_array;
3801 foreach my $key (keys %{$attr}) {
3802 push( @rolled_array, { $key => $attr->{$key} } );
3803 }
3804 return \@rolled_array;
3805}
3806
3807sub _calculate_score {
3808 my ($self, $a, $b) = @_;
3809
3810 if (defined $a xor defined $b) {
3811 return 0;
3812 }
3813 elsif (not defined $a) {
3814 return 1;
3815 }
3816
3817 if (ref $b eq 'HASH') {
3818 my ($b_key) = keys %{$b};
3819 $b_key = '' if ! defined $b_key;
3820 if (ref $a eq 'HASH') {
3821 my ($a_key) = keys %{$a};
3822 $a_key = '' if ! defined $a_key;
3823 if ($a_key eq $b_key) {
3824 return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
3825 } else {
3826 return 0;
3827 }
3828 } else {
3829 return ($a eq $b_key) ? 1 : 0;
3830 }
3831 } else {
3832 if (ref $a eq 'HASH') {
3833 my ($a_key) = keys %{$a};
3834 return ($b eq $a_key) ? 1 : 0;
3835 } else {
3836 return ($b eq $a) ? 1 : 0;
3837 }
3838 }
3839}
3840
3841sub _merge_joinpref_attr {
3842 my ($self, $orig, $import) = @_;
3843
3844 return $import unless defined($orig);
3845 return $orig unless defined($import);
3846
3847 $orig = $self->_rollout_attr($orig);
3848 $import = $self->_rollout_attr($import);
3849
3850 my $seen_keys;
3851 foreach my $import_element ( @{$import} ) {
3852 # find best candidate from $orig to merge $b_element into
3853 my $best_candidate = { position => undef, score => 0 }; my $position = 0;
3854 foreach my $orig_element ( @{$orig} ) {
3855 my $score = $self->_calculate_score( $orig_element, $import_element );
3856 if ($score > $best_candidate->{score}) {
3857 $best_candidate->{position} = $position;
3858 $best_candidate->{score} = $score;
3859 }
3860 $position++;
3861 }
3862 my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
3863 $import_key = '' if not defined $import_key;
3864
3865 if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
3866 push( @{$orig}, $import_element );
3867 } else {
3868 my $orig_best = $orig->[$best_candidate->{position}];
3869 # merge orig_best and b_element together and replace original with merged
3870 if (ref $orig_best ne 'HASH') {
3871 $orig->[$best_candidate->{position}] = $import_element;
3872 } elsif (ref $import_element eq 'HASH') {
3873 my ($key) = keys %{$orig_best};
3874 $orig->[$best_candidate->{position}] = { $key => $self->_merge_joinpref_attr($orig_best->{$key}, $import_element->{$key}) };
3875 }
3876 }
3877 $seen_keys->{$import_key} = 1; # don't merge the same key twice
3878 }
3879
3880 return @$orig ? $orig : ();
3881}
3882
3883{
3884 my $hm;
3885
3886 sub _merge_attr {
3887 $hm ||= do {
3888 require Hash::Merge;
3889 my $hm = Hash::Merge->new;
3890
3891 $hm->specify_behavior({
3892 SCALAR => {
3893 SCALAR => sub {
3894 my ($defl, $defr) = map { defined $_ } (@_[0,1]);
3895
3896 if ($defl xor $defr) {
3897 return [ $defl ? $_[0] : $_[1] ];
3898 }
3899 elsif (! $defl) {
3900 return [];
3901 }
3902 elsif (__HM_DEDUP and $_[0] eq $_[1]) {
3903 return [ $_[0] ];
3904 }
3905 else {
3906 return [$_[0], $_[1]];
3907 }
3908 },
3909 ARRAY => sub {
3910 return $_[1] if !defined $_[0];
3911 return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3912 return [$_[0], @{$_[1]}]
3913 },
3914 HASH => sub {
3915 return [] if !defined $_[0] and !keys %{$_[1]};
3916 return [ $_[1] ] if !defined $_[0];
3917 return [ $_[0] ] if !keys %{$_[1]};
3918 return [$_[0], $_[1]]
3919 },
3920 },
3921 ARRAY => {
3922 SCALAR => sub {
3923 return $_[0] if !defined $_[1];
3924 return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3925 return [@{$_[0]}, $_[1]]
3926 },
3927 ARRAY => sub {
3928 my @ret = @{$_[0]} or return $_[1];
3929 return [ @ret, @{$_[1]} ] unless __HM_DEDUP;
3930 my %idx = map { $_ => 1 } @ret;
3931 push @ret, grep { ! defined $idx{$_} } (@{$_[1]});
3932 \@ret;
3933 },
3934 HASH => sub {
3935 return [ $_[1] ] if ! @{$_[0]};
3936 return $_[0] if !keys %{$_[1]};
3937 return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
3938 return [ @{$_[0]}, $_[1] ];
3939 },
3940 },
3941 HASH => {
3942 SCALAR => sub {
3943 return [] if !keys %{$_[0]} and !defined $_[1];
3944 return [ $_[0] ] if !defined $_[1];
3945 return [ $_[1] ] if !keys %{$_[0]};
3946 return [$_[0], $_[1]]
3947 },
3948 ARRAY => sub {
3949 return [] if !keys %{$_[0]} and !@{$_[1]};
3950 return [ $_[0] ] if !@{$_[1]};
3951 return $_[1] if !keys %{$_[0]};
3952 return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
3953 return [ $_[0], @{$_[1]} ];
3954 },
3955 HASH => sub {
3956 return [] if !keys %{$_[0]} and !keys %{$_[1]};
3957 return [ $_[0] ] if !keys %{$_[1]};
3958 return [ $_[1] ] if !keys %{$_[0]};
3959 return [ $_[0] ] if $_[0] eq $_[1];
3960 return [ $_[0], $_[1] ];
3961 },
3962 }
3963 } => 'DBIC_RS_ATTR_MERGER');
3964 $hm;
3965 };
3966
3967 return $hm->merge ($_[1], $_[2]);
3968 }
3969}
3970
3971sub STORABLE_freeze {
3972 my ($self, $cloning) = @_;
3973 my $to_serialize = { %$self };
3974
3975 # A cursor in progress can't be serialized (and would make little sense anyway)
3976 # the parser can be regenerated (and can't be serialized)
3977 delete @{$to_serialize}{qw/cursor _row_parser _result_inflator/};
3978
3979 # nor is it sensical to store a not-yet-fired-count pager
3980 if ($to_serialize->{pager} and ref $to_serialize->{pager}{total_entries} eq 'CODE') {
3981 delete $to_serialize->{pager};
3982 }
3983
3984 Storable::nfreeze($to_serialize);
3985}
3986
3987# need this hook for symmetry
3988sub STORABLE_thaw {
3989 my ($self, $cloning, $serialized) = @_;
3990
3991 %$self = %{ Storable::thaw($serialized) };
3992
3993 $self;
3994}
3995
3996
3997=head2 throw_exception
3998
3999See L<DBIx::Class::Schema/throw_exception> for details.
4000
4001=cut
4002
4003sub throw_exception {
4004 my $self=shift;
4005
4006 if (ref $self and my $rsrc = $self->result_source) {
4007 $rsrc->throw_exception(@_)
4008 }
4009 else {
4010 DBIx::Class::Exception->throw(@_);
4011 }
4012}
4013
40141;
4015
401612.90ms__END__
# spent 2.90ms making 1 call to B::Hooks::EndOfScope::XS::__ANON__
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.