local-lib5/lib/perl5/Parse/Method/Signatures/Sig.pm

   1 package Parse::Method::Signatures::Sig;
   2
   3 use Moose;
   4 use MooseX::Types::Moose qw/HashRef/;
   5 use Parse::Method::Signatures::Types qw/Param ParamCollection NamedParam/;
   6 use List::MoreUtils qw/part/;
   7
   8 use namespace::clean -except => 'meta';
   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     my ($self) = @_;
  58     return {} unless $self->has_named_params;
  59     return { map { $_->label => $_ } @{ $self->named_params } };
  60 }
  61
  62 sub named_param {
  63     my ($self, $name) = @_;
  64     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     my ($self) = @_;
  87     my $ret = q{(};
  88
  89     if ($self->has_invocant) {
  90         $ret .= $self->invocant->to_string;
  91         $ret .= q{:};
  92
  93         if ($self->has_positional_params || $self->has_named_params) {
  94             $ret .= q{ };
  95         }
  96     }
  97
  98     $ret .= $self->_positional_params->to_string if $self->has_positional_params;
  99     $ret .= q{, } if $self->has_positional_params && $self->has_named_params;
 100     $ret .= $self->_named_params->to_string if $self->has_named_params;
 101
 102     $ret .= q{)};
 103     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