File Coverage

blib/lib/Tie/Array/IntSpan.pm

Criterion	Covered	Total	%
statement	45	61	73.7
branch	5	6	83.3
condition	2	3	66.6
subroutine	11	18	61.1
pod			n/a
total	63	88	71.5

package Tie::Array::IntSpan;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-07-25'; # DATE
our $DIST = 'Tie-Array-IntSpan'; # DIST
our $VERSION = '0.001'; # VERSION

use strict;
use warnings;
use Log::ger;

sub TIEARRAY {
    my ($class, $intspan) = @_;

    log_trace "TIEARRAY(%s, %s)", $class, \@_;
    bless [$intspan], $class;
}

sub FETCH {
    my ($this, $index) = @_;
    my $res = $this->[0]->lookup($index);
    log_trace "FETCH(%i) = %s", $index, $res;
    $res;
}

sub STORE {
    my ($this, $index, $value) = @_;
    log_trace "STORE(%i, %s)", $index, $value;
    $this->[0]->set($index, $value);
}

sub FETCHSIZE {
    my ($this) = @_;
    my @ranges = $this->[0]->get_range_list;
    my $res = !@ranges ? 0 : ($ranges[-1][1] < 0 ? die("FETCHSIZE(): Cannot handle negative range") : $ranges[-1][1]+1);
    log_trace "FETCHSIZE(): %s", $res;
    $res;
}

sub STORESIZE {
    my ($this, $count) = @_;
    die "STORESIZE() not implemented";
    #log_trace "STORESIZE(%i)", $count;
}

sub EXTEND {
    my ($this, $count) = @_;
    die "STORESIZE() not implemented";
    #log_trace "EXTEND(%i)", $count;
}

sub EXISTS {
    my ($this, $key) = @_; # key = index in our case
    my @ranges = $this->[0]->get_range_list;
    my $res = "";
    for (@ranges) { if ($key >= $_->[0] && $key <= $_->[1]) { $res=1; last } }
    log_trace "EXISTS(%i): %s", $key, $res;
    $res;
}

sub DELETE {
    my ($this, $key) = @_; # key = index in our case
    my $res = $this->[0]->lookup($key);
    $this->[0]->set($key, undef);
    log_trace "DELETE(%i): %s", $key, $res;
    $res;
}

sub CLEAR {
    my $this = shift;
    log_trace "CLEAR()";
    $this->[0]->clear;
}

sub PUSH {
    my $this = shift;
    log_trace "PUSH(%s)", \@_;
    for (@_) {
        $this->[0]->set($this->FETCHSIZE, $_);
    }
}

sub POP {
    my $this = shift;
    die "POP() not yet implemented";
    #log_trace "POP(): %s", $res;
    #$res;
}

sub SHIFT {
    my $this = shift;
    die "SHIFT() not yet implemented";
    #log_trace "SHIFT(): %s", $res;
    #$res;
}

sub UNSHIFT {
    my $this = shift;
    die "UNSHIFT() not yet implemented";
    #log_trace "UNSHIFT(%s)", \@_;
}

sub SPLICE {
    my $this = shift;
    my $offset = shift;
    my $length = shift;
    die "UNSHIFT() not yet implemented";
    #log_trace "SPLICE(%i, %i, %s): %s", $offset, $length, \@_, \@res;
    #@res;
}

sub UNTIE {
    my ($this) = @_;
    log_trace "UNTIE()";
}

# DESTROY

1;
# ABSTRACT: Tied-array interface for Array::IntSpan

__END__