Commit | Line | Data |
d816d7bf |
1 | package Catalyst::TraitFor::Model::DBIC::Schema::SchemaProxy; |
2 | |
3 | use namespace::autoclean; |
4 | use Moose::Role; |
5 | use Carp::Clan '^Catalyst::Model::DBIC::Schema'; |
ae3d05c2 |
6 | use Catalyst::Model::DBIC::Schema::Types 'Schema'; |
d816d7bf |
7 | |
8 | =head1 NAME |
9 | |
10 | Catalyst::TraitFor::Model::DBIC::Schema::SchemaProxy - Proxy Schema Methods and |
11 | Options from Model |
12 | |
13 | =head1 DESCRIPTION |
14 | |
ae3d05c2 |
15 | Allows you to call your L<DBIx::Class::Schema> methods directly on the Model |
21d8159f |
16 | instance, and passes config options to your L<DBIx::Class::Schema> and |
17 | L<DBIx::Class::ResultSet> attributes at C<BUILD> time. |
d816d7bf |
18 | |
21d8159f |
19 | Methods and attributes local to your C<Model> take precedence over |
20 | L<DBIx::Class::Schema> or L<DBIx::Class::ResultSet> methods and attributes. |
21 | |
22 | =head1 CREATING SCHEMA CONFIG ATTRIBUTES |
23 | |
24 | To create attributes in your C<Schema.pm>, use either Moose or |
25 | L<Class::Accessor::Grouped>, which is inherited from by all L<DBIx::Class> |
26 | classes automatically. E.g.: |
27 | |
28 | __PACKAGE__->mk_group_accessors(simple => qw/ |
29 | config_key1 |
30 | config_key2 |
31 | ... |
32 | /); |
33 | |
34 | Or with L<Moose>: |
35 | |
36 | use Moose; |
37 | has config_key1 => (is => 'rw', default => 'default_value'); |
38 | |
39 | This code can be added after the md5sum on L<DBIx::Class::Schema::Loader> |
40 | generated schemas. |
41 | |
42 | At app startup, any non-local options will be passed to these accessors, and can |
43 | be accessed as usual via C<< $schema->config_key1 >>. |
44 | |
45 | These config values go into your C<Model::DB> block, along with normal config |
46 | values. |
47 | |
48 | =head1 CREATING RESULTSET CONFIG ATTRIBUTES |
49 | |
50 | You can create classdata on L<DBIx::Class::ResultSet> classes to hold values |
51 | from L<Catalyst> config. |
52 | |
53 | The code for this looks something like this: |
54 | |
55 | package MySchema::ResultSet::Foo; |
56 | |
57 | use base 'DBIx::Class::ResultSet'; |
58 | |
59 | __PACKAGE__->mk_group_accessors(inherited => qw/ |
60 | rs_config_key1 |
61 | rs_config_key2 |
62 | ... |
63 | /); |
64 | __PACKAGE__->rs_config_key1('default_value'); |
65 | |
66 | Or, if you prefer L<Moose>: |
67 | |
68 | package MySchema::ResultSet::Foo; |
69 | |
70 | use Moose; |
71 | use MooseX::NonMoose; |
72 | use MooseX::ClassAttribute; |
73 | extends 'DBIx::Class::ResultSet'; |
74 | |
75 | class_has rs_config_key1 => (is => 'rw', default => 'default_value'); |
76 | |
77 | In your catalyst config, use the generated Model name as the config key, e.g.: |
78 | |
79 | <Model::DB::Users> |
80 | strict_passwords 1 |
81 | </Model::DB::Users> |
d816d7bf |
82 | |
83 | =cut |
84 | |
85 | after setup => sub { |
86 | my ($self, $args) = @_; |
87 | |
ae3d05c2 |
88 | my $schema = $self->schema; |
89 | |
d816d7bf |
90 | my $was_mutable = $self->meta->is_mutable; |
91 | |
92 | $self->meta->make_mutable; |
93 | $self->meta->add_attribute('schema', |
94 | is => 'rw', |
ae3d05c2 |
95 | isa => Schema, |
d816d7bf |
96 | handles => $self->_delegates # this removes the attribute too |
97 | ); |
98 | $self->meta->make_immutable unless $was_mutable; |
ae3d05c2 |
99 | |
100 | $self->schema($schema) if $schema; |
d816d7bf |
101 | }; |
102 | |
103 | after BUILD => sub { |
104 | my ($self, $args) = @_; |
105 | |
106 | $self->_pass_options_to_schema($args); |
21d8159f |
107 | |
108 | for my $source ($self->schema->sources) { |
109 | my $config_key = 'Model::' . $self->model_name . '::' . $source; |
110 | my $config = $self->app_class->config->{$config_key}; |
111 | next unless $config; |
112 | $self->_pass_options_to_resultset($source, $config); |
113 | } |
d816d7bf |
114 | }; |
115 | |
116 | sub _delegates { |
117 | my $self = shift; |
118 | |
119 | my $schema_meta = Class::MOP::Class->initialize($self->schema_class); |
120 | my @schema_methods = $schema_meta->get_all_method_names; |
121 | |
122 | # combine with any already added by other schemas |
123 | my @handles = eval { |
124 | @{ $self->meta->find_attribute_by_name('schema')->handles } |
125 | }; |
126 | |
127 | # now kill the attribute, otherwise add_attribute in BUILD will not do the right |
128 | # thing (it clears the handles for some reason.) May be a Moose bug. |
129 | eval { $self->meta->remove_attribute('schema') }; |
130 | |
131 | my %schema_methods; |
132 | @schema_methods{ @schema_methods, @handles } = (); |
133 | @schema_methods = keys %schema_methods; |
134 | |
135 | my @my_methods = $self->meta->get_all_method_names; |
136 | my %my_methods; |
137 | @my_methods{@my_methods} = (); |
138 | |
139 | my @delegates; |
140 | for my $method (@schema_methods) { |
141 | push @delegates, $method unless exists $my_methods{$method}; |
142 | } |
143 | |
144 | return \@delegates; |
145 | } |
146 | |
147 | sub _pass_options_to_schema { |
148 | my ($self, $args) = @_; |
149 | |
150 | my @attributes = map { |
151 | $_->init_arg || () |
152 | } $self->meta->get_all_attributes; |
153 | |
154 | my %attributes; |
155 | @attributes{@attributes} = (); |
156 | |
157 | for my $opt (keys %$args) { |
158 | if (not exists $attributes{$opt}) { |
159 | next unless $self->schema->can($opt); |
21d8159f |
160 | $self->schema->$opt($args->{$opt}); |
161 | } |
162 | } |
163 | } |
164 | |
165 | sub _pass_options_to_resultset { |
166 | my ($self, $source, $args) = @_; |
167 | |
21d8159f |
168 | for my $opt (keys %$args) { |
f24a5fbb |
169 | my $rs_class = $self->schema->source($source)->resultset_class; |
170 | next unless $rs_class->can($opt); |
171 | $rs_class->$opt($args->{$opt}); |
d816d7bf |
172 | } |
173 | } |
174 | |
175 | =head1 SEE ALSO |
176 | |
177 | L<Catalyst::Model::DBIC::Schema>, L<DBIx::Class::Schema> |
178 | |
179 | =head1 AUTHOR |
180 | |
181 | See L<Catalyst::Model::DBIC::Schema/AUTHOR> and |
182 | L<Catalyst::Model::DBIC::Schema/CONTRIBUTORS>. |
183 | |
184 | =head1 COPYRIGHT |
185 | |
186 | See L<Catalyst::Model::DBIC::Schema/COPYRIGHT>. |
187 | |
188 | =head1 LICENSE |
189 | |
190 | This program is free software, you can redistribute it and/or modify it |
191 | under the same terms as Perl itself. |
192 | |
193 | =cut |
194 | |
195 | 1; |