view release on metacpan or  search on metacpan

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

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

our $VERSION = "0.15";

use Carp ();
use Scalar::Util ();

use Sub::Meta::Param;

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

sub _croak { require Carp; goto &Carp::croak }

sub param_class { return 'Sub::Meta::Param' }

sub new {
    my ($class, @args) = @_;
    my %args = @args == 1 ? %{$args[0]} : @args;

    my $self = bless \%args => $class;
    $self->set_args($args{args}) if exists $args{args};
    $self->set_invocant(delete $args{invocant}) if defined $args{invocant};
    $self->set_nshift(delete $args{nshift}) if defined $args{nshift};
    $self->set_slurpy(delete $args{slurpy}) if defined $args{slurpy};

    return $self;
}

sub nshift()    { my $self = shift; return $self->{nshift} // 0 }
sub slurpy()    { my $self = shift; return $self->{slurpy} }
sub args()      { my $self = shift; return $self->{args} // [] }
sub invocant()  { my $self = shift; return $self->{invocant} }
sub invocants() { my $self = shift; return $self->has_invocant ? [ $self->{invocant} ] : [] }
sub all_args()  { my $self = shift; return [ @{$self->invocants}, @{$self->args} ] }

sub has_args()     { my $self = shift; return defined $self->{args} }
sub has_invocant() { my $self = shift; return defined $self->{invocant} }
sub has_slurpy()   { my $self = shift; return defined $self->{slurpy} }

sub set_slurpy {
    my ($self, $v) = @_;
    $self->{slurpy} = Scalar::Util::blessed($v) && $v->isa('Sub::Meta::Param')
                    ? $v
                    : $self->param_class->new($v);
    return $self;
}

sub set_args {
    my ($self, @args) = @_;
    $self->{args} = $self->_normalize_args(@args);
    return $self;
}

sub set_nshift {
    my ($self, $v) = @_;

    unless (defined $v && ($v == 0 || $v == 1) ) {
        _croak sprintf("Can't set this nshift: %s", $v//'');
    }

    $self->{nshift} = $v;

    if ($v == 1 && !defined $self->invocant) {
        my $default_invocant = $self->param_class->new(invocant => 1);
        $self->set_invocant($default_invocant)
    }

    if ($v == 0 && defined $self->invocant) {
        delete $self->{invocant}
    }

    return $self;
}

sub set_invocant {
    my ($self, $v) = @_;

    my $invocant = Scalar::Util::blessed($v) && $v->isa('Sub::Meta::Param')
                 ? $v
                 : $self->param_class->new($v);