File Coverage

blib/lib/Validation/Class/Listing.pm

Criterion	Covered	Total	%
statement	48	94	51.0
branch	9	22	40.9
condition	2	7	28.5
subroutine	13	30	43.3
pod	21	21	100.0
total	93	174	53.4

# ABSTRACT: Generic Container Class for an Array Reference

package Validation::Class::Listing;

use strict;
use warnings;

use Validation::Class::Util '!has', '!hold';
use List::MoreUtils 'uniq';

our $VERSION = '7.900058'; # VERSION



sub new {

    my $class = shift;

    $class = ref $class if ref $class;

    my $arguments = isa_arrayref($_[0]) ? $_[0] : [@_];

    my $self = bless [], $class;

    $self->add($arguments);

    return $self;

}


sub add {

    my $self = shift;

    my $arguments = isa_arrayref($_[0]) ? $_[0] : [@_];

    push @{$self}, @{$arguments};

    return $self;

}


sub clear {

    my ($self) = @_;

    foreach my $pair ($self->pairs) {
        $self->delete($pair->{index});
    }

    return $self->new;

}


sub count {

    my ($self) = @_;

    return scalar($self->list);

}


sub delete {

    my ($self, $index) = @_;

    return delete $self->[$index];

}


sub defined {

    my ($self, $index) = @_;

    return defined $self->[$index];

}


sub each {

    my ($self, $code) = @_;

    $code ||= sub {};

    my $i=0;

    foreach my $value ($self->list) {

        $code->($i, $value); $i++;

    }

    return $self;

}


sub first {

    my ($self) = @_;

    return $self->[0];

}


sub get {

    my ($self, $index) = @_;

    return $self->[$index];

}


sub grep {

    my ($self, $pattern) = @_;

    $pattern = qr/$pattern/ unless "REGEXP" eq uc ref $pattern;

    return $self->new(grep { $_ =~ $pattern } ($self->list));

}


sub has {

    my ($self, $index) = @_;

    return $self->defined($index) ? 1 : 0;

}


sub iterator {

    my ($self, $function, @arguments) = @_;

    $function = 'list'
        unless grep { $function eq $_ } ('sort', 'rsort', 'nsort', 'rnsort');

    my @keys = ($self->$function(@arguments));

    @keys = $keys[0]->list if $keys[0] eq ref $self;

    my $i = 0;

    return sub {

        return unless defined $keys[$i];

        return $keys[$i++];

    }

}


sub join {

    my ($self, $delimiter) = @_;

    return join($delimiter, ($self->list));

}


sub last {

    my ($self) = @_;

    return $self->[-1];

}


sub list {

    my ($self) = @_;

    return (@{$self});

}


sub nsort {

    my ($self) = @_;

    my $code = sub { $_[0] <=> $_[1] };

    return $self->sort($code);

}


sub pairs {

    my ($self, $function, @arguments) = @_;

    $function ||= 'list';

    my @values = ($self->$function(@arguments));

    return () unless @values;

    @values = $values[0]->list if ref $values[0] && ref $values[0] eq ref $self;

    my $i=0;

    my @pairs = map {{ index => $i++, value => $_ }} (@values);

    return (@pairs);

}


sub rnsort {

    my ($self) = @_;

    my $code = sub { $_[1] <=> $_[0] };

    return $self->sort($code);

}


sub rsort {

    my ($self) = @_;

    my $code = sub { $_[1] cmp $_[0] };

    return $self->sort($code);

}


sub sort {

    my ($self, $code) = @_;

    return "CODE" eq ref $code ?
        sort { $a->$code($b) } ($self->keys) : sort { $a cmp $b } ($self->list);

}


sub unique {

    my ($self) = @_;

    return uniq ($self->list);

}

1;

__END__