File Coverage

blib/lib/MooX/Role/Parameterized.pm
Criterion Covered Total %
statement 42 49 85.7
branch 3 4 75.0
condition 2 3 66.6
subroutine 11 15 73.3
pod 4 4 100.0
total 62 75 82.6


line stmt bran cond sub pod time code
1             package MooX::Role::Parameterized;
2             {
3             $MooX::Role::Parameterized::VERSION = '0.082';
4             }
5 9     9   2535547 use strict;
  9         22  
  9         253  
6 9     9   47 use warnings;
  9         24  
  9         243  
7 9     9   56 use Carp;
  9         22  
  9         2045  
8              
9             # ABSTRACT: MooX::Role::Parameterized - roles with composition parameters
10 9     9   5603 use MooX::Role::Parameterized::Proxy;
  9         60  
  9         319  
11 9     9   111 use Exporter qw(import);
  9         20  
  9         318  
12 9     9   886 use Module::Runtime qw(use_module);
  9         1695  
  9         64  
13             our @EXPORT = qw(role method apply hasp);
14              
15             my %code_for;
16              
17 0     0 1 0 sub hasp { carp "hasp deprecated"; }
18              
19             sub apply {
20 12     12 1 57216 my ( $role, $args, %extra ) = @_;
21              
22 12 50       61 return if !exists $code_for{$role};
23              
24 12 100       69 $args = [$args] if ref($args) ne ref( [] );
25              
26 12   66     95 my $target = $extra{target} // caller;
27              
28             {
29 9     9   1424 no strict 'refs';
  9         33  
  9         324  
  12         210  
30 9     9   51 no warnings 'redefine';
  9         26  
  9         997  
31              
32             # necessary for magic
33 12         63 *{ $role . '::hasp' } = sub {
34              
35             # carp 'hasp deprecated, use $object->has instead.';
36 0     0   0 goto &{ $target . '::has' };
  0         0  
37 12         61 };
38 12         53 *{ $role . '::method' } = sub {
39              
40             # carp 'method deprecated, use $object->method instead.';
41 0     0   0 my ( $name, $code ) = @_;
42 9     9   56 no strict 'refs';
  9         16  
  9         2078  
43 0         0 *{"$target\::$name"} = $code;
  0         0  
44 12         55 };
45             }
46 12         178 my $p =
47             MooX::Role::Parameterized::Proxy->new( target => $target, role => $role );
48 12         27 $code_for{$role}->( $_, $p ) foreach ( @{$args} );
  12         78  
49              
50 10         2176899 use_module('Moo::Role')->apply_roles_to_package( $target, $role );
51             }
52              
53             sub role(&) {
54 8     8 1 49720 my $package = (caller)[0];
55              
56 8         96 $code_for{$package} = shift;
57             }
58              
59 0     0 1   sub method { carp "hasp deprecated"; }
60              
61             1;
62             __END__