lib/Catalyst/TraitFor/Model/DBIC/Schema/SchemaProxy.pm

   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';
   6 use Catalyst::Model::DBIC::Schema::Types 'Schema';
   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
  15 Allows you to call your L<DBIx::Class::Schema> methods directly on the Model
  16 instance, and passes config options to your L<DBIx::Class::Schema> and
  17 L<DBIx::Class::ResultSet> attributes at C<BUILD> time.
  18
  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>
  82
  83 =cut
  84
  85 after setup => sub {
  86     my ($self, $args) = @_;
  87
  88     my $schema = $self->schema;
  89
  90     my $was_mutable = $self->meta->is_mutable;
  91
  92     $self->meta->make_mutable;
  93     $self->meta->add_attribute('schema',
  94         is => 'rw',
  95         isa => Schema,
  96         handles => $self->_delegates # this removes the attribute too
  97     );
  98     $self->meta->make_immutable unless $was_mutable;
  99
 100     $self->schema($schema) if $schema;
 101 };
 102
 103 after BUILD => sub {
 104     my ($self, $args) = @_;
 105
 106     $self->_pass_options_to_schema($args);
 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     }
 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);
 160             $self->schema->$opt($args->{$opt});
 161         }
 162     }
 163 }
 164
 165 sub _pass_options_to_resultset {
 166     my ($self, $source, $args) = @_;
 167
 168     my @attributes = map {
 169         $_->init_arg || ()
 170     } $self->meta->get_all_attributes;
 171
 172     my %attributes;
 173     @attributes{@attributes} = ();
 174
 175     for my $opt (keys %$args) {
 176         if (not exists $attributes{$opt}) {
 177             my $rs_class = $self->schema->source($source)->resultset_class;
 178             next unless $rs_class->can($opt);
 179             $rs_class->$opt($args->{$opt});
 180         }
 181     }
 182 }
 183
 184 =head1 SEE ALSO
 185
 186 L<Catalyst::Model::DBIC::Schema>, L<DBIx::Class::Schema>
 187
 188 =head1 AUTHOR
 189
 190 See L<Catalyst::Model::DBIC::Schema/AUTHOR> and
 191 L<Catalyst::Model::DBIC::Schema/CONTRIBUTORS>.
 192
 193 =head1 COPYRIGHT
 194
 195 See L<Catalyst::Model::DBIC::Schema/COPYRIGHT>.
 196
 197 =head1 LICENSE
 198
 199 This program is free software, you can redistribute it and/or modify it
 200 under the same terms as Perl itself.
 201
 202 =cut
 203
 204 1;