File Coverage

blib/lib/Env/ShellWords.pm

Criterion	Covered	Total	%
statement	79	86	91.8
branch	5	6	83.3
condition	4	4	100.0
subroutine	22	24	91.6
pod			n/a
total	110	120	91.6

package Env::ShellWords;

use strict;
use warnings;
use Text::ParseWords qw( shellwords );

# ABSTRACT: Environment variables for arguments as array
our $VERSION = '0.02'; # VERSION


use constant _NAME  => 0;
use constant _SPLIT  => 1;
use constant _JOIN => 2;

sub _join
{
  join ' ', map {
    my $value = $_;
    $value = '' unless defined $value;
    $value =~ s/(\s)/\\$1/g;
    $value eq '' ? "''" : $value;
  } @_;
}

sub TIEARRAY
{
  my($class, $name, $read, $write) = @_;
  bless [$name, $read || \&shellwords, $write || \&_join ], $class;
}

sub FETCH
{
  my($self, $key) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  $list[$key];
}

sub _render
{
  my $self = shift;
  $ENV{$self->[_NAME]} = $self->[_JOIN]->(@_);
}

sub STORE
{
  my($self, $key, $value) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  $list[$key] = $value;
  _render($self, @list);
  $value;
}

sub FETCHSIZE
{
  my($self) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  $#list + 1;
}

sub STORESIZE
{
  my($self, $count) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  $#list = $count - 1;
  _render($self, @list);
  return;
}

sub CLEAR
{
  my($self) = @_;
  _render($self);
  return;
}

sub PUSH
{
  my($self, @values) = @_;
  _render($self, $self->[_SPLIT]->($ENV{$self->[_NAME]}), @values);
  return;
}

sub POP
{
  my($self) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  my $value = pop @list;
  _render($self, @list);
  return $value;
}

sub SHIFT
{
  my($self) = @_;
  my($value, @list) = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  _render($self, @list);
  return $value;
}

sub UNSHIFT
{
  my($self, @values) = @_;
  _render($self, @values, $self->[_SPLIT]->($ENV{$self->[_NAME]}));
  return;
}

sub SPLICE
{
  my($self, $offset, $length, @values) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  my @ret = splice @list, $offset, $length, @values;
  _render($self, @list);
  @ret;
}

sub DELETE
{
  my($self, $key) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  my $value = delete $list[$key];
  _render($self, @list);
  return $value;
}

sub EXISTS
{
  my($self, $key) = @_;
  my @list = $self->[_SPLIT]->($ENV{$self->[_NAME]});
  return exists $list[$key];
}

sub EXTEND {} # do nothing!

sub import
{
  my $caller = caller;
  my(undef, @vars) = @_;
  foreach my $var (@vars)
  {
    if($var =~ s/^\@//)
    {
      no strict 'refs';
      tie my @list, __PACKAGE__, $var;
      *{"${caller}::${var}"} = \@list;
    }
    else
    {
      require Carp;
      Carp::croak("Env::ShellWords does not work with $var");
    }
  }
}

1;

__END__