File Coverage

blib/lib/MouseX/POE/Meta/Trait/Class.pm
Criterion Covered Total %
statement 16 16 100.0
branch 1 2 50.0
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 22 23 95.6


line stmt bran cond sub pod time code
1             package MouseX::POE::Meta::Trait::Class;
2             BEGIN {
3 11     11   1673 $MouseX::POE::Meta::Trait::Class::VERSION = '0.214';
4             }
5             # ABSTRACT: No achmed inside
6 11     11   7491 use Mouse::Role;
  11         9457  
  11         58  
7              
8             with qw(MouseX::POE::Meta::Trait);
9              
10             # TODO: subclass events to be a hashref that maps the event to the method
11             # so we can support on_ events
12              
13             around default_events => sub {
14             my ( $next, $self ) = @_;
15             my $events = $next->($self);
16             push @$events, grep { s/^on_(\w+)/$1/; } $self->get_method_list;
17             return $events;
18             };
19              
20              
21             around get_state_method_name => sub {
22             my ( $next, $self, $name ) = @_;
23             return 'on_' . $name if $self->has_method( 'on_' . $name );
24             return $next->( $self, $name );
25             };
26              
27             sub get_all_events {
28 47     47 1 560 my ($self) = @_;
29 47         69 my $wanted_role = 'MouseX::POE::Meta::Trait';
30              
31             # This horrible grep can be removed once Mouse gets more metacircular.
32             # Currently Mouse::Meta::Class->meta isn't a MMC. It should be, and it
33             # should also be a Mouse::Object so does works on it.
34 51         1904 my %events
35             = map {
36 145 50       5660 my $m = $_;
37 51         193 map { $_ => $m->get_state_method_name($_) } $m->get_events
  122         1016  
38             }
39             grep {
40 145         1260 $_->meta->can('does_role') && $_->meta->does_role($wanted_role)
41             }
42 47         194 map { $_->meta } $self->linearized_isa;
43 47         1497 return %events;
44             }
45              
46 11     11   6331 no Mouse::Role;
  11         25  
  11         62  
47             1;
48              
49              
50             =pod
51              
52             =head1 NAME
53              
54             MouseX::POE::Meta::Trait::Class - No achmed inside
55              
56             =head1 VERSION
57              
58             version 0.214
59              
60             =head1 METHODS
61              
62             =head2 get_all_events
63              
64             =begin comment
65              
66              
67              
68              
69             =end comment
70              
71             around add_role => sub {
72             my ( $next, $self, $role ) = @_;
73             $next->( $self, $role );
74              
75             if ( $role->meta->can('does_role')
76             && $role->meta->does_role("MouseX::POE::Meta::Trait") ) {
77             $self->add_event( $role->get_events );
78             }
79             };
80              
81             =head1 METHODS
82              
83             =head1 DEPENDENCIES
84              
85             Mouse::Role
86              
87             =head1 AUTHORS
88              
89             =over 4
90              
91             =item *
92              
93             Chris Prather
94              
95             =item *
96              
97             Ash Berlin
98              
99             =item *
100              
101             Chris Williams
102              
103             =item *
104              
105             Yuval (nothingmuch) Kogman
106              
107             =item *
108              
109             Torsten Raudssus L
110              
111             =back
112              
113             =head1 COPYRIGHT AND LICENSE
114              
115             This software is copyright (c) 2010 by Chris Prather, Ash Berlin, Chris Williams, Yuval Kogman, Torsten Raudssus.
116              
117             This is free software; you can redistribute it and/or modify it under
118             the same terms as the Perl 5 programming language system itself.
119              
120             =cut
121              
122              
123             __END__