File Coverage

blib/lib/Mite/Trait/HasSuperclasses.pm.mite.pm
Criterion Covered Total %
statement 60 85 70.5
branch 5 18 27.7
condition 1 5 20.0
subroutine 12 21 57.1
pod 0 2 0.0
total 78 131 59.5


line stmt bran cond sub pod time code
1             {
2              
3             use strict;
4 108     108   716 use warnings;
  108         6743  
  108         3118  
5 108     108   575 no warnings qw( once void );
  108         240  
  108         3223  
6 108     108   486  
  108         243  
  108         12303  
7             our $USES_MITE = "Mite::Role";
8             our $MITE_SHIM = "Mite::Shim";
9             our $MITE_VERSION = "0.010007";
10              
11             # Mite keywords
12             BEGIN {
13             my ( $SHIM, $CALLER ) =
14 108     108   510 ( "Mite::Shim", "Mite::Trait::HasSuperclasses" );
15             (
16             *after, *around, *before,
17             *field, *has, *param,
18             *requires, *signature_for, *with
19             )
20             = do {
21 108         200  
22             no warnings 'redefine';
23             (
24 108     108   775 sub { $SHIM->HANDLE_after( $CALLER, "role", @_ ) },
  108         232  
  108         23096  
25             sub { $SHIM->HANDLE_around( $CALLER, "role", @_ ) },
26 0     0   0 sub { $SHIM->HANDLE_before( $CALLER, "role", @_ ) },
27 324     324   1096 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
28 108     108   689 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
29 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
30 324     324   449122 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 108         16786  
36             # Mite imports
37             BEGIN {
38             require Scalar::Util;
39             *STRICT = \&Mite::Shim::STRICT;
40             *bare = \&Mite::Shim::bare;
41 108     108   744 *blessed = \&Scalar::Util::blessed;
42 108         353 *carp = \&Mite::Shim::carp;
43 108         245 *confess = \&Mite::Shim::confess;
44 108         292 *croak = \&Mite::Shim::croak;
45 108         236 *false = \&Mite::Shim::false;
46 108         305 *guard = \&Mite::Shim::guard;
47 108         243 *lazy = \&Mite::Shim::lazy;
48 108         197 *ro = \&Mite::Shim::ro;
49 108         249 *rw = \&Mite::Shim::rw;
50 108         219 *rwp = \&Mite::Shim::rwp;
51 108         280 *true = \&Mite::Shim::true;
52 108         216 }
53 108         394  
54 108         3614 # Gather metadata for constructor and destructor
55             no strict 'refs';
56             my $class = shift;
57             $class = ref($class) || $class;
58             my $linear_isa = mro::get_linear_isa($class);
59 108     108   676 return {
  108         270  
  108         35140  
60 0     0   0 BUILD => [
61 0   0     0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
62 0         0 map { "$_\::BUILD" } reverse @$linear_isa
63             ],
64             DEMOLISH => [
65 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
66 0         0 map { "$_\::DEMOLISH" } @$linear_isa
67             ],
68             HAS_BUILDARGS => $class->can('BUILDARGS'),
69 0 0       0 HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
  0         0  
  0         0  
70 0         0 };
  0         0  
71             }
72              
73             # See UNIVERSAL
74             my ( $self, $role ) = @_;
75             our %DOES;
76             return $DOES{$role} if exists $DOES{$role};
77             return 1 if $role eq __PACKAGE__;
78             return $self->SUPER::DOES($role);
79 0     0 0 0 }
80 0         0  
81 0 0       0 # Alias for Moose/Moo-compatibility
82 0 0       0 shift->DOES(@_);
83 0         0 }
84              
85             # Callback which classes consuming this role will call
86             my ( $me, $target, $args ) = @_;
87             our ( %CONSUMERS, @METHOD_MODIFIERS );
88 0     0 0 0  
89             # Ensure a given target only consumes this role once.
90             if ( exists $CONSUMERS{$target} ) {
91             return;
92             }
93 108     108   355 $CONSUMERS{$target} = 1;
94 108         202  
95             my $type = do { no strict 'refs'; ${"$target\::USES_MITE"} };
96             return if $type ne 'Mite::Class';
97 108 50       414  
98 0         0 my @missing_methods;
99             @missing_methods = grep( !$target->can($_),
100 108         345 "_compile_meta_method", "_compile_mop_postamble",
101             "compilation_stages", "inject_mite_functions" )
102 108     108   823 and croak( "$me requires $target to implement methods: " . join q[, ],
  108         438  
  108         26901  
  108         219  
  108         206  
  108         558  
103 108 50       445 @missing_methods );
104              
105 108         231 my @roles = ();
106 108 50       2883 my %nextargs = %{ $args || {} };
107             ( $nextargs{-indirect} ||= 0 )++;
108             croak("PANIC!") if $nextargs{-indirect} > 100;
109             for my $role (@roles) {
110             $role->__FINALIZE_APPLICATION__( $target, {%nextargs} );
111             }
112 108         307  
113 108 50       217 my $shim = "Mite::Shim";
  108         788  
114 108   50     750 for my $modifier_rule (@METHOD_MODIFIERS) {
115 108 50       445 my ( $modification, $names, $coderef ) = @$modifier_rule;
116 108         317 my $handler = "HANDLE_$modification";
117 0         0 $shim->$handler( $target, "class", $names, $coderef );
118             }
119              
120 108         289 return;
121 108         308 }
122 432         1293  
123 432         919 1;
124 432         1576