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 109     109   13192 use 5.010001;
  109         407  
2 109     109   637 use strict;
  109         266  
  109         15510  
3 109     109   616 use warnings;
  109         330  
  109         5199  
4              
5             use Mite::Miteception -all;
6 109     109   735 extends qw(
  109         13159  
  109         1032  
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.011000';
21              
22             use Path::Tiny;
23 109     109   843 use mro;
  109         247  
  109         6794  
24 109     109   749 use B ();
  109         237  
  109         898  
25 109     109   2324  
  109         248  
  109         68584  
26              
27 214     214 0 592 my ( $self, $name ) = ( shift, @_ );
28              
29             return $self->project->class($name);
30 2     2 0 13 }
31              
32 2         7 my ( $self, @classes ) = ( shift, @_ );
33              
34             my %attributes;
35             for my $class (reverse @classes) {
36 67     67 0 200 for my $attribute (values %{$class->attributes}) {
37             $attributes{$attribute->name} = $attribute;
38 67         103 }
39 67         181 }
40 141         198  
  141         401  
41 159         356 return \%attributes;
42             }
43              
44             around all_attributes => sub {
45 67         415 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 6     6 0 688 }
59              
60 6         47 my ($self, $name, %args) = ( shift, @_ );
61 6         18  
62 6         29 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         10 $found_signature = $parent->method_signatures->{$name};
69 2         7 last;
70             }
71 2         6 }
72 2         7  
73 2 50       13 if ( $found_signature ) {
74 2         8 $self->method_signatures->{$name} = %args
75 2         4 ? $found_signature->clone( %args, class => $self )
76             : $found_signature;
77             }
78             else {
79 2 50       6 croak "Could not find signature for $name in any parent class";
80 2 100       11 }
81              
82             return;
83             }
84              
85 0         0 around extend_attribute => sub {
86             my ( $next, $self, %attr_args ) = ( shift, shift, @_ );
87              
88 2         11 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 113     113   650 }
116              
117             1;