File Coverage

blib/lib/MooseX/RoleFor/Meta/Role/Trait/RoleFor.pm
Criterion Covered Total %
statement 26 26 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 35 35 100.0


line stmt bran cond sub pod time code
1             package MooseX::RoleFor::Meta::Role::Trait::RoleFor;
2              
3 1     1   4472 use 5.010;
  1         5  
  1         50  
4 1     1   7 use strict;
  1         2  
  1         34  
5 1     1   26 use utf8;
  1         3  
  1         6  
6              
7             BEGIN
8             {
9 1     1   2 $MooseX::RoleFor::Meta::Role::Trait::RoleFor::AUTHORITY = 'cpan:TOBYINK';
10 1         28 $MooseX::RoleFor::Meta::Role::Trait::RoleFor::VERSION = '0.001';
11             }
12              
13 1     1   6 use Moose::Role;
  1         2  
  1         9  
14 1     1   5426 use Moose::Util::TypeConstraints;
  1         3  
  1         12  
15 1     1   1805 use Carp qw[croak carp];
  1         3  
  1         73  
16 1     1   5 use Scalar::Util qw[blessed];
  1         1  
  1         47  
17 1     1   1621 use namespace::autoclean;
  1         1382  
  1         4  
18              
19             has role_is_for => (
20             is => 'rw',
21             isa => 'Undef|Str|ArrayRef[Str]',
22             );
23              
24             has role_misapplication_consequence => (
25             is => 'rw',
26             isa => enum([qw/croak carp/]),
27             default => 'carp',
28             );
29              
30             before apply => sub
31             {
32             my ($meta, $thing, @options) = @_;
33              
34             my $applying_to = $thing;
35             if ($applying_to->isa('Moose::Meta::Class'))
36             {
37             $applying_to = $thing->name;
38             }
39            
40             my @targets;
41             @targets = ref $meta->role_is_for
42             ? @{$meta->role_is_for}
43             : ($meta->role_is_for)
44             if defined $meta->role_is_for;
45            
46             return unless @targets;
47            
48             my $compliance = 0;
49             TARGET: foreach (@targets)
50             {
51             if ($applying_to->DOES($_))
52             {
53             $compliance = 1;
54             last TARGET;
55             }
56             }
57            
58             return if $compliance;
59            
60             my $message = sprintf(
61             "Role '%s' must only be applied to classes %s (not '%s')",
62             $meta->name,
63             (join '|', map {"'$_'"} @targets),
64             (ref $applying_to || $applying_to),
65             );
66            
67             foreach (keys %INC)
68             {
69             s{\.pm$}{};
70             s{[/\\]}{::}g;
71             $Carp::Internal{$_}++ if /^(?:Class::MOP|Moose|MooseX)\b/
72             }
73            
74             $meta->role_misapplication_consequence eq 'croak'
75             ? croak($message)
76             : carp($message);
77            
78             foreach (keys %INC)
79             {
80             s{\.pm$}{};
81             s{[/\\]}{::}g;
82             $Carp::Internal{$_}-- if /^(?:Class::MOP|Moose|MooseX)\b/
83             }
84             };
85              
86             'Yay!';
87              
88             __END__
89              
90             =head1 NAME
91              
92             MooseX::RoleFor::Meta::Role::Trait::RoleFor - Moose::Meta::Role trait
93              
94             =head1 DESCRIPTION
95              
96             This trait provides two attributes:
97              
98             =over
99              
100             =item C<< role_is_for >>
101              
102             An arrayref of class names, or a single class name as a string,
103             or undef. Indicates which classes this role may be composed
104             with. (Actually these may be classes B<< or roles >>!)
105              
106             =item C<< role_misapplication_consequence >>
107              
108             Either "croak" or "carp" (the default). Indicates the
109             consequences of applying the role to the wrong class.
110              
111             =back
112              
113             This trait hooks onto the C<apply> method to enforce the
114             consequences.
115              
116             =head1 BUGS
117              
118             Please report any bugs to
119             L<http://rt.cpan.org/Dist/Display.html?Queue=MooseX-RoleFor>.
120              
121             =head1 SEE ALSO
122              
123             L<MooseX::RoleFor>.
124              
125             =head1 AUTHOR
126              
127             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
128              
129             =head1 COPYRIGHT AND LICENCE
130              
131             This software is copyright (c) 2011-2012 by Toby Inkster.
132              
133             This is free software; you can redistribute it and/or modify it under
134             the same terms as the Perl 5 programming language system itself.
135              
136             =head1 DISCLAIMER OF WARRANTIES
137              
138             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
139             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
140             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
141