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

package Evo::Attr;
use strict;
use warnings;
use Carp 'croak';
use Evo::Internal::Util;
use feature 'signatures';
no warnings 'experimental::signatures';

my $MCO = \&invoke_handlers;

sub patch_package ($me, $pkg) {
  Evo::Internal::Util::monkey_patch $pkg, MODIFY_CODE_ATTRIBUTES => $MCO;
}

our %HANDLERS;

%HANDLERS = (
  Attr => {
    provider => __PACKAGE__,
    handler  => sub ($provider, $handler, $name) {
      register_attribute($provider, $name, $handler);
    }
  }
);

# $provider is a key, just for error message
sub register_attribute ($provider, $name, $handler) {
  croak "$name was already taken by $HANDLERS{$name}{provider}" if $HANDLERS{$name};
  $HANDLERS{$name} = {provider => $provider, handler => $handler};
}

sub invoke_handlers ($dest, $code, @attrs) {
  my (undef, $subname) = Evo::Internal::Util::code2names($code);
  my @remaining;
  foreach my $attr_raw (@attrs) {
    my ($attr, @args) = parse_attr($attr_raw);

    if (my $slot = $HANDLERS{$attr}) {
      $slot->{handler}->($dest, $code, $subname, @args);
    }
    else { push @remaining, $attr_raw }
  }
  @remaining;
}

sub parse_attr ($attr) {
  $attr =~ /(\w+) ( \( \s* ([\w\,\s]+) \s* \) )?/x;
  return ($1, split /\,\s?/, $3 // '');
}

1;

__END__