File Coverage

blib/lib/Venus/Args.pm

Criterion	Covered	Total	%
statement	53	59	89.8
branch	17	22	77.2
condition	0	3	0.0
subroutine	14	16	87.5
pod	8	10	80.0
total	92	110	83.6

package Venus::Args;

use 5.018;

use strict;
use warnings;

use Venus::Class 'attr', 'base', 'with';

base 'Venus::Kind::Utility';

with 'Venus::Role::Valuable';
with 'Venus::Role::Buildable';
with 'Venus::Role::Accessible';
with 'Venus::Role::Proxyable';

# ATTRIBUTES

attr 'named';

# BUILDERS

sub build_proxy {
  my ($self, $package, $method, $value) = @_;

  my $has_value = exists $_[3];

  return sub {
    return $self->get($method) if !$has_value; # no value
    return $self->set($method, $value);
  };
}

sub build_self {
  my ($self, $data) = @_;

  $self->named({}) if !$self->named;

  return $self;
}

# METHODS

sub assertion {
  my ($self) = @_;

  my $assertion = $self->SUPER::assertion;

  $assertion->match('arrayref')->format(sub{
    (ref $self || $self)->new($_)
  });

  return $assertion;
}

sub default {
  my ($self) = @_;

  return [@ARGV];
}

sub exists {
  my ($self, $name) = @_;

  return if not defined $name;

  my $pos = $self->name($name);

  return if not defined $pos;

  return CORE::exists $self->indexed->{$pos};
}

sub get {
  my ($self, $name) = @_;

  return if not defined $name;

  my $pos = $self->name($name);

  return if not defined $pos;

  return $self->indexed->{$pos};
}

sub indexed {
  my ($self) = @_;

  return {map +($_, $self->value->[$_]), 0..$#{$self->value}};
}

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

  if (defined $self->named->{$name}) {
    return $self->named->{$name};
  }

  if (defined $self->indexed->{$name}) {
    return $name;
  }

  return undef;
}

sub set {
  my ($self, $name, $data) = @_;

  return if not defined $name;

  my $pos = $self->name($name);

  return if not defined $pos;

  return $self->value->[$pos] = $data;
}

sub unnamed {
  my ($self) = @_;

  my $list = [];

  my $argv = $self->indexed;
  my $data = +{reverse %{$self->named}};

  for my $index (sort keys %$argv) {
    unless (exists $data->{$index}) {
      push @$list, $argv->{$index};
    }
  }

  return $list;
}

1;



=head1 NAME

Venus::Args - Args Class

=cut

=head1 ABSTRACT

Args Class for Perl 5

=cut

=head1 SYNOPSIS

  package main;

  use Venus::Args;

  my $args = Venus::Args->new(
    named => { flag => 0, command => 1 }, # optional
    value => ['--help', 'execute'],
  );

  # $args->flag; # $ARGV[0]
  # $args->get(0); # $ARGV[0]
  # $args->get(1); # $ARGV[1]
  # $args->action; # $ARGV[1]
  # $args->exists(0); # exists $ARGV[0]
  # $args->exists('flag'); # exists $ARGV[0]
  # $args->get('flag'); # $ARGV[0]

=cut

=head1 DESCRIPTION

This package provides methods for accessing C<@ARGS> items.

=cut

=head1 ATTRIBUTES

This package has the following attributes:

=cut

=head2 named

  named(HashRef)

This attribute is read-write, accepts C<(HashRef)> values, is optional, and defaults to C<{}>.

=cut

=head1 INHERITS

This package inherits behaviors from:

L

=cut

=head1 INTEGRATES

This package integrates behaviors from:

L

L

L

L

=cut

=head1 METHODS

This package provides the following methods:

=cut

=head2 default

  default() (arrayref)

The default method returns the default value, i.e. C<@ARGV>.

I>

=over 4

=item default example 1

  # given: synopsis;

  my $default = $args->default;

  # [@ARGV]

  # ["--help", "execute"]

=back

=cut

=head2 exists

  exists(string $key) (boolean)

The exists method returns truthy or falsy if an index or alias value exists.

I>

=over 4

=item exists example 1

  # given: synopsis;

  my $exists = $args->exists(0);

  # 1

=back

=over 4

=item exists example 2

  # given: synopsis;

  my $exists = $args->exists('flag');

  # 1

=back

=over 4

=item exists example 3

  # given: synopsis;

  my $exists = $args->exists(2);

  # undef

=back

=cut

=head2 get

  get(string $key) (any)

The get method returns the value of the index or alias.

I>

=over 4

=item get example 1

  # given: synopsis;

  my $get = $args->get(0);

  # "--help"

=back

=over 4

=item get example 2

  # given: synopsis;

  my $get = $args->get('flag');

  # "--help"

=back

=over 4

=item get example 3

  # given: synopsis;

  my $get = $args->get(2);

  # undef

=back

=cut

=head2 indexed

  indexed() (hashref)

The indexed method returns a set of indices and values.

I>

=over 4

=item indexed example 1

  # given: synopsis;

  my $indexed = $args->indexed;

  # { "0" => "--help", "1" => "execute" }

=back

=cut

=head2 name

  name(string $key) (string | undef)

The name method resolves and returns the index for an index or alias, and
returns undefined if not found.

I>

=over 4

=item name example 1

  # given: synopsis;

  my $name = $args->name('flag');

=back

=cut

=head2 set

  set(string $key, any $data) (any)

The set method sets and returns the value of an index or alias.

I>

=over 4

=item set example 1

  # given: synopsis;

  my $set = $args->set(0, '-?');

  # "-?"

=back

=over 4

=item set example 2

  # given: synopsis;

  my $set = $args->set('flag', '-?');

  # "-?"

=back

=over 4

=item set example 3

  # given: synopsis;

  my $set = $args->set('verbose', 1);

  # undef

=back

=cut

=head2 unnamed

  unnamed() (arrayref)

The unnamed method returns a list of unaliases indices.

I>

=over 4

=item unnamed example 1

  package main;

  use Venus::Args;

  my $args = Venus::Args->new(
    named => { flag => 0, command => 1 },
    value => ['--help', 'execute', '--format', 'markdown'],
  );

  my $unnamed = $args->unnamed;

  # ["--format", "markdown"]

=back

=over 4

=item unnamed example 2

  package main;

  use Venus::Args;

  my $args = Venus::Args->new(
    named => { command => 1 },
    value => ['execute', 'phase-1', '--format', 'markdown'],
  );

  my $unnamed = $args->unnamed;

  # ["execute", "--format", "markdown"]

=back

=cut

=head1 AUTHORS

Awncorp, C

=cut

=head1 LICENSE

Copyright (C) 2000, Awncorp, C.

This program is free software, you can redistribute it and/or modify it under
the terms of the Apache license version 2.0.

=cut