File Coverage

blib/lib/MooX/Keyword.pm
Criterion Covered Total %
statement 38 40 95.0
branch 7 12 58.3
condition n/a
subroutine 10 10 100.0
pod 0 1 0.0
total 55 63 87.3


line stmt bran cond sub pod time code
1             package MooX::Keyword;
2 3     3   197286 use 5.006; use strict; use warnings; our $VERSION = '0.04';
  3     3   15  
  3     3   12  
  3         6  
  3         52  
  3         12  
  3         4  
  3         93  
3 3     3   1099 use MooX::ReturnModifiers; use Anonymous::Object;
  3     3   1234  
  3         114  
  3         1095  
  3         25053  
  3         568  
4              
5             sub import {
6 4 100   4   813 my ( $package, %import ) = (shift, ref $_[0] ? %{ $_[0] } : @_);
  2         9  
7 4         10 my $target = caller;
8 4         19 my $moo = Anonymous::Object->new(object_name => 'MooX::Keyword')->hash_to_object_context({
9             return_modifiers( $target )
10             }); # *\o/*
11            
12 4 100       250983 if ($import{extends}) {
13 1 50       6 for my $extend ( ref $import{extends} ? @{ $import{extends} } : $import{extends} ) {
  0         0  
14 1         3 $extend =~ s/^\+/MooX::Keyword::/;
15 1         17 $moo->extends($import{extends});
16 1         336 %import = (%import, $import{extends}->keyword_meta);
17             }
18 1         3 delete $import{extends};
19             }
20              
21             keyword($target, $moo, 'keyword_meta', { builder => sub {
22 1     1   3 my $m = shift;
23 1         4 return %import;
24 4         28 }});
25 4         15 keyword($target, $moo, $_, $import{$_}) for keys %import;
26            
27 4         231 return 1;
28             }
29              
30             sub keyword {
31 3     3   21 no strict 'refs';
  3         5  
  3         400  
32 7     7 0 18 my ($target, $moo, $keyword, $params) = @_;
33 7 50       31 die 'no builder for ${keyword}' unless $params->{builder};
34 7 0       22 for ($keyword, $params->{alias} ? ref $params->{alias} ? @{ $params->{alias} } : $params->{alias} : ()) {
  0 50       0  
35 7         39 *{"${target}::${_}"} = sub {
36 6     6   33789 $params->{builder}->($moo, @_);
37 7         23 };
38             }
39             }
40              
41             1;
42              
43             __END__