File Coverage

blib/lib/MooseX/Does/Delegated.pm
Criterion Covered Total %
statement 15 17 88.2
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 21 23 91.3


line stmt bran cond sub pod time code
1             package MooseX::Does::Delegated;
2              
3 1     1   22596 use 5.008;
  1         2  
  1         29  
4 1     1   4 use strict;
  1         3  
  1         27  
5 1     1   4 use warnings;
  1         6  
  1         36  
6 1     1   950 use if $] < 5.010, 'UNIVERSAL::DOES';
  1         8  
  1         5  
7              
8             BEGIN {
9 1     1   51 $MooseX::Does::Delegated::AUTHORITY = 'cpan:TOBYINK';
10 1         16 $MooseX::Does::Delegated::VERSION = '0.004';
11             }
12              
13 1     1   437 use Moose::Role;
  0            
  0            
14              
15             around DOES => sub {
16             my ($orig, $self, $role) = @_;
17             return 1 if $self->$orig($role);
18             return unless blessed($self);
19             for my $attr ($self->meta->get_all_attributes) {
20             next unless $attr->has_handles;
21             my $handles = $attr->handles;
22             next if ref $handles;
23             next unless $attr->has_value($self) || $attr->is_lazy;
24             return 1 if $role eq $handles;
25             return 1 if Class::MOP::class_of($handles)->does_role($role);
26             }
27             return;
28             };
29              
30             # Allow import method to work, yet hide it from role method list.
31             our @ISA = do {
32             package # Hide from CPAN indexer too.
33             MooseX::Does::Delegated::__ANON__::0001;
34             use Moose::Util qw(ensure_all_roles);
35             sub import {
36             no warnings qw(uninitialized);
37             my $class = shift;
38             ensure_all_roles('Moose::Object', $class)
39             if $_[0] =~ /^[-](?:everywhere|rafl)/;
40             }
41             __PACKAGE__;
42             };
43              
44             no Moose::Role;
45              
46             __PACKAGE__
47             __END__
48              
49             =head1 NAME
50              
51             MooseX::Does::Delegated - allow your class's DOES method to respond the affirmative to delegated roles
52              
53             =head1 SYNOPSIS
54              
55             use strict;
56             use Test::More;
57            
58             {
59             package HttpGet;
60             use Moose::Role;
61             requires 'get';
62             };
63            
64             {
65             package UserAgent;
66             use Moose;
67             with qw( HttpGet );
68             sub get { ... };
69             };
70            
71             {
72             package Spider;
73             use Moose;
74             has ua => (
75             is => 'ro',
76             does => 'HttpGet',
77             handles => 'HttpGet',
78             lazy_build => 1,
79             );
80             sub _build_ua { UserAgent->new };
81             };
82            
83             my $woolly = Spider->new;
84            
85             # Note that the default Moose implementation of DOES
86             # ignores the fact that Spider has delegated the HttpGet
87             # role to its "ua" attribute.
88             #
89             ok( $woolly->DOES('Spider') );
90             ok( not $woolly->DOES('HttpGet') );
91            
92             Moose::Util::apply_all_roles(
93             'Spider',
94             'MooseX::Does::Delegated',
95             );
96            
97             # Our reimplemented DOES pays attention to delegated roles.
98             #
99             ok( $woolly->DOES('Spider') );
100             ok( $woolly->DOES('HttpGet') );
101            
102             done_testing;
103              
104             =head1 DESCRIPTION
105              
106             According to L<UNIVERSAL> the point of C<DOES> is that it allows you
107             to check whether an object does a role without caring about I<how>
108             it does the role.
109              
110             However, the default Moose implementation of C<DOES> (which you can
111             of course override!) only checks whether the object does the role via
112             inheritance or the application of a role to a class.
113              
114             This module overrides your object's C<DOES> method, allowing it to
115             respond the affirmative to delegated roles. This module is a standard
116             Moose role, so it can be used like this:
117              
118             with qw( MooseX::Does::Delegated );
119              
120             Alternatively, if you wish to apply this role ubiqitously (i.e. to all
121             Moose objects in your application) - as is your prerogative - you can use:
122              
123             use MooseX::Does::Delegated -everywhere;
124              
125             This will apply the role to the Moose::Object base class.
126              
127             =head1 BUGS
128              
129             Please report any bugs to
130             L<http://rt.cpan.org/Dist/Display.html?Queue=MooseX-Does-Delegated>.
131              
132             =head1 SEE ALSO
133              
134             L<Moose::Manual::Delegation>.
135              
136             =head1 AUTHOR
137              
138             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
139              
140             =head1 COPYRIGHT AND LICENCE
141              
142             This software is copyright (c) 2012 by Toby Inkster.
143              
144             This is free software; you can redistribute it and/or modify it under
145             the same terms as the Perl 5 programming language system itself.
146              
147             =head1 DISCLAIMER OF WARRANTIES
148              
149             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
150             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
151             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
152