File Coverage

blib/lib/Evo/Attr.pm
Criterion Covered Total %
statement 51 51 100.0
branch 11 18 61.1
condition 2 2 100.0
subroutine 10 10 100.0
pod 0 4 0.0
total 74 85 87.0


line stmt bran cond sub pod time code
1             package Evo::Attr;
2 67     67   377 use strict;
  67         128  
  67         1634  
3 67     67   308 use warnings;
  67         137  
  67         1550  
4 67     67   339 use Carp 'croak';
  67         111  
  67         2370  
5 67     67   21016 use Evo::Internal::Util;
  67         170  
  67         1832  
6 67     67   372 use feature 'signatures';
  67         126  
  67         3501  
7 67     67   345 no warnings 'experimental::signatures';
  67         124  
  67         30178  
8              
9             my $MCO = \&invoke_handlers;
10              
11 811 50   811 0 2565 sub patch_package ($me, $pkg) {
  811 50       2044  
  811         1440  
  811         1236  
  811         1205  
12 811         3012 Evo::Internal::Util::monkey_patch $pkg, MODIFY_CODE_ATTRIBUTES => $MCO;
13             }
14              
15             our %HANDLERS;
16              
17             %HANDLERS = (
18             Attr => {
19             provider => __PACKAGE__,
20             handler => sub ($provider, $handler, $name) {
21             register_attribute($provider, $name, $handler);
22             }
23             }
24             );
25              
26             # $provider is a key, just for error message
27 189 50   189 0 2281 sub register_attribute ($provider, $name, $handler) {
  189 50       481  
  189         331  
  189         296  
  189         269  
  189         285  
28 189 100       667 croak "$name was already taken by $HANDLERS{$name}{provider}" if $HANDLERS{$name};
29 188         880 $HANDLERS{$name} = {provider => $provider, handler => $handler};
30             }
31              
32 1267 50   1267 0 52039 sub invoke_handlers ($dest, $code, @attrs) {
  1267         2204  
  1267         1999  
  1267         3426  
  1267         2021  
33 1267         3682 my (undef, $subname) = Evo::Internal::Util::code2names($code);
34 1267         2353 my @remaining;
35 1267         2539 foreach my $attr_raw (@attrs) {
36 1276         4463 my ($attr, @args) = parse_attr($attr_raw);
37              
38 1276 100       3803 if (my $slot = $HANDLERS{$attr}) {
39 1270         3843 $slot->{handler}->($dest, $code, $subname, @args);
40             }
41 6         18 else { push @remaining, $attr_raw }
42             }
43 1267         3669 @remaining;
44             }
45              
46 1280 50   1280 0 3532 sub parse_attr ($attr) {
  1280 50       2778  
  1280         2041  
  1280         1806  
47 1280         5828 $attr =~ /(\w+) ( \( \s* ([\w\,\s]+) \s* \) )?/x;
48 1280   100     9471 return ($1, split /\,\s?/, $3 // '');
49             }
50              
51             1;
52              
53             __END__