Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
Param	[ DIR ]	drwxrwxrwx	2024-07-26 17:39
Param.pm	3.7 KB	-rw-rw-rw-	2017-04-01 18:28
ParamCollection.pm	418 B	-rw-rw-rw-	2017-04-01 18:28
Sig.pm	3.15 KB	-rw-rw-rw-	2017-04-01 18:28
TypeConstraint.pm	5.02 KB	-rw-rw-rw-	2017-04-01 18:28
Types.pm	1.03 KB	-rw-rw-rw-	2017-04-01 18:28

Rename

package Parse::Method::Signatures::Sig;

use Moose;
use MooseX::Types::Moose qw/HashRef/;
use Parse::Method::Signatures::Types qw/Param ParamCollection NamedParam/;
use List::MoreUtils qw/part/;

use namespace::clean -except => 'meta';

has invocant => (
    is        => 'ro',
    does      => Param,
    predicate => 'has_invocant',
);

has _positional_params => (
    is        => 'ro',
    isa       => ParamCollection,
    init_arg  => 'positional_params',
    predicate => 'has_positional_params',
    coerce    => 1,
    handles   => {
        positional_params => 'params',
    },
);

has _named_params => (
    is        => 'ro',
    isa       => ParamCollection,
    init_arg  => 'named_params',
    predicate => 'has_named_params',
    coerce    => 1,
    handles   => {
        named_params => 'params',
    },
);

has _named_map => (
    is         => 'ro',
    isa        => HashRef[Param],
    lazy_build => 1,
);

override BUILDARGS => sub {
    my $args = super();

if (my $params = delete $args->{params}) {
        my ($positional, $named) = part { NamedParam->check($_) ? 1 : 0 } @{ $params };
        $args->{positional_params} = $positional if $positional;
        $args->{named_params} = $named if $named;
    }

return $args;
};

sub _build__named_map {
    my ($self) = @_;
    return {} unless $self->has_named_params;
    return { map { $_->label => $_ } @{ $self->named_params } };
}

sub named_param {
    my ($self, $name) = @_;
    return $self->_named_map->{$name};
}

around has_positional_params => sub {
    my $orig = shift;
    my $ret = $orig->(@_);
    return unless $ret;

my ($self) = @_;
    return scalar @{ $self->positional_params };
};

around has_named_params => sub {
    my $orig = shift;
    my $ret = $orig->(@_);
    return unless $ret;

my ($self) = @_;
    return scalar @{ $self->named_params };
};

sub to_string {
    my ($self) = @_;
    my $ret = q{(};

if ($self->has_invocant) {
        $ret .= $self->invocant->to_string;
        $ret .= q{:};

if ($self->has_positional_params || $self->has_named_params) {
            $ret .= q{ };
        }
    }

$ret .= $self->_positional_params->to_string if $self->has_positional_params;
    $ret .= q{, } if $self->has_positional_params && $self->has_named_params;
    $ret .= $self->_named_params->to_string if $self->has_named_params;

$ret .= q{)};
    return $ret;
}

__PACKAGE__->meta->make_immutable;

__END__

=head1 NAME

Parse::Method::Signatures::Sig - Method Signature

=head1 DESCRIPTION

Represents the parsed method signature.

=head1 ATTRIBUTES

=head2 invocant

=head2 named_params

A ParamCollection representing the name parameters of this signature.

=head2 positional_params

A ParamCollection representing the positional parameters of this signature.

=head1 METHODS

=head2 has_named_params

Predicate returning true if this signature has named parameters.

=head2 has_positional_params

Predicate returning true if this signature has positional parameters.

=head2 named_param

Returns the Param with the specified name.

=head2 to_string

Returns a string representation of this signature.

=head1 LICENSE

Licensed under the same terms as Perl itself.

=cut