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
|
package DBIx::Class::ResultSetManager;
use strict;
use warnings;
use base 'DBIx::Class';
use Class::Inspector;
=head1 NAME
DBIx::Class::ResultSetManager - helpful methods for managing resultset
classes (EXPERIMENTAL)
=head1 SYNOPSIS
# in a table class
__PACKAGE__->load_components(qw/ResultSetManager Core/); # note order!
# will be removed from the table class and inserted into a
# table-specific resultset class
sub search_by_year_desc : ResultSet {
my $self = shift;
my $cond = shift;
my $attrs = shift || {};
$attrs->{order_by} = 'year DESC';
$self->search($cond, $attrs);
}
$rs = $schema->resultset('CD')->search_by_year_desc({ artist => 'Tool' });
=head1 DESCRIPTION
This package implements two useful features for customizing resultset
classes. C<load_resultset_components> loads components in addition to
C<DBIx::Class::ResultSet> (or whatever you set as
C<base_resultset_class>). Any methods tagged with the C<ResultSet>
attribute will be moved into a table-specific resultset class (by
default called C<Class::_resultset>, but configurable via
C<table_resultset_class_suffix>). Most of the magic is done when you
call C<< __PACKAGE__->table >>.
=cut
__PACKAGE__->mk_classdata($_)
for qw/ base_resultset_class table_resultset_class_suffix /;
__PACKAGE__->base_resultset_class('DBIx::Class::ResultSet');
__PACKAGE__->table_resultset_class_suffix('::_resultset');
=head2 table
Stacks on top of the normal L<DBIx::Class> C<table> method. Any
methods tagged with the C<ResultSet> attribute will be moved into a
table-specific resultset class (by default called
C<Class::_resultset>, but configurable via
C<table_resultset_class_suffix>). The magic for this is done within
this C<< __PACKAGE__->table >> call.
=cut
sub table {
my ($self,@rest) = @_;
my $ret = $self->next::method(@rest);
if (@rest) {
$self->_register_attributes;
$self->_register_resultset_class;
}
return $ret;
}
=head2 load_resultset_components
C<load_resultset_components> loads components in addition to
C<DBIx::Class::ResultSet> (or whatever you set as
C<base_resultset_class>).
=cut
sub load_resultset_components {
my ($self,@comp) = @_;
my $resultset_class = $self->_setup_resultset_class;
$resultset_class->load_components(@comp);
}
sub _register_attributes {
my $self = shift;
my $cache = $self->_attr_cache;
return if keys %$cache == 0;
foreach my $meth (@{Class::Inspector->methods($self) || []}) {
my $attrs = $cache->{$self->can($meth)};
next unless $attrs;
if ($attrs->[0] eq 'ResultSet') {
no strict 'refs';
my $resultset_class = $self->_setup_resultset_class;
*{"$resultset_class\::$meth"} = $self->can($meth);
delete ${"${self}::"}{$meth};
}
}
}
sub _setup_resultset_class {
my $self = shift;
my $resultset_class = $self . $self->table_resultset_class_suffix;
no strict 'refs';
unless (@{"$resultset_class\::ISA"}) {
@{"$resultset_class\::ISA"} = ($self->base_resultset_class);
}
return $resultset_class;
}
sub _register_resultset_class {
my $self = shift;
my $resultset_class = $self . $self->table_resultset_class_suffix;
no strict 'refs';
if (@{"$resultset_class\::ISA"}) {
$self->result_source_instance->resultset_class($resultset_class);
} else {
$self->result_source_instance->resultset_class
($self->base_resultset_class);
}
}
1;
=head1 AUTHORS
David Kamholz <dkamholz@cpan.org>
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
=cut
|
