File Coverage

blib/lib/Mite/Class.pm
Criterion Covered Total %
statement 46 49 93.8
branch 4 6 66.6
condition n/a
subroutine 13 15 86.6
pod 0 5 0.0
total 63 75 84.0


line stmt bran cond sub pod time code
1 108     108   15812 use 5.010001;
  108         350  
2 108     108   547 use strict;
  108         206  
  108         2415  
3 108     108   555 use warnings;
  108         241  
  108         4793  
4              
5             use Mite::Miteception -all;
6 108     108   615 extends qw(
  108         199  
  108         1025  
7             Mite::Package
8             );
9             with qw(
10             Mite::Trait::HasSuperclasses
11             Mite::Trait::HasConstructor
12             Mite::Trait::HasDestructor
13             Mite::Trait::HasAttributes
14             Mite::Trait::HasRoles
15             Mite::Trait::HasMethods
16             Mite::Trait::HasMOP
17             );
18              
19             our $AUTHORITY = 'cpan:TOBYINK';
20             our $VERSION = '0.010008';
21              
22             use Path::Tiny;
23 108     108   684 use mro;
  108         194  
  108         5709  
24 108     108   644 use B ();
  108         196  
  108         772  
25 108     108   1912  
  108         206  
  108         59245  
26              
27 212     212 0 507 my ( $self, $name ) = ( shift, @_ );
28              
29             return $self->project->class($name);
30 2     2 0 12 }
31              
32 2         6 my ( $self, @classes ) = ( shift, @_ );
33              
34             my %attributes;
35             for my $class (reverse @classes) {
36 75     75 0 187 for my $attribute (values %{$class->attributes}) {
37             $attributes{$attribute->name} = $attribute;
38 75         108 }
39 75         209 }
40 162         198  
  162         393  
41 167         362 return \%attributes;
42             }
43              
44             around all_attributes => sub {
45 75         582 my ( $next, $self ) = ( shift, shift );
46              
47             return $self->$next
48             if not @{ $self->superclasses || [] };
49              
50             return $self->chained_attributes( $self->linear_parents );
51             };
52              
53             my $self = shift;
54              
55             my @parents = $self->linear_parents;
56             shift @parents; # remove ourselves from the inheritance list
57             return $self->chained_attributes(@parents);
58 7     7 0 517 }
59              
60 7         40 my ($self, $name, %args) = ( shift, @_ );
61 7         16  
62 7         28 my @parents = $self->linear_parents;
63             shift @parents; # remove ourselves from the inheritance list
64              
65             my $found_signature;
66 2     2 0 11 for my $parent ( @parents ) {
67             if ( $parent->method_signatures->{$name} ) {
68 2         21 $found_signature = $parent->method_signatures->{$name};
69 2         6 last;
70             }
71 2         3 }
72 2         10  
73 2 50       15 if ( $found_signature ) {
74 2         7 $self->method_signatures->{$name} = %args
75 2         19 ? $found_signature->clone( %args, class => $self )
76             : $found_signature;
77             }
78             else {
79 2 50       8 croak "Could not find signature for $name in any parent class";
80 2 100       18 }
81              
82             return;
83             }
84              
85 0         0 around extend_attribute => sub {
86             my ( $next, $self, %attr_args ) = ( shift, shift, @_ );
87              
88 2         8 my $name = delete $attr_args{name};
89              
90             if ( $self->attributes->{$name} ) {
91             return $self->$next( name => $name, %attr_args );
92             }
93              
94             my $parent_attr = $self->parents_attributes->{$name};
95             croak <<'ERROR', $name, $self->name unless $parent_attr;
96             Could not find an attribute by the name of '%s' to inherit from in %s
97             ERROR
98              
99             if ( ref $attr_args{default} ) {
100             $attr_args{_class_for_default} = $self;
101             }
102              
103             $self->add_attribute($parent_attr->clone(%attr_args));
104              
105             return;
106             };
107              
108             return true;
109             }
110              
111             return '$META_CLASS';
112             }
113              
114             return 'Moose::Meta::Attribute';
115 121     121   551 }
116              
117             1;