-
Notifications
You must be signed in to change notification settings - Fork 151
/
ResultSet.pm
4437 lines (3328 loc) · 123 KB
/
ResultSet.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
package DBIx::Class::ResultSet;
use strict;
use warnings;
use base qw/DBIx::Class/;
use DBIx::Class::Carp;
use DBIx::Class::ResultSetColumn;
use Scalar::Util qw/blessed weaken reftype/;
use Try::Tiny;
use Data::Compare (); # no imports!!! guard against insane architecture
# not importing first() as it will clash with our own method
use List::Util ();
BEGIN {
# De-duplication in _merge_attr() is disabled, but left in for reference
# (the merger is used for other things that ought not to be de-duped)
*__HM_DEDUP = sub () { 0 };
}
use namespace::clean;
use overload
'0+' => "count",
'bool' => "_bool",
fallback => 1;
# this is real - CDBICompat overrides it with insanity
# yes, prototype won't matter, but that's for now ;)
sub _bool () { 1 }
__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
=head1 NAME
DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
=head1 SYNOPSIS
my $users_rs = $schema->resultset('User');
while( $user = $users_rs->next) {
print $user->username;
}
my $registered_users_rs = $schema->resultset('User')->search({ registered => 1 });
my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
=head1 DESCRIPTION
A ResultSet is an object which stores a set of conditions representing
a query. It is the backbone of DBIx::Class (i.e. the really
important/useful bit).
No SQL is executed on the database when a ResultSet is created, it
just stores all the conditions needed to create the query.
A basic ResultSet representing the data of an entire table is returned
by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
L<Source|DBIx::Class::Manual::Glossary/Source> name.
my $users_rs = $schema->resultset('User');
A new ResultSet is returned from calling L</search> on an existing
ResultSet. The new one will contain all the conditions of the
original, plus any new conditions added in the C<search> call.
A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
can be used to walk through all the L<DBIx::Class::Row>s the ResultSet
represents.
The query that the ResultSet represents is B<only> executed against
the database when these methods are called:
L</find>, L</next>, L</all>, L</first>, L</single>, L</count>.
If a resultset is used in a numeric context it returns the L</count>.
However, if it is used in a boolean context it is B<always> true. So if
you want to check if a resultset has any results, you must use C<if $rs
!= 0>.
=head1 CUSTOM ResultSet CLASSES THAT USE Moose
If you want to make your custom ResultSet classes with L<Moose>, use a template
similar to:
package MyApp::Schema::ResultSet::User;
use Moose;
use namespace::autoclean;
use MooseX::NonMoose;
extends 'DBIx::Class::ResultSet';
sub BUILDARGS { $_[2] }
...your code...
__PACKAGE__->meta->make_immutable;
1;
The L<MooseX::NonMoose> is necessary so that the L<Moose> constructor does not
clash with the regular ResultSet constructor. Alternatively, you can use:
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
The L<BUILDARGS|Moose::Manual::Construction/BUILDARGS> is necessary because the
signature of the ResultSet C<new> is C<< ->new($source, \%args) >>.
=head1 EXAMPLES
=head2 Chaining resultsets
Let's say you've got a query that needs to be run to return some data
to the user. But, you have an authorization system in place that
prevents certain users from seeing certain information. So, you want
to construct the basic query in one method, but add constraints to it in
another.
sub get_data {
my $self = shift;
my $request = $self->get_request; # Get a request object somehow.
my $schema = $self->result_source->schema;
my $cd_rs = $schema->resultset('CD')->search({
title => $request->param('title'),
year => $request->param('year'),
});
$cd_rs = $self->apply_security_policy( $cd_rs );
return $cd_rs->all();
}
sub apply_security_policy {
my $self = shift;
my ($rs) = @_;
return $rs->search({
subversive => 0,
});
}
=head3 Resolving conditions and attributes
When a resultset is chained from another resultset, conditions and
attributes with the same keys need resolving.
L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
into the existing ones from the original resultset.
The L</where> and L</having> attributes, and any search conditions, are
merged with an SQL C<AND> to the existing condition from the original
resultset.
All other attributes are overridden by any new ones supplied in the
search attributes.
=head2 Multiple queries
Since a resultset just defines a query, you can do all sorts of
things with it with the same object.
# Don't hit the DB yet.
my $cd_rs = $schema->resultset('CD')->search({
title => 'something',
year => 2009,
});
# Each of these hits the DB individually.
my $count = $cd_rs->count;
my $most_recent = $cd_rs->get_column('date_released')->max();
my @records = $cd_rs->all;
And it's not just limited to SELECT statements.
$cd_rs->delete();
This is even cooler:
$cd_rs->create({ artist => 'Fred' });
Which is the same as:
$schema->resultset('CD')->create({
title => 'something',
year => 2009,
artist => 'Fred'
});
See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
=head1 METHODS
=head2 new
=over 4
=item Arguments: L<$source|DBIx::Class::ResultSource>, L<\%attrs?|/ATTRIBUTES>
=item Return Value: L<$resultset|/search>
=back
The resultset constructor. Takes a source object (usually a
L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see
L</ATTRIBUTES> below). Does not perform any queries -- these are
executed as needed by the other methods.
Generally you never construct a resultset manually. Instead you get one
from e.g. a
C<< $schema->L<resultset|DBIx::Class::Schema/resultset>('$source_name') >>
or C<< $another_resultset->L<search|/search>(...) >> (the later called in
scalar context):
my $rs = $schema->resultset('CD')->search({ title => '100th Window' });
=over
=item WARNING
If called on an object, proxies to L</new_result> instead, so
my $cd = $schema->resultset('CD')->new({ title => 'Spoon' });
will return a CD object, not a ResultSet, and is equivalent to:
my $cd = $schema->resultset('CD')->new_result({ title => 'Spoon' });
Please also keep in mind that many internals call L</new_result> directly,
so overloading this method with the idea of intercepting new result object
creation B<will not work>. See also warning pertaining to L</create>.
=back
=cut
sub new {
my $class = shift;
return $class->new_result(@_) if ref $class;
my ($source, $attrs) = @_;
$source = $source->resolve
if $source->isa('DBIx::Class::ResultSourceHandle');
$attrs = { %{$attrs||{}} };
if ($attrs->{page}) {
$attrs->{rows} ||= 10;
}
$attrs->{alias} ||= 'me';
my $self = bless {
result_source => $source,
cond => $attrs->{where},
pager => undef,
attrs => $attrs,
}, $class;
# if there is a dark selector, this means we are already in a
# chain and the cleanup/sanification was taken care of by
# _search_rs already
$self->_normalize_selection($attrs)
unless $attrs->{_dark_selector};
$self->result_class(
$attrs->{result_class} || $source->result_class
);
$self;
}
=head2 search
=over 4
=item Arguments: L<$cond|DBIx::Class::SQLMaker> | undef, L<\%attrs?|/ATTRIBUTES>
=item Return Value: $resultset (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
=back
my @cds = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
my $new_rs = $cd_rs->search({ year => 2005 });
my $new_rs = $cd_rs->search([ { year => 2005 }, { year => 2004 } ]);
# year = 2005 OR year = 2004
In list context, C<< ->all() >> is called implicitly on the resultset, thus
returning a list of L<result|DBIx::Class::Manual::ResultClass> objects instead.
To avoid that, use L</search_rs>.
If you need to pass in additional attributes but no additional condition,
call it as C<search(undef, \%attrs)>.
# "SELECT name, artistid FROM $artist_table"
my @all_artists = $schema->resultset('Artist')->search(undef, {
columns => [qw/name artistid/],
});
For a list of attributes that can be passed to C<search>, see
L</ATTRIBUTES>. For more examples of using this function, see
L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
documentation for the first argument, see L<SQL::Abstract>
and its extension L<DBIx::Class::SQLMaker>.
For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
=head3 CAVEAT
Note that L</search> does not process/deflate any of the values passed in the
L<SQL::Abstract>-compatible search condition structure. This is unlike other
condition-bound methods L</new_result>, L</create> and L</find>. The user must ensure
manually that any value passed to this method will stringify to something the
RDBMS knows how to deal with. A notable example is the handling of L<DateTime>
objects, for more info see:
L<DBIx::Class::Manual::Cookbook/Formatting DateTime objects in queries>.
=cut
sub search {
my $self = shift;
my $rs = $self->search_rs( @_ );
if (wantarray) {
return $rs->all;
}
elsif (defined wantarray) {
return $rs;
}
else {
# we can be called by a relationship helper, which in
# turn may be called in void context due to some braindead
# overload or whatever else the user decided to be clever
# at this particular day. Thus limit the exception to
# external code calls only
$self->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense')
if (caller)[0] !~ /^\QDBIx::Class::/;
return ();
}
}
=head2 search_rs
=over 4
=item Arguments: L<$cond|DBIx::Class::SQLMaker>, L<\%attrs?|/ATTRIBUTES>
=item Return Value: L<$resultset|/search>
=back
This method does the same exact thing as search() except it will
always return a resultset, even in list context.
=cut
sub search_rs {
my $self = shift;
my $rsrc = $self->result_source;
my ($call_cond, $call_attrs);
# Special-case handling for (undef, undef) or (undef)
# Note that (foo => undef) is valid deprecated syntax
@_ = () if not scalar grep { defined $_ } @_;
# just a cond
if (@_ == 1) {
$call_cond = shift;
}
# fish out attrs in the ($condref, $attr) case
elsif (@_ == 2 and ( ! defined $_[0] or (ref $_[0]) ne '') ) {
($call_cond, $call_attrs) = @_;
}
elsif (@_ % 2) {
$self->throw_exception('Odd number of arguments to search')
}
# legacy search
elsif (@_) {
carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead'
unless $rsrc->result_class->isa('DBIx::Class::CDBICompat');
for my $i (0 .. $#_) {
next if $i % 2;
$self->throw_exception ('All keys in condition key/value pairs must be plain scalars')
if (! defined $_[$i] or ref $_[$i] ne '');
}
$call_cond = { @_ };
}
# see if we can keep the cache (no $rs changes)
my $cache;
my %safe = (alias => 1, cache => 1);
if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
! defined $call_cond
or
ref $call_cond eq 'HASH' && ! keys %$call_cond
or
ref $call_cond eq 'ARRAY' && ! @$call_cond
)) {
$cache = $self->get_cache;
}
my $old_attrs = { %{$self->{attrs}} };
my $old_having = delete $old_attrs->{having};
my $old_where = delete $old_attrs->{where};
my $new_attrs = { %$old_attrs };
# take care of call attrs (only if anything is changing)
if ($call_attrs and keys %$call_attrs) {
# copy for _normalize_selection
$call_attrs = { %$call_attrs };
my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
# reset the current selector list if new selectors are supplied
if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
}
# Normalize the new selector list (operates on the passed-in attr structure)
# Need to do it on every chain instead of only once on _resolved_attrs, in
# order to allow detection of empty vs partial 'as'
$call_attrs->{_dark_selector} = $old_attrs->{_dark_selector}
if $old_attrs->{_dark_selector};
$self->_normalize_selection ($call_attrs);
# start with blind overwriting merge, exclude selector attrs
$new_attrs = { %{$old_attrs}, %{$call_attrs} };
delete @{$new_attrs}{@selector_attrs};
for (@selector_attrs) {
$new_attrs->{$_} = $self->_merge_attr($old_attrs->{$_}, $call_attrs->{$_})
if ( exists $old_attrs->{$_} or exists $call_attrs->{$_} );
}
# older deprecated name, use only if {columns} is not there
if (my $c = delete $new_attrs->{cols}) {
carp_unique( "Resultset attribute 'cols' is deprecated, use 'columns' instead" );
if ($new_attrs->{columns}) {
carp "Resultset specifies both the 'columns' and the legacy 'cols' attributes - ignoring 'cols'";
}
else {
$new_attrs->{columns} = $c;
}
}
# join/prefetch use their own crazy merging heuristics
foreach my $key (qw/join prefetch/) {
$new_attrs->{$key} = $self->_merge_joinpref_attr($old_attrs->{$key}, $call_attrs->{$key})
if exists $call_attrs->{$key};
}
# stack binds together
$new_attrs->{bind} = [ @{ $old_attrs->{bind} || [] }, @{ $call_attrs->{bind} || [] } ];
}
for ($old_where, $call_cond) {
if (defined $_) {
$new_attrs->{where} = $self->_stack_cond (
$_, $new_attrs->{where}
);
}
}
if (defined $old_having) {
$new_attrs->{having} = $self->_stack_cond (
$old_having, $new_attrs->{having}
)
}
my $rs = (ref $self)->new($rsrc, $new_attrs);
$rs->set_cache($cache) if ($cache);
return $rs;
}
my $dark_sel_dumper;
sub _normalize_selection {
my ($self, $attrs) = @_;
# legacy syntax
if ( exists $attrs->{include_columns} ) {
carp_unique( "Resultset attribute 'include_columns' is deprecated, use '+columns' instead" );
$attrs->{'+columns'} = $self->_merge_attr(
$attrs->{'+columns'}, delete $attrs->{include_columns}
);
}
# columns are always placed first, however
# Keep the X vs +X separation until _resolved_attrs time - this allows to
# delay the decision on whether to use a default select list ($rsrc->columns)
# allowing stuff like the remove_columns helper to work
#
# select/as +select/+as pairs need special handling - the amount of select/as
# elements in each pair does *not* have to be equal (think multicolumn
# selectors like distinct(foo, bar) ). If the selector is bare (no 'as'
# supplied at all) - try to infer the alias, either from the -as parameter
# of the selector spec, or use the parameter whole if it looks like a column
# name (ugly legacy heuristic). If all fails - leave the selector bare (which
# is ok as well), but make sure no more additions to the 'as' chain take place
for my $pref ('', '+') {
my ($sel, $as) = map {
my $key = "${pref}${_}";
my $val = [ ref $attrs->{$key} eq 'ARRAY'
? @{$attrs->{$key}}
: $attrs->{$key} || ()
];
delete $attrs->{$key};
$val;
} qw/select as/;
if (! @$as and ! @$sel ) {
next;
}
elsif (@$as and ! @$sel) {
$self->throw_exception(
"Unable to handle ${pref}as specification (@$as) without a corresponding ${pref}select"
);
}
elsif( ! @$as ) {
# no as part supplied at all - try to deduce (unless explicit end of named selection is declared)
# if any @$as has been supplied we assume the user knows what (s)he is doing
# and blindly keep stacking up pieces
unless ($attrs->{_dark_selector}) {
SELECTOR:
for (@$sel) {
if ( ref $_ eq 'HASH' and exists $_->{-as} ) {
push @$as, $_->{-as};
}
# assume any plain no-space, no-parenthesis string to be a column spec
# FIXME - this is retarded but is necessary to support shit like 'count(foo)'
elsif ( ! ref $_ and $_ =~ /^ [^\s\(\)]+ $/x) {
push @$as, $_;
}
# if all else fails - raise a flag that no more aliasing will be allowed
else {
$attrs->{_dark_selector} = {
plus_stage => $pref,
string => ($dark_sel_dumper ||= do {
require Data::Dumper::Concise;
Data::Dumper::Concise::DumperObject()->Indent(0);
})->Values([$_])->Dump
,
};
last SELECTOR;
}
}
}
}
elsif (@$as < @$sel) {
$self->throw_exception(
"Unable to handle an ${pref}as specification (@$as) with less elements than the corresponding ${pref}select"
);
}
elsif ($pref and $attrs->{_dark_selector}) {
$self->throw_exception(
"Unable to process named '+select', resultset contains an unnamed selector $attrs->{_dark_selector}{string}"
);
}
# merge result
$attrs->{"${pref}select"} = $self->_merge_attr($attrs->{"${pref}select"}, $sel);
$attrs->{"${pref}as"} = $self->_merge_attr($attrs->{"${pref}as"}, $as);
}
}
sub _stack_cond {
my ($self, $left, $right) = @_;
# collapse single element top-level conditions
# (single pass only, unlikely to need recursion)
for ($left, $right) {
if (ref $_ eq 'ARRAY') {
if (@$_ == 0) {
$_ = undef;
}
elsif (@$_ == 1) {
$_ = $_->[0];
}
}
elsif (ref $_ eq 'HASH') {
my ($first, $more) = keys %$_;
# empty hash
if (! defined $first) {
$_ = undef;
}
# one element hash
elsif (! defined $more) {
if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
$_ = $_->{'-and'};
}
elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
$_ = $_->{'-or'};
}
}
}
}
# merge hashes with weeding out of duplicates (simple cases only)
if (ref $left eq 'HASH' and ref $right eq 'HASH') {
# shallow copy to destroy
$right = { %$right };
for (grep { exists $right->{$_} } keys %$left) {
# the use of eq_deeply here is justified - the rhs of an
# expression can contain a lot of twisted weird stuff
delete $right->{$_} if Data::Compare::Compare( $left->{$_}, $right->{$_} );
}
$right = undef unless keys %$right;
}
if (defined $left xor defined $right) {
return defined $left ? $left : $right;
}
elsif (! defined $left) {
return undef;
}
else {
return { -and => [ $left, $right ] };
}
}
=head2 search_literal
B<CAVEAT>: C<search_literal> is provided for Class::DBI compatibility and
should only be used in that context. C<search_literal> is a convenience
method. It is equivalent to calling C<< $schema->search(\[]) >>, but if you
want to ensure columns are bound correctly, use L</search>.
See L<DBIx::Class::Manual::Cookbook/Searching> and
L<DBIx::Class::Manual::FAQ/Searching> for searching techniques that do not
require C<search_literal>.
=over 4
=item Arguments: $sql_fragment, @standalone_bind_values
=item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
=back
my @cds = $cd_rs->search_literal('year = ? AND title = ?', qw/2001 Reload/);
my $newrs = $artist_rs->search_literal('name = ?', 'Metallica');
Pass a literal chunk of SQL to be added to the conditional part of the
resultset query.
Example of how to use C<search> instead of C<search_literal>
my @cds = $cd_rs->search_literal('cdid = ? AND (artist = ? OR artist = ?)', (2, 1, 2));
my @cds = $cd_rs->search(\[ 'cdid = ? AND (artist = ? OR artist = ?)', [ 'cdid', 2 ], [ 'artist', 1 ], [ 'artist', 2 ] ]);
=cut
sub search_literal {
my ($self, $sql, @bind) = @_;
my $attr;
if ( @bind && ref($bind[-1]) eq 'HASH' ) {
$attr = pop @bind;
}
return $self->search(\[ $sql, map [ {} => $_ ], @bind ], ($attr || () ));
}
=head2 find
=over 4
=item Arguments: \%columns_values | @pk_values, { key => $unique_constraint, L<%attrs|/ATTRIBUTES> }?
=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> | undef
=back
Finds and returns a single row based on supplied criteria. Takes either a
hashref with the same format as L</create> (including inference of foreign
keys from related objects), or a list of primary key values in the same
order as the L<primary columns|DBIx::Class::ResultSource/primary_columns>
declaration on the L</result_source>.
In either case an attempt is made to combine conditions already existing on
the resultset with the condition passed to this method.
To aid with preparing the correct query for the storage you may supply the
C<key> attribute, which is the name of a
L<unique constraint|DBIx::Class::ResultSource/add_unique_constraint> (the
unique constraint corresponding to the
L<primary columns|DBIx::Class::ResultSource/primary_columns> is always named
C<primary>). If the C<key> attribute has been supplied, and DBIC is unable
to construct a query that satisfies the named unique constraint fully (
non-NULL values for each column member of the constraint) an exception is
thrown.
If no C<key> is specified, the search is carried over all unique constraints
which are fully defined by the available condition.
If no such constraint is found, C<find> currently defaults to a simple
C<< search->(\%column_values) >> which may or may not do what you expect.
Note that this fallback behavior may be deprecated in further versions. If
you need to search with arbitrary conditions - use L</search>. If the query
resulting from this fallback produces more than one row, a warning to the
effect is issued, though only the first row is constructed and returned as
C<$result_object>.
In addition to C<key>, L</find> recognizes and applies standard
L<resultset attributes|/ATTRIBUTES> in the same way as L</search> does.
Note that if you have extra concerns about the correctness of the resulting
query you need to specify the C<key> attribute and supply the entire condition
as an argument to find (since it is not always possible to perform the
combination of the resultset condition with the supplied one, especially if
the resultset condition contains literal sql).
For example, to find a row by its primary key:
my $cd = $schema->resultset('CD')->find(5);
You can also find a row by a specific unique constraint:
my $cd = $schema->resultset('CD')->find(
{
artist => 'Massive Attack',
title => 'Mezzanine',
},
{ key => 'cd_artist_title' }
);
See also L</find_or_create> and L</update_or_create>.
=cut
sub find {
my $self = shift;
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
my $rsrc = $self->result_source;
my $constraint_name;
if (exists $attrs->{key}) {
$constraint_name = defined $attrs->{key}
? $attrs->{key}
: $self->throw_exception("An undefined 'key' resultset attribute makes no sense")
;
}
# Parse out the condition from input
my $call_cond;
if (ref $_[0] eq 'HASH') {
$call_cond = { %{$_[0]} };
}
else {
# if only values are supplied we need to default to 'primary'
$constraint_name = 'primary' unless defined $constraint_name;
my @c_cols = $rsrc->unique_constraint_columns($constraint_name);
$self->throw_exception(
"No constraint columns, maybe a malformed '$constraint_name' constraint?"
) unless @c_cols;
$self->throw_exception (
'find() expects either a column/value hashref, or a list of values '
. "corresponding to the columns of the specified unique constraint '$constraint_name'"
) unless @c_cols == @_;
$call_cond = {};
@{$call_cond}{@c_cols} = @_;
}
my %related;
for my $key (keys %$call_cond) {
if (
my $keyref = ref($call_cond->{$key})
and
my $relinfo = $rsrc->relationship_info($key)
) {
my $val = delete $call_cond->{$key};
next if $keyref eq 'ARRAY'; # has_many for multi_create
my $rel_q = $rsrc->_resolve_condition(
$relinfo->{cond}, $val, $key, $key
);
die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH';
@related{keys %$rel_q} = values %$rel_q;
}
}
# relationship conditions take precedence (?)
@{$call_cond}{keys %related} = values %related;
my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
my $final_cond;
if (defined $constraint_name) {
$final_cond = $self->_qualify_cond_columns (
$self->_build_unique_cond (
$constraint_name,
$call_cond,
),
$alias,
);
}
elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
# This means that we got here after a merger of relationship conditions
# in ::Relationship::Base::search_related (the row method), and furthermore
# the relationship is of the 'single' type. This means that the condition
# provided by the relationship (already attached to $self) is sufficient,
# as there can be only one row in the database that would satisfy the
# relationship
}
else {
# no key was specified - fall down to heuristics mode:
# run through all unique queries registered on the resultset, and
# 'OR' all qualifying queries together
my (@unique_queries, %seen_column_combinations);
for my $c_name ($rsrc->unique_constraint_names) {
next if $seen_column_combinations{
join "\x00", sort $rsrc->unique_constraint_columns($c_name)
}++;
push @unique_queries, try {
$self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls')
} || ();
}
$final_cond = @unique_queries
? [ map { $self->_qualify_cond_columns($_, $alias) } @unique_queries ]
: $self->_non_unique_find_fallback ($call_cond, $attrs)
;
}
# Run the query, passing the result_class since it should propagate for find
my $rs = $self->search ($final_cond, {result_class => $self->result_class, %$attrs});
if (keys %{$rs->_resolved_attrs->{collapse}}) {
my $row = $rs->next;
carp "Query returned more than one row" if $rs->next;
return $row;
}
else {
return $rs->single;
}
}
# This is a stop-gap method as agreed during the discussion on find() cleanup:
# http://lists.scsys.co.uk/pipermail/dbix-class/2010-October/009535.html
#
# It is invoked when find() is called in legacy-mode with insufficiently-unique
# condition. It is provided for overrides until a saner way forward is devised
#
# *NOTE* This is not a public method, and it's *GUARANTEED* to disappear down
# the road. Please adjust your tests accordingly to catch this situation early
# DBIx::Class::ResultSet->can('_non_unique_find_fallback') is reasonable
#
# The method will not be removed without an adequately complete replacement
# for strict-mode enforcement
sub _non_unique_find_fallback {
my ($self, $cond, $attrs) = @_;
return $self->_qualify_cond_columns(
$cond,
exists $attrs->{alias}
? $attrs->{alias}
: $self->{attrs}{alias}
);
}
sub _qualify_cond_columns {
my ($self, $cond, $alias) = @_;
my %aliased = %$cond;
for (keys %aliased) {
$aliased{"$alias.$_"} = delete $aliased{$_}
if $_ !~ /\./;
}
return \%aliased;
}
sub _build_unique_cond {
my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
# combination may fail if $self->{cond} is non-trivial
my ($final_cond) = try {
$self->_merge_with_rscond ($extra_cond)
} catch {
+{ %$extra_cond }
};
# trim out everything not in $columns
$final_cond = { map {
exists $final_cond->{$_}
? ( $_ => $final_cond->{$_} )
: ()
} @c_cols };
if (my @missing = grep
{ ! ($croak_on_null ? defined $final_cond->{$_} : exists $final_cond->{$_}) }
(@c_cols)
) {
$self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s",
$constraint_name,
join (', ', map { "'$_'" } @missing),
) );
}
if (
!$croak_on_null
and
!$ENV{DBIC_NULLABLE_KEY_NOWARN}
and
my @undefs = sort grep { ! defined $final_cond->{$_} } (keys %$final_cond)
) {
carp_unique ( sprintf (
"NULL/undef values supplied for requested unique constraint '%s' (NULL "
. 'values in column(s): %s). This is almost certainly not what you wanted, '
. 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
$constraint_name,
join (', ', map { "'$_'" } @undefs),
));
}
return $final_cond;
}
=head2 search_related
=over 4
=item Arguments: $rel_name, $cond?, L<\%attrs?|/ATTRIBUTES>
=item Return Value: L<$resultset|/search> (scalar context) | L<@result_objs|DBIx::Class::Manual::ResultClass> (list context)
=back
$new_rs = $cd_rs->search_related('artist', {
name => 'Emo-R-Us',
});
Searches the specified relationship, optionally specifying a condition and
attributes for matching records. See L</ATTRIBUTES> for more information.
In list context, C<< ->all() >> is called implicitly on the resultset, thus
returning a list of result objects instead. To avoid that, use L</search_related_rs>.
See also L</search_related_rs>.
=cut
sub search_related {
return shift->related_resultset(shift)->search(@_);
}
=head2 search_related_rs
This method works exactly the same as search_related, except that
it guarantees a resultset, even in list context.
=cut
sub search_related_rs {
return shift->related_resultset(shift)->search_rs(@_);
}
=head2 cursor
=over 4
=item Arguments: none
=item Return Value: L<$cursor|DBIx::Class::Cursor>
=back
Returns a storage-driven cursor to the given resultset. See
L<DBIx::Class::Cursor> for more information.
=cut
sub cursor {
my $self = shift;