line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Class::ResultSet; |
2
|
|
|
|
|
|
|
|
3
|
379
|
|
|
379
|
|
2350
|
use strict; |
|
379
|
|
|
|
|
752
|
|
|
379
|
|
|
|
|
9989
|
|
4
|
379
|
|
|
379
|
|
1449
|
use warnings; |
|
379
|
|
|
|
|
693
|
|
|
379
|
|
|
|
|
10113
|
|
5
|
379
|
|
|
379
|
|
1427
|
use base qw/DBIx::Class/; |
|
379
|
|
|
|
|
662
|
|
|
379
|
|
|
|
|
27154
|
|
6
|
379
|
|
|
379
|
|
1892
|
use DBIx::Class::Carp; |
|
379
|
|
|
|
|
791
|
|
|
379
|
|
|
|
|
2936
|
|
7
|
379
|
|
|
379
|
|
154128
|
use DBIx::Class::ResultSetColumn; |
|
379
|
|
|
|
|
827
|
|
|
379
|
|
|
|
|
14339
|
|
8
|
379
|
|
|
379
|
|
2229
|
use Scalar::Util qw/blessed weaken reftype/; |
|
379
|
|
|
|
|
681
|
|
|
379
|
|
|
|
|
21910
|
|
9
|
379
|
|
|
|
|
17004
|
use DBIx::Class::_Util qw( |
10
|
|
|
|
|
|
|
fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION |
11
|
379
|
|
|
379
|
|
1698
|
); |
|
379
|
|
|
|
|
687
|
|
12
|
379
|
|
|
379
|
|
2002
|
use Try::Tiny; |
|
379
|
|
|
|
|
728
|
|
|
379
|
|
|
|
|
17638
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# not importing first() as it will clash with our own method |
15
|
379
|
|
|
379
|
|
1681
|
use List::Util (); |
|
379
|
|
|
|
|
683
|
|
|
379
|
|
|
|
|
15313
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
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
|
379
|
|
|
379
|
|
6437
|
*__HM_DEDUP = sub () { 0 }; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
379
|
|
|
379
|
|
1625
|
use namespace::clean; |
|
379
|
|
|
|
|
744
|
|
|
379
|
|
|
|
|
1561
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use overload |
26
|
379
|
|
|
|
|
3122
|
'0+' => "count", |
27
|
|
|
|
|
|
|
'bool' => "_bool", |
28
|
379
|
|
|
379
|
|
102178
|
fallback => 1; |
|
379
|
|
|
|
|
738
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# this is real - CDBICompat overrides it with insanity |
31
|
|
|
|
|
|
|
# yes, prototype won't matter, but that's for now ;) |
32
|
|
|
|
|
|
|
sub _bool () { 1 } |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 NAME |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
DBIx::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
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
A ResultSet is an object which stores a set of conditions representing |
53
|
|
|
|
|
|
|
a query. It is the backbone of DBIx::Class (i.e. the really |
54
|
|
|
|
|
|
|
important/useful bit). |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
No SQL is executed on the database when a ResultSet is created, it |
57
|
|
|
|
|
|
|
just stores all the conditions needed to create the query. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
A basic ResultSet representing the data of an entire table is returned |
60
|
|
|
|
|
|
|
by calling C on a L and passing in a |
61
|
|
|
|
|
|
|
L name. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $users_rs = $schema->resultset('User'); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
A new ResultSet is returned from calling L on an existing |
66
|
|
|
|
|
|
|
ResultSet. The new one will contain all the conditions of the |
67
|
|
|
|
|
|
|
original, plus any new conditions added in the C call. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
A ResultSet also incorporates an implicit iterator. L and L |
70
|
|
|
|
|
|
|
can be used to walk through all the Ls the ResultSet |
71
|
|
|
|
|
|
|
represents. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
The query that the ResultSet represents is B executed against |
74
|
|
|
|
|
|
|
the database when these methods are called: |
75
|
|
|
|
|
|
|
L, L, L, L, L, L. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
If a resultset is used in a numeric context it returns the L. |
78
|
|
|
|
|
|
|
However, if it is used in a boolean context it is B true. So if |
79
|
|
|
|
|
|
|
you want to check if a resultset has any results, you must use C
|
80
|
|
|
|
|
|
|
!= 0>. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 EXAMPLES |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 Chaining resultsets |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Let's say you've got a query that needs to be run to return some data |
87
|
|
|
|
|
|
|
to the user. But, you have an authorization system in place that |
88
|
|
|
|
|
|
|
prevents certain users from seeing certain information. So, you want |
89
|
|
|
|
|
|
|
to construct the basic query in one method, but add constraints to it in |
90
|
|
|
|
|
|
|
another. |
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
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
When a resultset is chained from another resultset (e.g.: |
119
|
|
|
|
|
|
|
C<< my $new_rs = $old_rs->search(\%extra_cond, \%attrs) >>), conditions |
120
|
|
|
|
|
|
|
and attributes with the same keys need resolving. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
If any of L, L, L are present, they reset the |
123
|
|
|
|
|
|
|
original selection, and start the selection "clean". |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
The L, L, L+columns>, L+select>, L+as> attributes |
126
|
|
|
|
|
|
|
are merged into the existing ones from the original resultset. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
The L and L attributes, and any search conditions, are |
129
|
|
|
|
|
|
|
merged with an SQL C to the existing condition from the original |
130
|
|
|
|
|
|
|
resultset. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
All other attributes are overridden by any new ones supplied in the |
133
|
|
|
|
|
|
|
search attributes. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 Multiple queries |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Since a resultset just defines a query, you can do all sorts of |
138
|
|
|
|
|
|
|
things 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
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
And it's not just limited to SELECT statements. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$cd_rs->delete(); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
This is even cooler: |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
$cd_rs->create({ artist => 'Fred' }); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Which is the same as: |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
$schema->resultset('CD')->create({ |
162
|
|
|
|
|
|
|
title => 'something', |
163
|
|
|
|
|
|
|
year => 2009, |
164
|
|
|
|
|
|
|
artist => 'Fred' |
165
|
|
|
|
|
|
|
}); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
See: L, L, L, L, L. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head2 Custom ResultSet classes |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
To add methods to your resultsets, you can subclass L, 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
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
See L on how DBIC can discover and |
206
|
|
|
|
|
|
|
automatically attach L-specific |
207
|
|
|
|
|
|
|
L classes. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=head3 ResultSet subclassing with Moose and similar constructor-providers |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
Using L or L in your ResultSet classes is usually overkill, but |
212
|
|
|
|
|
|
|
you may find it useful if your ResultSets contain a lot of business logic |
213
|
|
|
|
|
|
|
(e.g. C, C, etc) or if you just prefer to organize |
214
|
|
|
|
|
|
|
your code via roles. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
In order to write custom ResultSet classes with L you need to use the |
217
|
|
|
|
|
|
|
following template. The L is necessary due to the |
218
|
|
|
|
|
|
|
unusual signature of the L
|
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
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
If you want to build your custom ResultSet classes with L, you need |
230
|
|
|
|
|
|
|
a similar, though a little more elaborate template in order to interface the |
231
|
|
|
|
|
|
|
inlining of the L-provided |
232
|
|
|
|
|
|
|
L |
233
|
|
|
|
|
|
|
with 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
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
The L is necessary so that the L constructor does not |
250
|
|
|
|
|
|
|
entirely overwrite the DBIC one (in contrast L does this automatically). |
251
|
|
|
|
|
|
|
Alternatively, you can skip L and get by with just L |
252
|
|
|
|
|
|
|
instead 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
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
The resultset constructor. Takes a source object (usually a |
269
|
|
|
|
|
|
|
L) and an attribute hash (see |
270
|
|
|
|
|
|
|
L below). Does not perform any queries -- these are |
271
|
|
|
|
|
|
|
executed as needed by the other methods. |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Generally you never construct a resultset manually. Instead you get one |
274
|
|
|
|
|
|
|
from e.g. a |
275
|
|
|
|
|
|
|
C<< $schema->L('$source_name') >> |
276
|
|
|
|
|
|
|
or C<< $another_resultset->L(...) >> (the later called in |
277
|
|
|
|
|
|
|
scalar context): |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
my $rs = $schema->resultset('CD')->search({ title => '100th Window' }); |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=over |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=item WARNING |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
If called on an object, proxies to L instead, so |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
my $cd = $schema->resultset('CD')->new({ title => 'Spoon' }); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
will return a CD object, not a ResultSet, and is equivalent to: |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
my $cd = $schema->resultset('CD')->new_result({ title => 'Spoon' }); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
Please also keep in mind that many internals call L directly, |
294
|
|
|
|
|
|
|
so overloading this method with the idea of intercepting new result object |
295
|
|
|
|
|
|
|
creation B. See also warning pertaining to L. |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=back |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=cut |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub new { |
302
|
32952
|
|
|
32952
|
1
|
40658
|
my $class = shift; |
303
|
|
|
|
|
|
|
|
304
|
32952
|
100
|
|
|
|
62683
|
if (ref $class) { |
305
|
21
|
|
|
|
|
30
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
306
|
21
|
|
|
|
|
117
|
return $class->new_result(@_); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
32931
|
|
|
|
|
38379
|
my ($source, $attrs) = @_; |
310
|
32931
|
100
|
|
|
|
173377
|
$source = $source->resolve |
311
|
|
|
|
|
|
|
if $source->isa('DBIx::Class::ResultSourceHandle'); |
312
|
|
|
|
|
|
|
|
313
|
32931
|
100
|
|
|
|
28359
|
$attrs = { %{$attrs||{}} }; |
|
32931
|
|
|
|
|
134038
|
|
314
|
32931
|
|
|
|
|
42052
|
delete @{$attrs}{qw(_last_sqlmaker_alias_map _simple_passthrough_construction)}; |
|
32931
|
|
|
|
|
44930
|
|
315
|
|
|
|
|
|
|
|
316
|
32931
|
100
|
|
|
|
64141
|
if ($attrs->{page}) { |
317
|
26
|
|
100
|
|
|
80
|
$attrs->{rows} ||= 10; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
32931
|
|
100
|
|
|
93422
|
$attrs->{alias} ||= 'me'; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
my $self = bless { |
323
|
|
|
|
|
|
|
result_source => $source, |
324
|
|
|
|
|
|
|
cond => $attrs->{where}, |
325
|
32931
|
|
|
|
|
109983
|
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 |
332
|
|
|
|
|
|
|
$self->_normalize_selection($attrs) |
333
|
32931
|
100
|
|
|
|
94420
|
unless $attrs->{_dark_selector}; |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
$self->result_class( |
336
|
32931
|
|
66
|
|
|
793639
|
$attrs->{result_class} || $source->result_class |
337
|
|
|
|
|
|
|
); |
338
|
|
|
|
|
|
|
|
339
|
32929
|
|
|
|
|
139965
|
$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
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
In list context, C<< ->all() >> is called implicitly on the resultset, thus |
359
|
|
|
|
|
|
|
returning a list of L objects instead. |
360
|
|
|
|
|
|
|
To avoid that, use L. |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
If you need to pass in additional attributes but no additional condition, |
363
|
|
|
|
|
|
|
call it as C. |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# "SELECT name, artistid FROM $artist_table" |
366
|
|
|
|
|
|
|
my @all_artists = $schema->resultset('Artist')->search(undef, { |
367
|
|
|
|
|
|
|
columns => [qw/name artistid/], |
368
|
|
|
|
|
|
|
}); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
For a list of attributes that can be passed to C, see |
371
|
|
|
|
|
|
|
L. For more examples of using this function, see |
372
|
|
|
|
|
|
|
L. For a complete |
373
|
|
|
|
|
|
|
documentation for the first argument, see L |
374
|
|
|
|
|
|
|
and its extension L. |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
For more help on using joins with search, see L. |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=head3 CAVEAT |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
Note that L does not process/deflate any of the values passed in the |
381
|
|
|
|
|
|
|
L-compatible search condition structure. This is unlike other |
382
|
|
|
|
|
|
|
condition-bound methods L, L and L. The user must ensure |
383
|
|
|
|
|
|
|
manually that any value passed to this method will stringify to something the |
384
|
|
|
|
|
|
|
RDBMS knows how to deal with. A notable example is the handling of L |
385
|
|
|
|
|
|
|
objects, for more info see: |
386
|
|
|
|
|
|
|
L. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=cut |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub search { |
391
|
16492
|
|
|
16492
|
1
|
740926
|
my $self = shift; |
392
|
16492
|
|
|
|
|
33018
|
my $rs = $self->search_rs( @_ ); |
393
|
|
|
|
|
|
|
|
394
|
16484
|
100
|
|
|
|
37911
|
if (wantarray) { |
|
|
100
|
|
|
|
|
|
395
|
85
|
|
|
|
|
106
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray; |
396
|
85
|
|
|
|
|
295
|
return $rs->all; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
elsif (defined wantarray) { |
399
|
16398
|
|
|
|
|
83121
|
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
|
1
|
50
|
|
|
|
6
|
$self->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense') |
408
|
|
|
|
|
|
|
if (caller)[0] !~ /^\QDBIx::Class::/; |
409
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
0
|
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
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
This method does the same exact thing as search() except it will |
425
|
|
|
|
|
|
|
always return a resultset, even in list context. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=cut |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub search_rs { |
430
|
17480
|
|
|
17480
|
1
|
17375
|
my $self = shift; |
431
|
|
|
|
|
|
|
|
432
|
17480
|
|
|
|
|
29579
|
my $rsrc = $self->result_source; |
433
|
17480
|
|
|
|
|
17610
|
my ($call_cond, $call_attrs); |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# Special-case handling for (undef, undef) or (undef) |
436
|
|
|
|
|
|
|
# Note that (foo => undef) is valid deprecated syntax |
437
|
17480
|
100
|
|
|
|
27244
|
@_ = () if not scalar grep { defined $_ } @_; |
|
22493
|
|
|
|
|
52885
|
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# just a cond |
440
|
17480
|
100
|
100
|
|
|
86188
|
if (@_ == 1) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
441
|
5593
|
|
|
|
|
5804
|
$call_cond = shift; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
# fish out attrs in the ($condref, $attr) case |
444
|
|
|
|
|
|
|
elsif (@_ == 2 and ( ! defined $_[0] or (ref $_[0]) ne '') ) { |
445
|
8440
|
|
|
|
|
12131
|
($call_cond, $call_attrs) = @_; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
elsif (@_ % 2) { |
448
|
6
|
|
|
|
|
15
|
$self->throw_exception('Odd number of arguments to search') |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
# legacy search |
451
|
|
|
|
|
|
|
elsif (@_) { |
452
|
1
|
50
|
|
|
|
18
|
carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead' |
453
|
|
|
|
|
|
|
unless $rsrc->result_class->isa('DBIx::Class::CDBICompat'); |
454
|
|
|
|
|
|
|
|
455
|
1
|
|
|
|
|
74
|
for my $i (0 .. $#_) { |
456
|
2
|
100
|
|
|
|
6
|
next if $i % 2; |
457
|
1
|
50
|
33
|
|
|
7
|
$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
|
1
|
|
|
|
|
3
|
$call_cond = { @_ }; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# see if we can keep the cache (no $rs changes) |
465
|
17474
|
|
|
|
|
15149
|
my $cache; |
466
|
17474
|
|
|
|
|
44514
|
my %safe = (alias => 1, cache => 1); |
467
|
17474
|
100
|
66
|
8555
|
|
152507
|
if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and ( |
|
8555
|
|
66
|
|
|
24402
|
|
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
|
3636
|
|
|
|
|
7505
|
$cache = $self->get_cache; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
17474
|
|
|
|
|
41194
|
my $old_attrs = { %{$self->{attrs}} }; |
|
17474
|
|
|
|
|
69904
|
|
478
|
17474
|
|
|
|
|
23322
|
my ($old_having, $old_where) = delete @{$old_attrs}{qw(having where)}; |
|
17474
|
|
|
|
|
32179
|
|
479
|
|
|
|
|
|
|
|
480
|
17474
|
|
|
|
|
45520
|
my $new_attrs = { %$old_attrs }; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# take care of call attrs (only if anything is changing) |
483
|
17474
|
100
|
66
|
|
|
74978
|
if ($call_attrs and keys %$call_attrs) { |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
# copy for _normalize_selection |
486
|
8435
|
|
|
|
|
21779
|
$call_attrs = { %$call_attrs }; |
487
|
|
|
|
|
|
|
|
488
|
8435
|
|
|
|
|
25351
|
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
|
8435
|
100
|
|
29805
|
|
28555
|
if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) { |
|
29805
|
|
|
|
|
35653
|
|
492
|
1648
|
|
|
|
|
2381
|
delete @{$old_attrs}{(@selector_attrs, '_dark_selector')}; |
|
1648
|
|
|
|
|
3618
|
|
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
|
8435
|
100
|
|
|
|
26039
|
if $old_attrs->{_dark_selector}; |
500
|
8435
|
|
|
|
|
17489
|
$self->_normalize_selection ($call_attrs); |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# start with blind overwriting merge, exclude selector attrs |
503
|
8433
|
|
|
|
|
8261
|
$new_attrs = { %{$old_attrs}, %{$call_attrs} }; |
|
8433
|
|
|
|
|
13380
|
|
|
8433
|
|
|
|
|
29606
|
|
504
|
8433
|
|
|
|
|
17541
|
delete @{$new_attrs}{@selector_attrs}; |
|
8433
|
|
|
|
|
15582
|
|
505
|
|
|
|
|
|
|
|
506
|
8433
|
|
|
|
|
12573
|
for (@selector_attrs) { |
507
|
|
|
|
|
|
|
$new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_}) |
508
|
67464
|
100
|
66
|
|
|
160284
|
if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} ); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
# older deprecated name, use only if {columns} is not there |
512
|
8433
|
100
|
|
|
|
19388
|
if (my $c = delete $new_attrs->{cols}) { |
513
|
1
|
|
|
|
|
28
|
carp_unique( "Resultset attribute 'cols' is deprecated, use 'columns' instead" ); |
514
|
1
|
50
|
|
|
|
77
|
if ($new_attrs->{columns}) { |
515
|
0
|
|
|
|
|
0
|
carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'"; |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
else { |
518
|
1
|
|
|
|
|
3
|
$new_attrs->{columns} = $c; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
# join/prefetch use their own crazy merging heuristics |
524
|
8433
|
|
|
|
|
11578
|
foreach my $key (qw/join prefetch/) { |
525
|
|
|
|
|
|
|
$new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key}) |
526
|
16866
|
100
|
|
|
|
32737
|
if exists $call_attrs->{$key}; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# stack binds together |
530
|
8433
|
100
|
|
|
|
8331
|
$new_attrs->{bind} = [ @{ $old_attrs->{bind} || [] }, @{ $call_attrs->{bind} || [] } ]; |
|
8433
|
100
|
|
|
|
29245
|
|
|
8433
|
|
|
|
|
39776
|
|
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
|
534
|
17472
|
|
|
|
|
26051
|
for ($old_where, $call_cond) { |
535
|
34944
|
100
|
|
|
|
59037
|
if (defined $_) { |
536
|
|
|
|
|
|
|
$new_attrs->{where} = $self->_stack_cond ( |
537
|
|
|
|
|
|
|
$_, $new_attrs->{where} |
538
|
21718
|
|
|
|
|
56650
|
); |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
17472
|
100
|
|
|
|
30329
|
if (defined $old_having) { |
543
|
|
|
|
|
|
|
$new_attrs->{having} = $self->_stack_cond ( |
544
|
|
|
|
|
|
|
$old_having, $new_attrs->{having} |
545
|
|
|
|
|
|
|
) |
546
|
27
|
|
|
|
|
93
|
} |
547
|
|
|
|
|
|
|
|
548
|
17472
|
|
|
|
|
48522
|
my $rs = (ref $self)->new($rsrc, $new_attrs); |
549
|
|
|
|
|
|
|
|
550
|
17470
|
100
|
|
|
|
32945
|
$rs->set_cache($cache) if ($cache); |
551
|
|
|
|
|
|
|
|
552
|
17470
|
|
|
|
|
79690
|
return $rs; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
my $dark_sel_dumper; |
556
|
|
|
|
|
|
|
sub _normalize_selection { |
557
|
41339
|
|
|
41339
|
|
45153
|
my ($self, $attrs) = @_; |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# legacy syntax |
560
|
41339
|
100
|
|
|
|
74266
|
if ( exists $attrs->{include_columns} ) { |
561
|
1
|
|
|
|
|
7
|
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
|
1
|
|
|
|
|
61
|
); |
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 |
580
|
41339
|
|
|
|
|
54236
|
for my $pref ('', '+') { |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
my ($sel, $as) = map { |
583
|
82678
|
|
|
|
|
81779
|
my $key = "${pref}${_}"; |
|
165356
|
|
|
|
|
166729
|
|
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
my $val = [ ref $attrs->{$key} eq 'ARRAY' |
586
|
2358
|
|
|
|
|
4198
|
? @{$attrs->{$key}} |
587
|
165356
|
100
|
66
|
|
|
520505
|
: $attrs->{$key} || () |
588
|
|
|
|
|
|
|
]; |
589
|
165356
|
|
|
|
|
138484
|
delete $attrs->{$key}; |
590
|
165356
|
|
|
|
|
216166
|
$val; |
591
|
|
|
|
|
|
|
} qw/select as/; |
592
|
|
|
|
|
|
|
|
593
|
82678
|
100
|
100
|
|
|
276883
|
if (! @$as and ! @$sel ) { |
|
|
50
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
594
|
80443
|
|
|
|
|
119320
|
next; |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
elsif (@$as and ! @$sel) { |
597
|
0
|
|
|
|
|
0
|
$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
|
599
|
100
|
|
|
|
1524
|
unless ($attrs->{_dark_selector}) { |
606
|
|
|
|
|
|
|
SELECTOR: |
607
|
594
|
|
|
|
|
1360
|
for (@$sel) { |
608
|
660
|
100
|
100
|
|
|
5976
|
if ( ref $_ eq 'HASH' and exists $_->{-as} ) { |
|
|
100
|
66
|
|
|
|
|
609
|
5
|
|
|
|
|
29
|
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
|
634
|
|
|
|
|
1520
|
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
|
21
|
|
66
|
|
|
140
|
string => ($dark_sel_dumper ||= do { |
621
|
9
|
|
|
|
|
64
|
require Data::Dumper::Concise; |
622
|
9
|
|
|
|
|
45
|
Data::Dumper::Concise::DumperObject()->Indent(0); |
623
|
|
|
|
|
|
|
})->Values([$_])->Dump |
624
|
|
|
|
|
|
|
, |
625
|
|
|
|
|
|
|
}; |
626
|
21
|
|
|
|
|
5553
|
last SELECTOR; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
elsif (@$as < @$sel) { |
632
|
0
|
|
|
|
|
0
|
$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
|
2
|
|
|
|
|
16
|
$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
|
2233
|
|
|
|
|
8831
|
$attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel); |
645
|
2233
|
|
|
|
|
7999
|
$attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub _stack_cond { |
650
|
21745
|
|
|
21745
|
|
41172
|
my ($self, $left, $right) = @_; |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
( |
653
|
|
|
|
|
|
|
(ref $_ eq 'ARRAY' and !@$_) |
654
|
|
|
|
|
|
|
or |
655
|
|
|
|
|
|
|
(ref $_ eq 'HASH' and ! keys %$_) |
656
|
21745
|
|
33
|
|
|
211333
|
) and $_ = undef for ($left, $right); |
|
|
|
100
|
|
|
|
|
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
# either one of the two undef |
659
|
21745
|
100
|
100
|
|
|
80223
|
if ( (defined $left) xor (defined $right) ) { |
|
|
100
|
|
|
|
|
|
660
|
16856
|
100
|
|
|
|
58432
|
return defined $left ? $left : $right; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
# both undef |
663
|
|
|
|
|
|
|
elsif ( ! defined $left ) { |
664
|
|
|
|
|
|
|
return undef |
665
|
968
|
|
|
|
|
2983
|
} |
666
|
|
|
|
|
|
|
else { |
667
|
3921
|
|
|
|
|
16467
|
return $self->result_source->schema->storage->_collapse_cond({ -and => [$left, $right] }); |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=head2 search_literal |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
B: C is provided for Class::DBI compatibility and |
674
|
|
|
|
|
|
|
should only be used in that context. C is a convenience |
675
|
|
|
|
|
|
|
method. It is equivalent to calling C<< $schema->search(\[]) >>, but if you |
676
|
|
|
|
|
|
|
want to ensure columns are bound correctly, use L. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
See L and |
679
|
|
|
|
|
|
|
L for searching techniques that do not |
680
|
|
|
|
|
|
|
require C. |
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
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
Pass a literal chunk of SQL to be added to the conditional part of the |
694
|
|
|
|
|
|
|
resultset query. |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
Example of how to use C instead of C |
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
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
sub search_literal { |
704
|
1
|
|
|
1
|
1
|
3
|
my ($self, $sql, @bind) = @_; |
705
|
1
|
|
|
|
|
1
|
my $attr; |
706
|
1
|
50
|
33
|
|
|
5
|
if ( @bind && ref($bind[-1]) eq 'HASH' ) { |
707
|
0
|
|
|
|
|
0
|
$attr = pop @bind; |
708
|
|
|
|
|
|
|
} |
709
|
1
|
|
33
|
|
|
14
|
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
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Finds and returns a single row based on supplied criteria. Takes either a |
723
|
|
|
|
|
|
|
hashref with the same format as L (including inference of foreign |
724
|
|
|
|
|
|
|
keys from related objects), or a list of primary key values in the same |
725
|
|
|
|
|
|
|
order as the L |
726
|
|
|
|
|
|
|
declaration on the L. |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
In either case an attempt is made to combine conditions already existing on |
729
|
|
|
|
|
|
|
the resultset with the condition passed to this method. |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
To aid with preparing the correct query for the storage you may supply the |
732
|
|
|
|
|
|
|
C attribute, which is the name of a |
733
|
|
|
|
|
|
|
L (the |
734
|
|
|
|
|
|
|
unique constraint corresponding to the |
735
|
|
|
|
|
|
|
L is always named |
736
|
|
|
|
|
|
|
C). If the C attribute has been supplied, and DBIC is unable |
737
|
|
|
|
|
|
|
to construct a query that satisfies the named unique constraint fully ( |
738
|
|
|
|
|
|
|
non-NULL values for each column member of the constraint) an exception is |
739
|
|
|
|
|
|
|
thrown. |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
If no C is specified, the search is carried over all unique constraints |
742
|
|
|
|
|
|
|
which are fully defined by the available condition. |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
If no such constraint is found, C currently defaults to a simple |
745
|
|
|
|
|
|
|
C<< search->(\%column_values) >> which may or may not do what you expect. |
746
|
|
|
|
|
|
|
Note that this fallback behavior may be deprecated in further versions. If |
747
|
|
|
|
|
|
|
you need to search with arbitrary conditions - use L. If the query |
748
|
|
|
|
|
|
|
resulting from this fallback produces more than one row, a warning to the |
749
|
|
|
|
|
|
|
effect is issued, though only the first row is constructed and returned as |
750
|
|
|
|
|
|
|
C<$result_object>. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
In addition to C, L recognizes and applies standard |
753
|
|
|
|
|
|
|
L in the same way as L does. |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
Note that if you have extra concerns about the correctness of the resulting |
756
|
|
|
|
|
|
|
query you need to specify the C attribute and supply the entire condition |
757
|
|
|
|
|
|
|
as an argument to find (since it is not always possible to perform the |
758
|
|
|
|
|
|
|
combination of the resultset condition with the supplied one, especially if |
759
|
|
|
|
|
|
|
the resultset condition contains literal sql). |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
For example, to find a row by its primary key: |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
my $cd = $schema->resultset('CD')->find(5); |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
You 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
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
See also L and L. |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=cut |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
sub find { |
780
|
1381
|
|
|
1381
|
1
|
41187
|
my $self = shift; |
781
|
1381
|
100
|
100
|
|
|
7219
|
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); |
782
|
|
|
|
|
|
|
|
783
|
1381
|
|
|
|
|
3391
|
my $rsrc = $self->result_source; |
784
|
|
|
|
|
|
|
|
785
|
1381
|
|
|
|
|
1916
|
my $constraint_name; |
786
|
1381
|
100
|
|
|
|
4030
|
if (exists $attrs->{key}) { |
787
|
|
|
|
|
|
|
$constraint_name = defined $attrs->{key} |
788
|
|
|
|
|
|
|
? $attrs->{key} |
789
|
18
|
50
|
|
|
|
48
|
: $self->throw_exception("An undefined 'key' resultset attribute makes no sense") |
790
|
|
|
|
|
|
|
; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
# Parse out the condition from input |
794
|
1381
|
|
|
|
|
1650
|
my $call_cond; |
795
|
|
|
|
|
|
|
|
796
|
1381
|
100
|
|
|
|
4169
|
if (ref $_[0] eq 'HASH') { |
797
|
1166
|
|
|
|
|
1833
|
$call_cond = { %{$_[0]} }; |
|
1166
|
|
|
|
|
3998
|
|
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
else { |
800
|
|
|
|
|
|
|
# if only values are supplied we need to default to 'primary' |
801
|
215
|
100
|
|
|
|
716
|
$constraint_name = 'primary' unless defined $constraint_name; |
802
|
|
|
|
|
|
|
|
803
|
215
|
|
|
|
|
1279
|
my @c_cols = $rsrc->unique_constraint_columns($constraint_name); |
804
|
|
|
|
|
|
|
|
805
|
215
|
50
|
|
|
|
619
|
$self->throw_exception( |
806
|
|
|
|
|
|
|
"No constraint columns, maybe a malformed '$constraint_name' constraint?" |
807
|
|
|
|
|
|
|
) unless @c_cols; |
808
|
|
|
|
|
|
|
|
809
|
215
|
100
|
|
|
|
654
|
$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
|
214
|
|
|
|
|
436
|
@{$call_cond}{@c_cols} = @_; |
|
214
|
|
|
|
|
674
|
|
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
# process relationship data if any |
818
|
1380
|
|
|
|
|
4149
|
for my $key (keys %$call_cond) { |
819
|
1274
|
100
|
100
|
|
|
4760
|
if ( |
|
|
|
100
|
|
|
|
|
820
|
|
|
|
|
|
|
length ref($call_cond->{$key}) |
821
|
|
|
|
|
|
|
and |
822
|
|
|
|
|
|
|
my $relinfo = $rsrc->relationship_info($key) |
823
|
|
|
|
|
|
|
and |
824
|
|
|
|
|
|
|
# implicitly skip has_many's (likely MC) |
825
|
|
|
|
|
|
|
(ref (my $val = delete $call_cond->{$key}) ne 'ARRAY' ) |
826
|
|
|
|
|
|
|
) { |
827
|
|
|
|
|
|
|
my ($rel_cond, $crosstable) = $rsrc->_resolve_condition( |
828
|
19
|
|
|
|
|
116
|
$relinfo->{cond}, $val, $key, $key |
829
|
|
|
|
|
|
|
); |
830
|
|
|
|
|
|
|
|
831
|
18
|
50
|
33
|
|
|
115
|
$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
|
18
|
|
|
|
|
55
|
@{$call_cond}{keys %$rel_cond} = values %$rel_cond; |
|
18
|
|
|
|
|
66
|
|
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
|
840
|
1379
|
50
|
|
|
|
4790
|
my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias}; |
841
|
1379
|
|
|
|
|
1596
|
my $final_cond; |
842
|
1379
|
100
|
100
|
|
|
6916
|
if (defined $constraint_name) { |
|
|
100
|
|
|
|
|
|
843
|
231
|
|
|
|
|
1213
|
$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
|
1140
|
|
|
|
|
1619
|
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
|
1140
|
|
|
|
|
5172
|
for my $c_name ( sort { |
871
|
4140
|
100
|
|
|
|
9768
|
$a eq 'primary' ? -1 |
|
|
100
|
|
|
|
|
|
872
|
|
|
|
|
|
|
: $b eq 'primary' ? 1 |
873
|
|
|
|
|
|
|
: $a cmp $b |
874
|
|
|
|
|
|
|
} $rsrc->unique_constraint_names) { |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
next if $seen_column_combinations{ |
877
|
3801
|
100
|
|
|
|
24151
|
join "\x00", sort $rsrc->unique_constraint_columns($c_name) |
878
|
|
|
|
|
|
|
}++; |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
try { |
881
|
2983
|
|
66
|
2983
|
|
139326
|
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
|
1951
|
100
|
|
1951
|
|
30888
|
push @fc_exceptions, $_ if $_ =~ /\bFilterColumn\b/; |
892
|
2983
|
|
|
|
|
25313
|
}; |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
$final_cond = |
896
|
|
|
|
|
|
|
@unique_queries ? \@unique_queries |
897
|
1140
|
100
|
|
|
|
8433
|
: @fc_exceptions ? $self->throw_exception(join "; ", map { $_ =~ /(.*) at .+ line \d+$/s } @fc_exceptions ) |
|
1
|
100
|
|
|
|
3
|
|
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
|
1374
|
|
|
|
|
5287
|
my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs}); |
904
|
1374
|
100
|
|
|
|
5548
|
if ($rs->_resolved_attrs->{collapse}) { |
905
|
11
|
|
|
|
|
60
|
my $row = $rs->next; |
906
|
11
|
100
|
|
|
|
46
|
carp "Query returned more than one row" if $rs->next; |
907
|
11
|
|
|
|
|
112
|
return $row; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
else { |
910
|
1363
|
|
|
|
|
5469
|
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 |
926
|
|
|
|
|
|
|
sub _non_unique_find_fallback { |
927
|
132
|
|
|
132
|
|
255
|
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
|
132
|
50
|
|
|
|
709
|
); |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
sub _qualify_cond_columns { |
939
|
1391
|
|
|
1391
|
|
4070
|
my ($self, $cond, $alias) = @_; |
940
|
|
|
|
|
|
|
|
941
|
1391
|
|
|
|
|
4400
|
my %aliased = %$cond; |
942
|
1391
|
|
|
|
|
3527
|
for (keys %aliased) { |
943
|
1525
|
50
|
|
|
|
8803
|
$aliased{"$alias.$_"} = delete $aliased{$_} |
944
|
|
|
|
|
|
|
if $_ !~ /\./; |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
1391
|
|
|
|
|
4911
|
return \%aliased; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
sub _build_unique_cond { |
951
|
0
|
|
|
0
|
|
0
|
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
|
0
|
|
|
|
|
0
|
my ($self, $constraint_name, $cond, $croak_on_null) = @_; |
959
|
|
|
|
|
|
|
|
960
|
0
|
|
|
|
|
0
|
$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
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
Searches the specified relationship, optionally specifying a condition and |
982
|
|
|
|
|
|
|
attributes for matching records. See L for more information. |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
In list context, C<< ->all() >> is called implicitly on the resultset, thus |
985
|
|
|
|
|
|
|
returning a list of result objects instead. To avoid that, use L. |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
See also L. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=cut |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
sub search_related { |
992
|
214
|
|
|
214
|
1
|
5684
|
return shift->related_resultset(shift)->search(@_); |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=head2 search_related_rs |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
This method works exactly the same as search_related, except that |
998
|
|
|
|
|
|
|
it guarantees a resultset, even in list context. |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=cut |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
sub search_related_rs { |
1003
|
1
|
|
|
1
|
1
|
18
|
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
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
Returns a storage-driven cursor to the given resultset. See |
1017
|
|
|
|
|
|
|
L for more information. |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=cut |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
sub cursor { |
1022
|
10728
|
|
|
10728
|
1
|
12086
|
my $self = shift; |
1023
|
|
|
|
|
|
|
|
1024
|
10728
|
|
66
|
|
|
35275
|
return $self->{cursor} ||= do { |
1025
|
3788
|
|
|
|
|
9153
|
my $attrs = $self->_resolved_attrs; |
1026
|
|
|
|
|
|
|
$self->result_source->storage->select( |
1027
|
3788
|
|
|
|
|
16470
|
$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
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
Inflates the first result without creating a cursor if the resultset has |
1045
|
|
|
|
|
|
|
any records in it; if not returns C. Used by L as a lean version |
1046
|
|
|
|
|
|
|
of L. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
While this method can take an optional search condition (just like L) |
1049
|
|
|
|
|
|
|
being a fast-code-path it does not recognize search attributes. If you need to |
1050
|
|
|
|
|
|
|
add extra joins or similar, call L and then chain-call L on the |
1051
|
|
|
|
|
|
|
L returned. |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
=over |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=item B |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
As of 0.08100, this method enforces the assumption that the preceding |
1058
|
|
|
|
|
|
|
query returns only one row. If more than one row is returned, you will receive |
1059
|
|
|
|
|
|
|
a warning: |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
Query returned more than one row |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
In this case, you should be using L or L instead, or if you really |
1064
|
|
|
|
|
|
|
know what you are doing, use the L attribute to explicitly limit the size |
1065
|
|
|
|
|
|
|
of the resultset. |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
This method will also throw an exception if it is called on a resultset prefetching |
1068
|
|
|
|
|
|
|
has_many, as such a prefetch implies fetching multiple rows from the database in |
1069
|
|
|
|
|
|
|
order to assemble the resulting object. |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
=back |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
=cut |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
sub single { |
1076
|
2704
|
|
|
2704
|
1
|
4853
|
my ($self, $where) = @_; |
1077
|
2704
|
50
|
|
|
|
6344
|
if(@_ > 2) { |
1078
|
0
|
|
|
|
|
0
|
$self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()'); |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
|
1081
|
2704
|
|
|
|
|
2893
|
my $attrs = { %{$self->_resolved_attrs} }; |
|
2704
|
|
|
|
|
6200
|
|
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
$self->throw_exception( |
1084
|
|
|
|
|
|
|
'single() can not be used on resultsets collapsing a has_many. Use find( \%cond ) or next() instead' |
1085
|
2704
|
100
|
|
|
|
8201
|
) if $attrs->{collapse}; |
1086
|
|
|
|
|
|
|
|
1087
|
2703
|
100
|
|
|
|
5474
|
if ($where) { |
1088
|
9
|
50
|
|
|
|
36
|
if (defined $attrs->{where}) { |
1089
|
|
|
|
|
|
|
$attrs->{where} = { |
1090
|
|
|
|
|
|
|
'-and' => |
1091
|
0
|
0
|
|
|
|
0
|
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } |
1092
|
0
|
|
|
|
|
0
|
$where, delete $attrs->{where} ] |
1093
|
|
|
|
|
|
|
}; |
1094
|
|
|
|
|
|
|
} else { |
1095
|
9
|
|
|
|
|
21
|
$attrs->{where} = $where; |
1096
|
|
|
|
|
|
|
} |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
my $data = [ $self->result_source->storage->select_single( |
1100
|
|
|
|
|
|
|
$attrs->{from}, $attrs->{select}, |
1101
|
2703
|
|
|
|
|
11463
|
$attrs->{where}, $attrs |
1102
|
|
|
|
|
|
|
)]; |
1103
|
|
|
|
|
|
|
|
1104
|
2702
|
100
|
|
|
|
10548
|
return undef unless @$data; |
1105
|
2408
|
|
|
|
|
6437
|
$self->{_stashed_rows} = [ $data ]; |
1106
|
2408
|
|
|
|
|
7535
|
$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
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
Returns a L instance for a column of the ResultSet. |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=cut |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
sub get_column { |
1126
|
711
|
|
|
711
|
1
|
8342
|
my ($self, $column) = @_; |
1127
|
711
|
|
|
|
|
4364
|
my $new = DBIx::Class::ResultSetColumn->new($self, $column); |
1128
|
711
|
|
|
|
|
3504
|
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
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
Performs a search, but uses C instead of C<=> as the condition. Note |
1145
|
|
|
|
|
|
|
that this is simply a convenience method retained for ex Class::DBI users. |
1146
|
|
|
|
|
|
|
You most likely want to use L with specific operators. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
For more information, see L. |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
This method is deprecated and will be removed in 0.09. Use L |
1151
|
|
|
|
|
|
|
instead. An example conversion is: |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
->search_like({ foo => 'bar' }); |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
# Becomes |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
->search({ foo => { like => 'bar' } }); |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
=cut |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
sub search_like { |
1162
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
1163
|
0
|
|
|
|
|
0
|
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
|
0
|
0
|
0
|
|
|
0
|
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); |
1169
|
0
|
0
|
|
|
|
0
|
my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_}; |
|
0
|
|
|
|
|
0
|
|
1170
|
0
|
|
|
|
|
0
|
$query->{$_} = { 'like' => $query->{$_} } for keys %$query; |
1171
|
0
|
|
|
|
|
0
|
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
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
Returns a resultset or object list representing a subset of elements from the |
1185
|
|
|
|
|
|
|
resultset slice is called on. Indexes are from 0, i.e., to get the first |
1186
|
|
|
|
|
|
|
three records, call: |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
my ($one, $two, $three) = $rs->slice(0, 2); |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
=cut |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
sub slice { |
1193
|
14
|
|
|
14
|
1
|
30621
|
my ($self, $min, $max) = @_; |
1194
|
14
|
|
|
|
|
29
|
my $attrs = {}; # = { %{ $self->{attrs} || {} } }; |
1195
|
14
|
|
50
|
|
|
123
|
$attrs->{offset} = $self->{attrs}{offset} || 0; |
1196
|
14
|
|
|
|
|
34
|
$attrs->{offset} += $min; |
1197
|
14
|
100
|
|
|
|
56
|
$attrs->{rows} = ($max ? ($max - $min + 1) : 1); |
1198
|
14
|
|
|
|
|
58
|
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
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
Returns the next element in the resultset (C is there is none). |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
Can 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
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
Note that you need to store the resultset object, and call C on it. |
1221
|
|
|
|
|
|
|
Calling C<< resultset('Table')->next >> repeatedly will always return the |
1222
|
|
|
|
|
|
|
first record from the resultset. |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
=cut |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
sub next { |
1227
|
4887
|
|
|
4887
|
1
|
62649
|
my ($self) = @_; |
1228
|
|
|
|
|
|
|
|
1229
|
4887
|
100
|
|
|
|
8951
|
if (my $cache = $self->get_cache) { |
1230
|
65
|
|
100
|
|
|
279
|
$self->{all_cache_position} ||= 0; |
1231
|
65
|
|
|
|
|
1246
|
return $cache->[$self->{all_cache_position}++]; |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
|
1234
|
4822
|
100
|
|
|
|
10880
|
if ($self->{attrs}{cache}) { |
1235
|
2
|
|
|
|
|
5
|
delete $self->{pager}; |
1236
|
2
|
|
|
|
|
5
|
$self->{all_cache_position} = 1; |
1237
|
2
|
|
|
|
|
9
|
return ($self->all)[0]; |
1238
|
|
|
|
|
|
|
} |
1239
|
|
|
|
|
|
|
|
1240
|
4820
|
100
|
|
|
|
4639
|
return shift(@{$self->{_stashed_results}}) if @{ $self->{_stashed_results}||[] }; |
|
11
|
100
|
|
|
|
38
|
|
|
4820
|
|
|
|
|
16358
|
|
1241
|
|
|
|
|
|
|
|
1242
|
4809
|
100
|
|
|
|
9863
|
$self->{_stashed_results} = $self->_construct_results |
1243
|
|
|
|
|
|
|
or return undef; |
1244
|
|
|
|
|
|
|
|
1245
|
4069
|
|
|
|
|
3944
|
return shift @{$self->{_stashed_results}}; |
|
4069
|
|
|
|
|
28046
|
|
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 |
1264
|
|
|
|
|
|
|
sub _construct_results { |
1265
|
8828
|
|
|
8828
|
|
10395
|
my ($self, $fetch_all) = @_; |
1266
|
|
|
|
|
|
|
|
1267
|
8828
|
|
|
|
|
15448
|
my $rsrc = $self->result_source; |
1268
|
8828
|
|
|
|
|
16846
|
my $attrs = $self->_resolved_attrs; |
1269
|
|
|
|
|
|
|
|
1270
|
8827
|
100
|
100
|
|
|
41006
|
if ( |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
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
|
35
|
|
|
|
|
65
|
$attrs->{order_by} = [ map { join '.', $attrs->{alias}, $_} @pcols ]; |
|
35
|
|
|
|
|
159
|
|
1281
|
35
|
|
|
|
|
75
|
$attrs->{_ordered_for_collapse} = 1; |
1282
|
35
|
|
|
|
|
57
|
$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
|
8827
|
|
|
|
|
11927
|
my $rows = delete $self->{_stashed_rows}; |
1289
|
|
|
|
|
|
|
|
1290
|
8827
|
|
|
|
|
8873
|
my $cursor; # we may not need one at all |
1291
|
|
|
|
|
|
|
|
1292
|
8827
|
|
|
|
|
10476
|
my $did_fetch_all = $fetch_all; |
1293
|
|
|
|
|
|
|
|
1294
|
8827
|
100
|
|
|
|
22643
|
if ($fetch_all) { |
|
|
100
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
# FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref |
1296
|
1611
|
50
|
|
|
|
4769
|
$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
|
109
|
|
|
|
|
295
|
$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
|
109
|
100
|
66
|
|
|
465
|
) unless defined $attrs->{_ordered_for_collapse}; |
|
|
100
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
|
1313
|
109
|
100
|
|
|
|
315
|
if (! $attrs->{_ordered_for_collapse}) { |
1314
|
13
|
|
|
|
|
23
|
$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
|
13
|
100
|
|
|
|
43
|
if (! $cursor->{_done}) { |
1320
|
8
|
50
|
|
|
|
63
|
$rows = [ ($rows ? @$rows : ()), $cursor->all ]; |
1321
|
7
|
|
|
|
|
35
|
$cursor->{_done} = 1; |
1322
|
|
|
|
|
|
|
} |
1323
|
|
|
|
|
|
|
} |
1324
|
|
|
|
|
|
|
} |
1325
|
|
|
|
|
|
|
|
1326
|
8818
|
100
|
66
|
|
|
19225
|
if (! $did_fetch_all and ! @{$rows||[]} ) { |
|
7203
|
100
|
|
|
|
27432
|
|
1327
|
|
|
|
|
|
|
# FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref |
1328
|
4771
|
|
66
|
|
|
11945
|
$cursor ||= $self->cursor; |
1329
|
4771
|
100
|
|
|
|
12103
|
if (scalar (my @r = $cursor->next) ) { |
1330
|
4065
|
|
|
|
|
7421
|
$rows = [ \@r ]; |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
|
1334
|
8811
|
100
|
|
|
|
11328
|
return undef unless @{$rows||[]}; |
|
8811
|
100
|
|
|
|
30744
|
|
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
# sanity check - people are too clever for their own good |
1337
|
7822
|
100
|
66
|
|
|
20583
|
if ($attrs->{collapse} and my $aliastypes = $attrs->{_last_sqlmaker_alias_map} ) { |
1338
|
|
|
|
|
|
|
|
1339
|
226
|
|
|
|
|
284
|
my $multiplied_selectors; |
1340
|
226
|
|
|
|
|
388
|
for my $sel_alias ( grep { $_ ne $attrs->{alias} } keys %{ $aliastypes->{selecting} } ) { |
|
611
|
|
|
|
|
1359
|
|
|
226
|
|
|
|
|
808
|
|
1341
|
423
|
100
|
66
|
|
|
1517
|
if ( |
1342
|
|
|
|
|
|
|
$aliastypes->{multiplying}{$sel_alias} |
1343
|
|
|
|
|
|
|
or |
1344
|
|
|
|
|
|
|
$aliastypes->{premultiplied}{$sel_alias} |
1345
|
|
|
|
|
|
|
) { |
1346
|
341
|
|
|
|
|
381
|
$multiplied_selectors->{$_} = 1 for values %{$aliastypes->{selecting}{$sel_alias}{-seen_columns}} |
|
341
|
|
|
|
|
2223
|
|
1347
|
|
|
|
|
|
|
} |
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
|
1350
|
226
|
|
|
|
|
413
|
for my $i (0 .. $#{$attrs->{as}} ) { |
|
226
|
|
|
|
|
706
|
|
1351
|
2167
|
|
|
|
|
2075
|
my $sel = $attrs->{select}[$i]; |
1352
|
|
|
|
|
|
|
|
1353
|
2167
|
100
|
66
|
|
|
5882
|
if (ref $sel eq 'SCALAR') { |
|
|
100
|
|
|
|
|
|
1354
|
3
|
|
|
|
|
5
|
$sel = $$sel; |
1355
|
|
|
|
|
|
|
} |
1356
|
|
|
|
|
|
|
elsif( ref $sel eq 'REF' and ref $$sel eq 'ARRAY' ) { |
1357
|
6
|
|
|
|
|
16
|
$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
|
2167
|
100
|
100
|
|
|
6945
|
) if ($multiplied_selectors->{$sel} and $attrs->{as}[$i] !~ /\./); |
1363
|
|
|
|
|
|
|
} |
1364
|
|
|
|
|
|
|
} |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
# hotspot - skip the setter |
1367
|
7786
|
|
|
|
|
16617
|
my $res_class = $self->_result_class; |
1368
|
|
|
|
|
|
|
|
1369
|
7786
|
|
66
|
|
|
26737
|
my $inflator_cref = $self->{_result_inflator}{cref} ||= do { |
1370
|
4632
|
100
|
|
|
|
54270
|
$res_class->can ('inflate_result') |
1371
|
|
|
|
|
|
|
or $self->throw_exception("Inflator $res_class does not provide an inflate_result() method"); |
1372
|
|
|
|
|
|
|
}; |
1373
|
|
|
|
|
|
|
|
1374
|
7785
|
|
|
|
|
10445
|
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
|
7785
|
100
|
50
|
|
|
34335
|
) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_core_row}; |
|
|
100
|
|
|
|
|
|
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
|
7785
|
100
|
100
|
|
|
29741
|
) ? 1 : 0 ) unless defined $self->{_result_inflator}{is_hri}; |
|
|
100
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
|
1393
|
7785
|
100
|
|
|
|
14632
|
if ($attrs->{_simple_passthrough_construction}) { |
1394
|
|
|
|
|
|
|
# construct a much simpler array->hash folder for the one-table HRI cases right here |
1395
|
7519
|
100
|
66
|
|
|
37485
|
if ($self->{_result_inflator}{is_hri}) { |
|
|
100
|
|
|
|
|
|
1396
|
51
|
|
|
|
|
127
|
for my $r (@$rows) { |
1397
|
142
|
|
|
|
|
218
|
$r = { map { $infmap->[$_] => $r->[$_] } 0..$#$infmap }; |
|
317
|
|
|
|
|
654
|
|
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
|
7464
|
|
|
|
|
14049
|
for my $r (@$rows) { |
1409
|
8707
|
|
|
|
|
17781
|
$r = $inflator_cref->($res_class, $rsrc, { map { $infmap->[$_] => $r->[$_] } (0..$#$infmap) } ); |
|
51656
|
|
|
|
|
102779
|
|
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
|
4
|
50
|
|
|
|
27
|
( join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) ) |
|
26
|
100
|
|
|
|
741
|
|
1420
|
|
|
|
|
|
|
) . '; 1' or die; |
1421
|
|
|
|
|
|
|
} |
1422
|
|
|
|
|
|
|
} |
1423
|
|
|
|
|
|
|
else { |
1424
|
|
|
|
|
|
|
my $parser_type = |
1425
|
|
|
|
|
|
|
$self->{_result_inflator}{is_hri} ? 'hri' |
1426
|
266
|
100
|
|
|
|
1307
|
: $self->{_result_inflator}{is_core_row} ? 'classic_pruning' |
|
|
100
|
|
|
|
|
|
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
|
223
|
|
|
|
|
1282
|
@{$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
|
266
|
100
|
66
|
|
|
5309
|
}, $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
|
266
|
|
|
|
|
718
|
my ($unrolled_non_null_cols_to_check, $err); |
1449
|
|
|
|
|
|
|
|
1450
|
266
|
100
|
|
|
|
1141
|
if (my $check_non_null_cols = $self->{_row_parser}{$parser_type}{nullcheck} ) { |
1451
|
|
|
|
|
|
|
|
1452
|
168
|
|
|
|
|
364
|
$err = |
1453
|
|
|
|
|
|
|
'Collapse aborted due to invalid ResultSource metadata - the following ' |
1454
|
|
|
|
|
|
|
. 'selections are declared non-nullable but NULLs were retrieved: ' |
1455
|
|
|
|
|
|
|
; |
1456
|
|
|
|
|
|
|
|
1457
|
168
|
|
|
|
|
266
|
my @violating_idx; |
1458
|
168
|
|
|
|
|
400
|
COL: for my $i (@$check_non_null_cols) { |
1459
|
174
|
|
33
|
|
|
1903
|
! defined $_->[$i] and push @violating_idx, $i and next COL for @$rows; |
|
|
|
50
|
|
|
|
|
1460
|
|
|
|
|
|
|
} |
1461
|
|
|
|
|
|
|
|
1462
|
168
|
50
|
|
|
|
483
|
$self->throw_exception( $err . join (', ', map { "'$infmap->[$_]'" } @violating_idx ) ) |
|
0
|
|
|
|
|
0
|
|
1463
|
|
|
|
|
|
|
if @violating_idx; |
1464
|
|
|
|
|
|
|
|
1465
|
168
|
|
|
|
|
471
|
$unrolled_non_null_cols_to_check = join (',', @$check_non_null_cols); |
1466
|
|
|
|
|
|
|
|
1467
|
168
|
|
|
|
|
241
|
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 |
1474
|
|
|
|
|
|
|
sub { |
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
|
|
|
|
|
|
|
} |
1482
|
|
|
|
|
|
|
EOS |
1483
|
|
|
|
|
|
|
: sub { |
1484
|
|
|
|
|
|
|
# FIXME SUBOPTIMAL - we can do better, cursor->next/all (well diff. methods) should return a ref |
1485
|
90
|
100
|
|
90
|
|
210
|
my @r = $cursor->next or return; |
1486
|
|
|
|
|
|
|
\@r |
1487
|
88
|
|
|
|
|
2113
|
} |
1488
|
266
|
100
|
100
|
|
|
8449
|
; |
|
|
100
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
$self->{_row_parser}{$parser_type}{cref}->( |
1491
|
|
|
|
|
|
|
$rows, |
1492
|
266
|
100
|
|
|
|
8354
|
$next_cref ? ( $next_cref, $self->{_stashed_rows} = [] ) : (), |
1493
|
|
|
|
|
|
|
); |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
# simple in-place substitution, does not regrow $rows |
1496
|
266
|
100
|
|
|
|
1234
|
if ($self->{_result_inflator}{is_core_row}) { |
|
|
100
|
|
|
|
|
|
1497
|
200
|
|
|
|
|
1364
|
$_ = $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
|
9
|
|
|
|
|
29
|
@$rows = map { $inflator_cref->($res_class, $rsrc, @$_) } @$rows; |
|
53
|
|
|
|
|
153
|
|
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
|
7782
|
100
|
100
|
|
|
31065
|
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
|
7782
|
|
|
|
|
43634
|
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
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
An accessor for the primary ResultSource object from which this ResultSet |
1530
|
|
|
|
|
|
|
is 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
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
An accessor for the class to use when creating result objects. Defaults to |
1543
|
|
|
|
|
|
|
C<< result_source->result_class >> - which in most cases is the name of the |
1544
|
|
|
|
|
|
|
L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class. |
1545
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
Note that changing the result_class will also remove any components |
1547
|
|
|
|
|
|
|
that were originally loaded in the source class via |
1548
|
|
|
|
|
|
|
L. |
1549
|
|
|
|
|
|
|
Any overloaded methods in the original source class will not run. |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
=cut |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
sub result_class { |
1554
|
36955
|
|
|
36955
|
1
|
47356
|
my ($self, $result_class) = @_; |
1555
|
36955
|
100
|
|
|
|
60848
|
if ($result_class) { |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
# don't fire this for an object |
1558
|
32949
|
50
|
|
|
|
113280
|
$self->ensure_class_loaded($result_class) |
1559
|
|
|
|
|
|
|
unless ref($result_class); |
1560
|
|
|
|
|
|
|
|
1561
|
32945
|
100
|
66
|
|
|
322753
|
if ($self->get_cache) { |
|
|
100
|
|
|
|
|
|
1562
|
1
|
|
|
|
|
5
|
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
|
1
|
|
|
|
|
4
|
$self->throw_exception('Changing the result_class of a ResultSet instance with an active cursor is not supported'); |
1567
|
|
|
|
|
|
|
} |
1568
|
|
|
|
|
|
|
|
1569
|
32944
|
|
|
|
|
86596
|
$self->_result_class($result_class); |
1570
|
|
|
|
|
|
|
|
1571
|
32944
|
|
|
|
|
102841
|
delete $self->{_result_inflator}; |
1572
|
|
|
|
|
|
|
} |
1573
|
36950
|
|
|
|
|
93559
|
$self->_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
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
Performs an SQL C with the same query as the resultset was built |
1587
|
|
|
|
|
|
|
with to find the number of elements. Passing arguments is equivalent to |
1588
|
|
|
|
|
|
|
C<< $rs->search ($cond, \%attrs)->count >> |
1589
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
=cut |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
sub count { |
1593
|
621
|
|
|
621
|
1
|
64786
|
my $self = shift; |
1594
|
621
|
100
|
100
|
|
|
2542
|
return $self->search(@_)->count if @_ and defined $_[0]; |
1595
|
606
|
100
|
|
|
|
1480
|
return scalar @{ $self->get_cache } if $self->get_cache; |
|
58
|
|
|
|
|
93
|
|
1596
|
|
|
|
|
|
|
|
1597
|
548
|
|
|
|
|
867
|
my $attrs = { %{ $self->_resolved_attrs } }; |
|
548
|
|
|
|
|
1725
|
|
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
# this is a little optimization - it is faster to do the limit |
1600
|
|
|
|
|
|
|
# adjustments in software, instead of a subquery |
1601
|
548
|
|
|
|
|
1310
|
my ($rows, $offset) = delete @{$attrs}{qw/rows offset/}; |
|
548
|
|
|
|
|
1338
|
|
1602
|
|
|
|
|
|
|
|
1603
|
548
|
|
|
|
|
710
|
my $crs; |
1604
|
548
|
100
|
|
|
|
2517
|
if ($self->_has_resolved_attr (qw/collapse group_by/)) { |
1605
|
65
|
|
|
|
|
282
|
$crs = $self->_count_subq_rs ($attrs); |
1606
|
|
|
|
|
|
|
} |
1607
|
|
|
|
|
|
|
else { |
1608
|
483
|
|
|
|
|
1962
|
$crs = $self->_count_rs ($attrs); |
1609
|
|
|
|
|
|
|
} |
1610
|
548
|
|
|
|
|
2546
|
my $count = $crs->next; |
1611
|
|
|
|
|
|
|
|
1612
|
545
|
100
|
|
|
|
1424
|
$count -= $offset if $offset; |
1613
|
545
|
100
|
100
|
|
|
1740
|
$count = $rows if $rows and $rows < $count; |
1614
|
545
|
100
|
|
|
|
1342
|
$count = 0 if ($count < 0); |
1615
|
|
|
|
|
|
|
|
1616
|
545
|
|
|
|
|
2356
|
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
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
Same as L but returns a L object. |
1630
|
|
|
|
|
|
|
This can be very handy for subqueries: |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
->search( { amount => $some_rs->count_rs->as_query } ) |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
As with regular resultsets the SQL query will be executed only after |
1635
|
|
|
|
|
|
|
the resultset is accessed via L or L. That would return |
1636
|
|
|
|
|
|
|
the same single value obtainable via L. |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
=cut |
1639
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
sub count_rs { |
1641
|
68
|
|
|
68
|
1
|
210
|
my $self = shift; |
1642
|
68
|
100
|
|
|
|
247
|
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
|
58
|
100
|
|
|
|
281
|
if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) { |
1649
|
28
|
|
|
|
|
124
|
return $self->_count_subq_rs($self->{_attrs}); |
1650
|
|
|
|
|
|
|
} |
1651
|
|
|
|
|
|
|
else { |
1652
|
30
|
|
|
|
|
196
|
return $self->_count_rs($self->{_attrs}); |
1653
|
|
|
|
|
|
|
} |
1654
|
|
|
|
|
|
|
} |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
# |
1657
|
|
|
|
|
|
|
# returns a ResultSetColumn object tied to the count query |
1658
|
|
|
|
|
|
|
# |
1659
|
|
|
|
|
|
|
sub _count_rs { |
1660
|
513
|
|
|
513
|
|
893
|
my ($self, $attrs) = @_; |
1661
|
|
|
|
|
|
|
|
1662
|
513
|
|
|
|
|
1330
|
my $rsrc = $self->result_source; |
1663
|
|
|
|
|
|
|
|
1664
|
513
|
|
|
|
|
3408
|
my $tmp_attrs = { %$attrs }; |
1665
|
|
|
|
|
|
|
# take off any limits, record_filter is cdbi, and no point of ordering nor locking a count |
1666
|
513
|
|
|
|
|
1139
|
delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/}; |
|
513
|
|
|
|
|
1401
|
|
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
# overwrite the selector (supplied by the storage) |
1669
|
513
|
|
|
|
|
13678
|
$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
|
|
|
|
|
|
|
# |
1679
|
|
|
|
|
|
|
sub _count_subq_rs { |
1680
|
93
|
|
|
93
|
|
140
|
my ($self, $attrs) = @_; |
1681
|
|
|
|
|
|
|
|
1682
|
93
|
|
|
|
|
238
|
my $rsrc = $self->result_source; |
1683
|
|
|
|
|
|
|
|
1684
|
93
|
|
|
|
|
610
|
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
|
93
|
|
|
|
|
195
|
delete @{$sub_attrs}{qw/collapse columns as select order_by for/}; |
|
93
|
|
|
|
|
268
|
|
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
|
93
|
100
|
|
|
|
257
|
if ( $attrs->{collapse} ) { |
1691
|
31
|
|
|
|
|
222
|
$sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } @{ |
1692
|
31
|
50
|
|
|
|
44
|
$rsrc->_identifying_column_set || $self->throw_exception( |
|
31
|
|
|
|
|
234
|
|
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
|
93
|
100
|
|
|
|
255
|
if (my $g = $sub_attrs->{group_by}) { |
1701
|
|
|
|
|
|
|
|
1702
|
90
|
|
|
|
|
320
|
my $sql_maker = $rsrc->storage->sql_maker; |
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
# necessary as the group_by may refer to aliased functions |
1705
|
90
|
|
|
|
|
134
|
my $sel_index; |
1706
|
90
|
|
|
|
|
121
|
for my $sel (@{$attrs->{select}}) { |
|
90
|
|
|
|
|
222
|
|
1707
|
|
|
|
|
|
|
$sel_index->{$sel->{-as}} = $sel |
1708
|
544
|
100
|
100
|
|
|
1164
|
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
|
90
|
|
|
|
|
220
|
my @parts = @$g; |
1715
|
90
|
100
|
|
|
|
250
|
if ($attrs->{having}) { |
1716
|
3
|
|
|
|
|
49
|
local $sql_maker->{having_bind}; |
1717
|
3
|
|
|
|
|
10
|
local $sql_maker->{quote_char} = $sql_maker->{quote_char}; |
1718
|
3
|
|
|
|
|
9
|
local $sql_maker->{name_sep} = $sql_maker->{name_sep}; |
1719
|
3
|
50
|
33
|
|
|
17
|
unless (defined $sql_maker->{quote_char} and length $sql_maker->{quote_char}) { |
1720
|
3
|
|
|
|
|
9
|
$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
|
3
|
|
|
|
|
7
|
$sql_maker->{name_sep} = ''; |
1724
|
|
|
|
|
|
|
} |
1725
|
|
|
|
|
|
|
|
1726
|
3
|
|
|
|
|
20
|
my ($lquote, $rquote, $sep) = map { quotemeta $_ } ($sql_maker->_quote_chars, $sql_maker->name_sep); |
|
9
|
|
|
|
|
23
|
|
1727
|
|
|
|
|
|
|
|
1728
|
3
|
|
|
|
|
29
|
my $having_sql = $sql_maker->_parse_rs_attrs ({ having => $attrs->{having} }); |
1729
|
3
|
|
|
|
|
9
|
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
|
3
|
|
|
|
|
260
|
while ($having_sql =~ / |
1734
|
|
|
|
|
|
|
$rquote $sep $lquote (.+?) $rquote |
1735
|
|
|
|
|
|
|
| |
1736
|
|
|
|
|
|
|
[\s,] \w+ \. (\w+) [\s,] |
1737
|
|
|
|
|
|
|
| |
1738
|
|
|
|
|
|
|
[\s,] $lquote (.+?) $rquote [\s,] |
1739
|
|
|
|
|
|
|
/gx) { |
1740
|
3
|
|
33
|
|
|
24
|
my $part = $1 || $2 || $3; # one of them matched if we got here |
1741
|
3
|
100
|
|
|
|
25
|
unless ($seen_having{$part}++) { |
1742
|
2
|
|
|
|
|
30
|
push @parts, $part; |
1743
|
|
|
|
|
|
|
} |
1744
|
|
|
|
|
|
|
} |
1745
|
|
|
|
|
|
|
} |
1746
|
|
|
|
|
|
|
|
1747
|
90
|
|
|
|
|
161
|
for (@parts) { |
1748
|
140
|
|
66
|
|
|
423
|
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
|
140
|
100
|
100
|
|
|
1163
|
if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) { |
1754
|
3
|
|
|
|
|
5
|
my $as = $colpiece; |
1755
|
3
|
|
|
|
|
10
|
$as =~ s/\./__/; |
1756
|
3
|
|
|
|
|
5
|
$colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) ); |
|
6
|
|
|
|
|
59
|
|
1757
|
|
|
|
|
|
|
} |
1758
|
140
|
|
|
|
|
180
|
push @{$sub_attrs->{select}}, $colpiece; |
|
140
|
|
|
|
|
436
|
|
1759
|
|
|
|
|
|
|
} |
1760
|
|
|
|
|
|
|
} |
1761
|
|
|
|
|
|
|
else { |
1762
|
3
|
|
|
|
|
31
|
my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns); |
|
3
|
|
|
|
|
13
|
|
1763
|
3
|
50
|
|
|
|
11
|
$sub_attrs->{select} = @pcols ? \@pcols : [ 1 ]; |
1764
|
|
|
|
|
|
|
} |
1765
|
|
|
|
|
|
|
|
1766
|
93
|
|
|
|
|
1960
|
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
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
B: C is provided for Class::DBI compatibility and |
1777
|
|
|
|
|
|
|
should only be used in that context. See L 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
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
Counts the results in a literal query. Equivalent to calling L |
1788
|
|
|
|
|
|
|
with the passed arguments, then L. |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
=cut |
1791
|
|
|
|
|
|
|
|
1792
|
0
|
|
|
0
|
1
|
0
|
sub 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
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
Returns all elements in the resultset. |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
=cut |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
sub all { |
1809
|
1677
|
|
|
1677
|
1
|
245662
|
my $self = shift; |
1810
|
1677
|
50
|
|
|
|
4771
|
if(@_) { |
1811
|
0
|
|
|
|
|
0
|
$self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()"); |
1812
|
|
|
|
|
|
|
} |
1813
|
|
|
|
|
|
|
|
1814
|
1677
|
|
|
|
|
2659
|
delete @{$self}{qw/_stashed_rows _stashed_results/}; |
|
1677
|
|
|
|
|
4188
|
|
1815
|
|
|
|
|
|
|
|
1816
|
1677
|
100
|
|
|
|
3843
|
if (my $c = $self->get_cache) { |
1817
|
66
|
|
|
|
|
317
|
return @$c; |
1818
|
|
|
|
|
|
|
} |
1819
|
|
|
|
|
|
|
|
1820
|
1611
|
|
|
|
|
4345
|
$self->cursor->reset; |
1821
|
|
|
|
|
|
|
|
1822
|
1611
|
|
100
|
|
|
4743
|
my $objs = $self->_construct_results('fetch_all') || []; |
1823
|
|
|
|
|
|
|
|
1824
|
1590
|
100
|
|
|
|
5191
|
$self->set_cache($objs) if $self->{attrs}{cache}; |
1825
|
|
|
|
|
|
|
|
1826
|
1590
|
|
|
|
|
7809
|
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
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
Resets the resultset's cursor, so you can iterate through the elements again. |
1840
|
|
|
|
|
|
|
Implicitly resets the storage cursor, so a subsequent L will trigger |
1841
|
|
|
|
|
|
|
another query. |
1842
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
=cut |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
sub reset { |
1846
|
1523
|
|
|
1523
|
1
|
2463
|
my ($self) = @_; |
1847
|
|
|
|
|
|
|
|
1848
|
1523
|
|
|
|
|
2336
|
delete @{$self}{qw/_stashed_rows _stashed_results/}; |
|
1523
|
|
|
|
|
3465
|
|
1849
|
1523
|
|
|
|
|
3126
|
$self->{all_cache_position} = 0; |
1850
|
1523
|
|
|
|
|
4167
|
$self->cursor->reset; |
1851
|
1523
|
|
|
|
|
4126
|
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
|
|
|
|
|
|
|
|
1864
|
|
|
|
|
|
|
L the resultset (causing a fresh query to storage) and returns |
1865
|
|
|
|
|
|
|
an object for the first result (or C if the resultset is empty). |
1866
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
=cut |
1868
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
sub first { |
1870
|
884
|
|
|
884
|
1
|
82303
|
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
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
sub _rs_update_delete { |
1881
|
602
|
|
|
602
|
|
967
|
my ($self, $op, $values) = @_; |
1882
|
|
|
|
|
|
|
|
1883
|
602
|
|
|
|
|
1627
|
my $rsrc = $self->result_source; |
1884
|
602
|
|
|
|
|
2588
|
my $storage = $rsrc->schema->storage; |
1885
|
|
|
|
|
|
|
|
1886
|
602
|
|
|
|
|
6410
|
my $attrs = { %{$self->_resolved_attrs} }; |
|
602
|
|
|
|
|
1892
|
|
1887
|
|
|
|
|
|
|
|
1888
|
602
|
|
|
|
|
1390
|
my $join_classifications; |
1889
|
602
|
|
|
|
|
857
|
my ($existing_group_by) = delete @{$attrs}{qw(group_by _grouped_by_distinct)}; |
|
602
|
|
|
|
|
1501
|
|
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
# do we need a subquery for any reason? |
1892
|
|
|
|
|
|
|
my $needs_subq = ( |
1893
|
|
|
|
|
|
|
defined $existing_group_by |
1894
|
|
|
|
|
|
|
or |
1895
|
|
|
|
|
|
|
# if {from} is unparseable wrap a subq |
1896
|
602
|
|
100
|
|
|
5182
|
ref($attrs->{from}) ne 'ARRAY' |
1897
|
|
|
|
|
|
|
or |
1898
|
|
|
|
|
|
|
# limits call for a subq |
1899
|
|
|
|
|
|
|
$self->_has_resolved_attr(qw/rows offset/) |
1900
|
|
|
|
|
|
|
); |
1901
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
# simplify the joinmap, so we can further decide if a subq is necessary |
1903
|
602
|
100
|
100
|
|
|
2268
|
if (!$needs_subq and @{$attrs->{from}} > 1) { |
|
597
|
|
|
|
|
2288
|
|
1904
|
|
|
|
|
|
|
|
1905
|
19
|
|
|
|
|
171
|
($attrs->{from}, $join_classifications) = |
1906
|
|
|
|
|
|
|
$storage->_prune_unused_joins ($attrs); |
1907
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
# any non-pruneable non-local restricting joins imply subq |
1909
|
19
|
50
|
|
25
|
|
92
|
$needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} }; |
|
25
|
|
|
|
|
56
|
|
|
19
|
|
|
|
|
107
|
|
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
|
602
|
|
66
|
|
|
5416
|
); |
|
|
|
100
|
|
|
|
|
1918
|
|
|
|
|
|
|
|
1919
|
602
|
|
|
|
|
646
|
my ($cond, $guard); |
1920
|
|
|
|
|
|
|
# do we need anything like a subquery? |
1921
|
602
|
100
|
|
|
|
1259
|
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
|
571
|
|
|
|
|
545
|
$cond = do { |
1926
|
571
|
|
|
|
|
2182
|
my $sqla = $rsrc->storage->sql_maker; |
1927
|
571
|
|
|
|
|
1711
|
local $sqla->{_dequalify_idents} = 1; |
1928
|
571
|
|
|
|
|
2439
|
\[ $sqla->_recurse_where($self->{cond}) ]; |
1929
|
|
|
|
|
|
|
}; |
1930
|
|
|
|
|
|
|
} |
1931
|
|
|
|
|
|
|
else { |
1932
|
|
|
|
|
|
|
# we got this far - means it is time to wrap a subquery |
1933
|
31
|
|
33
|
|
|
236
|
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
|
31
|
|
|
|
|
138
|
delete $attrs->{$_} for qw/select as collapse/; |
1943
|
31
|
|
|
|
|
72
|
$attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$idcols ]; |
|
66
|
|
|
|
|
183
|
|
1944
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
# this will be consumed by the pruner waaaaay down the stack |
1946
|
31
|
|
|
|
|
84
|
$attrs->{_force_prune_multiplying_joins} = 1; |
1947
|
|
|
|
|
|
|
|
1948
|
31
|
|
|
|
|
140
|
my $subrs = (ref $self)->new($rsrc, $attrs); |
1949
|
|
|
|
|
|
|
|
1950
|
31
|
100
|
|
|
|
357
|
if (@$idcols == 1) { |
|
|
100
|
|
|
|
|
|
1951
|
20
|
|
|
|
|
142
|
$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
|
1
|
|
|
|
|
17
|
$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
|
10
|
100
|
100
|
|
|
29
|
if ( |
1966
|
|
|
|
|
|
|
$existing_group_by |
1967
|
|
|
|
|
|
|
or |
1968
|
|
|
|
|
|
|
# we do not need to check pre-multipliers, since if the premulti is there, its |
1969
|
|
|
|
|
|
|
# parent (who is multi) will be there too |
1970
|
8
|
100
|
|
|
|
60
|
keys %{ $join_classifications->{multiplying} || {} } |
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
|
5
|
100
|
|
|
|
13
|
if ($existing_group_by) { |
1976
|
|
|
|
|
|
|
my @current_group_by = map |
1977
|
2
|
100
|
|
|
|
4
|
{ $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" } |
|
14
|
|
|
|
|
28
|
|
1978
|
|
|
|
|
|
|
@$existing_group_by |
1979
|
|
|
|
|
|
|
; |
1980
|
|
|
|
|
|
|
|
1981
|
2
|
100
|
|
|
|
13
|
if ( |
1982
|
|
|
|
|
|
|
join ("\x00", sort @current_group_by) |
1983
|
|
|
|
|
|
|
ne |
1984
|
2
|
|
|
|
|
14
|
join ("\x00", sort @{$attrs->{columns}} ) |
1985
|
|
|
|
|
|
|
) { |
1986
|
1
|
|
|
|
|
20
|
$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
|
4
|
|
|
|
|
17
|
$subrs = $subrs->search({}, { group_by => $attrs->{columns} }); |
1997
|
|
|
|
|
|
|
} |
1998
|
|
|
|
|
|
|
|
1999
|
9
|
|
|
|
|
61
|
$guard = $storage->txn_scope_guard; |
2000
|
|
|
|
|
|
|
|
2001
|
9
|
|
|
|
|
38
|
for my $row ($subrs->cursor->all) { |
2002
|
|
|
|
|
|
|
push @$cond, { map |
2003
|
19
|
|
|
|
|
44
|
{ $idcols->[$_] => $row->[$_] } |
|
66
|
|
|
|
|
146
|
|
2004
|
|
|
|
|
|
|
(0 .. $#$idcols) |
2005
|
|
|
|
|
|
|
}; |
2006
|
|
|
|
|
|
|
} |
2007
|
|
|
|
|
|
|
} |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
|
2010
|
601
|
100
|
|
|
|
103812
|
my $res = $cond ? $storage->$op ( |
|
|
100
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
$rsrc, |
2012
|
|
|
|
|
|
|
$op eq 'update' ? $values : (), |
2013
|
|
|
|
|
|
|
$cond, |
2014
|
|
|
|
|
|
|
) : '0E0'; |
2015
|
|
|
|
|
|
|
|
2016
|
596
|
100
|
|
|
|
3842
|
$guard->commit if $guard; |
2017
|
|
|
|
|
|
|
|
2018
|
596
|
|
|
|
|
4833
|
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
|
|
|
|
|
|
|
|
2031
|
|
|
|
|
|
|
Sets the specified columns in the resultset to the supplied values in a |
2032
|
|
|
|
|
|
|
single query. Note that this will not run any accessor/set_column/update |
2033
|
|
|
|
|
|
|
triggers, nor will it update any result object instances derived from this |
2034
|
|
|
|
|
|
|
resultset (this includes the contents of the L |
2035
|
|
|
|
|
|
|
if any). See L if you need to execute any on-update |
2036
|
|
|
|
|
|
|
triggers or cascades defined either by you or a |
2037
|
|
|
|
|
|
|
L. |
2038
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
The return value is a pass through of what the underlying |
2040
|
|
|
|
|
|
|
storage backend returned, and may vary. See L for the most |
2041
|
|
|
|
|
|
|
common case. |
2042
|
|
|
|
|
|
|
|
2043
|
|
|
|
|
|
|
=head3 CAVEAT |
2044
|
|
|
|
|
|
|
|
2045
|
|
|
|
|
|
|
Note that L does not process/deflate any of the values passed in. |
2046
|
|
|
|
|
|
|
This is unlike the corresponding L. The user must |
2047
|
|
|
|
|
|
|
ensure manually that any value passed to this method will stringify to |
2048
|
|
|
|
|
|
|
something the RDBMS knows how to deal with. A notable example is the |
2049
|
|
|
|
|
|
|
handling of L objects, for more info see: |
2050
|
|
|
|
|
|
|
L. |
2051
|
|
|
|
|
|
|
|
2052
|
|
|
|
|
|
|
=cut |
2053
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
sub update { |
2055
|
496
|
|
|
496
|
1
|
4354
|
my ($self, $values) = @_; |
2056
|
496
|
50
|
|
|
|
1478
|
$self->throw_exception('Values for update must be a hash') |
2057
|
|
|
|
|
|
|
unless ref $values eq 'HASH'; |
2058
|
|
|
|
|
|
|
|
2059
|
496
|
|
|
|
|
1841
|
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
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
Fetches all objects and updates them one at a time via |
2073
|
|
|
|
|
|
|
L. Note that C will run DBIC defined |
2074
|
|
|
|
|
|
|
triggers, while L will not. |
2075
|
|
|
|
|
|
|
|
2076
|
|
|
|
|
|
|
=cut |
2077
|
|
|
|
|
|
|
|
2078
|
|
|
|
|
|
|
sub update_all { |
2079
|
1
|
|
|
1
|
1
|
712
|
my ($self, $values) = @_; |
2080
|
1
|
50
|
|
|
|
5
|
$self->throw_exception('Values for update_all must be a hash') |
2081
|
|
|
|
|
|
|
unless ref $values eq 'HASH'; |
2082
|
|
|
|
|
|
|
|
2083
|
1
|
|
|
|
|
6
|
my $guard = $self->result_source->schema->txn_scope_guard; |
2084
|
1
|
|
|
|
|
7
|
$_->update({%$values}) for $self->all; # shallow copy - update will mangle it |
2085
|
1
|
|
|
|
|
13
|
$guard->commit; |
2086
|
1
|
|
|
|
|
2
|
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
|
|
|
|
|
|
|
|
2099
|
|
|
|
|
|
|
Deletes the rows matching this resultset in a single query. Note that this |
2100
|
|
|
|
|
|
|
will not run any delete triggers, nor will it alter the |
2101
|
|
|
|
|
|
|
L status of any result object instances |
2102
|
|
|
|
|
|
|
derived from this resultset (this includes the contents of the |
2103
|
|
|
|
|
|
|
L if any). See L if you need to |
2104
|
|
|
|
|
|
|
execute any on-delete triggers or cascades defined either by you or a |
2105
|
|
|
|
|
|
|
L. |
2106
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
The return value is a pass through of what the underlying storage backend |
2108
|
|
|
|
|
|
|
returned, and may vary. See L for the most common case. |
2109
|
|
|
|
|
|
|
|
2110
|
|
|
|
|
|
|
=cut |
2111
|
|
|
|
|
|
|
|
2112
|
|
|
|
|
|
|
sub delete { |
2113
|
106
|
|
|
106
|
1
|
3133
|
my $self = shift; |
2114
|
106
|
50
|
|
|
|
334
|
$self->throw_exception('delete does not accept any arguments') |
2115
|
|
|
|
|
|
|
if @_; |
2116
|
|
|
|
|
|
|
|
2117
|
106
|
|
|
|
|
378
|
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
|
|
|
|
|
|
|
|
2130
|
|
|
|
|
|
|
Fetches all objects and deletes them one at a time via |
2131
|
|
|
|
|
|
|
L. Note that C will run DBIC defined |
2132
|
|
|
|
|
|
|
triggers, while L will not. |
2133
|
|
|
|
|
|
|
|
2134
|
|
|
|
|
|
|
=cut |
2135
|
|
|
|
|
|
|
|
2136
|
|
|
|
|
|
|
sub delete_all { |
2137
|
270
|
|
|
270
|
1
|
558
|
my $self = shift; |
2138
|
270
|
50
|
|
|
|
611
|
$self->throw_exception('delete_all does not accept any arguments') |
2139
|
|
|
|
|
|
|
if @_; |
2140
|
|
|
|
|
|
|
|
2141
|
270
|
|
|
|
|
1115
|
my $guard = $self->result_source->schema->txn_scope_guard; |
2142
|
270
|
|
|
|
|
821
|
$_->delete for $self->all; |
2143
|
270
|
|
|
|
|
1107
|
$guard->commit; |
2144
|
270
|
|
|
|
|
1088
|
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
|
|
|
|
|
|
|
|
2157
|
|
|
|
|
|
|
Accepts either an arrayref of hashrefs or alternatively an arrayref of |
2158
|
|
|
|
|
|
|
arrayrefs. |
2159
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
=over |
2161
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
=item NOTE |
2163
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
The context of this method call has an important effect on what is |
2165
|
|
|
|
|
|
|
submitted to storage. In void context data is fed directly to fastpath |
2166
|
|
|
|
|
|
|
insertion routines provided by the underlying storage (most often |
2167
|
|
|
|
|
|
|
L), bypassing the L and |
2168
|
|
|
|
|
|
|
L calls on the |
2169
|
|
|
|
|
|
|
L class, including any |
2170
|
|
|
|
|
|
|
augmentation of these methods provided by components. For example if you |
2171
|
|
|
|
|
|
|
are using something like L to create primary |
2172
|
|
|
|
|
|
|
keys for you, you will find that your PKs are empty. In this case you |
2173
|
|
|
|
|
|
|
will have to explicitly force scalar or list context in order to create |
2174
|
|
|
|
|
|
|
those values. |
2175
|
|
|
|
|
|
|
|
2176
|
|
|
|
|
|
|
=back |
2177
|
|
|
|
|
|
|
|
2178
|
|
|
|
|
|
|
In non-void (scalar or list) context, this method is simply a wrapper |
2179
|
|
|
|
|
|
|
for L. Depending on list or scalar context either a list of |
2180
|
|
|
|
|
|
|
L objects or an arrayref |
2181
|
|
|
|
|
|
|
containing these objects is returned. |
2182
|
|
|
|
|
|
|
|
2183
|
|
|
|
|
|
|
When supplying data in "arrayref of arrayrefs" invocation style, the |
2184
|
|
|
|
|
|
|
first element should be a list of column names and each subsequent |
2185
|
|
|
|
|
|
|
element should be a data value in the earlier specified column order. |
2186
|
|
|
|
|
|
|
For 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
|
|
|
|
|
|
|
|
2195
|
|
|
|
|
|
|
For the arrayref of hashrefs style each hashref should be a structure |
2196
|
|
|
|
|
|
|
suitable for passing to L. Multi-create is also permitted with |
2197
|
|
|
|
|
|
|
this 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
|
|
|
|
|
|
|
|
2213
|
|
|
|
|
|
|
If you attempt a void-context multi-create as in the example above (each |
2214
|
|
|
|
|
|
|
Artist also has the related list of CDs), and B supply the |
2215
|
|
|
|
|
|
|
necessary autoinc foreign key information, this method will proxy to the |
2216
|
|
|
|
|
|
|
less efficient L, and then throw the Result objects away. In this |
2217
|
|
|
|
|
|
|
case there are obviously no benefits to using this method over L. |
2218
|
|
|
|
|
|
|
|
2219
|
|
|
|
|
|
|
=cut |
2220
|
|
|
|
|
|
|
|
2221
|
|
|
|
|
|
|
sub populate { |
2222
|
7705
|
|
|
7705
|
1
|
14279
|
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
|
7705
|
50
|
33
|
|
|
20951
|
( @{$_[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
|
7698
|
100
|
|
|
|
13532
|
if(defined wantarray) { |
2241
|
41
|
|
|
|
|
82
|
my (@results, $guard); |
2242
|
|
|
|
|
|
|
|
2243
|
41
|
100
|
|
|
|
145
|
if (ref $data->[0] eq 'ARRAY') { |
2244
|
|
|
|
|
|
|
# column names only, nothing to do |
2245
|
21
|
100
|
|
|
|
64
|
return if @$data == 1; |
2246
|
|
|
|
|
|
|
|
2247
|
17
|
100
|
|
|
|
92
|
$guard = $self->result_source->schema->storage->txn_scope_guard |
2248
|
|
|
|
|
|
|
if @$data > 2; |
2249
|
|
|
|
|
|
|
|
2250
|
|
|
|
|
|
|
@results = map |
2251
|
46
|
|
|
|
|
67
|
{ my $vals = $_; $self->new_result({ map { $data->[0][$_] => $vals->[$_] } 0..$#{$data->[0]} })->insert } |
|
46
|
|
|
|
|
63
|
|
|
108
|
|
|
|
|
345
|
|
|
46
|
|
|
|
|
86
|
|
2252
|
17
|
|
|
|
|
44
|
@{$data}[1 .. $#$data] |
|
17
|
|
|
|
|
39
|
|
2253
|
|
|
|
|
|
|
; |
2254
|
|
|
|
|
|
|
} |
2255
|
|
|
|
|
|
|
else { |
2256
|
|
|
|
|
|
|
|
2257
|
20
|
100
|
|
|
|
128
|
$guard = $self->result_source->schema->storage->txn_scope_guard |
2258
|
|
|
|
|
|
|
if @$data > 1; |
2259
|
|
|
|
|
|
|
|
2260
|
20
|
|
|
|
|
60
|
@results = map { $self->new_result($_)->insert } @$data; |
|
56
|
|
|
|
|
219
|
|
2261
|
|
|
|
|
|
|
} |
2262
|
|
|
|
|
|
|
|
2263
|
37
|
100
|
|
|
|
203
|
$guard->commit if $guard; |
2264
|
37
|
100
|
|
|
|
252
|
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
|
7657
|
|
|
|
|
12461
|
my $rsrc = $self->result_source; |
2272
|
7657
|
|
|
|
|
47008
|
my $rel_info = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships }; |
|
21457
|
|
|
|
|
33605
|
|
2273
|
|
|
|
|
|
|
|
2274
|
7657
|
|
|
|
|
9582
|
my ($colinfo, $colnames, $slices_with_rels); |
2275
|
7657
|
|
|
|
|
7577
|
my $data_start = 0; |
2276
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
DATA_SLICE: |
2278
|
7657
|
|
|
|
|
16966
|
for my $i (0 .. $#$data) { |
2279
|
|
|
|
|
|
|
|
2280
|
44501
|
|
|
|
|
30671
|
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
|
44501
|
100
|
|
|
|
58735
|
if( ref $data->[$i] eq 'ARRAY' ) { |
|
|
50
|
|
|
|
|
|
2285
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
# positional(!) explicit column list |
2287
|
44395
|
100
|
|
|
|
45214
|
if ($i == 0) { |
2288
|
|
|
|
|
|
|
# column names only, nothing to do |
2289
|
7613
|
100
|
|
|
|
14682
|
return if @$data == 1; |
2290
|
|
|
|
|
|
|
|
2291
|
|
|
|
|
|
|
$colinfo->{$data->[0][$_]} = { pos => $_, name => $data->[0][$_] } and push @$colnames, $data->[0][$_] |
2292
|
7611
|
|
33
|
|
|
6712
|
for 0 .. $#{$data->[0]}; |
|
7611
|
|
|
|
|
81447
|
|
2293
|
|
|
|
|
|
|
|
2294
|
7611
|
|
|
|
|
8531
|
$data_start = 1; |
2295
|
|
|
|
|
|
|
|
2296
|
7611
|
|
|
|
|
12727
|
next DATA_SLICE; |
2297
|
|
|
|
|
|
|
} |
2298
|
|
|
|
|
|
|
else { |
2299
|
36782
|
|
|
|
|
45899
|
for (values %$colinfo) { |
2300
|
102956
|
100
|
100
|
|
|
468901
|
if ($_->{is_rel} ||= ( |
|
|
|
100
|
|
|
|
|
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
|
4
|
50
|
|
|
|
11
|
for ( ref $data->[$i][$_->{pos}] eq 'ARRAY' ? @{$data->[$i][$_->{pos}]} : $data->[$i][$_->{pos}] ) { |
|
4
|
|
|
|
|
9
|
|
2316
|
5
|
50
|
33
|
|
|
21
|
if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) { |
2317
|
0
|
|
|
|
|
0
|
carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()"); |
2318
|
0
|
|
|
|
|
0
|
return my $throwaway = $self->populate(@_); |
2319
|
|
|
|
|
|
|
} |
2320
|
|
|
|
|
|
|
} |
2321
|
|
|
|
|
|
|
|
2322
|
4
|
|
|
|
|
13
|
push @$current_slice_seen_rel_infos, $rel_info->{$_->{name}}; |
2323
|
|
|
|
|
|
|
} |
2324
|
|
|
|
|
|
|
} |
2325
|
|
|
|
|
|
|
} |
2326
|
|
|
|
|
|
|
|
2327
|
36782
|
100
|
|
|
|
45719
|
if ($current_slice_seen_rel_infos) { |
2328
|
4
|
|
|
|
|
11
|
push @$slices_with_rels, { map { $colnames->[$_] => $data->[$i][$_] } 0 .. $#$colnames }; |
|
8
|
|
|
|
|
23
|
|
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
|
4
|
|
66
|
|
|
38
|
for 0 .. $#$colnames; |
2333
|
|
|
|
|
|
|
} |
2334
|
|
|
|
|
|
|
} |
2335
|
|
|
|
|
|
|
elsif( ref $data->[$i] eq 'HASH' ) { |
2336
|
|
|
|
|
|
|
|
2337
|
106
|
|
|
|
|
107
|
for ( sort keys %{$data->[$i]} ) { |
|
106
|
|
|
|
|
311
|
|
2338
|
|
|
|
|
|
|
|
2339
|
224
|
|
66
|
|
|
411
|
$colinfo->{$_} ||= do { |
2340
|
|
|
|
|
|
|
|
2341
|
97
|
50
|
|
|
|
172
|
$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
|
97
|
|
|
|
|
142
|
push @$colnames, $_; |
2345
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
# RV |
2347
|
97
|
|
|
|
|
327
|
{ pos => $#$colnames, name => $_ } |
2348
|
|
|
|
|
|
|
}; |
2349
|
|
|
|
|
|
|
|
2350
|
224
|
100
|
100
|
|
|
2678
|
if ($colinfo->{$_}{is_rel} ||= ( |
|
|
|
100
|
|
|
|
|
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
|
12
|
100
|
|
|
|
34
|
for ( ref $data->[$i]{$_} eq 'ARRAY' ? @{$data->[$i]{$_}} : $data->[$i]{$_} ) { |
|
10
|
|
|
|
|
23
|
|
2366
|
18
|
100
|
66
|
|
|
59
|
if ( defined blessed $_ and $_->isa('DBIx::Class::Row' ) ) { |
2367
|
1
|
|
|
|
|
4
|
carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()"); |
2368
|
1
|
|
|
|
|
84
|
return my $throwaway = $self->populate(@_); |
2369
|
|
|
|
|
|
|
} |
2370
|
|
|
|
|
|
|
} |
2371
|
|
|
|
|
|
|
|
2372
|
11
|
|
|
|
|
23
|
push @$current_slice_seen_rel_infos, $rel_info->{$_}; |
2373
|
|
|
|
|
|
|
} |
2374
|
|
|
|
|
|
|
} |
2375
|
|
|
|
|
|
|
|
2376
|
105
|
100
|
|
|
|
188
|
if ($current_slice_seen_rel_infos) { |
2377
|
11
|
|
|
|
|
17
|
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
|
11
|
|
66
|
|
|
15
|
for keys %{$data->[$i]}; |
|
11
|
|
|
|
|
109
|
|
2382
|
|
|
|
|
|
|
} |
2383
|
|
|
|
|
|
|
} |
2384
|
|
|
|
|
|
|
else { |
2385
|
0
|
|
|
|
|
0
|
$self->throw_exception('Unexpected populate() data structure member type: ' . ref $data->[$i] ); |
2386
|
|
|
|
|
|
|
} |
2387
|
|
|
|
|
|
|
|
2388
|
36887
|
100
|
|
|
|
24373
|
if ( grep |
2389
|
15
|
|
|
|
|
60
|
{ $_->{attrs}{is_depends_on} } |
2390
|
36887
|
100
|
|
|
|
129183
|
@{ $current_slice_seen_rel_infos || [] } |
2391
|
|
|
|
|
|
|
) { |
2392
|
2
|
|
|
|
|
11
|
carp_unique("Fast-path populate() of belongs_to relationship data is not possible - falling back to regular create()"); |
2393
|
2
|
|
|
|
|
214
|
return my $throwaway = $self->populate(@_); |
2394
|
|
|
|
|
|
|
} |
2395
|
|
|
|
|
|
|
} |
2396
|
|
|
|
|
|
|
|
2397
|
7652
|
100
|
|
|
|
12934
|
if( $slices_with_rels ) { |
2398
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
# need to exclude the rel "columns" |
2400
|
5
|
|
|
|
|
9
|
$colnames = [ grep { ! $colinfo->{$_}{is_rel} } @$colnames ]; |
|
15
|
|
|
|
|
32
|
|
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
|
5
|
|
|
|
|
24
|
my $ci = $rsrc->columns_info($colnames); |
2405
|
|
|
|
|
|
|
|
2406
|
8
|
|
|
|
|
39
|
$ci->{$_} = { %{$ci->{$_}}, is_nullable => 0 } |
2407
|
5
|
|
|
|
|
18
|
for grep { ! $colinfo->{$_}{seen_null} } keys %$ci; |
|
10
|
|
|
|
|
25
|
|
2408
|
|
|
|
|
|
|
|
2409
|
5
|
100
|
|
|
|
35
|
unless( $rsrc->_identifying_column_set($ci) ) { |
2410
|
1
|
|
|
|
|
7
|
carp_unique("Fast-path populate() of non-uniquely identifiable rows with related data is not possible - falling back to regular create()"); |
2411
|
1
|
|
|
|
|
148
|
return my $throwaway = $self->populate(@_); |
2412
|
|
|
|
|
|
|
} |
2413
|
|
|
|
|
|
|
} |
2414
|
|
|
|
|
|
|
|
2415
|
|
|
|
|
|
|
### inherit the data locked in the conditions of the resultset |
2416
|
7651
|
|
|
|
|
17582
|
my ($rs_data) = $self->_merge_with_rscond({}); |
2417
|
7651
|
|
|
|
|
10066
|
delete @{$rs_data}{@$colnames}; # passed-in stuff takes precedence |
|
7651
|
|
|
|
|
11211
|
|
2418
|
|
|
|
|
|
|
|
2419
|
|
|
|
|
|
|
# if anything left - decompose rs_data |
2420
|
7651
|
|
|
|
|
6481
|
my $rs_data_vals; |
2421
|
7651
|
100
|
|
|
|
15293
|
if (keys %$rs_data) { |
2422
|
|
|
|
|
|
|
push @$rs_data_vals, $rs_data->{$_} |
2423
|
9
|
|
|
|
|
43
|
for sort keys %$rs_data; |
2424
|
|
|
|
|
|
|
} |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
### start work |
2427
|
7651
|
|
|
|
|
7033
|
my $guard; |
2428
|
7651
|
100
|
|
|
|
11202
|
$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
|
7651
|
|
|
|
|
20159
|
ref $data->[$_] eq 'ARRAY' |
2439
|
|
|
|
|
|
|
? ( |
2440
|
0
|
0
|
|
|
|
0
|
$slices_with_rels ? [ @{$data->[$_]}[0..$#$colnames], @{$rs_data_vals||[]} ] # the collist changed |
|
0
|
|
|
|
|
0
|
|
2441
|
0
|
|
|
|
|
0
|
: $rs_data_vals ? [ @{$data->[$_]}, @$rs_data_vals ] |
2442
|
|
|
|
|
|
|
: $data->[$_] |
2443
|
|
|
|
|
|
|
) |
2444
|
36881
|
50
|
|
|
|
292852
|
: [ @{$data->[$_]}{@$colnames}, @{$rs_data_vals||[]} ] |
|
103
|
50
|
|
|
|
129
|
|
|
103
|
100
|
|
|
|
1043
|
|
|
|
100
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
} $data_start .. $#$data ], |
2446
|
|
|
|
|
|
|
); |
2447
|
|
|
|
|
|
|
|
2448
|
|
|
|
|
|
|
### do the children relationships |
2449
|
7644
|
100
|
|
|
|
24165
|
if ( $slices_with_rels ) { |
2450
|
4
|
50
|
|
|
|
14
|
my @rels = grep { $colinfo->{$_}{is_rel} } keys %$colinfo |
|
13
|
|
|
|
|
32
|
|
2451
|
|
|
|
|
|
|
or die 'wtf... please report a bug with DBIC_TRACE=1 output (stacktrace)'; |
2452
|
|
|
|
|
|
|
|
2453
|
4
|
|
|
|
|
11
|
for my $sl (@$slices_with_rels) { |
2454
|
|
|
|
|
|
|
|
2455
|
9
|
|
|
|
|
12
|
my ($main_proto, $main_proto_rs); |
2456
|
9
|
|
|
|
|
18
|
for my $rel (@rels) { |
2457
|
9
|
50
|
|
|
|
25
|
next unless defined $sl->{$rel}; |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
$main_proto ||= { |
2460
|
|
|
|
|
|
|
%$rs_data, |
2461
|
9
|
|
50
|
|
|
41
|
(map { $_ => $sl->{$_} } @$colnames), |
|
17
|
|
|
|
|
56
|
|
2462
|
|
|
|
|
|
|
}; |
2463
|
|
|
|
|
|
|
|
2464
|
9
|
100
|
|
|
|
29
|
unless (defined $colinfo->{$rel}{rs}) { |
2465
|
|
|
|
|
|
|
|
2466
|
4
|
|
|
|
|
21
|
$colinfo->{$rel}{rs} = $rsrc->related_source($rel)->resultset; |
2467
|
|
|
|
|
|
|
|
2468
|
4
|
|
|
|
|
27
|
$colinfo->{$rel}{fk_map} = { reverse %{ $rsrc->_resolve_relationship_condition( |
2469
|
|
|
|
|
|
|
rel_name => $rel, |
2470
|
|
|
|
|
|
|
self_alias => "\xFE", # irrelevant |
2471
|
|
|
|
|
|
|
foreign_alias => "\xFF", # irrelevant |
2472
|
4
|
50
|
|
|
|
23
|
)->{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
|
10
|
|
66
|
|
|
61
|
->get_column( $colinfo->{$rel}{fk_map}{$_} ) |
2481
|
|
|
|
|
|
|
->as_query |
2482
|
|
|
|
|
|
|
} |
2483
|
|
|
|
|
|
|
} |
2484
|
9
|
|
|
|
|
27
|
keys %{$colinfo->{$rel}{fk_map}} |
2485
|
9
|
50
|
|
|
|
22
|
})->populate( ref $sl->{$rel} eq 'ARRAY' ? $sl->{$rel} : [ $sl->{$rel} ] ); |
2486
|
|
|
|
|
|
|
|
2487
|
9
|
|
|
|
|
33
|
1; |
2488
|
|
|
|
|
|
|
} |
2489
|
|
|
|
|
|
|
} |
2490
|
|
|
|
|
|
|
} |
2491
|
|
|
|
|
|
|
|
2492
|
7644
|
100
|
|
|
|
59365
|
$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
|
|
|
|
|
|
|
|
2505
|
|
|
|
|
|
|
Returns a L object for the current resultset. Only makes |
2506
|
|
|
|
|
|
|
sense for queries with a C attribute. |
2507
|
|
|
|
|
|
|
|
2508
|
|
|
|
|
|
|
To get the full count of entries for a paged resultset, call |
2509
|
|
|
|
|
|
|
C on the L object. |
2510
|
|
|
|
|
|
|
|
2511
|
|
|
|
|
|
|
=cut |
2512
|
|
|
|
|
|
|
|
2513
|
|
|
|
|
|
|
sub pager { |
2514
|
28
|
|
|
28
|
1
|
4937
|
my ($self) = @_; |
2515
|
|
|
|
|
|
|
|
2516
|
28
|
100
|
|
|
|
103
|
return $self->{pager} if $self->{pager}; |
2517
|
|
|
|
|
|
|
|
2518
|
16
|
|
|
|
|
22
|
my $attrs = $self->{attrs}; |
2519
|
16
|
50
|
|
|
|
54
|
if (!defined $attrs->{page}) { |
|
|
50
|
|
|
|
|
|
2520
|
0
|
|
|
|
|
0
|
$self->throw_exception("Can't create pager for non-paged rs"); |
2521
|
|
|
|
|
|
|
} |
2522
|
|
|
|
|
|
|
elsif ($attrs->{page} <= 0) { |
2523
|
0
|
|
|
|
|
0
|
$self->throw_exception('Invalid page number (page-numbers are 1-based)'); |
2524
|
|
|
|
|
|
|
} |
2525
|
16
|
|
50
|
|
|
29
|
$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
|
16
|
|
|
|
|
63
|
my $count_attrs = { %$attrs }; |
2530
|
16
|
|
|
|
|
29
|
delete @{$count_attrs}{qw/rows offset page pager/}; |
|
16
|
|
|
|
|
35
|
|
2531
|
|
|
|
|
|
|
|
2532
|
16
|
|
|
|
|
55
|
my $total_rs = (ref $self)->new($self->result_source, $count_attrs); |
2533
|
|
|
|
|
|
|
|
2534
|
16
|
|
|
|
|
1649
|
require DBIx::Class::ResultSet::Pager; |
2535
|
|
|
|
|
|
|
return $self->{pager} = DBIx::Class::ResultSet::Pager->new( |
2536
|
10
|
|
|
10
|
|
27
|
sub { $total_rs->count }, #lazy-get the total |
2537
|
|
|
|
|
|
|
$attrs->{rows}, |
2538
|
|
|
|
|
|
|
$self->{attrs}{page}, |
2539
|
16
|
|
|
|
|
144
|
); |
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
|
|
|
|
|
|
|
|
2552
|
|
|
|
|
|
|
Returns a resultset for the $page_number page of the resultset on which page |
2553
|
|
|
|
|
|
|
is called, where each page contains a number of rows equal to the 'rows' |
2554
|
|
|
|
|
|
|
attribute set on the resultset (10 by default). |
2555
|
|
|
|
|
|
|
|
2556
|
|
|
|
|
|
|
=cut |
2557
|
|
|
|
|
|
|
|
2558
|
|
|
|
|
|
|
sub page { |
2559
|
12
|
|
|
12
|
1
|
728
|
my ($self, $page) = @_; |
2560
|
12
|
|
|
|
|
30
|
return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page }); |
|
12
|
|
|
|
|
64
|
|
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
|
|
|
|
|
|
|
|
2573
|
|
|
|
|
|
|
Creates a new result object in the resultset's result class and returns |
2574
|
|
|
|
|
|
|
it. The row is not inserted into the database at this point, call |
2575
|
|
|
|
|
|
|
L to do that. Calling L |
2576
|
|
|
|
|
|
|
will tell you whether the result object has been inserted or not. |
2577
|
|
|
|
|
|
|
|
2578
|
|
|
|
|
|
|
Passes the hashref of input on to L. |
2579
|
|
|
|
|
|
|
|
2580
|
|
|
|
|
|
|
=cut |
2581
|
|
|
|
|
|
|
|
2582
|
|
|
|
|
|
|
sub new_result { |
2583
|
1492
|
|
|
1492
|
1
|
2070
|
my ($self, $values) = @_; |
2584
|
|
|
|
|
|
|
|
2585
|
1492
|
50
|
|
|
|
3898
|
$self->throw_exception( "new_result takes only one argument - a hashref of values" ) |
2586
|
|
|
|
|
|
|
if @_ > 2; |
2587
|
|
|
|
|
|
|
|
2588
|
1492
|
50
|
|
|
|
3900
|
$self->throw_exception( "Result object instantiation requires a hashref as argument" ) |
2589
|
|
|
|
|
|
|
unless (ref $values eq 'HASH'); |
2590
|
|
|
|
|
|
|
|
2591
|
1492
|
|
|
|
|
3561
|
my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values); |
2592
|
|
|
|
|
|
|
|
2593
|
1492
|
100
|
|
|
|
3994
|
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
|
1490
|
50
|
33
|
|
|
12395
|
if ( |
|
|
|
33
|
|
|
|
|
2603
|
|
|
|
|
|
|
reftype($new) eq 'HASH' |
2604
|
|
|
|
|
|
|
and |
2605
|
|
|
|
|
|
|
! keys %$new |
2606
|
|
|
|
|
|
|
and |
2607
|
|
|
|
|
|
|
blessed($new) |
2608
|
|
|
|
|
|
|
) { |
2609
|
0
|
|
|
|
|
0
|
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
|
1490
|
|
|
|
|
11586
|
$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) |
2624
|
|
|
|
|
|
|
sub _merge_with_rscond { |
2625
|
12357
|
|
|
12357
|
|
14948
|
my ($self, $data) = @_; |
2626
|
|
|
|
|
|
|
|
2627
|
12357
|
|
|
|
|
10727
|
my ($implied_data, @cols_from_relations); |
2628
|
|
|
|
|
|
|
|
2629
|
12357
|
|
|
|
|
31849
|
my $alias = $self->{attrs}{alias}; |
2630
|
|
|
|
|
|
|
|
2631
|
12357
|
100
|
|
|
|
27649
|
if (! defined $self->{cond}) { |
|
|
100
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
# just massage $data below |
2633
|
|
|
|
|
|
|
} |
2634
|
|
|
|
|
|
|
elsif ($self->{cond} eq UNRESOLVABLE_CONDITION) { |
2635
|
6
|
|
|
|
|
13
|
$implied_data = $self->{attrs}{related_objects}; # nothing might have been inserted yet |
2636
|
6
|
50
|
|
|
|
8
|
@cols_from_relations = keys %{ $implied_data || {} }; |
|
6
|
|
|
|
|
35
|
|
2637
|
|
|
|
|
|
|
} |
2638
|
|
|
|
|
|
|
else { |
2639
|
2061
|
|
|
|
|
8566
|
my $eqs = $self->result_source->schema->storage->_extract_fixed_condition_columns($self->{cond}, 'consider_nulls'); |
2640
|
|
|
|
|
|
|
$implied_data = { map { |
2641
|
2061
|
50
|
100
|
|
|
4770
|
( ($eqs->{$_}||'') eq UNRESOLVABLE_CONDITION ) ? () : ( $_ => $eqs->{$_} ) |
|
2107
|
|
|
|
|
13212
|
|
2642
|
|
|
|
|
|
|
} keys %$eqs }; |
2643
|
|
|
|
|
|
|
} |
2644
|
|
|
|
|
|
|
|
2645
|
|
|
|
|
|
|
return ( |
2646
|
|
|
|
|
|
|
{ map |
2647
|
12357
|
|
100
|
|
|
49841
|
{ %{ $self->_remove_alias($_, $alias) } } |
|
14424
|
|
|
|
|
11175
|
|
|
14424
|
|
|
|
|
25862
|
|
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
|
|
|
|
|
|
|
|
2669
|
|
|
|
|
|
|
sub _has_resolved_attr { |
2670
|
1422
|
|
|
1422
|
|
3411
|
my ($self, @attr_names) = @_; |
2671
|
|
|
|
|
|
|
|
2672
|
1422
|
|
|
|
|
3602
|
my $attrs = $self->_resolved_attrs; |
2673
|
|
|
|
|
|
|
|
2674
|
1422
|
|
|
|
|
1919
|
my %extra_checks; |
2675
|
|
|
|
|
|
|
|
2676
|
1422
|
|
|
|
|
2878
|
for my $n (@attr_names) { |
2677
|
3294
|
50
|
|
|
|
3585
|
if (grep { $n eq $_ } (qw/-join/) ) { |
|
3294
|
|
|
|
|
8465
|
|
2678
|
0
|
|
|
|
|
0
|
$extra_checks{$n}++; |
2679
|
0
|
|
|
|
|
0
|
next; |
2680
|
|
|
|
|
|
|
} |
2681
|
|
|
|
|
|
|
|
2682
|
3294
|
|
|
|
|
3903
|
my $attr = $attrs->{$n}; |
2683
|
|
|
|
|
|
|
|
2684
|
3294
|
100
|
|
|
|
6453
|
next if not defined $attr; |
2685
|
|
|
|
|
|
|
|
2686
|
125
|
50
|
|
|
|
498
|
if (ref $attr eq 'HASH') { |
|
|
100
|
|
|
|
|
|
2687
|
0
|
0
|
|
|
|
0
|
return 1 if keys %$attr; |
2688
|
|
|
|
|
|
|
} |
2689
|
|
|
|
|
|
|
elsif (ref $attr eq 'ARRAY') { |
2690
|
64
|
50
|
|
|
|
278
|
return 1 if @$attr; |
2691
|
|
|
|
|
|
|
} |
2692
|
|
|
|
|
|
|
else { |
2693
|
61
|
100
|
|
|
|
298
|
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
|
1317
|
0
|
33
|
|
|
4991
|
@{$attrs->{from}} > 1 |
|
0
|
|
33
|
|
|
0
|
|
2704
|
|
|
|
|
|
|
); |
2705
|
|
|
|
|
|
|
|
2706
|
1317
|
|
|
|
|
5044
|
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
|
|
|
|
|
|
|
|
2714
|
|
|
|
|
|
|
sub _remove_alias { |
2715
|
14424
|
|
|
14424
|
|
16700
|
my ($self, $query, $alias) = @_; |
2716
|
|
|
|
|
|
|
|
2717
|
14424
|
50
|
|
|
|
12097
|
my %orig = %{ $query || {} }; |
|
14424
|
|
|
|
|
47585
|
|
2718
|
14424
|
|
|
|
|
14591
|
my %unaliased; |
2719
|
|
|
|
|
|
|
|
2720
|
14424
|
|
|
|
|
23096
|
foreach my $key (keys %orig) { |
2721
|
8299
|
100
|
|
|
|
19912
|
if ($key !~ /\./) { |
2722
|
6644
|
|
|
|
|
9850
|
$unaliased{$key} = $orig{$key}; |
2723
|
6644
|
|
|
|
|
8058
|
next; |
2724
|
|
|
|
|
|
|
} |
2725
|
1655
|
100
|
|
|
|
18283
|
$unaliased{$1} = $orig{$key} |
2726
|
|
|
|
|
|
|
if $key =~ m/^(?:\Q$alias\E\.)?([^.]+)$/; |
2727
|
|
|
|
|
|
|
} |
2728
|
|
|
|
|
|
|
|
2729
|
14424
|
|
|
|
|
79707
|
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
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
Returns the SQL query and bind vars associated with the invocant. |
2743
|
|
|
|
|
|
|
|
2744
|
|
|
|
|
|
|
This is generally used as the RHS for a subquery. |
2745
|
|
|
|
|
|
|
|
2746
|
|
|
|
|
|
|
=cut |
2747
|
|
|
|
|
|
|
|
2748
|
|
|
|
|
|
|
sub as_query { |
2749
|
663
|
|
|
663
|
1
|
195469
|
my $self = shift; |
2750
|
|
|
|
|
|
|
|
2751
|
663
|
|
|
|
|
829
|
my $attrs = { %{ $self->_resolved_attrs } }; |
|
663
|
|
|
|
|
1941
|
|
2752
|
|
|
|
|
|
|
|
2753
|
|
|
|
|
|
|
my $aq = $self->result_source->storage->_select_args_to_query ( |
2754
|
663
|
|
|
|
|
3475
|
$attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs |
2755
|
|
|
|
|
|
|
); |
2756
|
|
|
|
|
|
|
|
2757
|
659
|
|
|
|
|
7920
|
$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
|
|
|
|
|
|
|
|
2776
|
|
|
|
|
|
|
Find an existing record from this resultset using L. if none exists, |
2777
|
|
|
|
|
|
|
instantiate a new result object and return it. The object will not be saved |
2778
|
|
|
|
|
|
|
into your storage until you call L on it. |
2779
|
|
|
|
|
|
|
|
2780
|
|
|
|
|
|
|
You most likely want this method when looking for existing rows using a unique |
2781
|
|
|
|
|
|
|
constraint that is not the primary key, or looking for related rows. |
2782
|
|
|
|
|
|
|
|
2783
|
|
|
|
|
|
|
If you want objects to be saved immediately, use L instead. |
2784
|
|
|
|
|
|
|
|
2785
|
|
|
|
|
|
|
B: Make sure to read the documentation of L and understand the |
2786
|
|
|
|
|
|
|
significance of the C attribute, as its lack may skew your search, and |
2787
|
|
|
|
|
|
|
subsequently result in spurious new objects. |
2788
|
|
|
|
|
|
|
|
2789
|
|
|
|
|
|
|
B: Take care when using C with a table having |
2790
|
|
|
|
|
|
|
columns with default values that you intend to be automatically |
2791
|
|
|
|
|
|
|
supplied by the database (e.g. an auto_increment primary key column). |
2792
|
|
|
|
|
|
|
In normal usage, the value of such columns should NOT be included at |
2793
|
|
|
|
|
|
|
all in the call to C, even when set to C. |
2794
|
|
|
|
|
|
|
|
2795
|
|
|
|
|
|
|
=cut |
2796
|
|
|
|
|
|
|
|
2797
|
|
|
|
|
|
|
sub find_or_new { |
2798
|
4
|
|
|
4
|
1
|
8
|
my $self = shift; |
2799
|
4
|
100
|
66
|
|
|
29
|
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); |
2800
|
4
|
50
|
|
|
|
17
|
my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; |
2801
|
4
|
100
|
66
|
|
|
31
|
if (keys %$hash and my $row = $self->find($hash, $attrs) ) { |
2802
|
2
|
|
|
|
|
7
|
return $row; |
2803
|
|
|
|
|
|
|
} |
2804
|
2
|
|
|
|
|
12
|
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
|
|
|
|
|
|
|
|
2817
|
|
|
|
|
|
|
Attempt to create a single new row or a row with multiple related rows |
2818
|
|
|
|
|
|
|
in the table represented by the resultset (and related tables). This |
2819
|
|
|
|
|
|
|
will not check for duplicate rows before inserting, use |
2820
|
|
|
|
|
|
|
L to do that. |
2821
|
|
|
|
|
|
|
|
2822
|
|
|
|
|
|
|
To create one row for this resultset, pass a hashref of key/value |
2823
|
|
|
|
|
|
|
pairs representing the columns of the table and the values you wish to |
2824
|
|
|
|
|
|
|
store. If the appropriate relationships are set up, foreign key fields |
2825
|
|
|
|
|
|
|
can also be passed an object representing the foreign row, and the |
2826
|
|
|
|
|
|
|
value will be set to its primary key. |
2827
|
|
|
|
|
|
|
|
2828
|
|
|
|
|
|
|
To create related objects, pass a hashref of related-object column values |
2829
|
|
|
|
|
|
|
B. If the relationship is of type C |
2830
|
|
|
|
|
|
|
(L) - pass an arrayref of hashrefs. |
2831
|
|
|
|
|
|
|
The process will correctly identify columns holding foreign keys, and will |
2832
|
|
|
|
|
|
|
transparently populate them from the keys of the corresponding relation. |
2833
|
|
|
|
|
|
|
This can be applied recursively, and will work correctly for a structure |
2834
|
|
|
|
|
|
|
with an arbitrary depth and width, as long as the relationships actually |
2835
|
|
|
|
|
|
|
exists and the correct column data has been supplied. |
2836
|
|
|
|
|
|
|
|
2837
|
|
|
|
|
|
|
Instead of hashrefs of plain related data (key/value pairs), you may |
2838
|
|
|
|
|
|
|
also pass new or inserted objects. New objects (not inserted yet, see |
2839
|
|
|
|
|
|
|
L), will be inserted into their appropriate tables. |
2840
|
|
|
|
|
|
|
|
2841
|
|
|
|
|
|
|
Effectively a shortcut for C<< ->new_result(\%col_data)->insert >>. |
2842
|
|
|
|
|
|
|
|
2843
|
|
|
|
|
|
|
Example of creating a new row. |
2844
|
|
|
|
|
|
|
|
2845
|
|
|
|
|
|
|
$person_rs->create({ |
2846
|
|
|
|
|
|
|
name=>"Some Person", |
2847
|
|
|
|
|
|
|
email=>"somebody@someplace.com" |
2848
|
|
|
|
|
|
|
}); |
2849
|
|
|
|
|
|
|
|
2850
|
|
|
|
|
|
|
Example of creating a new row and also creating rows in a related C |
2851
|
|
|
|
|
|
|
or C 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
|
|
|
|
|
|
|
|
2861
|
|
|
|
|
|
|
Example of creating a new row and also creating a row in a related |
2862
|
|
|
|
|
|
|
C 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
|
|
|
|
|
|
|
|
2876
|
|
|
|
|
|
|
When subclassing ResultSet never attempt to override this method. Since |
2877
|
|
|
|
|
|
|
it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a |
2878
|
|
|
|
|
|
|
lot of the internals simply never call it, so your override will be |
2879
|
|
|
|
|
|
|
bypassed more often than not. Override either L |
2880
|
|
|
|
|
|
|
or L depending on how early in the |
2881
|
|
|
|
|
|
|
L process you need to intervene. See also warning pertaining to |
2882
|
|
|
|
|
|
|
L. |
2883
|
|
|
|
|
|
|
|
2884
|
|
|
|
|
|
|
=back |
2885
|
|
|
|
|
|
|
|
2886
|
|
|
|
|
|
|
=cut |
2887
|
|
|
|
|
|
|
|
2888
|
|
|
|
|
|
|
sub create { |
2889
|
|
|
|
|
|
|
#my ($self, $col_data) = @_; |
2890
|
387
|
|
|
387
|
1
|
8190
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
2891
|
387
|
|
|
|
|
1786
|
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
|
|
|
|
|
|
|
|
2907
|
|
|
|
|
|
|
Tries to find a record based on its primary key or unique constraints; if none |
2908
|
|
|
|
|
|
|
is 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
|
|
|
|
|
|
|
|
2917
|
|
|
|
|
|
|
Also takes an optional C attribute, to search by a specific key or unique |
2918
|
|
|
|
|
|
|
constraint. 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
|
|
|
|
|
|
|
|
2928
|
|
|
|
|
|
|
B: Make sure to read the documentation of L and understand the |
2929
|
|
|
|
|
|
|
significance of the C attribute, as its lack may skew your search, and |
2930
|
|
|
|
|
|
|
subsequently result in spurious row creation. |
2931
|
|
|
|
|
|
|
|
2932
|
|
|
|
|
|
|
B: Because find_or_create() reads from the database and then |
2933
|
|
|
|
|
|
|
possibly inserts based on the result, this method is subject to a race |
2934
|
|
|
|
|
|
|
condition. Another process could create a record in the table after |
2935
|
|
|
|
|
|
|
the find has completed and before the create has started. To avoid |
2936
|
|
|
|
|
|
|
this problem, use find_or_create() inside a transaction. |
2937
|
|
|
|
|
|
|
|
2938
|
|
|
|
|
|
|
B: Take care when using C with a table having |
2939
|
|
|
|
|
|
|
columns with default values that you intend to be automatically |
2940
|
|
|
|
|
|
|
supplied by the database (e.g. an auto_increment primary key column). |
2941
|
|
|
|
|
|
|
In normal usage, the value of such columns should NOT be included at |
2942
|
|
|
|
|
|
|
all in the call to C, even when set to C. |
2943
|
|
|
|
|
|
|
|
2944
|
|
|
|
|
|
|
See also L and L. For information on how to declare |
2945
|
|
|
|
|
|
|
unique constraints, see L. |
2946
|
|
|
|
|
|
|
|
2947
|
|
|
|
|
|
|
If you need to know if an existing row was found or a new one created use |
2948
|
|
|
|
|
|
|
L and L instead. Don't forget |
2949
|
|
|
|
|
|
|
to call L to save the newly created row to the |
2950
|
|
|
|
|
|
|
database! |
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
|
|
|
|
|
|
|
|
2966
|
|
|
|
|
|
|
sub find_or_create { |
2967
|
30
|
|
|
30
|
1
|
92
|
my $self = shift; |
2968
|
30
|
100
|
66
|
|
|
190
|
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); |
2969
|
30
|
50
|
|
|
|
131
|
my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; |
2970
|
30
|
100
|
66
|
|
|
229
|
if (keys %$hash and my $row = $self->find($hash, $attrs) ) { |
2971
|
7
|
|
|
|
|
134
|
return $row; |
2972
|
|
|
|
|
|
|
} |
2973
|
21
|
|
|
|
|
346
|
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
|
|
|
|
|
|
|
|
2988
|
|
|
|
|
|
|
Like L, but if a row is found it is immediately updated via |
2989
|
|
|
|
|
|
|
C<< $found_row->update (\%col_data) >>. |
2990
|
|
|
|
|
|
|
|
2991
|
|
|
|
|
|
|
|
2992
|
|
|
|
|
|
|
Takes an optional C attribute to search on a specific unique constraint. |
2993
|
|
|
|
|
|
|
For 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
|
|
|
|
|
|
|
|
3012
|
|
|
|
|
|
|
B: Make sure to read the documentation of L and understand the |
3013
|
|
|
|
|
|
|
significance of the C attribute, as its lack may skew your search, and |
3014
|
|
|
|
|
|
|
subsequently result in spurious row creation. |
3015
|
|
|
|
|
|
|
|
3016
|
|
|
|
|
|
|
B: Take care when using C with a table having |
3017
|
|
|
|
|
|
|
columns with default values that you intend to be automatically |
3018
|
|
|
|
|
|
|
supplied by the database (e.g. an auto_increment primary key column). |
3019
|
|
|
|
|
|
|
In normal usage, the value of such columns should NOT be included at |
3020
|
|
|
|
|
|
|
all in the call to C, even when set to C. |
3021
|
|
|
|
|
|
|
|
3022
|
|
|
|
|
|
|
See also L and L. For information on how to declare |
3023
|
|
|
|
|
|
|
unique constraints, see L. |
3024
|
|
|
|
|
|
|
|
3025
|
|
|
|
|
|
|
If you need to know if an existing row was updated or a new one created use |
3026
|
|
|
|
|
|
|
L and L instead. Don't forget |
3027
|
|
|
|
|
|
|
to call L to save the newly created row to the |
3028
|
|
|
|
|
|
|
database! |
3029
|
|
|
|
|
|
|
|
3030
|
|
|
|
|
|
|
=cut |
3031
|
|
|
|
|
|
|
|
3032
|
|
|
|
|
|
|
sub update_or_create { |
3033
|
13
|
|
|
13
|
1
|
22
|
my $self = shift; |
3034
|
13
|
100
|
66
|
|
|
109
|
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); |
3035
|
13
|
50
|
|
|
|
42
|
my $cond = ref $_[0] eq 'HASH' ? shift : {@_}; |
3036
|
|
|
|
|
|
|
|
3037
|
13
|
|
|
|
|
44
|
my $row = $self->find($cond, $attrs); |
3038
|
13
|
100
|
|
|
|
49
|
if (defined $row) { |
3039
|
8
|
|
|
|
|
92
|
$row->update($cond); |
3040
|
8
|
|
|
|
|
29
|
return $row; |
3041
|
|
|
|
|
|
|
} |
3042
|
|
|
|
|
|
|
|
3043
|
5
|
|
|
|
|
29
|
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
|
|
|
|
|
|
|
|
3058
|
|
|
|
|
|
|
Like L but if a row is found it is immediately updated via |
3059
|
|
|
|
|
|
|
C<< $found_row->update (\%col_data) >>. |
3060
|
|
|
|
|
|
|
|
3061
|
|
|
|
|
|
|
For 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
|
|
|
|
|
|
|
|
3081
|
|
|
|
|
|
|
B: Make sure to read the documentation of L and understand the |
3082
|
|
|
|
|
|
|
significance of the C attribute, as its lack may skew your search, and |
3083
|
|
|
|
|
|
|
subsequently result in spurious new objects. |
3084
|
|
|
|
|
|
|
|
3085
|
|
|
|
|
|
|
B: Take care when using C with a table having |
3086
|
|
|
|
|
|
|
columns with default values that you intend to be automatically |
3087
|
|
|
|
|
|
|
supplied by the database (e.g. an auto_increment primary key column). |
3088
|
|
|
|
|
|
|
In normal usage, the value of such columns should NOT be included at |
3089
|
|
|
|
|
|
|
all in the call to C, even when set to C. |
3090
|
|
|
|
|
|
|
|
3091
|
|
|
|
|
|
|
See also L, L and L. |
3092
|
|
|
|
|
|
|
|
3093
|
|
|
|
|
|
|
=cut |
3094
|
|
|
|
|
|
|
|
3095
|
|
|
|
|
|
|
sub update_or_new { |
3096
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
3097
|
2
|
50
|
33
|
|
|
19
|
my $attrs = ( @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {} ); |
3098
|
2
|
50
|
|
|
|
8
|
my $cond = ref $_[0] eq 'HASH' ? shift : {@_}; |
3099
|
|
|
|
|
|
|
|
3100
|
2
|
|
|
|
|
7
|
my $row = $self->find( $cond, $attrs ); |
3101
|
2
|
100
|
|
|
|
7
|
if ( defined $row ) { |
3102
|
1
|
|
|
|
|
6
|
$row->update($cond); |
3103
|
1
|
|
|
|
|
4
|
return $row; |
3104
|
|
|
|
|
|
|
} |
3105
|
|
|
|
|
|
|
|
3106
|
1
|
|
|
|
|
6
|
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
|
|
|
|
|
|
|
|
3119
|
|
|
|
|
|
|
Gets the contents of the cache for the resultset, if the cache is set. |
3120
|
|
|
|
|
|
|
|
3121
|
|
|
|
|
|
|
The cache is populated either by using the L attribute to |
3122
|
|
|
|
|
|
|
L or by calling L. |
3123
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
=cut |
3125
|
|
|
|
|
|
|
|
3126
|
|
|
|
|
|
|
sub get_cache { |
3127
|
44078
|
|
|
44078
|
1
|
168575
|
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
|
|
|
|
|
|
|
|
3140
|
|
|
|
|
|
|
Sets the contents of the cache for the resultset. Expects an arrayref |
3141
|
|
|
|
|
|
|
of objects of the same class as those produced by the resultset. Note that |
3142
|
|
|
|
|
|
|
if the cache is set, the resultset will return the cached objects rather |
3143
|
|
|
|
|
|
|
than re-querying the database even if the cache attr is not set. |
3144
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
The contents of the cache can also be populated by using the |
3146
|
|
|
|
|
|
|
L attribute to L. |
3147
|
|
|
|
|
|
|
|
3148
|
|
|
|
|
|
|
=cut |
3149
|
|
|
|
|
|
|
|
3150
|
|
|
|
|
|
|
sub set_cache { |
3151
|
798
|
|
|
798
|
1
|
2914
|
my ( $self, $data ) = @_; |
3152
|
798
|
50
|
66
|
|
|
3458
|
$self->throw_exception("set_cache requires an arrayref") |
3153
|
|
|
|
|
|
|
if defined($data) && (ref $data ne 'ARRAY'); |
3154
|
798
|
|
|
|
|
1995
|
$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
|
|
|
|
|
|
|
|
3167
|
|
|
|
|
|
|
Clears the cache for the resultset. |
3168
|
|
|
|
|
|
|
|
3169
|
|
|
|
|
|
|
=cut |
3170
|
|
|
|
|
|
|
|
3171
|
|
|
|
|
|
|
sub clear_cache { |
3172
|
2
|
|
|
2
|
1
|
7
|
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
|
|
|
|
|
|
|
|
3187
|
|
|
|
|
|
|
sub is_paged { |
3188
|
2
|
|
|
2
|
1
|
11
|
my ($self) = @_; |
3189
|
2
|
|
|
|
|
13
|
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. |
3199
|
|
|
|
|
|
|
|
3200
|
|
|
|
|
|
|
=back |
3201
|
|
|
|
|
|
|
|
3202
|
|
|
|
|
|
|
=cut |
3203
|
|
|
|
|
|
|
|
3204
|
|
|
|
|
|
|
sub is_ordered { |
3205
|
14
|
|
|
14
|
1
|
71
|
my ($self) = @_; |
3206
|
14
|
|
|
|
|
57
|
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
|
|
|
|
|
|
|
|
3219
|
|
|
|
|
|
|
Returns a related resultset for the supplied relationship name. |
3220
|
|
|
|
|
|
|
|
3221
|
|
|
|
|
|
|
$artist_rs = $schema->resultset('CD')->related_resultset('Artist'); |
3222
|
|
|
|
|
|
|
|
3223
|
|
|
|
|
|
|
=cut |
3224
|
|
|
|
|
|
|
|
3225
|
|
|
|
|
|
|
sub related_resultset { |
3226
|
230
|
|
|
230
|
1
|
2792
|
my ($self, $rel) = @_; |
3227
|
|
|
|
|
|
|
|
3228
|
|
|
|
|
|
|
return $self->{related_resultsets}{$rel} |
3229
|
230
|
100
|
|
|
|
942
|
if defined $self->{related_resultsets}{$rel}; |
3230
|
|
|
|
|
|
|
|
3231
|
216
|
|
|
|
|
242
|
return $self->{related_resultsets}{$rel} = do { |
3232
|
216
|
|
|
|
|
494
|
my $rsrc = $self->result_source; |
3233
|
216
|
|
|
|
|
938
|
my $rel_info = $rsrc->relationship_info($rel); |
3234
|
|
|
|
|
|
|
|
3235
|
216
|
50
|
|
|
|
551
|
$self->throw_exception( |
3236
|
|
|
|
|
|
|
"search_related: result source '" . $rsrc->source_name . |
3237
|
|
|
|
|
|
|
"' has no such relationship $rel") |
3238
|
|
|
|
|
|
|
unless $rel_info; |
3239
|
|
|
|
|
|
|
|
3240
|
216
|
|
|
|
|
767
|
my $attrs = $self->_chain_relationship($rel); |
3241
|
|
|
|
|
|
|
|
3242
|
216
|
|
|
|
|
403
|
my $join_count = $attrs->{seen_join}{$rel}; |
3243
|
|
|
|
|
|
|
|
3244
|
216
|
|
|
|
|
980
|
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
|
216
|
|
|
|
|
754
|
$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
|
216
|
|
|
|
|
627
|
delete @{$attrs}{qw(result_class alias)}; |
|
216
|
|
|
|
|
423
|
|
3256
|
|
|
|
|
|
|
|
3257
|
216
|
|
|
|
|
648
|
my $rel_source = $rsrc->related_source($rel); |
3258
|
|
|
|
|
|
|
|
3259
|
216
|
|
|
|
|
766
|
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
|
216
|
|
|
|
|
707
|
my $rel_attrs = $rel_source->resultset_attributes; |
3268
|
216
|
|
|
|
|
494
|
local $rel_attrs->{alias} = $alias; |
3269
|
|
|
|
|
|
|
|
3270
|
|
|
|
|
|
|
$rel_source->resultset |
3271
|
|
|
|
|
|
|
->search_rs( |
3272
|
|
|
|
|
|
|
undef, { |
3273
|
|
|
|
|
|
|
%$attrs, |
3274
|
|
|
|
|
|
|
where => $attrs->{where}, |
3275
|
216
|
|
|
|
|
1385
|
}); |
3276
|
|
|
|
|
|
|
}; |
3277
|
|
|
|
|
|
|
|
3278
|
216
|
100
|
|
|
|
887
|
if (my $cache = $self->get_cache) { |
3279
|
|
|
|
|
|
|
my @related_cache = map |
3280
|
13
|
100
|
|
|
|
29
|
{ $_->related_resultset($rel)->get_cache || () } |
|
39
|
|
|
|
|
108
|
|
3281
|
|
|
|
|
|
|
@$cache |
3282
|
|
|
|
|
|
|
; |
3283
|
|
|
|
|
|
|
|
3284
|
13
|
100
|
|
|
|
66
|
$new->set_cache([ map @$_, @related_cache ]) if @related_cache == @$cache; |
3285
|
|
|
|
|
|
|
} |
3286
|
|
|
|
|
|
|
|
3287
|
216
|
|
|
|
|
1194
|
$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
|
|
|
|
|
|
|
|
3301
|
|
|
|
|
|
|
Returns the current table alias for the result source this resultset is built |
3302
|
|
|
|
|
|
|
on, that will be used in the SQL query. Usually it is C. |
3303
|
|
|
|
|
|
|
|
3304
|
|
|
|
|
|
|
Currently the source alias that refers to the result set returned by a |
3305
|
|
|
|
|
|
|
L/L family method depends on how you got to the resultset: it's |
3306
|
|
|
|
|
|
|
C by default, but eg. L aliases it to the related result |
3307
|
|
|
|
|
|
|
source name (and keeps C referring to the original result set). The long |
3308
|
|
|
|
|
|
|
term goal is to make L always alias the current resultset as C |
3309
|
|
|
|
|
|
|
(and make this method unnecessary). |
3310
|
|
|
|
|
|
|
|
3311
|
|
|
|
|
|
|
Thus it's currently necessary to use this method in predefined queries (see |
3312
|
|
|
|
|
|
|
L) when referring to the |
3313
|
|
|
|
|
|
|
source 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
|
|
|
|
|
|
|
The alias of L can be altered by the |
3327
|
|
|
|
|
|
|
L. |
3328
|
|
|
|
|
|
|
|
3329
|
|
|
|
|
|
|
=cut |
3330
|
|
|
|
|
|
|
|
3331
|
|
|
|
|
|
|
sub current_source_alias { |
3332
|
717
|
|
50
|
717
|
1
|
4256
|
return (shift->{attrs} || {})->{alias} || 'me'; |
3333
|
|
|
|
|
|
|
} |
3334
|
|
|
|
|
|
|
|
3335
|
|
|
|
|
|
|
=head2 as_subselect_rs |
3336
|
|
|
|
|
|
|
|
3337
|
|
|
|
|
|
|
=over 4 |
3338
|
|
|
|
|
|
|
|
3339
|
|
|
|
|
|
|
=item Arguments: none |
3340
|
|
|
|
|
|
|
|
3341
|
|
|
|
|
|
|
=item Return Value: L<$resultset|/search> |
3342
|
|
|
|
|
|
|
|
3343
|
|
|
|
|
|
|
=back |
3344
|
|
|
|
|
|
|
|
3345
|
|
|
|
|
|
|
Act as a barrier to SQL symbols. The resultset provided will be made into a |
3346
|
|
|
|
|
|
|
"virtual view" by including it as a subquery within the from clause. From this |
3347
|
|
|
|
|
|
|
point on, any joined tables are inaccessible to ->search on the resultset (as if |
3348
|
|
|
|
|
|
|
it were simply where-filtered without joins). For example: |
3349
|
|
|
|
|
|
|
|
3350
|
|
|
|
|
|
|
my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' }); |
3351
|
|
|
|
|
|
|
|
3352
|
|
|
|
|
|
|
# 'x' now pollutes the query namespace |
3353
|
|
|
|
|
|
|
|
3354
|
|
|
|
|
|
|
# So the following works as expected |
3355
|
|
|
|
|
|
|
my $ok_rs = $rs->search({'x.other' => 1}); |
3356
|
|
|
|
|
|
|
|
3357
|
|
|
|
|
|
|
# But this doesn't: instead of finding a 'Bar' related to two x rows (abc and |
3358
|
|
|
|
|
|
|
# def) we look for one row with contradictory terms and join in another table |
3359
|
|
|
|
|
|
|
# (aliased 'x_2') which we never use |
3360
|
|
|
|
|
|
|
my $broken_rs = $rs->search({'x.name' => 'def'}); |
3361
|
|
|
|
|
|
|
|
3362
|
|
|
|
|
|
|
my $rs2 = $rs->as_subselect_rs; |
3363
|
|
|
|
|
|
|
|
3364
|
|
|
|
|
|
|
# doesn't work - 'x' is no longer accessible in $rs2, having been sealed away |
3365
|
|
|
|
|
|
|
my $not_joined_rs = $rs2->search({'x.other' => 1}); |
3366
|
|
|
|
|
|
|
|
3367
|
|
|
|
|
|
|
# works as expected: finds a 'table' row related to two x rows (abc and def) |
3368
|
|
|
|
|
|
|
my $correctly_joined_rs = $rs2->search({'x.name' => 'def'}); |
3369
|
|
|
|
|
|
|
|
3370
|
|
|
|
|
|
|
Another example of when one might use this would be to select a subset of |
3371
|
|
|
|
|
|
|
columns in a group by clause: |
3372
|
|
|
|
|
|
|
|
3373
|
|
|
|
|
|
|
my $rs = $schema->resultset('Bar')->search(undef, { |
3374
|
|
|
|
|
|
|
group_by => [qw{ id foo_id baz_id }], |
3375
|
|
|
|
|
|
|
})->as_subselect_rs->search(undef, { |
3376
|
|
|
|
|
|
|
columns => [qw{ id foo_id }] |
3377
|
|
|
|
|
|
|
}); |
3378
|
|
|
|
|
|
|
|
3379
|
|
|
|
|
|
|
In the above example normally columns would have to be equal to the group by, |
3380
|
|
|
|
|
|
|
but because we isolated the group by into a subselect the above works. |
3381
|
|
|
|
|
|
|
|
3382
|
|
|
|
|
|
|
=cut |
3383
|
|
|
|
|
|
|
|
3384
|
|
|
|
|
|
|
sub as_subselect_rs { |
3385
|
109
|
|
|
109
|
1
|
207
|
my $self = shift; |
3386
|
|
|
|
|
|
|
|
3387
|
109
|
|
|
|
|
286
|
my $attrs = $self->_resolved_attrs; |
3388
|
|
|
|
|
|
|
|
3389
|
109
|
|
|
|
|
492
|
my $fresh_rs = (ref $self)->new ( |
3390
|
|
|
|
|
|
|
$self->result_source |
3391
|
|
|
|
|
|
|
); |
3392
|
|
|
|
|
|
|
|
3393
|
|
|
|
|
|
|
# these pieces will be locked in the subquery |
3394
|
109
|
|
|
|
|
196
|
delete $fresh_rs->{cond}; |
3395
|
109
|
|
|
|
|
158
|
delete @{$fresh_rs->{attrs}}{qw/where bind/}; |
|
109
|
|
|
|
|
226
|
|
3396
|
|
|
|
|
|
|
|
3397
|
|
|
|
|
|
|
return $fresh_rs->search( {}, { |
3398
|
|
|
|
|
|
|
from => [{ |
3399
|
|
|
|
|
|
|
$attrs->{alias} => $self->as_query, |
3400
|
|
|
|
|
|
|
-alias => $attrs->{alias}, |
3401
|
|
|
|
|
|
|
-rsrc => $self->result_source, |
3402
|
|
|
|
|
|
|
}], |
3403
|
|
|
|
|
|
|
alias => $attrs->{alias}, |
3404
|
109
|
|
|
|
|
495
|
}); |
3405
|
|
|
|
|
|
|
} |
3406
|
|
|
|
|
|
|
|
3407
|
|
|
|
|
|
|
# This code is called by search_related, and makes sure there |
3408
|
|
|
|
|
|
|
# is clear separation between the joins before, during, and |
3409
|
|
|
|
|
|
|
# after the relationship. This information is needed later |
3410
|
|
|
|
|
|
|
# in order to properly resolve prefetch aliases (any alias |
3411
|
|
|
|
|
|
|
# with a relation_chain_depth less than the depth of the |
3412
|
|
|
|
|
|
|
# current prefetch is not considered) |
3413
|
|
|
|
|
|
|
# |
3414
|
|
|
|
|
|
|
# The increments happen twice per join. An even number means a |
3415
|
|
|
|
|
|
|
# relationship specified via a search_related, whereas an odd |
3416
|
|
|
|
|
|
|
# number indicates a join/prefetch added via attributes |
3417
|
|
|
|
|
|
|
# |
3418
|
|
|
|
|
|
|
# Also this code will wrap the current resultset (the one we |
3419
|
|
|
|
|
|
|
# chain to) in a subselect IFF it contains limiting attributes |
3420
|
|
|
|
|
|
|
sub _chain_relationship { |
3421
|
216
|
|
|
216
|
|
304
|
my ($self, $rel) = @_; |
3422
|
216
|
|
|
|
|
456
|
my $source = $self->result_source; |
3423
|
216
|
50
|
|
|
|
246
|
my $attrs = { %{$self->{attrs}||{}} }; |
|
216
|
|
|
|
|
1421
|
|
3424
|
|
|
|
|
|
|
|
3425
|
|
|
|
|
|
|
# we need to take the prefetch the attrs into account before we |
3426
|
|
|
|
|
|
|
# ->_resolve_join as otherwise they get lost - captainL |
3427
|
216
|
|
|
|
|
1084
|
my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} ); |
3428
|
|
|
|
|
|
|
|
3429
|
216
|
|
|
|
|
562
|
delete @{$attrs}{qw/join prefetch collapse group_by distinct _grouped_by_distinct select as columns +select +as +columns/}; |
|
216
|
|
|
|
|
553
|
|
3430
|
|
|
|
|
|
|
|
3431
|
216
|
100
|
|
|
|
279
|
my $seen = { %{ (delete $attrs->{seen_join}) || {} } }; |
|
216
|
|
|
|
|
1094
|
|
3432
|
|
|
|
|
|
|
|
3433
|
216
|
|
|
|
|
352
|
my $from; |
3434
|
216
|
|
|
|
|
573
|
my @force_subq_attrs = qw/offset rows group_by having/; |
3435
|
|
|
|
|
|
|
|
3436
|
216
|
100
|
66
|
|
|
1489
|
if ( |
|
|
100
|
66
|
|
|
|
|
3437
|
|
|
|
|
|
|
($attrs->{from} && ref $attrs->{from} ne 'ARRAY') |
3438
|
|
|
|
|
|
|
|| |
3439
|
|
|
|
|
|
|
$self->_has_resolved_attr (@force_subq_attrs) |
3440
|
|
|
|
|
|
|
) { |
3441
|
|
|
|
|
|
|
# Nuke the prefetch (if any) before the new $rs attrs |
3442
|
|
|
|
|
|
|
# are resolved (prefetch is useless - we are wrapping |
3443
|
|
|
|
|
|
|
# a subquery anyway). |
3444
|
9
|
|
|
|
|
32
|
my $rs_copy = $self->search; |
3445
|
|
|
|
|
|
|
$rs_copy->{attrs}{join} = $self->_merge_joinpref_attr ( |
3446
|
|
|
|
|
|
|
$rs_copy->{attrs}{join}, |
3447
|
|
|
|
|
|
|
delete $rs_copy->{attrs}{prefetch}, |
3448
|
9
|
|
|
|
|
45
|
); |
3449
|
|
|
|
|
|
|
|
3450
|
|
|
|
|
|
|
$from = [{ |
3451
|
|
|
|
|
|
|
-rsrc => $source, |
3452
|
|
|
|
|
|
|
-alias => $attrs->{alias}, |
3453
|
9
|
|
|
|
|
69
|
$attrs->{alias} => $rs_copy->as_query, |
3454
|
|
|
|
|
|
|
}]; |
3455
|
9
|
|
|
|
|
24
|
delete @{$attrs}{@force_subq_attrs, qw/where bind/}; |
|
9
|
|
|
|
|
32
|
|
3456
|
9
|
|
|
|
|
57
|
$seen->{-relation_chain_depth} = 0; |
3457
|
|
|
|
|
|
|
} |
3458
|
|
|
|
|
|
|
elsif ($attrs->{from}) { #shallow copy suffices |
3459
|
22
|
|
|
|
|
34
|
$from = [ @{$attrs->{from}} ]; |
|
22
|
|
|
|
|
69
|
|
3460
|
|
|
|
|
|
|
} |
3461
|
|
|
|
|
|
|
else { |
3462
|
|
|
|
|
|
|
$from = [{ |
3463
|
|
|
|
|
|
|
-rsrc => $source, |
3464
|
|
|
|
|
|
|
-alias => $attrs->{alias}, |
3465
|
185
|
|
|
|
|
854
|
$attrs->{alias} => $source->from, |
3466
|
|
|
|
|
|
|
}]; |
3467
|
|
|
|
|
|
|
} |
3468
|
|
|
|
|
|
|
|
3469
|
|
|
|
|
|
|
my $jpath = ($seen->{-relation_chain_depth}) |
3470
|
|
|
|
|
|
|
? $from->[-1][0]{-join_path} |
3471
|
216
|
100
|
|
|
|
710
|
: []; |
3472
|
|
|
|
|
|
|
|
3473
|
|
|
|
|
|
|
my @requested_joins = $source->_resolve_join( |
3474
|
|
|
|
|
|
|
$join, |
3475
|
|
|
|
|
|
|
$attrs->{alias}, |
3476
|
216
|
|
|
|
|
1255
|
$seen, |
3477
|
|
|
|
|
|
|
$jpath, |
3478
|
|
|
|
|
|
|
); |
3479
|
|
|
|
|
|
|
|
3480
|
216
|
|
|
|
|
355
|
push @$from, @requested_joins; |
3481
|
|
|
|
|
|
|
|
3482
|
216
|
|
|
|
|
549
|
$seen->{-relation_chain_depth}++; |
3483
|
|
|
|
|
|
|
|
3484
|
|
|
|
|
|
|
# if $self already had a join/prefetch specified on it, the requested |
3485
|
|
|
|
|
|
|
# $rel might very well be already included. What we do in this case |
3486
|
|
|
|
|
|
|
# is effectively a no-op (except that we bump up the chain_depth on |
3487
|
|
|
|
|
|
|
# the join in question so we could tell it *is* the search_related) |
3488
|
216
|
|
|
|
|
259
|
my $already_joined; |
3489
|
|
|
|
|
|
|
|
3490
|
|
|
|
|
|
|
# we consider the last one thus reverse |
3491
|
216
|
|
|
|
|
461
|
for my $j (reverse @requested_joins) { |
3492
|
30
|
|
|
|
|
43
|
my ($last_j) = keys %{$j->[0]{-join_path}[-1]}; |
|
30
|
|
|
|
|
121
|
|
3493
|
30
|
100
|
|
|
|
110
|
if ($rel eq $last_j) { |
3494
|
12
|
|
|
|
|
33
|
$j->[0]{-relation_chain_depth}++; |
3495
|
12
|
|
|
|
|
20
|
$already_joined++; |
3496
|
12
|
|
|
|
|
25
|
last; |
3497
|
|
|
|
|
|
|
} |
3498
|
|
|
|
|
|
|
} |
3499
|
|
|
|
|
|
|
|
3500
|
216
|
100
|
|
|
|
455
|
unless ($already_joined) { |
3501
|
|
|
|
|
|
|
push @$from, $source->_resolve_join( |
3502
|
|
|
|
|
|
|
$rel, |
3503
|
|
|
|
|
|
|
$attrs->{alias}, |
3504
|
204
|
|
|
|
|
614
|
$seen, |
3505
|
|
|
|
|
|
|
$jpath, |
3506
|
|
|
|
|
|
|
); |
3507
|
|
|
|
|
|
|
} |
3508
|
|
|
|
|
|
|
|
3509
|
216
|
|
|
|
|
538
|
$seen->{-relation_chain_depth}++; |
3510
|
|
|
|
|
|
|
|
3511
|
216
|
|
|
|
|
1567
|
return {%$attrs, from => $from, seen_join => $seen}; |
3512
|
|
|
|
|
|
|
} |
3513
|
|
|
|
|
|
|
|
3514
|
|
|
|
|
|
|
sub _resolved_attrs { |
3515
|
20782
|
|
|
20782
|
|
21575
|
my $self = shift; |
3516
|
20782
|
100
|
|
|
|
61384
|
return $self->{_attrs} if $self->{_attrs}; |
3517
|
|
|
|
|
|
|
|
3518
|
8960
|
50
|
|
|
|
8654
|
my $attrs = { %{ $self->{attrs} || {} } }; |
|
8960
|
|
|
|
|
54965
|
|
3519
|
8960
|
|
|
|
|
24666
|
my $source = $attrs->{result_source} = $self->result_source; |
3520
|
8960
|
|
|
|
|
11958
|
my $alias = $attrs->{alias}; |
3521
|
|
|
|
|
|
|
|
3522
|
|
|
|
|
|
|
$self->throw_exception("Specifying distinct => 1 in conjunction with collapse => 1 is unsupported") |
3523
|
8960
|
50
|
66
|
|
|
18632
|
if $attrs->{collapse} and $attrs->{distinct}; |
3524
|
|
|
|
|
|
|
|
3525
|
|
|
|
|
|
|
# default selection list |
3526
|
|
|
|
|
|
|
$attrs->{columns} = [ $source->columns ] |
3527
|
8960
|
100
|
|
30796
|
|
43247
|
unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/; |
|
30796
|
|
|
|
|
56313
|
|
3528
|
|
|
|
|
|
|
|
3529
|
|
|
|
|
|
|
# merge selectors together |
3530
|
8960
|
|
|
|
|
29742
|
for (qw/columns select as/) { |
3531
|
|
|
|
|
|
|
$attrs->{$_} = $self->_merge_attr($attrs->{$_}, delete $attrs->{"+$_"}) |
3532
|
26880
|
100
|
100
|
|
|
118701
|
if $attrs->{$_} or $attrs->{"+$_"}; |
3533
|
|
|
|
|
|
|
} |
3534
|
|
|
|
|
|
|
|
3535
|
|
|
|
|
|
|
# disassemble columns |
3536
|
8960
|
|
|
|
|
10081
|
my (@sel, @as); |
3537
|
8960
|
100
|
|
|
|
23443
|
if (my $cols = delete $attrs->{columns}) { |
3538
|
7845
|
50
|
|
|
|
21486
|
for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) { |
3539
|
35737
|
100
|
|
|
|
39387
|
if (ref $c eq 'HASH') { |
3540
|
1065
|
|
|
|
|
2946
|
for my $as (sort keys %$c) { |
3541
|
1132
|
|
|
|
|
2160
|
push @sel, $c->{$as}; |
3542
|
1132
|
|
|
|
|
2333
|
push @as, $as; |
3543
|
|
|
|
|
|
|
} |
3544
|
|
|
|
|
|
|
} |
3545
|
|
|
|
|
|
|
else { |
3546
|
34672
|
|
|
|
|
35868
|
push @sel, $c; |
3547
|
34672
|
|
|
|
|
36440
|
push @as, $c; |
3548
|
|
|
|
|
|
|
} |
3549
|
|
|
|
|
|
|
} |
3550
|
|
|
|
|
|
|
} |
3551
|
|
|
|
|
|
|
|
3552
|
|
|
|
|
|
|
# when trying to weed off duplicates later do not go past this point - |
3553
|
|
|
|
|
|
|
# everything added from here on is unbalanced "anyone's guess" stuff |
3554
|
8960
|
|
|
|
|
12265
|
my $dedup_stop_idx = $#as; |
3555
|
|
|
|
|
|
|
|
3556
|
1165
|
50
|
|
|
|
4857
|
push @as, @{ ref $attrs->{as} eq 'ARRAY' ? $attrs->{as} : [ $attrs->{as} ] } |
3557
|
8960
|
100
|
|
|
|
18949
|
if $attrs->{as}; |
3558
|
1170
|
50
|
|
|
|
3724
|
push @sel, @{ ref $attrs->{select} eq 'ARRAY' ? $attrs->{select} : [ $attrs->{select} ] } |
3559
|
8960
|
100
|
|
|
|
19663
|
if $attrs->{select}; |
3560
|
|
|
|
|
|
|
|
3561
|
|
|
|
|
|
|
# assume all unqualified selectors to apply to the current alias (legacy stuff) |
3562
|
8960
|
100
|
100
|
|
|
121087
|
$_ = (ref $_ or $_ =~ /\./) ? $_ : "$alias.$_" for @sel; |
3563
|
|
|
|
|
|
|
|
3564
|
|
|
|
|
|
|
# disqualify all $alias.col as-bits (inflate-map mandated) |
3565
|
8960
|
100
|
|
|
|
97226
|
$_ = ($_ =~ /^\Q$alias.\E(.+)$/) ? $1 : $_ for @as; |
3566
|
|
|
|
|
|
|
|
3567
|
|
|
|
|
|
|
# de-duplicate the result (remove *identical* select/as pairs) |
3568
|
|
|
|
|
|
|
# and also die on duplicate {as} pointing to different {select}s |
3569
|
|
|
|
|
|
|
# not using a c-style for as the condition is prone to shrinkage |
3570
|
8960
|
|
|
|
|
9097
|
my $seen; |
3571
|
8960
|
|
|
|
|
10736
|
my $i = 0; |
3572
|
8960
|
|
|
|
|
19047
|
while ($i <= $dedup_stop_idx) { |
3573
|
35804
|
100
|
|
|
|
124945
|
if ($seen->{"$sel[$i] \x00\x00 $as[$i]"}++) { |
|
|
50
|
|
|
|
|
|
3574
|
10
|
|
|
|
|
20
|
splice @sel, $i, 1; |
3575
|
10
|
|
|
|
|
14
|
splice @as, $i, 1; |
3576
|
10
|
|
|
|
|
24
|
$dedup_stop_idx--; |
3577
|
|
|
|
|
|
|
} |
3578
|
|
|
|
|
|
|
elsif ($seen->{$as[$i]}++) { |
3579
|
0
|
|
|
|
|
0
|
$self->throw_exception( |
3580
|
|
|
|
|
|
|
"inflate_result() alias '$as[$i]' specified twice with different SQL-side {select}-ors" |
3581
|
|
|
|
|
|
|
); |
3582
|
|
|
|
|
|
|
} |
3583
|
|
|
|
|
|
|
else { |
3584
|
35794
|
|
|
|
|
51160
|
$i++; |
3585
|
|
|
|
|
|
|
} |
3586
|
|
|
|
|
|
|
} |
3587
|
|
|
|
|
|
|
|
3588
|
8960
|
|
|
|
|
15663
|
$attrs->{select} = \@sel; |
3589
|
8960
|
|
|
|
|
14348
|
$attrs->{as} = \@as; |
3590
|
|
|
|
|
|
|
|
3591
|
|
|
|
|
|
|
$attrs->{from} ||= [{ |
3592
|
|
|
|
|
|
|
-rsrc => $source, |
3593
|
|
|
|
|
|
|
-alias => $self->{attrs}{alias}, |
3594
|
8960
|
|
100
|
|
|
60210
|
$self->{attrs}{alias} => $source->from, |
3595
|
|
|
|
|
|
|
}]; |
3596
|
|
|
|
|
|
|
|
3597
|
8960
|
100
|
66
|
|
|
34743
|
if ( $attrs->{join} || $attrs->{prefetch} ) { |
3598
|
|
|
|
|
|
|
|
3599
|
|
|
|
|
|
|
$self->throw_exception ('join/prefetch can not be used with a custom {from}') |
3600
|
720
|
50
|
|
|
|
2393
|
if ref $attrs->{from} ne 'ARRAY'; |
3601
|
|
|
|
|
|
|
|
3602
|
720
|
|
100
|
|
|
2694
|
my $join = (delete $attrs->{join}) || {}; |
3603
|
|
|
|
|
|
|
|
3604
|
720
|
100
|
|
|
|
1962
|
if ( defined $attrs->{prefetch} ) { |
3605
|
485
|
|
|
|
|
1786
|
$join = $self->_merge_joinpref_attr( $join, $attrs->{prefetch} ); |
3606
|
|
|
|
|
|
|
} |
3607
|
|
|
|
|
|
|
|
3608
|
|
|
|
|
|
|
$attrs->{from} = # have to copy here to avoid corrupting the original |
3609
|
|
|
|
|
|
|
[ |
3610
|
720
|
|
|
|
|
1494
|
@{ $attrs->{from} }, |
3611
|
|
|
|
|
|
|
$source->_resolve_join( |
3612
|
|
|
|
|
|
|
$join, |
3613
|
|
|
|
|
|
|
$alias, |
3614
|
720
|
100
|
|
|
|
8782
|
{ %{ $attrs->{seen_join} || {} } }, |
3615
|
|
|
|
|
|
|
( $attrs->{seen_join} && keys %{$attrs->{seen_join}}) |
3616
|
|
|
|
|
|
|
? $attrs->{from}[-1][0]{-join_path} |
3617
|
720
|
100
|
100
|
|
|
1130
|
: [] |
3618
|
|
|
|
|
|
|
, |
3619
|
|
|
|
|
|
|
) |
3620
|
|
|
|
|
|
|
]; |
3621
|
|
|
|
|
|
|
} |
3622
|
|
|
|
|
|
|
|
3623
|
8960
|
|
|
|
|
15644
|
for my $attr (qw(order_by group_by)) { |
3624
|
|
|
|
|
|
|
|
3625
|
17920
|
100
|
|
|
|
35714
|
if ( defined $attrs->{$attr} ) { |
3626
|
|
|
|
|
|
|
$attrs->{$attr} = ( |
3627
|
|
|
|
|
|
|
ref( $attrs->{$attr} ) eq 'ARRAY' |
3628
|
630
|
|
|
|
|
1960
|
? [ @{ $attrs->{$attr} } ] |
3629
|
3579
|
100
|
66
|
|
|
15142
|
: [ $attrs->{$attr} || () ] |
3630
|
|
|
|
|
|
|
); |
3631
|
|
|
|
|
|
|
|
3632
|
3579
|
100
|
|
|
|
4033
|
delete $attrs->{$attr} unless @{$attrs->{$attr}}; |
|
3579
|
|
|
|
|
9422
|
|
3633
|
|
|
|
|
|
|
} |
3634
|
|
|
|
|
|
|
} |
3635
|
|
|
|
|
|
|
|
3636
|
|
|
|
|
|
|
# generate selections based on the prefetch helper |
3637
|
8960
|
|
|
|
|
8725
|
my ($prefetch, @prefetch_select, @prefetch_as); |
3638
|
|
|
|
|
|
|
$prefetch = $self->_merge_joinpref_attr( {}, delete $attrs->{prefetch} ) |
3639
|
8960
|
100
|
|
|
|
18148
|
if defined $attrs->{prefetch}; |
3640
|
|
|
|
|
|
|
|
3641
|
8960
|
100
|
|
|
|
17328
|
if ($prefetch) { |
3642
|
|
|
|
|
|
|
|
3643
|
|
|
|
|
|
|
$self->throw_exception("Unable to prefetch, resultset contains an unnamed selector $attrs->{_dark_selector}{string}") |
3644
|
353
|
100
|
|
|
|
1086
|
if $attrs->{_dark_selector}; |
3645
|
|
|
|
|
|
|
|
3646
|
|
|
|
|
|
|
$self->throw_exception("Specifying prefetch in conjunction with an explicit collapse => 0 is unsupported") |
3647
|
352
|
50
|
33
|
|
|
1248
|
if defined $attrs->{collapse} and ! $attrs->{collapse}; |
3648
|
|
|
|
|
|
|
|
3649
|
352
|
|
|
|
|
731
|
$attrs->{collapse} = 1; |
3650
|
|
|
|
|
|
|
|
3651
|
|
|
|
|
|
|
# this is a separate structure (we don't look in {from} directly) |
3652
|
|
|
|
|
|
|
# as the resolver needs to shift things off the lists to work |
3653
|
|
|
|
|
|
|
# properly (identical-prefetches on different branches) |
3654
|
352
|
|
|
|
|
621
|
my $join_map = {}; |
3655
|
352
|
50
|
|
|
|
1184
|
if (ref $attrs->{from} eq 'ARRAY') { |
3656
|
|
|
|
|
|
|
|
3657
|
352
|
|
100
|
|
|
2196
|
my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0; |
3658
|
|
|
|
|
|
|
|
3659
|
352
|
|
|
|
|
736
|
for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) { |
|
352
|
|
|
|
|
947
|
|
|
352
|
|
|
|
|
760
|
|
3660
|
529
|
50
|
|
|
|
1466
|
next unless $j->[0]{-alias}; |
3661
|
529
|
50
|
|
|
|
1376
|
next unless $j->[0]{-join_path}; |
3662
|
529
|
100
|
50
|
|
|
1798
|
next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth; |
3663
|
|
|
|
|
|
|
|
3664
|
517
|
|
|
|
|
618
|
my @jpath = map { keys %$_ } @{$j->[0]{-join_path}}; |
|
756
|
|
|
|
|
2004
|
|
|
517
|
|
|
|
|
1103
|
|
3665
|
|
|
|
|
|
|
|
3666
|
517
|
|
|
|
|
725
|
my $p = $join_map; |
3667
|
517
|
|
100
|
|
|
3431
|
$p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries |
3668
|
517
|
|
|
|
|
586
|
push @{$p->{-join_aliases} }, $j->[0]{-alias}; |
|
517
|
|
|
|
|
2069
|
|
3669
|
|
|
|
|
|
|
} |
3670
|
|
|
|
|
|
|
} |
3671
|
|
|
|
|
|
|
|
3672
|
352
|
|
|
|
|
2975
|
my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map ); |
3673
|
|
|
|
|
|
|
|
3674
|
|
|
|
|
|
|
# save these for after distinct resolution |
3675
|
352
|
|
|
|
|
751
|
@prefetch_select = map { $_->[0] } @prefetch; |
|
1848
|
|
|
|
|
2354
|
|
3676
|
352
|
|
|
|
|
1094
|
@prefetch_as = map { $_->[1] } @prefetch; |
|
1848
|
|
|
|
|
2837
|
|
3677
|
|
|
|
|
|
|
} |
3678
|
|
|
|
|
|
|
|
3679
|
|
|
|
|
|
|
# run through the resulting joinstructure (starting from our current slot) |
3680
|
|
|
|
|
|
|
# and unset collapse if proven unnecessary |
3681
|
|
|
|
|
|
|
# |
3682
|
|
|
|
|
|
|
# also while we are at it find out if the current root source has |
3683
|
|
|
|
|
|
|
# been premultiplied by previous related_source chaining |
3684
|
|
|
|
|
|
|
# |
3685
|
|
|
|
|
|
|
# this allows to predict whether a root object with all other relation |
3686
|
|
|
|
|
|
|
# data set to NULL is in fact unique |
3687
|
8959
|
100
|
|
|
|
17378
|
if ($attrs->{collapse}) { |
3688
|
|
|
|
|
|
|
|
3689
|
388
|
50
|
|
|
|
1378
|
if (ref $attrs->{from} eq 'ARRAY') { |
3690
|
|
|
|
|
|
|
|
3691
|
388
|
100
|
|
|
|
444
|
if (@{$attrs->{from}} == 1) { |
|
388
|
|
|
|
|
1318
|
|
3692
|
|
|
|
|
|
|
# no joins - no collapse |
3693
|
63
|
|
|
|
|
198
|
$attrs->{collapse} = 0; |
3694
|
|
|
|
|
|
|
} |
3695
|
|
|
|
|
|
|
else { |
3696
|
|
|
|
|
|
|
# find where our table-spec starts |
3697
|
325
|
|
|
|
|
461
|
my @fromlist = @{$attrs->{from}}; |
|
325
|
|
|
|
|
772
|
|
3698
|
325
|
|
|
|
|
977
|
while (@fromlist) { |
3699
|
373
|
|
|
|
|
597
|
my $t = shift @fromlist; |
3700
|
|
|
|
|
|
|
|
3701
|
373
|
|
|
|
|
507
|
my $is_multi; |
3702
|
|
|
|
|
|
|
# me vs join from-spec distinction - a ref means non-root |
3703
|
373
|
100
|
|
|
|
1314
|
if (ref $t eq 'ARRAY') { |
3704
|
48
|
|
|
|
|
66
|
$t = $t->[0]; |
3705
|
48
|
|
66
|
|
|
181
|
$is_multi ||= ! $t->{-is_single}; |
3706
|
|
|
|
|
|
|
} |
3707
|
373
|
100
|
66
|
|
|
2596
|
last if ($t->{-alias} && $t->{-alias} eq $alias); |
3708
|
48
|
|
100
|
|
|
249
|
$attrs->{_main_source_premultiplied} ||= $is_multi; |
3709
|
|
|
|
|
|
|
} |
3710
|
|
|
|
|
|
|
|
3711
|
|
|
|
|
|
|
# no non-singles remaining, nor any premultiplication - nothing to collapse |
3712
|
325
|
100
|
66
|
|
|
2515
|
if ( |
3713
|
|
|
|
|
|
|
! $attrs->{_main_source_premultiplied} |
3714
|
|
|
|
|
|
|
and |
3715
|
404
|
|
|
404
|
|
1535
|
! List::Util::first { ! $_->[0]{-is_single} } @fromlist |
3716
|
|
|
|
|
|
|
) { |
3717
|
95
|
|
|
|
|
235
|
$attrs->{collapse} = 0; |
3718
|
|
|
|
|
|
|
} |
3719
|
|
|
|
|
|
|
} |
3720
|
|
|
|
|
|
|
} |
3721
|
|
|
|
|
|
|
|
3722
|
|
|
|
|
|
|
else { |
3723
|
|
|
|
|
|
|
# if we can not analyze the from - err on the side of safety |
3724
|
0
|
|
|
|
|
0
|
$attrs->{_main_source_premultiplied} = 1; |
3725
|
|
|
|
|
|
|
} |
3726
|
|
|
|
|
|
|
} |
3727
|
|
|
|
|
|
|
|
3728
|
|
|
|
|
|
|
# generate the distinct induced group_by before injecting the prefetched select/as parts |
3729
|
8959
|
100
|
|
|
|
18056
|
if (delete $attrs->{distinct}) { |
3730
|
70
|
100
|
|
|
|
168
|
if ($attrs->{group_by}) { |
3731
|
1
|
|
|
|
|
6
|
carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)"); |
3732
|
|
|
|
|
|
|
} |
3733
|
|
|
|
|
|
|
else { |
3734
|
69
|
|
|
|
|
139
|
$attrs->{_grouped_by_distinct} = 1; |
3735
|
|
|
|
|
|
|
# distinct affects only the main selection part, not what prefetch may add below |
3736
|
69
|
|
|
|
|
271
|
($attrs->{group_by}, my $new_order) = $source->storage->_group_over_selection($attrs); |
3737
|
|
|
|
|
|
|
|
3738
|
|
|
|
|
|
|
# FIXME possibly ignore a rewritten order_by (may turn out to be an issue) |
3739
|
|
|
|
|
|
|
# The thinking is: if we are collapsing the subquerying prefetch engine will |
3740
|
|
|
|
|
|
|
# rip stuff apart for us anyway, and we do not want to have a potentially |
3741
|
|
|
|
|
|
|
# function-converted external order_by |
3742
|
|
|
|
|
|
|
# ( there is an explicit if ( collapse && _grouped_by_distinct ) check in DBIHacks ) |
3743
|
69
|
100
|
|
|
|
295
|
$attrs->{order_by} = $new_order unless $attrs->{collapse}; |
3744
|
|
|
|
|
|
|
} |
3745
|
|
|
|
|
|
|
} |
3746
|
|
|
|
|
|
|
|
3747
|
|
|
|
|
|
|
# inject prefetch-bound selection (if any) |
3748
|
8959
|
|
|
|
|
9456
|
push @{$attrs->{select}}, @prefetch_select; |
|
8959
|
|
|
|
|
16230
|
|
3749
|
8959
|
|
|
|
|
8698
|
push @{$attrs->{as}}, @prefetch_as; |
|
8959
|
|
|
|
|
11928
|
|
3750
|
|
|
|
|
|
|
|
3751
|
|
|
|
|
|
|
$attrs->{_simple_passthrough_construction} = !( |
3752
|
|
|
|
|
|
|
$attrs->{collapse} |
3753
|
|
|
|
|
|
|
or |
3754
|
8959
|
|
100
|
|
|
21083
|
grep { $_ =~ /\./ } @{$attrs->{as}} |
3755
|
|
|
|
|
|
|
); |
3756
|
|
|
|
|
|
|
|
3757
|
|
|
|
|
|
|
# if both page and offset are specified, produce a combined offset |
3758
|
|
|
|
|
|
|
# even though it doesn't make much sense, this is what pre 081xx has |
3759
|
|
|
|
|
|
|
# been doing |
3760
|
8959
|
100
|
|
|
|
19807
|
if (my $page = delete $attrs->{page}) { |
3761
|
|
|
|
|
|
|
$attrs->{offset} = |
3762
|
|
|
|
|
|
|
($attrs->{rows} * ($page - 1)) |
3763
|
|
|
|
|
|
|
+ |
3764
|
15
|
|
100
|
|
|
66
|
($attrs->{offset} || 0) |
3765
|
|
|
|
|
|
|
; |
3766
|
|
|
|
|
|
|
} |
3767
|
|
|
|
|
|
|
|
3768
|
8959
|
|
|
|
|
59977
|
return $self->{_attrs} = $attrs; |
3769
|
|
|
|
|
|
|
} |
3770
|
|
|
|
|
|
|
|
3771
|
|
|
|
|
|
|
sub _rollout_attr { |
3772
|
2038
|
|
|
2038
|
|
2243
|
my ($self, $attr) = @_; |
3773
|
|
|
|
|
|
|
|
3774
|
2038
|
100
|
|
|
|
4851
|
if (ref $attr eq 'HASH') { |
|
|
100
|
|
|
|
|
|
3775
|
734
|
|
|
|
|
1948
|
return $self->_rollout_hash($attr); |
3776
|
|
|
|
|
|
|
} elsif (ref $attr eq 'ARRAY') { |
3777
|
940
|
|
|
|
|
1669
|
return $self->_rollout_array($attr); |
3778
|
|
|
|
|
|
|
} else { |
3779
|
364
|
|
|
|
|
793
|
return [$attr]; |
3780
|
|
|
|
|
|
|
} |
3781
|
|
|
|
|
|
|
} |
3782
|
|
|
|
|
|
|
|
3783
|
|
|
|
|
|
|
sub _rollout_array { |
3784
|
1280
|
|
|
1280
|
|
1195
|
my ($self, $attr) = @_; |
3785
|
|
|
|
|
|
|
|
3786
|
1280
|
|
|
|
|
1045
|
my @rolled_array; |
3787
|
1280
|
|
|
|
|
1050
|
foreach my $element (@{$attr}) { |
|
1280
|
|
|
|
|
1957
|
|
3788
|
1362
|
100
|
|
|
|
2883
|
if (ref $element eq 'HASH') { |
|
|
100
|
|
|
|
|
|
3789
|
474
|
|
|
|
|
481
|
push( @rolled_array, @{ $self->_rollout_hash( $element ) } ); |
|
474
|
|
|
|
|
854
|
|
3790
|
|
|
|
|
|
|
} elsif (ref $element eq 'ARRAY') { |
3791
|
|
|
|
|
|
|
# XXX - should probably recurse here |
3792
|
340
|
|
|
|
|
321
|
push( @rolled_array, @{$self->_rollout_array($element)} ); |
|
340
|
|
|
|
|
575
|
|
3793
|
|
|
|
|
|
|
} else { |
3794
|
548
|
|
|
|
|
984
|
push( @rolled_array, $element ); |
3795
|
|
|
|
|
|
|
} |
3796
|
|
|
|
|
|
|
} |
3797
|
1280
|
|
|
|
|
2194
|
return \@rolled_array; |
3798
|
|
|
|
|
|
|
} |
3799
|
|
|
|
|
|
|
|
3800
|
|
|
|
|
|
|
sub _rollout_hash { |
3801
|
1208
|
|
|
1208
|
|
1345
|
my ($self, $attr) = @_; |
3802
|
|
|
|
|
|
|
|
3803
|
1208
|
|
|
|
|
1174
|
my @rolled_array; |
3804
|
1208
|
|
|
|
|
1251
|
foreach my $key (keys %{$attr}) { |
|
1208
|
|
|
|
|
2813
|
|
3805
|
242
|
|
|
|
|
728
|
push( @rolled_array, { $key => $attr->{$key} } ); |
3806
|
|
|
|
|
|
|
} |
3807
|
1208
|
|
|
|
|
2532
|
return \@rolled_array; |
3808
|
|
|
|
|
|
|
} |
3809
|
|
|
|
|
|
|
|
3810
|
|
|
|
|
|
|
sub _calculate_score { |
3811
|
324
|
|
|
324
|
|
444
|
my ($self, $a, $b) = @_; |
3812
|
|
|
|
|
|
|
|
3813
|
324
|
100
|
100
|
|
|
1907
|
if (defined $a xor defined $b) { |
|
|
100
|
|
|
|
|
|
3814
|
44
|
|
|
|
|
82
|
return 0; |
3815
|
|
|
|
|
|
|
} |
3816
|
|
|
|
|
|
|
elsif (not defined $a) { |
3817
|
10
|
|
|
|
|
24
|
return 1; |
3818
|
|
|
|
|
|
|
} |
3819
|
|
|
|
|
|
|
|
3820
|
270
|
100
|
|
|
|
563
|
if (ref $b eq 'HASH') { |
3821
|
92
|
|
|
|
|
96
|
my ($b_key) = keys %{$b}; |
|
92
|
|
|
|
|
201
|
|
3822
|
92
|
100
|
|
|
|
214
|
$b_key = '' if ! defined $b_key; |
3823
|
92
|
100
|
|
|
|
191
|
if (ref $a eq 'HASH') { |
3824
|
35
|
|
|
|
|
45
|
my ($a_key) = keys %{$a}; |
|
35
|
|
|
|
|
69
|
|
3825
|
35
|
100
|
|
|
|
98
|
$a_key = '' if ! defined $a_key; |
3826
|
35
|
100
|
|
|
|
71
|
if ($a_key eq $b_key) { |
3827
|
25
|
|
|
|
|
71
|
return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} )); |
3828
|
|
|
|
|
|
|
} else { |
3829
|
10
|
|
|
|
|
23
|
return 0; |
3830
|
|
|
|
|
|
|
} |
3831
|
|
|
|
|
|
|
} else { |
3832
|
57
|
100
|
|
|
|
152
|
return ($a eq $b_key) ? 1 : 0; |
3833
|
|
|
|
|
|
|
} |
3834
|
|
|
|
|
|
|
} else { |
3835
|
178
|
100
|
|
|
|
375
|
if (ref $a eq 'HASH') { |
3836
|
30
|
|
|
|
|
35
|
my ($a_key) = keys %{$a}; |
|
30
|
|
|
|
|
69
|
|
3837
|
30
|
100
|
|
|
|
101
|
return ($b eq $a_key) ? 1 : 0; |
3838
|
|
|
|
|
|
|
} else { |
3839
|
148
|
100
|
|
|
|
434
|
return ($b eq $a) ? 1 : 0; |
3840
|
|
|
|
|
|
|
} |
3841
|
|
|
|
|
|
|
} |
3842
|
|
|
|
|
|
|
} |
3843
|
|
|
|
|
|
|
|
3844
|
|
|
|
|
|
|
sub _merge_joinpref_attr { |
3845
|
2829
|
|
|
2829
|
|
16660
|
my ($self, $orig, $import) = @_; |
3846
|
|
|
|
|
|
|
|
3847
|
2829
|
100
|
|
|
|
8896
|
return $import unless defined($orig); |
3848
|
1042
|
100
|
|
|
|
2101
|
return $orig unless defined($import); |
3849
|
|
|
|
|
|
|
|
3850
|
1019
|
|
|
|
|
2529
|
$orig = $self->_rollout_attr($orig); |
3851
|
1019
|
|
|
|
|
2085
|
$import = $self->_rollout_attr($import); |
3852
|
|
|
|
|
|
|
|
3853
|
1019
|
|
|
|
|
999
|
my $seen_keys; |
3854
|
1019
|
|
|
|
|
1059
|
foreach my $import_element ( @{$import} ) { |
|
1019
|
|
|
|
|
1680
|
|
3855
|
|
|
|
|
|
|
# find best candidate from $orig to merge $b_element into |
3856
|
865
|
|
|
|
|
2116
|
my $best_candidate = { position => undef, score => 0 }; my $position = 0; |
|
865
|
|
|
|
|
1342
|
|
3857
|
865
|
|
|
|
|
805
|
foreach my $orig_element ( @{$orig} ) { |
|
865
|
|
|
|
|
1292
|
|
3858
|
299
|
|
|
|
|
816
|
my $score = $self->_calculate_score( $orig_element, $import_element ); |
3859
|
299
|
100
|
|
|
|
743
|
if ($score > $best_candidate->{score}) { |
3860
|
90
|
|
|
|
|
112
|
$best_candidate->{position} = $position; |
3861
|
90
|
|
|
|
|
144
|
$best_candidate->{score} = $score; |
3862
|
|
|
|
|
|
|
} |
3863
|
299
|
|
|
|
|
425
|
$position++; |
3864
|
|
|
|
|
|
|
} |
3865
|
865
|
100
|
|
|
|
1970
|
my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element); |
|
176
|
|
|
|
|
345
|
|
3866
|
865
|
100
|
|
|
|
2001
|
$import_key = '' if not defined $import_key; |
3867
|
|
|
|
|
|
|
|
3868
|
865
|
100
|
66
|
|
|
2546
|
if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) { |
3869
|
794
|
|
|
|
|
792
|
push( @{$orig}, $import_element ); |
|
794
|
|
|
|
|
1304
|
|
3870
|
|
|
|
|
|
|
} else { |
3871
|
71
|
|
|
|
|
117
|
my $orig_best = $orig->[$best_candidate->{position}]; |
3872
|
|
|
|
|
|
|
# merge orig_best and b_element together and replace original with merged |
3873
|
71
|
100
|
|
|
|
187
|
if (ref $orig_best ne 'HASH') { |
|
|
100
|
|
|
|
|
|
3874
|
46
|
|
|
|
|
82
|
$orig->[$best_candidate->{position}] = $import_element; |
3875
|
|
|
|
|
|
|
} elsif (ref $import_element eq 'HASH') { |
3876
|
15
|
|
|
|
|
25
|
my ($key) = keys %{$orig_best}; |
|
15
|
|
|
|
|
28
|
|
3877
|
15
|
|
|
|
|
59
|
$orig->[$best_candidate->{position}] = { $key => $self->_merge_joinpref_attr($orig_best->{$key}, $import_element->{$key}) }; |
3878
|
|
|
|
|
|
|
} |
3879
|
|
|
|
|
|
|
} |
3880
|
865
|
|
|
|
|
2347
|
$seen_keys->{$import_key} = 1; # don't merge the same key twice |
3881
|
|
|
|
|
|
|
} |
3882
|
|
|
|
|
|
|
|
3883
|
1019
|
100
|
|
|
|
3008
|
return @$orig ? $orig : (); |
3884
|
|
|
|
|
|
|
} |
3885
|
|
|
|
|
|
|
|
3886
|
|
|
|
|
|
|
{ |
3887
|
|
|
|
|
|
|
my $hm; |
3888
|
|
|
|
|
|
|
|
3889
|
|
|
|
|
|
|
sub _merge_attr { |
3890
|
17197
|
|
66
|
17197
|
|
31669
|
$hm ||= do { |
3891
|
185
|
|
|
|
|
110813
|
require Hash::Merge; |
3892
|
185
|
|
|
|
|
430914
|
my $hm = Hash::Merge->new; |
3893
|
|
|
|
|
|
|
|
3894
|
|
|
|
|
|
|
$hm->specify_behavior({ |
3895
|
|
|
|
|
|
|
SCALAR => { |
3896
|
|
|
|
|
|
|
SCALAR => sub { |
3897
|
72
|
|
|
72
|
|
1462
|
my ($defl, $defr) = map { defined $_ } (@_[0,1]); |
|
144
|
|
|
|
|
355
|
|
3898
|
|
|
|
|
|
|
|
3899
|
72
|
50
|
25
|
|
|
475
|
if ($defl xor $defr) { |
|
|
0
|
|
|
|
|
|
3900
|
72
|
50
|
|
|
|
474
|
return [ $defl ? $_[0] : $_[1] ]; |
3901
|
|
|
|
|
|
|
} |
3902
|
|
|
|
|
|
|
elsif (! $defl) { |
3903
|
0
|
|
|
|
|
0
|
return []; |
3904
|
|
|
|
|
|
|
} |
3905
|
|
|
|
|
|
|
elsif (__HM_DEDUP and $_[0] eq $_[1]) { |
3906
|
|
|
|
|
|
|
return [ $_[0] ]; |
3907
|
|
|
|
|
|
|
} |
3908
|
|
|
|
|
|
|
else { |
3909
|
0
|
|
|
|
|
0
|
return [$_[0], $_[1]]; |
3910
|
|
|
|
|
|
|
} |
3911
|
|
|
|
|
|
|
}, |
3912
|
|
|
|
|
|
|
ARRAY => sub { |
3913
|
5909
|
50
|
|
5909
|
|
82461
|
return $_[1] if !defined $_[0]; |
3914
|
0
|
|
|
|
|
0
|
return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]}; |
3915
|
0
|
|
|
|
|
0
|
return [$_[0], @{$_[1]}] |
|
0
|
|
|
|
|
0
|
|
3916
|
|
|
|
|
|
|
}, |
3917
|
|
|
|
|
|
|
HASH => sub { |
3918
|
867
|
100
|
33
|
867
|
|
13552
|
return [] if !defined $_[0] and !keys %{$_[1]}; |
|
867
|
|
|
|
|
2953
|
|
3919
|
866
|
50
|
|
|
|
4483
|
return [ $_[1] ] if !defined $_[0]; |
3920
|
0
|
0
|
|
|
|
0
|
return [ $_[0] ] if !keys %{$_[1]}; |
|
0
|
|
|
|
|
0
|
|
3921
|
0
|
|
|
|
|
0
|
return [$_[0], $_[1]] |
3922
|
|
|
|
|
|
|
}, |
3923
|
|
|
|
|
|
|
}, |
3924
|
|
|
|
|
|
|
ARRAY => { |
3925
|
|
|
|
|
|
|
SCALAR => sub { |
3926
|
10224
|
100
|
|
10224
|
|
177244
|
return $_[0] if !defined $_[1]; |
3927
|
1
|
|
|
|
|
2
|
return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]}; |
3928
|
1
|
|
|
|
|
2
|
return [@{$_[0]}, $_[1]] |
|
1
|
|
|
|
|
4
|
|
3929
|
|
|
|
|
|
|
}, |
3930
|
|
|
|
|
|
|
ARRAY => sub { |
3931
|
125
|
100
|
|
125
|
|
1538
|
my @ret = @{$_[0]} or return $_[1]; |
|
125
|
|
|
|
|
536
|
|
3932
|
120
|
|
|
|
|
202
|
return [ @ret, @{$_[1]} ] unless __HM_DEDUP; |
|
120
|
|
|
|
|
479
|
|
3933
|
0
|
|
|
|
|
0
|
my %idx = map { $_ => 1 } @ret; |
|
0
|
|
|
|
|
0
|
|
3934
|
0
|
|
|
|
|
0
|
push @ret, grep { ! defined $idx{$_} } (@{$_[1]}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
3935
|
0
|
|
|
|
|
0
|
\@ret; |
3936
|
|
|
|
|
|
|
}, |
3937
|
|
|
|
|
|
|
HASH => sub { |
3938
|
0
|
0
|
|
0
|
|
0
|
return [ $_[1] ] if ! @{$_[0]}; |
|
0
|
|
|
|
|
0
|
|
3939
|
0
|
0
|
|
|
|
0
|
return $_[0] if !keys %{$_[1]}; |
|
0
|
|
|
|
|
0
|
|
3940
|
0
|
|
|
|
|
0
|
return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]}; |
3941
|
0
|
|
|
|
|
0
|
return [ @{$_[0]}, $_[1] ]; |
|
0
|
|
|
|
|
0
|
|
3942
|
|
|
|
|
|
|
}, |
3943
|
|
|
|
|
|
|
}, |
3944
|
|
|
|
|
|
|
HASH => { |
3945
|
|
|
|
|
|
|
SCALAR => sub { |
3946
|
0
|
0
|
0
|
0
|
|
0
|
return [] if !keys %{$_[0]} and !defined $_[1]; |
|
0
|
|
|
|
|
0
|
|
3947
|
0
|
0
|
|
|
|
0
|
return [ $_[0] ] if !defined $_[1]; |
3948
|
0
|
0
|
|
|
|
0
|
return [ $_[1] ] if !keys %{$_[0]}; |
|
0
|
|
|
|
|
0
|
|
3949
|
0
|
|
|
|
|
0
|
return [$_[0], $_[1]] |
3950
|
|
|
|
|
|
|
}, |
3951
|
|
|
|
|
|
|
ARRAY => sub { |
3952
|
0
|
0
|
0
|
0
|
|
0
|
return [] if !keys %{$_[0]} and !@{$_[1]}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
3953
|
0
|
0
|
|
|
|
0
|
return [ $_[0] ] if !@{$_[1]}; |
|
0
|
|
|
|
|
0
|
|
3954
|
0
|
0
|
|
|
|
0
|
return $_[1] if !keys %{$_[0]}; |
|
0
|
|
|
|
|
0
|
|
3955
|
0
|
|
|
|
|
0
|
return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]}; |
3956
|
0
|
|
|
|
|
0
|
return [ $_[0], @{$_[1]} ]; |
|
0
|
|
|
|
|
0
|
|
3957
|
|
|
|
|
|
|
}, |
3958
|
|
|
|
|
|
|
HASH => sub { |
3959
|
0
|
0
|
0
|
0
|
|
0
|
return [] if !keys %{$_[0]} and !keys %{$_[1]}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
3960
|
0
|
0
|
|
|
|
0
|
return [ $_[0] ] if !keys %{$_[1]}; |
|
0
|
|
|
|
|
0
|
|
3961
|
0
|
0
|
|
|
|
0
|
return [ $_[1] ] if !keys %{$_[0]}; |
|
0
|
|
|
|
|
0
|
|
3962
|
0
|
0
|
|
|
|
0
|
return [ $_[0] ] if $_[0] eq $_[1]; |
3963
|
0
|
|
|
|
|
0
|
return [ $_[0], $_[1] ]; |
3964
|
|
|
|
|
|
|
}, |
3965
|
|
|
|
|
|
|
} |
3966
|
185
|
|
|
|
|
6889
|
} => 'DBIC_RS_ATTR_MERGER'); |
3967
|
185
|
|
|
|
|
6073
|
$hm; |
3968
|
|
|
|
|
|
|
}; |
3969
|
|
|
|
|
|
|
|
3970
|
17197
|
|
|
|
|
51431
|
return $hm->merge ($_[1], $_[2]); |
3971
|
|
|
|
|
|
|
} |
3972
|
|
|
|
|
|
|
} |
3973
|
|
|
|
|
|
|
|
3974
|
|
|
|
|
|
|
sub STORABLE_freeze { |
3975
|
146
|
|
|
146
|
0
|
2741
|
my ($self, $cloning) = @_; |
3976
|
146
|
|
|
|
|
686
|
my $to_serialize = { %$self }; |
3977
|
|
|
|
|
|
|
|
3978
|
|
|
|
|
|
|
# A cursor in progress can't be serialized (and would make little sense anyway) |
3979
|
|
|
|
|
|
|
# the parser can be regenerated (and can't be serialized) |
3980
|
146
|
|
|
|
|
187
|
delete @{$to_serialize}{qw/cursor _row_parser _result_inflator/}; |
|
146
|
|
|
|
|
219
|
|
3981
|
|
|
|
|
|
|
|
3982
|
|
|
|
|
|
|
# nor is it sensical to store a not-yet-fired-count pager |
3983
|
146
|
100
|
100
|
|
|
331
|
if ($to_serialize->{pager} and ref $to_serialize->{pager}{total_entries} eq 'CODE') { |
3984
|
1
|
|
|
|
|
3
|
delete $to_serialize->{pager}; |
3985
|
|
|
|
|
|
|
} |
3986
|
|
|
|
|
|
|
|
3987
|
146
|
|
|
|
|
276
|
Storable::nfreeze($to_serialize); |
3988
|
|
|
|
|
|
|
} |
3989
|
|
|
|
|
|
|
|
3990
|
|
|
|
|
|
|
# need this hook for symmetry |
3991
|
|
|
|
|
|
|
sub STORABLE_thaw { |
3992
|
146
|
|
|
146
|
0
|
1046
|
my ($self, $cloning, $serialized) = @_; |
3993
|
|
|
|
|
|
|
|
3994
|
146
|
|
|
|
|
100
|
%$self = %{ Storable::thaw($serialized) }; |
|
146
|
|
|
|
|
258
|
|
3995
|
|
|
|
|
|
|
|
3996
|
146
|
|
|
|
|
2475
|
$self; |
3997
|
|
|
|
|
|
|
} |
3998
|
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
|
|
4000
|
|
|
|
|
|
|
=head2 throw_exception |
4001
|
|
|
|
|
|
|
|
4002
|
|
|
|
|
|
|
See L for details. |
4003
|
|
|
|
|
|
|
|
4004
|
|
|
|
|
|
|
=cut |
4005
|
|
|
|
|
|
|
|
4006
|
|
|
|
|
|
|
sub throw_exception { |
4007
|
57
|
|
|
57
|
1
|
2237
|
my $self=shift; |
4008
|
|
|
|
|
|
|
|
4009
|
57
|
100
|
66
|
|
|
313
|
if (ref $self and my $rsrc = $self->result_source) { |
4010
|
56
|
|
|
|
|
244
|
$rsrc->throw_exception(@_) |
4011
|
|
|
|
|
|
|
} |
4012
|
|
|
|
|
|
|
else { |
4013
|
1
|
|
|
|
|
5
|
DBIx::Class::Exception->throw(@_); |
4014
|
|
|
|
|
|
|
} |
4015
|
|
|
|
|
|
|
} |
4016
|
|
|
|
|
|
|
|
4017
|
|
|
|
|
|
|
1; |
4018
|
|
|
|
|
|
|
|
4019
|
|
|
|
|
|
|
__END__ |