File Coverage

blib/lib/Mite/Trait/HasRequiredMethods.pm.mite.pm
Criterion Covered Total %
statement 62 89 69.6
branch 5 22 22.7
condition 1 14 7.1
subroutine 12 21 57.1
pod 0 2 0.0
total 80 148 54.0


line stmt bran cond sub pod time code
1             {
2              
3             use strict;
4 15     15   130 use warnings;
  15         52  
  15         487  
5 15     15   95 no warnings qw( once void );
  15         37  
  15         550  
6 15     15   87  
  15         35  
  15         2070  
7             our $USES_MITE = "Mite::Role";
8             our $MITE_SHIM = "Mite::Shim";
9             our $MITE_VERSION = "0.011000";
10              
11             # Mite keywords
12             BEGIN {
13             my ( $SHIM, $CALLER ) =
14 15     15   93 ( "Mite::Shim", "Mite::Trait::HasRequiredMethods" );
15             (
16             *after, *around, *before,
17             *field, *has, *param,
18             *requires, *signature_for, *with
19             )
20             = do {
21 15         45  
22             no warnings 'redefine';
23             (
24 15     15   118 sub { $SHIM->HANDLE_after( $CALLER, "role", @_ ) },
  15         35  
  15         3676  
25             sub { $SHIM->HANDLE_around( $CALLER, "role", @_ ) },
26 0     0   0 sub { $SHIM->HANDLE_before( $CALLER, "role", @_ ) },
27 15     15   89 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
28 15     15   99 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
29 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
30 15     15   10542 sub { },
31 0     0   0 sub { $SHIM->HANDLE_signature_for( $CALLER, "role", @_ ) },
32       0     sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
33 0     0   0 );
34 0     0   0 }
35 15         2911  
36             # Mite imports
37             BEGIN {
38             require Scalar::Util;
39             *STRICT = \&Mite::Shim::STRICT;
40             *bare = \&Mite::Shim::bare;
41 15     15   119 *blessed = \&Scalar::Util::blessed;
42 15         215 *carp = \&Mite::Shim::carp;
43 15         50 *confess = \&Mite::Shim::confess;
44 15         49 *croak = \&Mite::Shim::croak;
45 15         38 *false = \&Mite::Shim::false;
46 15         38 *guard = \&Mite::Shim::guard;
47 15         43 *lazy = \&Mite::Shim::lazy;
48 15         41 *lock = \&Mite::Shim::lock;
49 15         38 *ro = \&Mite::Shim::ro;
50 15         35 *rw = \&Mite::Shim::rw;
51 15         41 *rwp = \&Mite::Shim::rwp;
52 15         34 *true = \&Mite::Shim::true;
53 15         56 *unlock = \&Mite::Shim::unlock;
54 15         35 }
55 15         36  
56 15         569 # Gather metadata for constructor and destructor
57             no strict 'refs';
58             my $class = shift;
59             $class = ref($class) || $class;
60             my $linear_isa = mro::get_linear_isa($class);
61 15     15   119 return {
  15         44  
  15         6618  
62 0     0   0 BUILD => [
63 0   0     0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
64 0         0 map { "$_\::BUILD" } reverse @$linear_isa
65             ],
66             DEMOLISH => [
67 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
68 0         0 map { "$_\::DEMOLISH" } @$linear_isa
69             ],
70             HAS_BUILDARGS => $class->can('BUILDARGS'),
71 0 0       0 HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
  0         0  
  0         0  
72 0         0 };
  0         0  
73             }
74              
75             # See UNIVERSAL
76             my ( $self, $role ) = @_;
77             our %DOES;
78             return $DOES{$role} if exists $DOES{$role};
79             return 1 if $role eq __PACKAGE__;
80             if ( $INC{'Moose/Util.pm'}
81 0     0 0 0 and my $meta = Moose::Util::find_meta( ref $self or $self ) )
82 0         0 {
83 0 0       0 $meta->can('does_role') and $meta->does_role($role) and return 1;
84 0 0       0 }
85 0 0 0     0 return $self->SUPER::DOES($role);
      0        
86             }
87              
88 0 0 0     0 # Alias for Moose/Moo-compatibility
89             shift->DOES(@_);
90 0         0 }
91              
92             # Callback which classes consuming this role will call
93             my ( $me, $target, $args ) = @_;
94             our ( %CONSUMERS, @METHOD_MODIFIERS );
95 0     0 0 0  
96             # Ensure a given target only consumes this role once.
97             if ( exists $CONSUMERS{$target} ) {
98             return;
99             }
100 15     15   66 $CONSUMERS{$target} = 1;
101 15         37  
102             my $type = do { no strict 'refs'; ${"$target\::USES_MITE"} };
103             return if $type ne 'Mite::Class';
104 15 50       64  
105 0         0 my @missing_methods;
106             @missing_methods = grep( !$target->can($_),
107 15         54 "_compile_mop_required_methods",
108             "inject_mite_functions" )
109 15     15   133 and croak( "$me requires $target to implement methods: " . join q[, ],
  15         41  
  15         4283  
  15         32  
  15         36  
  15         74  
110 15 50       75 @missing_methods );
111              
112 15         35 my @roles = ();
113 15 50       344 my %nextargs = %{ $args || {} };
114             ( $nextargs{-indirect} ||= 0 )++;
115             croak("PANIC!") if $nextargs{-indirect} > 100;
116             for my $role (@roles) {
117             $role->__FINALIZE_APPLICATION__( $target, {%nextargs} );
118             }
119 15         40  
120 15 50       42 my $shim = "Mite::Shim";
  15         218  
121 15   50     137 for my $modifier_rule (@METHOD_MODIFIERS) {
122 15 50       64 my ( $modification, $names, $coderef ) = @$modifier_rule;
123 15         46 my $handler = "HANDLE_$modification";
124 0         0 $shim->$handler( $target, "class", $names, $coderef );
125             }
126              
127 15         36 return;
128 15         44 }
129 30         96  
130 30         80 1;