remove_columns now deletes columns from _columns fixing has_columns false positives
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / ResultSetManager.pm
1 package DBIx::Class::ResultSetManager;
2 use strict;
3 use warnings;
4 use base 'DBIx::Class';
5 use Class::Inspector;
6
7 =head1 NAME
8
9 DBIx::Class::ResultSetManager - helpful methods for managing resultset
10 classes (EXPERIMENTAL)
11
12 =head1 SYNOPSIS
13
14   # in a table class
15   __PACKAGE__->load_components(qw/ResultSetManager Core/); # note order!
16   __PACKAGE__->load_resultset_components(qw/AlwaysRS/);
17
18   # will be removed from the table class and inserted into a
19   # table-specific resultset class
20   sub search_by_year_desc : ResultSet {
21     my $self = shift;
22     my $cond = shift;
23     my $attrs = shift || {};
24     $attrs->{order_by} = 'year DESC';
25     $self->search($cond, $attrs);
26   }
27
28   $rs = $schema->resultset('CD')->search_by_year_desc({ artist => 'Tool' });
29
30 =head1 DESCRIPTION
31
32 This package implements two useful features for customizing resultset
33 classes.  C<load_resultset_components> loads components in addition to
34 C<DBIx::Class::ResultSet> (or whatever you set as
35 C<base_resultset_class>). Any methods tagged with the C<ResultSet>
36 attribute will be moved into a table-specific resultset class (by
37 default called C<Class::_resultset>, but configurable via
38 C<table_resultset_class_suffix>).  Most of the magic is done when you
39 call C<< __PACKAGE__->table >>.
40
41 =cut
42
43 __PACKAGE__->mk_classdata($_)
44   for qw/ base_resultset_class table_resultset_class_suffix /;
45 __PACKAGE__->base_resultset_class('DBIx::Class::ResultSet');
46 __PACKAGE__->table_resultset_class_suffix('::_resultset');
47
48 =head2 table
49
50 Stacks on top of the normal L<DBIx::Class> C<table> method.  Any
51 methods tagged with the C<ResultSet> attribute will be moved into a
52 table-specific resultset class (by default called
53 C<Class::_resultset>, but configurable via
54 C<table_resultset_class_suffix>).  The magic for this is done within
55 this C<< __PACKAGE__->table >> call.
56
57 =cut
58
59 sub table {
60     my ($self,@rest) = @_;
61     my $ret = $self->next::method(@rest);
62     if (@rest) {
63         $self->_register_attributes;
64         $self->_register_resultset_class;
65     }
66     return $ret;
67 }
68
69 =head2 load_resultset_components
70
71   # in a table class
72   __PACKAGE__->load_components(qw/ResultSetManager Core/); # note order!
73   __PACKAGE__->load_resultset_components(qw/AlwaysRS/);
74
75 C<load_resultset_components> loads components in addition to
76 C<DBIx::Class::ResultSet> (or whatever you set as
77 C<base_resultset_class>).
78
79 =cut
80
81 sub load_resultset_components {
82     my ($self,@comp) = @_;
83     my $resultset_class = $self->_setup_resultset_class;
84     $resultset_class->load_components(@comp);
85 }
86
87 sub _register_attributes {
88     my $self = shift;
89     my $cache = $self->_attr_cache;
90     return if keys %$cache == 0;
91
92     foreach my $meth (@{Class::Inspector->methods($self) || []}) {
93         my $attrs = $cache->{$self->can($meth)};
94         next unless $attrs;
95         if ($attrs->[0] eq 'ResultSet') {
96             no strict 'refs';
97             my $resultset_class = $self->_setup_resultset_class;
98             *{"$resultset_class\::$meth"} = $self->can($meth);
99             delete ${"${self}::"}{$meth};
100         }
101     }
102 }
103
104 sub _setup_resultset_class {
105     my $self = shift;
106     my $resultset_class = $self . $self->table_resultset_class_suffix;
107     no strict 'refs';
108     unless (@{"$resultset_class\::ISA"}) {
109         @{"$resultset_class\::ISA"} = ($self->base_resultset_class);
110     }
111     return $resultset_class;
112 }
113
114 sub _register_resultset_class {
115     my $self = shift;
116     my $resultset_class = $self . $self->table_resultset_class_suffix;
117     no strict 'refs';
118     if (@{"$resultset_class\::ISA"}) {
119         $self->result_source_instance->resultset_class($resultset_class);
120     } else {
121         $self->result_source_instance->resultset_class
122           ($self->base_resultset_class);
123     }
124 }
125
126 1;
127
128 =head1 AUTHORS
129
130 David Kamholz <dkamholz@cpan.org>
131
132 =head1 LICENSE
133
134 You may distribute this code under the same terms as Perl itself.
135
136 =cut