File Coverage

blib/lib/MOP/Util.pm
Criterion Covered Total %
statement 28 36 77.7
branch 3 10 30.0
condition 3 9 33.3
subroutine 8 9 88.8
pod 4 4 100.0
total 46 68 67.6


line stmt bran cond sub pod time code
1             package MOP::Util;
2             # ABSTRACT: For MOP External Use Only
3              
4 7     7   48 use strict;
  7         15  
  7         200  
5 7     7   43 use warnings;
  7         15  
  7         189  
6              
7 7     7   38 use MOP::Role;
  7         29  
  7         196  
8 7     7   49 use MOP::Class;
  7         12  
  7         145  
9 7     7   43 use MOP::Internal::Util ();
  7         13  
  7         2399  
10              
11             our $VERSION = '0.12';
12             our $AUTHORITY = 'cpan:STEVAN';
13              
14             sub get_meta {
15 5     5 1 935 my ($package) = @_;
16              
17 5 50       51 return $package->METACLASS->new( $package )
18             if $package->can('METACLASS');
19              
20 5         52 my $meta = MOP::Role->new( $package );
21 5         91 my $isa = MOP::Internal::Util::GET_GLOB_SLOT( $meta->stash, 'ISA', 'ARRAY' );
22              
23             # without inheritance, we assume it is a role ...
24 5 50 33     32 return $meta
      66        
25             if not defined $isa
26             || (ref $isa eq 'ARRAY' && scalar @$isa == 0);
27              
28             # with inheritance, we know it is a class ....
29 1         5 return MOP::Class->new( $package );
30             }
31              
32             sub compose_roles {
33 5     5 1 29 my ($meta) = @_;
34              
35 5         18 my @roles = $meta->roles;
36 5 50       25 MOP::Internal::Util::APPLY_ROLES( $meta, \@roles ) if @roles;
37 5         51 return;
38             }
39              
40             sub inherit_slots {
41 0     0 1 0 my ($meta) = @_;
42              
43             # roles don't inherit, so do nothing ...
44 0 0       0 return unless $meta->isa('MOP::Class');
45              
46             # otherwise, inherit only the slots from
47             # the direct superclasses, this assumes that
48             # these superclasses have already done
49             # INHERIT_SLOTS themselves.
50 0         0 foreach my $super ( map { MOP::Role->new( name => $_ ) } $meta->superclasses ) {
  0         0  
51             # remember to use all_slots so that it
52             # will gives us *all* the slots, including
53             # those that are themselves inherited ...
54 0         0 foreach my $slot ( $super->all_slots ) {
55 0         0 my $slot_name = $slot->name;
56             # we always just alias this anyway ...
57 0 0 0     0 $meta->alias_slot( $slot_name, $slot->initializer )
58             unless $meta->has_slot( $slot_name )
59             || $meta->has_slot_alias( $slot_name );
60             }
61             }
62              
63             # nothing to return ...
64 0         0 return;
65             }
66              
67             sub defer_until_UNITCHECK {
68 5     5 1 4745 my ($cb) = @_;
69              
70 5         19 MOP::Internal::Util::ADD_UNITCHECK_HOOK( $cb );
71 5         2662 return;
72             }
73              
74             1;
75              
76             __END__