view lib/IMPL/Object/List.pm @ 422:b0481c071bea ref20150831

IMPL::Config::Container tests, YAMLConfiguration now works and tested
author cin
date Sun, 20 Aug 2017 00:20:41 +0300
parents c6e90e02dd17
children
line wrap: on
line source

package IMPL::Object::List;
use strict;
use warnings;

use Carp qw(carp);
use parent qw(IMPL::Object::ArrayObject);
require IMPL::Exception;

sub as_list {
    return $_[0];
}

sub CTOR {
    my ($this,$data) = @_;
    
    if ($data) {
        die new IMPL::InvalidArgumentException("The parameter should be a reference to an array") unless UNIVERSAL::isa($data,"ARRAY");
        @$this = @$data;
    }
}

sub Append {
	carp "Appen method is obsolete use Push instead";
    push @{$_[0]}, @_[1 .. $#_];
}

sub Push {
	push @{$_[0]}, @_[1 .. $#_];
}

sub AddLast {
	carp "Appen method is obsolete use Push instead";
    push @{$_[0]}, @_[1 .. $#_];
}

sub RemoveLast {
    return pop @{$_[0]};
}

sub AddFirst {
    return unshift @{$_[0]}, $_[1];
}

sub RemoveFirst {
    return shift @{$_[0]};
}

sub Count {
    return scalar @{$_[0]};
}

sub Item {
    return $_[0]->[$_[1]];
}

sub InsertAt {
    my ($this,$index,@val) = @_;
    
    splice @$this,($index||0),0,@val;
}

sub RemoveAt {
    my ($this,$index,$count) = @_;
    
    $count ||= 1;
    
    return splice @$this,$index,$count;
}

sub RemoveItem {
    my ($this,$item) = @_;
    
    @$this = grep $_ != $item, @$this;
    
    return $this;
}

sub RemoveItemStr {
    my ($this,$item) = @_;
    
    @$this = grep $_ ne $item, @$this;
    
    return $this;
}

sub FindItem {
    my ($this,$item) = @_;
    
    for (my $i = 0; $i < @$this; $i++ ) {
        return $i if $this->[$i] == $item
    }
    return undef;
}

sub FindItemStr {
    my ($this,$item) = @_;
    
    for (my $i = 0; $i < @$this; $i++ ) {
        return $i if $this->[$i] eq $item
    }
    return undef;
}

sub save {
    my ($this,$ctx) = @_;
    
    $ctx->AddVar( item => $_ ) foreach @$this;
}

sub restore {
    my ($class,$data,$surrogate) = @_;
    
    my $i = 0;
    
    if ($surrogate) {
        @$surrogate = grep { ($i++)%2 } @$data;
    } else {
        $surrogate = $class->new([grep { ($i++)%2 } @$data]);
    }
    
    return $surrogate;
}

1;