File Coverage

blib/lib/Sub/HandlesVia/Toolkit.pm.mite.pm
Criterion Covered Total %
statement 28 78 35.9
branch 3 36 8.3
condition 3 27 11.1
subroutine 9 13 69.2
pod 0 4 0.0
total 43 158 27.2


line stmt bran cond sub pod time code
1             {
2              
3             package Sub::HandlesVia::Toolkit;
4 94     94   727 use strict;
  94         215  
  94         2801  
5 94     94   550 use warnings;
  94         233  
  94         2702  
6 94     94   502 no warnings qw( once void );
  94         261  
  94         12308  
7              
8             our $USES_MITE = "Mite::Class";
9             our $MITE_SHIM = "Sub::HandlesVia::Mite";
10             our $MITE_VERSION = "0.012000";
11              
12             # Mite keywords
13             BEGIN {
14 94     94   507 my ( $SHIM, $CALLER ) =
15             ( "Sub::HandlesVia::Mite", "Sub::HandlesVia::Toolkit" );
16             ( *after, *around, *before, *extends, *has, *signature_for, *with ) =
17 94         217 do {
18              
19             package Sub::HandlesVia::Mite;
20 94     94   1779 no warnings 'redefine';
  94         275  
  94         18944  
21             (
22 0         0 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
23 0         0 sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
24 0         0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
25             sub { },
26 0         0 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
27 0         0 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
28 0         0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
29 94         5066 );
30             };
31             }
32              
33             # Gather metadata for constructor and destructor
34             sub __META__ {
35 94     94   739 no strict 'refs';
  94         295  
  94         60484  
36 0     0   0 my $class = shift;
37 0   0     0 $class = ref($class) || $class;
38 0         0 my $linear_isa = mro::get_linear_isa($class);
39             return {
40             BUILD => [
41 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
42 0         0 map { "$_\::BUILD" } reverse @$linear_isa
43             ],
44             DEMOLISH => [
45 0 0       0 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0         0  
  0         0  
46 0         0 map { "$_\::DEMOLISH" } @$linear_isa
  0         0  
47             ],
48             HAS_BUILDARGS => $class->can('BUILDARGS'),
49             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
50             };
51             }
52              
53             # Standard Moose/Moo-style constructor
54             sub new {
55 0 0   0 0 0 my $class = ref( $_[0] ) ? ref(shift) : shift;
56 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
57 0         0 my $self = bless {}, $class;
58             my $args =
59             $meta->{HAS_BUILDARGS}
60             ? $class->BUILDARGS(@_)
61 0 0       0 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 0       0  
62 0         0 my $no_build = delete $args->{__no_BUILD__};
63              
64             # Call BUILD methods
65 0 0 0     0 $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  0 0       0  
66              
67             # Unrecognized parameters
68             my @unknown = grep not(
69             do {
70              
71             package Sub::HandlesVia::Mite;
72 0 0       0 defined($_) and do {
73 0 0       0 ref( \$_ ) eq 'SCALAR'
74             or ref( \( my $val = $_ ) ) eq 'SCALAR';
75             }
76             }
77             ),
78 0         0 keys %{$args};
  0         0  
79             @unknown
80 0 0       0 and Sub::HandlesVia::Mite::croak(
81             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
82              
83 0         0 return $self;
84             }
85              
86             # Used by constructor to call BUILD methods
87             sub BUILDALL {
88 0     0 0 0 my $class = ref( $_[0] );
89 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
90 0 0       0 $_->(@_) for @{ $meta->{BUILD} || [] };
  0         0  
91             }
92              
93             # Destructor should call DEMOLISH methods
94             sub DESTROY {
95 0     0   0 my $self = shift;
96 0   0     0 my $class = ref($self) || $self;
97 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
98 0 0       0 my $in_global_destruction =
99             defined ${^GLOBAL_PHASE}
100             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
101             : Devel::GlobalDestruction::in_global_destruction();
102 0 0       0 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  0         0  
103 0         0 my $e = do {
104 0         0 local ( $?, $@ );
105 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
106 0         0 $@;
107             };
108 94     94   1814 no warnings 'misc'; # avoid (in cleanup) warnings
  94         362  
  94         24520  
109 0 0       0 die $e if $e; # rethrow
110             }
111 0         0 return;
112             }
113              
114             # See UNIVERSAL
115             sub DOES {
116 4097     4097 0 7565 my ( $self, $role ) = @_;
117 4097         5952 our %DOES;
118 4097 50       8564 return $DOES{$role} if exists $DOES{$role};
119 4097 50       7349 return 1 if $role eq __PACKAGE__;
120 4097 50 33     9236 if ( $INC{'Moose/Util.pm'}
      66        
121             and my $meta = Moose::Util::find_meta( ref $self or $self ) )
122             {
123 0 0 0     0 $meta->can('does_role') and $meta->does_role($role) and return 1;
124             }
125 4097         24779 return $self->SUPER::DOES($role);
126             }
127              
128             # Alias for Moose/Moo-compatibility
129             sub does {
130 2068     2068 0 266938 shift->DOES(@_);
131             }
132              
133             1;
134             }