File Coverage

blib/lib/DTL/Fast/Filter/Slice.pm

Criterion	Covered	Total	%
statement	62	66	93.9
branch	30	34	88.2
condition	8	13	61.5
subroutine	12	12	100.0
pod	0	7	0.0
total	112	132	84.8

package DTL::Fast::Filter::Slice;
use strict;
use utf8;
use warnings FATAL => 'all';
use parent 'DTL::Fast::Filter';

$DTL::Fast::FILTER_HANDLERS{slice} = __PACKAGE__;

use Scalar::Util qw(reftype);

#@Override
sub parse_parameters
{
    my $self = shift;
    die $self->get_parse_error("no slicing settings specified")
        if (not scalar @{$self->{parameter}});
    $self->{settings} = $self->{parameter}->[0];
    return $self;
}

#@Override
sub filter
{
    my ($self, $filter_manager, $value, $context) = @_;

    my $settings = $self->{settings}->render($context);

    die $self->get_render_error( $context, 'slicing format is not defined in current context')
        if (not defined $settings);

    my $value_type = reftype $value;

    if (not defined $value_type)
    {
        if (defined $value)
        {
            eval {
                $value = $self->slice_scalar($value, $settings);
            };
            die $self->get_render_error($context, $@) if ($@);
        }
        else
        {
            die $self->get_render_error( $context, 'unable to slice undef value');
        }
    }
    elsif ($value_type eq 'ARRAY')
    {
        eval
        {
            $value = $self->slice_array($value, $settings);
        };
        die $self->get_render_error($context, $@) if ($@);
    }
    elsif ($value_type eq 'HASH')
    {
        $value = $self->slice_hash($value, $settings);
    }
    elsif ($value_type eq 'SCALAR')
    {
        $value = $self->slice_scalar($$value, $settings);
    }
    else
    {
        die $self->get_render_error(
                $context
                , sprintf(
                    "can slice only HASH, ARRAY or SCALAR values, not %s (%s)"
                    , $value_type
                    , ref $value || 'SCALAR'
                )
            );
    }

    return $value;
}

sub slice_scalar
{
    my ($self, $scalar, $settings ) = @_;

    my ($start, $end) = $self->parse_indexes($settings, length($scalar) - 1 );

    return substr $scalar, $start, $end - $start + 1;
}

sub slice_array
{
    my ($self, $array, $settings ) = @_;

    my ($start, $end) = $self->parse_indexes($settings, $#$array);

    return [ @{$array}[$start .. $end] ];
}


sub slice_hash
{
    my ($self, $hash, $settings) = @_;
    return [ @{$hash}{(split /\s*,\s*/, $settings)} ];
}

sub parse_indexes
{
    my ($self, $settings, $last_index) = @_;

    my $start = 0;
    my $end;

    if ($settings =~ /^([-\d]+)?\:([-\d]+)?$/) # python's format
    {
        $start = $self->python_index_map($1, $last_index) // $start;
        $end = defined $2 ?
            $self->python_index_map($2, $last_index) - 1
                          : $last_index;
    }
    elsif ($settings =~ /^([-\d]+)?\s*\.\.\s*([-\d]+)?$/) # perl's format
    {
        $start = $1 // $start;
        $end = $2 // $last_index;
    }
    else
    {
        die sprintf(
                "array slicing option may be specified in one of the following formats:\npython: [from_index]:[to_index+1]\n  perl: [from_index]..[to_index]\ngot `%s` instead.\n"
                , $settings // undef
            );
    }

    $start = $last_index if ($start > $last_index);
    $end = $last_index if ($end > $last_index);

    if ($start > $end) {
        my $var = $start;
        $start = $end;
        $end = $var;
    }

    return ($start, $end);
}

sub python_index_map
{
    my ( $self, $pyvalue, $lastindex ) = @_;

    return $pyvalue if (not defined $pyvalue);

    return $pyvalue < 0 ?
        $lastindex + $pyvalue + 1
        : $pyvalue;
}

1;