File Coverage

blib/lib/Perinci/Sub/Property/result_postfilter.pm

Criterion	Covered	Total	%
statement	45	50	90.0
branch	16	24	66.6
condition	2	6	33.3
subroutine	7	7	100.0
pod	0	1	0.0
total	70	88	79.5

package Perinci::Sub::Property::result_postfilter;

use 5.010001;
use strict;
use warnings;

use Perinci::Sub::PropertyUtil qw(declare_property);

our $VERSION = '0.08'; # VERSION

sub filter_using_for {
    my ($self, %args) = @_;

    my $v    = $args{new} // $args{value};
    return unless $v && keys(%$v);

    $self->select_section('after_call_after_res_validation');
    $self->push_lines('', '# postfilter result');

    my $term = $self->{_meta}{result_naked} ? '$_w_res' : '$_w_res->[2]';

    my $errp = "result_postfilter: Unknown filter";
    my $gen_process_item = sub {
        my $t = shift;
        my $code = '';
        while (my ($a, $b) = each %$v) {
            if ($a eq 're') {
                $code .= ($code ? "elsif":"if").
                    "(ref($t) eq 'Regexp'){";
                if ($b eq 'str') {
                    $code .= "$t = \"$t\"";
                } else {
                    die "$errp for $a: $b";
                }
                $code.="}";
            } elsif ($a eq 'date') {
                $code .= ($code ? "elsif":"if").
                    "(ref($t) eq 'DateTime'){";
                if ($b eq 'epoch') {
                    $code .= "$t = $t->epoch";
                } else {
                    die "$errp for $a: $b";
                }
                $code.="}";
            } elsif ($a eq 'code') {
                $code .= ($code ? "elsif":"if").
                    "(ref($t) eq 'CODE'){";
                if ($b eq 'str') {
                    $code .= "$t = 'CODE'";
                } else {
                    die "$errp for $a: $b";
                }
                $code.="}";
            } else {
                die "$errp $a";
            }
        }
        $code .= "elsif(ref($t) eq 'ARRAY') { \$_w_resf_ary->($t) }";
        $code .= "elsif(ref($t) eq 'HASH') { \$_w_resf_hash->($t) }";
        $code;
    };

    $self->push_lines(
        'state $_w_resf_ary; state $_w_resf_hash;');
    $self->push_lines(
        'if (!$_w_resf_ary ) { $_w_resf_ary  = sub { '.
            'for my $el (@{$_[0]}) { '.
                $gen_process_item->('$el') . ' } } }'
            );
    $self->push_lines(
        'if (!$_w_resf_hash) { $_w_resf_hash = sub { '.
            'my $h=shift; for my $k (keys %$h) { '.
                $gen_process_item->('$h->{$k}') . ' } } }'
            );
    $self->push_lines(
        "for ($term) { " . $gen_process_item->('$_') . " }",
    );
}

our $_implementation = 'for';

declare_property(
    name => 'result_postfilter',
    type => 'function',
    schema => ['hash'],
    wrapper => {
        meta => {
            v       => 2,
            # very low, we want to be the last to process result before
            # returning it
            prio    => 100,
            convert => 1,
        },
        handler => sub {
            if ($_implementation eq 'for') {
                filter_using_for(@_);
            } else {
                die "Unknown implementation '$_implementation'";
            }
        },
    },
);

1;
# ABSTRACT: (DEPRECATED) Postfilter function result

__END__