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 |
16 | instance, and passes config options to the C<Schema> attributes at C<BUILD> |
17 | time. |
d816d7bf |
18 | |
ae3d05c2 |
19 | Methods and attributes local to your C<Model> take precedence over C<Schema> |
20 | methods and attributes. |
d816d7bf |
21 | |
22 | =cut |
23 | |
24 | after setup => sub { |
25 | my ($self, $args) = @_; |
26 | |
ae3d05c2 |
27 | my $schema = $self->schema; |
28 | |
d816d7bf |
29 | my $was_mutable = $self->meta->is_mutable; |
30 | |
31 | $self->meta->make_mutable; |
32 | $self->meta->add_attribute('schema', |
33 | is => 'rw', |
ae3d05c2 |
34 | isa => Schema, |
d816d7bf |
35 | handles => $self->_delegates # this removes the attribute too |
36 | ); |
37 | $self->meta->make_immutable unless $was_mutable; |
ae3d05c2 |
38 | |
39 | $self->schema($schema) if $schema; |
d816d7bf |
40 | }; |
41 | |
42 | after BUILD => sub { |
43 | my ($self, $args) = @_; |
44 | |
45 | $self->_pass_options_to_schema($args); |
46 | }; |
47 | |
48 | sub _delegates { |
49 | my $self = shift; |
50 | |
51 | my $schema_meta = Class::MOP::Class->initialize($self->schema_class); |
52 | my @schema_methods = $schema_meta->get_all_method_names; |
53 | |
54 | # combine with any already added by other schemas |
55 | my @handles = eval { |
56 | @{ $self->meta->find_attribute_by_name('schema')->handles } |
57 | }; |
58 | |
59 | # now kill the attribute, otherwise add_attribute in BUILD will not do the right |
60 | # thing (it clears the handles for some reason.) May be a Moose bug. |
61 | eval { $self->meta->remove_attribute('schema') }; |
62 | |
63 | my %schema_methods; |
64 | @schema_methods{ @schema_methods, @handles } = (); |
65 | @schema_methods = keys %schema_methods; |
66 | |
67 | my @my_methods = $self->meta->get_all_method_names; |
68 | my %my_methods; |
69 | @my_methods{@my_methods} = (); |
70 | |
71 | my @delegates; |
72 | for my $method (@schema_methods) { |
73 | push @delegates, $method unless exists $my_methods{$method}; |
74 | } |
75 | |
76 | return \@delegates; |
77 | } |
78 | |
79 | sub _pass_options_to_schema { |
80 | my ($self, $args) = @_; |
81 | |
82 | my @attributes = map { |
83 | $_->init_arg || () |
84 | } $self->meta->get_all_attributes; |
85 | |
86 | my %attributes; |
87 | @attributes{@attributes} = (); |
88 | |
89 | for my $opt (keys %$args) { |
90 | if (not exists $attributes{$opt}) { |
91 | next unless $self->schema->can($opt); |
92 | $self->schema->$opt($self->{$opt}); |
93 | } |
94 | } |
95 | } |
96 | |
97 | =head1 SEE ALSO |
98 | |
99 | L<Catalyst::Model::DBIC::Schema>, L<DBIx::Class::Schema> |
100 | |
101 | =head1 AUTHOR |
102 | |
103 | See L<Catalyst::Model::DBIC::Schema/AUTHOR> and |
104 | L<Catalyst::Model::DBIC::Schema/CONTRIBUTORS>. |
105 | |
106 | =head1 COPYRIGHT |
107 | |
108 | See L<Catalyst::Model::DBIC::Schema/COPYRIGHT>. |
109 | |
110 | =head1 LICENSE |
111 | |
112 | This program is free software, you can redistribute it and/or modify it |
113 | under the same terms as Perl itself. |
114 | |
115 | =cut |
116 | |
117 | 1; |