view release on metacpan or  search on metacpan

lib/Sub/Meta/Param.pm  view on Meta::CPAN

package Sub::Meta::Param;
use 5.010;
use strict;
use warnings;

our $VERSION = "0.15";

use Scalar::Util ();

use overload
    fallback => 1,
    eq       =>  \&is_same_interface,
;

my %DEFAULT = ( named => 0, optional => 0, invocant => 0 );

sub new {
    my ($class, @args) = @_;
    my $v = $args[0];
    my %args = @args == 1 ? ref $v && (ref $v eq 'HASH') ? %{$v}
                       : ( type => $v )
             : @args;

    $args{optional} = !delete $args{required} if exists $args{required};
    $args{named}    = !delete $args{positional} if exists $args{positional};
    $args{type}     = delete $args{isa} if exists $args{isa};

    %args = (%DEFAULT, %args);

    return bless \%args => $class;
}

sub name()       { my $self = shift; return $self->{name} // '' }
sub type()       { my $self = shift; return $self->{type} }
sub default()    { my $self = shift; return $self->{default} } ## no critic (ProhibitBuiltinHomonyms)
sub coerce()     { my $self = shift; return $self->{coerce} }
sub optional()   { my $self = shift; return !!$self->{optional} }
sub required()   { my $self = shift; return !$self->{optional} }
sub named()      { my $self = shift; return !!$self->{named} }
sub positional() { my $self = shift; return !$self->{named} }
sub invocant()   { my $self = shift; return !!$self->{invocant} }

sub has_name()    { my $self = shift; return defined $self->{name} }
sub has_type()    { my $self = shift; return defined $self->{type} }
sub has_default() { my $self = shift; return defined $self->{default} }
sub has_coerce()  { my $self = shift; return defined $self->{coerce} }

sub set_name      { my ($self, $v) = @_; $self->{name}     = $v; return $self }
sub set_type      { my ($self, $v) = @_; $self->{type}     = $v; return $self }
sub set_default   { my ($self, $v) = @_; $self->{default}  = $v; return $self }
sub set_coerce    { my ($self, $v) = @_; $self->{coerce}   = $v; return $self }
sub set_optional   { my ($self, $v) = @_; $self->{optional} = !!(defined $v ? $v : 1); return $self }
sub set_required   { my ($self, $v) = @_; $self->{optional} =  !(defined $v ? $v : 1); return $self }
sub set_named      { my ($self, $v) = @_; $self->{named}    = !!(defined $v ? $v : 1); return $self }
sub set_positional { my ($self, $v) = @_; $self->{named}    =  !(defined $v ? $v : 1); return $self }
sub set_invocant   { my ($self, $v) = @_; $self->{invocant} = !!(defined $v ? $v : 1); return $self }

# alias
sub isa_() :method; # NOT isa
*isa_ = \&type;

sub set_isa;
*set_isa = \&set_type;

sub is_same_interface {
    my ($self, $other) = @_;

    return unless Scalar::Util::blessed($other) && $other->isa('Sub::Meta::Param');

    if ($self->has_name) {
        return unless $self->name eq $other->name
    }
    else {
        return if $other->has_name
    }

    if ($self->has_type) {
        return unless $self->type eq ($other->type // '');
    }
    else {
        return if $other->has_type
    }

    return unless $self->optional eq $other->optional;

    return unless $self->named eq $other->named;

    return !!1;
}