File Coverage

blib/lib/MooseX/Enumeration/Meta/Method/Accessor/Native/Enumeration/is.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1 11     11   6556 use 5.008001;
  11         37  
2 11     11   62 use strict;
  11         22  
  11         289  
3 11     11   49 use warnings;
  11         22  
  11         782  
4              
5             package MooseX::Enumeration::Meta::Method::Accessor::Native::Enumeration::is;
6             our $AUTHORITY = 'cpan:TOBYINK';
7             our $VERSION = '0.009';
8              
9 11     11   64 use Moose::Role;
  11         27  
  11         93  
10             with 'Moose::Meta::Method::Accessor::Native::Reader';
11              
12             around _minimum_arguments => sub { 1 };
13             around _maximum_arguments => sub { 1 };
14              
15             sub _return_value
16             {
17 11     11   5949 require match::simple;
18            
19 11         10380 my $self = shift;
20 11         28 my ($slot_access) = @_;
21             # Note that $_[0] comes from @curried which has been closed over
22             # and contains the string we need to compare against.
23 11         134 return "match::simple::match($slot_access, \$_[0])";
24             }
25              
26             around _generate_method => sub
27             {
28             my $next = shift;
29             my $self = shift;
30            
31             my @curried = @{ $self->curried_arguments };
32            
33             # If everything is as expected...
34             if ( @curried==1
35             and defined $curried[0]
36             and not ref $curried[0]
37             and not $self->associated_attribute->is_lazy
38             and $self->_maximum_arguments==1
39             and $self->_minimum_arguments==1 )
40             {
41             my $type = $self->associated_attribute->type_constraint;
42             $type->assert_valid($curried[0]);
43            
44             # ... then provide a highly optimized accessor.
45             require B;
46             require Moose::Util;
47             return sprintf(
48             'sub { %s if @_ > 1; no warnings qw(uninitialized); %s eq %s }',
49             "Moose::Util::throw_exception('MethodExpectsFewerArgs', 'method_name', 'is', 'maximum_args', 1)",
50             $self->_get_value('$_[0]'),
51             B::perlstring($curried[0]),
52             );
53             }
54            
55             # Otherwise we should trust the default implementation
56             # from Moose::Meta::Method::Accessor::Native::Reader.
57             $self->$next(@_);
58             };
59              
60             1;