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   36 use strict;
  7         8  
  7         153  
5 7     7   25 use warnings;
  7         10  
  7         194  
6              
7 7     7   28 use MOP::Role;
  7         7  
  7         135  
8 7     7   37 use MOP::Class;
  7         15  
  7         114  
9 7     7   26 use MOP::Internal::Util ();
  7         20  
  7         2092  
10              
11             our $VERSION = '0.14';
12             our $AUTHORITY = 'cpan:STEVAN';
13              
14             sub get_meta {
15 5     5 1 913 my ($package) = @_;
16              
17 5 50       61 return $package->METACLASS->new( $package )
18             if $package->can('METACLASS');
19              
20 5         40 my $meta = MOP::Role->new( $package );
21 5         84 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     26 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         4 return MOP::Class->new( $package );
30             }
31              
32             sub compose_roles {
33 5     5 1 25 my ($meta) = @_;
34              
35 5         10 my @roles = $meta->roles;
36 5 50       17 MOP::Internal::Util::APPLY_ROLES( $meta, \@roles ) if @roles;
37 5         53 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 3979 my ($cb) = @_;
69              
70 5         15 MOP::Internal::Util::ADD_UNITCHECK_HOOK( $cb );
71 5         1949 return;
72             }
73              
74             1;
75              
76             __END__