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