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
|
package DBIx::Class::Helper::Row::ProxyResultSetMethod;
$DBIx::Class::Helper::Row::ProxyResultSetMethod::VERSION = '2.023007';
use strict;
use warnings;
# ABSTRACT: Efficiently reuse ResultSet methods from results with fallback
use base 'DBIx::Class::Helper::Row::SelfResultSet', 'Class::Accessor::Grouped';
use Sub::Name ();
use DBIx::Class::Candy::Exports;
export_methods [qw( proxy_resultset_method )];
__PACKAGE__->mk_group_accessors(inherited => '_proxy_slots');
sub proxy_resultset_method {
my ($self, $name, $attr) = @_;
my $rs_method = $attr->{resultset_method} || "with_$name";
my $slot = $attr->{slot} || $name;
$self->_proxy_slots([]) unless $self->_proxy_slots;
push @{$self->_proxy_slots}, $slot;
no strict 'refs';
my $method = $self . '::' . $name;
*{$method} = Sub::Name::subname $method, sub {
use strict 'refs';
# boo. The accessor checks that there's an actual column defined, so we
# skip it so we can cache results.
$_[0]->{_column_data}{$slot} = $_[0]->self_rs
->search(undef, { columns => [] })
->$rs_method
->get_column($slot)
->next unless $_[0]->has_column_loaded($slot);
return $_[0]->get_column($slot)
}
}
sub copy {
delete local @{$_[0]->{_column_data}}{@{$_[0]->_proxy_slots||[]}};
shift->next::method(@_);
}
1;
__END__
=pod
=head1 NAME
DBIx::Class::Helper::Row::ProxyResultSetMethod - Efficiently reuse ResultSet methods from results with fallback
=head1 SYNOPSIS
ResultSet:
package MyApp::Schema::ResultSet::Foo;
use base 'DBIx::Class::ResultSet';
__PACKAGE__->load_components(qw(
Helper::ResultSet::CorrelateRelationship
));
...;
sub with_friend_count {
shift->search(undef, {
'+columns' => {
'friend_count' => $self->correlate('friends')->count_rs->as_query,
},
})
}
Result:
package MyApp::Schema::Result::Foo;
use base 'DBIx::Class::Core';
__PACKAGE__->load_components(qw( Helper::Row::ProxyResultSetMethod ));
__PACKAGE__->proxy_resultset_method('friend_count');
or with L<DBIx::Class::Candy>:
package MyApp::Schema::Result::Foo;
use DBIx::Class::Candy -components => ['Helper::Row::ProxyResultSetMethod'];
proxy_resultset_method 'friend_count';
Elsewhere:
my $row = $foo_rs->first;
say $row->friend_count . ' friends';
=head1 DESCRIPTION
This module makes reusing resultset methods from a result trivially easy. You
should be using it.
=head1 METHODS
=head2 proxy_resultset_method
__PACKAGE__->proxy_resultset_method( $name => {
slot => $slot,
resultset_method => $rs_method
});
C<proxy_resultset_method>'s first argument is the name of the method to
generate and is required. The other two arguments, C<$slot>, and
C<$resultset_method> are optional. If unspecified C<$slot> will default to
C<$name> and C<$resultset_method> will default to C<"with_$name">. C<$slot>
is the column that the data being retrieved is stored as in the ResultSet
method being proxied to. C<$resultset_method> is (duh) the ResultSet method
being proxied to.
If you did not call the C<with_*> method on your ResultSet, and call the
proxy method, it will transparently B<fallback> and do the call and fetch
the needed data. E.g.:
my $foo = $schema->resultset('Foo')->first; ## did not call with_friend_count
print $foo->friend_count; ## will produce desired result magically
=head1 CANDY EXPORTS
If used in conjunction with L<DBIx::Class::Candy> this component will export:
=over
=item proxy_resultset_method
=back
=head1 DEDICATION
This module is dedicated to Ray Bradbury, who wrote Something Wicked This Way
Comes, Dandelion Wine, and numerous short stories, plays, etc etc. Read this
author's books.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
