/usr/share/perl5/MooseX/RelatedClassRoles.pm is in libmoosex-relatedclassroles-perl 0.004-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 | package MooseX::RelatedClassRoles;
our $VERSION = '0.004';
# ABSTRACT: Apply roles to a class related to yours
use MooseX::Role::Parameterized;
parameter name => (
isa => 'Str',
required => 1,
);
parameter class_accessor_name => (
isa => 'Str',
lazy => 1,
default => sub { $_[0]->name . '_class' },
);
parameter apply_method_name => (
isa => 'Str',
lazy => 1,
default => sub { 'apply_' . $_[0]->class_accessor_name . '_roles' },
);
# This is undocumented because you shouldn't use it unless you really know you
# have to.
parameter require_class_accessor => (
isa => 'Bool',
default => 1,
);
role {
my $p = shift;
my $class_accessor_name = $p->class_accessor_name;
my $apply_method_name = $p->apply_method_name;
requires $class_accessor_name
if $p->require_class_accessor;
method $apply_method_name => sub {
my $self = shift;
my $meta = Moose::Meta::Class->create_anon_class(
superclasses => [ $self->$class_accessor_name ],
roles => [ @_ ],
cache => 1,
);
$self->$class_accessor_name($meta->name);
};
};
no MooseX::Role::Parameterized;
1;
=pod
=head1 NAME
MooseX::RelatedClassRoles - Apply roles to a class related to yours
=head1 VERSION
version 0.004
=head1 SYNOPSIS
package My::Class;
use Moose;
has driver_class => (
isa => 'MyApp::Driver',
);
with 'MooseX::RelatedClassRoles' => { name => 'driver' };
# ...
my $obj = My::Class->new(driver_class => "Some::Driver");
$obj->apply_driver_class_roles("Other::Driver::Role");
=head1 DESCRIPTION
Frequently, you have to use a class that provides some C<foo_class> accessor or
attribute as a method of dependency injection. Use this role when you'd rather
apply roles to make your custom C<foo_class> instead of manually setting up a
subclass.
=head1 PARAMETERS
=head2 name
A string naming the related class. C<driver> in the L</SYNOPSIS>. Required.
=head2 class_accessor_name
A string naming the related class accessor. C<driver_class> in the
L</SYNOPSIS>. Defaults to appending C<_class> to the C<name>.
=head2 apply_method_name
A string naming the role applying method. C<apply_driver_class_names> in the
L</SYNOPSIS>. Defaults to adding C<apply_> and C<_names> to the
C<class_accessor_name>.
=head1 BLAME
Florian Ragwitz (rafl)
=head1 AUTHOR
Hans Dieter Pearcey <hdp@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2009 by Hans Dieter Pearcey <hdp@cpan.org>.
This is free software; you can redistribute it and/or modify it under
the same terms as perl itself.
=cut
__END__
|