ARGV-Struct

 view release on metacpan or  search on metacpan

cpanfile  view on Meta::CPAN

requires 'Moo';
requires 'Types::Standard';

on test => sub {
  requires 'Test::More';
  requires 'Test::Exception';
}

lib/ARGV/Struct.pm  view on Meta::CPAN

package ARGV::Struct;
  use Moo;
  use Types::Standard qw/ArrayRef/;

  our $VERSION = '0.06';

  has argv => (
    is => 'ro', 
    isa => ArrayRef, 
    default => sub { [ @ARGV ] }, 
  );

  sub argcount {
    my $self = shift;
    return scalar(@{ $self->argv });
  }

  sub arg {
    my ($self, $i) = @_;
    return $self->argv->[ $i ];
  }

  sub args {
    my $self = shift;
    return @{ $self->argv };
  }

  sub parse {
    my ($self) = @_;
    my $substruct = $self->_parse_argv($self->args);
    die "Trailing values after structure" if (scalar(@{ $substruct->{ leftover } }));
    return $substruct->{ struct };
  }

  sub _parse_list {
    my ($self, @args) = @_;
    my $list = [];
    while (my $token = shift @args) {
      if ($token eq '[') {
        my $substruct = $self->_parse_list(@args);
        push @$list, $substruct->{ struct };
        @args = @{ $substruct->{ leftover } };
      } elsif($token eq '{') {
        my $substruct = $self->_parse_hash(@args);
        push @$list, $substruct->{ struct };
        @args = @{ $substruct->{ leftover } };
      } elsif ($token eq ']') {
        return { struct => $list, leftover => [ @args ] };
      } else {
        push @$list, $token;
      }
    }
    die "Unclosed list";
  };

  sub _parse_hash {
    my ($self, @args) = @_;
    my $hash = {};
    while (my $token = shift @args) {
      if ($token eq '}') {
        return { struct => $hash, leftover => [ @args ] };
      }

      my ($k, $v) = ($token, shift @args);

      substr($k,-1,1) = '' if (substr($k,-1,1) eq ':');

lib/ARGV/Struct.pm  view on Meta::CPAN

        my $substruct = $self->_parse_list(@args);
        $hash->{ $k } = $substruct->{ struct };
        @args = @{ $substruct->{ leftover } };
      } else {
        $hash->{ $k } = $v;
      }
    }
    die "Unclosed hash";
  }

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

    my $token = shift @args;

    if ($token eq '[') {
      return $self->_parse_list(@args);
    } elsif($token eq '{') {
      return $self->_parse_hash(@args);
    } else {
      die "Expecting { or [";

t/04_errors.t  view on Meta::CPAN

 }, 
 { argv => [ qw/{ X }/],
 },
 { argv => [ qw/{ X: }/ ],
 },
);

foreach $test (@tests) {
  $test->{ error } = '.+' if (not defined $test->{ error });
  throws_ok(
    sub { ARGV::Struct->new(argv => $test->{ argv })->parse },
    qr/$test->{ error }/,
    "Conformance of " . join ' ', @{ $test->{ argv } }
  );
}

done_testing;