File Coverage

blib/lib/Data/Object/Args.pm

Criterion	Covered	Total	%
statement	76	77	98.7
branch	17	22	77.2
condition			n/a
subroutine	16	16	100.0
pod	6	8	75.0
total	115	123	93.5

package Data::Object::Args;

use 5.014;

use strict;
use warnings;

use registry;
use routines;

use Data::Object::Class;
use Data::Object::ClassHas;

with 'Data::Object::Role::Buildable';
with 'Data::Object::Role::Proxyable';
with 'Data::Object::Role::Stashable';

our $VERSION = '2.01'; # VERSION

# ATTRIBUTES

has 'named' => (
  is => 'ro',
  isa => 'HashRef',
  opt => 1,
);

# BUILD

method build_self($args) {
  $self->{named} = {} if !$args->{named};

  my $argv = { map +($_, $ARGV[$_]), 0..$#ARGV };

  $self->stash(argv => $argv);

  return $self;
}

method build_proxy($package, $method, $value) {
  my $has_value = exists $_[2];

  return sub {

    return $self->get($method) if !$has_value; # no val

    return $self->set($method, $value);
  };
}

# METHODS

method exists($key) {
  return if not defined $key;

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

  return if not defined $pos;

  return exists $self->stashed->{$pos};
}

method get($key) {
  return if not defined $key;

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

  return if not defined $pos;

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

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

  if (defined $self->stashed->{$key}) {
    return $key;
  }

  return undef;
}

method set($key, $val) {
  return if not defined $key;

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

  return if not defined $pos;

  return $self->stashed->{$pos} = $val;
}

method stashed() {
  my $data = $self->stash('argv');

  return $data;
}

method unnamed() {
  my $list = [];

  my $argv = $self->stash('argv');
  my $data = +{reverse %{$self->named}};

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

  return $list;
}

1;

=encoding utf8

=head1 NAME

Data::Object::Args - Args Class

=cut

=head1 ABSTRACT

Args Class for Perl 5

=cut

=head1 SYNOPSIS

  package main;

  use Data::Object::Args;

  local @ARGV = qw(--help execute);

  my $args = Data::Object::Args->new(
    named => { flag => 0, command => 1 }
  );

  # $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 INTEGRATES

This package integrates behaviors from:

L<Data::Object::Role::Buildable>

L<Data::Object::Role::Proxyable>

L<Data::Object::Role::Stashable>

=cut

=head1 LIBRARIES

This package uses type constraints from:

L<Types::Standard>

=cut

=head1 ATTRIBUTES

This package has the following attributes:

=cut

=head2 named

  named(HashRef)

This attribute is read-only, accepts C<(HashRef)> values, and is optional.

=cut

=head1 METHODS

This package implements the following methods:

=cut

=head2 exists

  exists(Str $key) : Any

The exists method takes a name or index and returns truthy if an associated
value exists.

=over 4

=item exists example #1

  # given: synopsis

  $args->exists(0); # truthy

=back

=over 4

=item exists example #2

  # given: synopsis

  $args->exists('flag'); # truthy

=back

=over 4

=item exists example #3

  # given: synopsis

  $args->exists(2); # falsy

=back

=cut

=head2 get

  get(Str $key) : Any

The get method takes a name or index and returns the associated value.

=over 4

=item get example #1

  # given: synopsis

  $args->get(0); # --help

=back

=over 4

=item get example #2

  # given: synopsis

  $args->get('flag'); # --help

=back

=over 4

=item get example #3

  # given: synopsis

  $args->get(2); # undef

=back

=cut

=head2 name

  name(Str $key) : Any

The name method takes a name or index and returns index if the the associated
value exists.

=over 4

=item name example #1

  # given: synopsis

  $args->name('flag'); # 0

=back

=cut

=head2 set

  set(Str $key, Maybe[Any] $value) : Any

The set method takes a name or index and sets the value provided if the
associated argument exists.

=over 4

=item set example #1

  # given: synopsis

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

=back

=over 4

=item set example #2

  # given: synopsis

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

=back

=over 4

=item set example #3

  # given: synopsis

  $args->set('verbose', 1); # undef

  # is not set

=back

=cut

=head2 stashed

  stashed() : HashRef

The stashed method returns the stashed data associated with the object.

=over 4

=item stashed example #1

  # given: synopsis

  $args->stashed

=back

=cut

=head2 unnamed

  unnamed() : ArrayRef

The unnamed method returns an arrayref of values which have not been named
using the C<named> attribute.

=over 4

=item unnamed example #1

  package main;

  use Data::Object::Args;

  local @ARGV = qw(--help execute --format markdown);

  my $args = Data::Object::Args->new(
    named => { flag => 0, command => 1 }
  );

  $args->unnamed # ['--format', 'markdown']

=back

=over 4

=item unnamed example #2

  package main;

  use Data::Object::Args;

  local @ARGV = qw(execute phase-1 --format markdown);

  my $args = Data::Object::Args->new(
    named => { command => 1 }
  );

  $args->unnamed # ['execute', '--format', 'markdown']

=back

=cut

=head1 AUTHOR

Al Newkirk, C<[e-mail]>

=head1 LICENSE

Copyright (C) 2011-2019, Al Newkirk, et al.

This is free software; you can redistribute it and/or modify it under the terms
of the The Apache License, Version 2.0, as elucidated in the L<"license
file"|https://github.com/iamalnewkirk/data-object-args/blob/master/LICENSE>.

=head1 PROJECT

L<Wiki|https://github.com/iamalnewkirk/data-object-args/wiki>

L<Project|https://github.com/iamalnewkirk/data-object-args>

L<Initiatives|https://github.com/iamalnewkirk/data-object-args/projects>

L<Milestones|https://github.com/iamalnewkirk/data-object-args/milestones>

L<Contributing|https://github.com/iamalnewkirk/data-object-args/blob/master/CONTRIBUTE.md>

L<Issues|https://github.com/iamalnewkirk/data-object-args/issues>

=cut