File Coverage

lib/Momo/Role.pm
Criterion Covered Total %
statement 63 67 94.0
branch 3 4 75.0
condition 1 4 25.0
subroutine 15 16 93.7
pod n/a
total 82 91 90.1


line stmt bran cond sub pod time code
1             package Momo::Role;
2              
3             # ABSTRACT support role
4 1     1   572 use feature ();
  1         1  
  1         20  
5 1     1   4 use strict;
  1         2  
  1         24  
6 1     1   5 use warnings;
  1         1  
  1         20  
7 1     1   6 use utf8;
  1         2  
  1         4  
8 1     1   21 use base qw(Role::Tiny);
  1         2  
  1         111  
9              
10 1     1   6 sub _getglob { no strict 'refs'; \*{ $_[0] } }
  1     12   2  
  1         65  
  12         21  
  12         52  
11 1     1   5 sub _getstash { no strict 'refs'; \%{"$_[0]::"} }
  1     2   8  
  1         107  
  2         2  
  2         5  
12              
13             sub import {
14 2     2   10 my $target = caller;
15 2         3 my $me = shift;
16              
17 2         18 strict->import;
18 2         25 warnings->import( FATAL => 'all' );
19 2         8 utf8->import;
20              
21 1     1   4 no strict 'refs';
  1         2  
  1         510  
22             return
23 2 50       5 if ( \%{'Role::Tiny::INFO'} )->{$target}
  2         9  
24             ; # already exported into this package
25 2         3 ( \%{'Role::Tiny::INFO'} )->{$target}{is_role} = 1;
  2         7  
26              
27             # get symbol table reference
28 2         3 my $stash = _getstash($target);
29              
30             # install before/after/around subs
31 2         3 foreach my $type (qw(before after around)) {
32 6         14 *{ _getglob "${target}::${type}" } = sub {
33 1     1   12 require Class::Method::Modifiers;
34 1   50     2 push @{ ( \%{'Role::Tiny::INFO'} )->{$target}{modifiers} ||= [] },
  1         2  
  1         12  
35             [ $type => @_ ];
36 1         3 return;
37 6         14 };
38             }
39 2         4 *{ _getglob "${target}::requires" } = sub {
40 0   0 0   0 push @{ ( \%{'Role::Tiny::INFO'} )->{$target}{requires} ||= [] }, @_;
  0         0  
  0         0  
41 0         0 return;
42 2         4 };
43 2         3 *{ _getglob "${target}::has" } = sub {
44 1     1   10 require Momo;
        1      
45 1         4 Momo::attr( $target, @_ );
46 2         5 };
47 2         6 *{ _getglob "${target}::with" } = sub {
48 1     1   24 $me->apply_roles_to_package( $target, @_ );
49 1         278 return;
50 2         10 };
51 2 100       8 my @not_methods = ( map { *$_{CODE} || () } grep !ref($_), values %$stash );
  14         33  
52 2         2 @{ ( \%{'Role::Tiny::INFO'} )->{$target}{not_methods} = {} }{@not_methods}
  2         3  
  2         16  
53             = @not_methods;
54              
55             # a role does itself
56 2         4 ( \%{'Role::Tiny::APPLIED_TO'} )->{$target} = { $target => undef };
  2         191  
57             }
58              
59             1;
60              
61             =encoding utf8
62              
63             =head1 NAME
64              
65             Momo::Role is a subclass of Role::Tiny and support C method.
66              
67             =head1 SYNOPSIS
68              
69            
70             package Role1;
71              
72             use Momo::Role;
73              
74             has is_role => 1;
75              
76             sub can_run{ .... };
77             sub can_fly{ .... };
78            
79             1;
80              
81              
82             =head1 DESCRIPTION
83              
84              
85             For the detail,check L,L.
86              
87              
88             =head1 SEE ALSO
89              
90              
91             L
92              
93              
94             =head1 AUTHOR
95              
96              
97             舌尖上的牛氓 C
98              
99             QQ: 492003149
100              
101             QQ-Group: 211685345
102              
103             Site: L
104              
105             =head1 Copyright
106              
107             Copyright (C) <2013>, <舌尖上的牛氓>.
108              
109             This module is free software; you
110             can redistribute it and/or modify it under the same terms
111             as Perl 5.10.0. For more details, see the full text of the
112             licenses in the directory LICENSES.
113              
114             This program is distributed in the hope that it will be
115             useful, but without any warranty; without even the implied
116             warranty of merchantability or fitness for a particular purpose.
117              
118             =cut
119              
120             # niumang // vim: ts=2 sw=2 expandtab
121             # TODO - Edit.