File Coverage

blib/lib/Parse/Method/Signatures/Sig.pm
Criterion Covered Total %
statement 27 34 79.4
branch 10 12 83.3
condition 6 6 100.0
subroutine 6 8 75.0
pod 2 2 100.0
total 51 62 82.2


line stmt bran cond sub pod time code
1             package Parse::Method::Signatures::Sig;
2              
3 3     3   2378 use Moose;
  3         4  
  3         20  
4 3     3   14298 use MooseX::Types::Moose qw/HashRef/;
  3         6  
  3         36  
5 3     3   9498 use Parse::Method::Signatures::Types qw/Param ParamCollection NamedParam/;
  3         4  
  3         23  
6 3     3   4807 use List::MoreUtils qw/part/;
  3         4  
  3         68  
7              
8 3     3   1538 use namespace::clean -except => 'meta';
  3         4  
  3         29  
9              
10             has invocant => (
11             is => 'ro',
12             does => Param,
13             predicate => 'has_invocant',
14             );
15              
16             has _positional_params => (
17             is => 'ro',
18             isa => ParamCollection,
19             init_arg => 'positional_params',
20             predicate => 'has_positional_params',
21             coerce => 1,
22             handles => {
23             positional_params => 'params',
24             },
25             );
26              
27             has _named_params => (
28             is => 'ro',
29             isa => ParamCollection,
30             init_arg => 'named_params',
31             predicate => 'has_named_params',
32             coerce => 1,
33             handles => {
34             named_params => 'params',
35             },
36             );
37              
38             has _named_map => (
39             is => 'ro',
40             isa => HashRef[Param],
41             lazy_build => 1,
42             );
43              
44             override BUILDARGS => sub {
45             my $args = super();
46              
47             if (my $params = delete $args->{params}) {
48             my ($positional, $named) = part { NamedParam->check($_) ? 1 : 0 } @{ $params };
49             $args->{positional_params} = $positional if $positional;
50             $args->{named_params} = $named if $named;
51             }
52              
53             return $args;
54             };
55              
56             sub _build__named_map {
57 0     0   0 my ($self) = @_;
58 0 0       0 return {} unless $self->has_named_params;
59 0         0 return { map { $_->label => $_ } @{ $self->named_params } };
  0         0  
  0         0  
60             }
61              
62             sub named_param {
63 0     0 1 0 my ($self, $name) = @_;
64 0         0 return $self->_named_map->{$name};
65             }
66              
67             around has_positional_params => sub {
68             my $orig = shift;
69             my $ret = $orig->(@_);
70             return unless $ret;
71              
72             my ($self) = @_;
73             return scalar @{ $self->positional_params };
74             };
75              
76             around has_named_params => sub {
77             my $orig = shift;
78             my $ret = $orig->(@_);
79             return unless $ret;
80              
81             my ($self) = @_;
82             return scalar @{ $self->named_params };
83             };
84              
85             sub to_string {
86 82     82 1 80719 my ($self) = @_;
87 82         188 my $ret = q{(};
88              
89 82 100       3198 if ($self->has_invocant) {
90 7         189 $ret .= $self->invocant->to_string;
91 7         16 $ret .= q{:};
92              
93 7 100 100     30 if ($self->has_positional_params || $self->has_named_params) {
94 6         20 $ret .= q{ };
95             }
96             }
97              
98 82 100       354 $ret .= $self->_positional_params->to_string if $self->has_positional_params;
99 82 100 100     302 $ret .= q{, } if $self->has_positional_params && $self->has_named_params;
100 82 100       242 $ret .= $self->_named_params->to_string if $self->has_named_params;
101              
102 82         146 $ret .= q{)};
103 82         406 return $ret;
104             }
105              
106             __PACKAGE__->meta->make_immutable;
107              
108             1;
109              
110             __END__
111              
112             =head1 NAME
113              
114             Parse::Method::Signatures::Sig - Method Signature
115              
116             =head1 DESCRIPTION
117              
118             Represents the parsed method signature.
119              
120             =head1 ATTRIBUTES
121              
122             =head2 invocant
123              
124             =head2 named_params
125              
126             A ParamCollection representing the name parameters of this signature.
127              
128             =head2 positional_params
129              
130             A ParamCollection representing the positional parameters of this signature.
131              
132             =head1 METHODS
133              
134             =head2 has_named_params
135              
136             Predicate returning true if this signature has named parameters.
137              
138             =head2 has_positional_params
139              
140             Predicate returning true if this signature has positional parameters.
141              
142             =head2 named_param
143              
144             Returns the Param with the specified name.
145              
146             =head2 to_string
147              
148             Returns a string representation of this signature.
149              
150             =head1 LICENSE
151              
152             Licensed under the same terms as Perl itself.
153              
154             =cut