Add automatic naming of unique constraints
[dbsrgits/DBIx-Class.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
10     resultset 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 sub table {
49     my ($self,@rest) = @_;
50     my $ret = $self->next::method(@rest);
51     if (@rest) {
52         $self->_register_attributes;
53         $self->_register_resultset_class;
54     }
55     return $ret;
56 }
57
58 sub load_resultset_components {
59     my ($self,@comp) = @_;
60     my $resultset_class = $self->_setup_resultset_class;
61     $resultset_class->load_components(@comp);
62 }
63
64 sub _register_attributes {
65     my $self = shift;
66     my $cache = $self->_attr_cache;
67     return if keys %$cache == 0;
68     
69     foreach my $meth (@{Class::Inspector->methods($self) || []}) {
70         my $attrs = $cache->{$self->can($meth)};
71         next unless $attrs;
72         if ($attrs->[0] eq 'ResultSet') {
73             no strict 'refs';
74             my $resultset_class = $self->_setup_resultset_class;
75             *{"$resultset_class\::$meth"} = $self->can($meth);
76             delete ${"${self}::"}{$meth};
77         }
78     }
79 }
80
81 sub _setup_resultset_class {
82     my $self = shift;
83     my $resultset_class = $self . $self->table_resultset_class_suffix;
84     no strict 'refs';
85     unless (@{"$resultset_class\::ISA"}) {
86         @{"$resultset_class\::ISA"} = ($self->base_resultset_class);
87     }
88     return $resultset_class;
89 }
90
91 sub _register_resultset_class {
92     my $self = shift;
93     my $resultset_class = $self . $self->table_resultset_class_suffix;
94     no strict 'refs';
95     if (@{"$resultset_class\::ISA"}) {
96         $self->result_source_instance->resultset_class($resultset_class);
97     } else {
98         $self->result_source_instance->resultset_class
99           ($self->base_resultset_class);
100     }
101 }
102
103 1;
104
105 =head1 AUTHORS
106
107 David Kamholz <dkamholz@cpan.org>
108
109 =head1 LICENSE
110
111 You may distribute this code under the same terms as Perl itself.
112
113 =cut