view release on metacpan or  search on metacpan

lib/Iterator/Flex/Role/Wrap/Throw.pm  view on Meta::CPAN

package Iterator::Flex::Role::Wrap::Throw;

# ABSTRACT: Role to add throw on exhaustion to an iterator which adapts another iterator

use v5.28;
use strict;
use warnings;

our $VERSION = '0.34';

use List::Util 'first';
use Iterator::Flex::Utils qw( INPUT_EXHAUSTION PASSTHROUGH );
use Ref::Util             qw( is_ref is_blessed_ref is_regexpref is_arrayref is_coderef );
use Role::Tiny;
use experimental 'signatures';

use namespace::clean;

around _construct_next => sub ( $orig, $class, $ipar, $gpar ) {

    my $next = $class->$orig( $ipar, $gpar );

    my $exception = (
        $gpar->{ +INPUT_EXHAUSTION } // do {
            require Iterator::Flex::Failure;
            Iterator::Flex::Failure::parameter->throw(
                q{internal error: input exhaustion policy was not registered} );
        }
    )->[1];

    my $wsub;

    ## no critic ( CascadingIfElse )
    if ( !defined $exception ) {

        $wsub = sub {
            my $self = $_[0] // $wsub;
            my $val  = eval { $next->( $self ) };
            return $@ ne q{} ? $self->signal_exhaustion( $@ ) : $val;
        };
    }

    elsif ( !is_ref( $exception ) && $exception eq PASSTHROUGH ) {

        $wsub = sub {
            my $self = $_[0] // $wsub;
            my $val  = eval { $next->( $self ) };
            return $@ ne q{} ? $self->signal_exhaustion( $@ ) : $val;
        };
    }

    elsif ( !is_ref( $exception ) || is_arrayref( $exception ) ) {
        $exception = [$exception]
          unless is_arrayref( $exception );

        $wsub = sub {
            my $self = $_[0] // $wsub;
            my $val  = eval { $next->( $self ) };
            if ( $@ ne q{} ) {
                my $e = $@;
                return $self->signal_exhaustion( $e )
                  if is_blessed_ref( $e ) && first { $e->isa( $_ ) } @$exception;
                die $e;
            }
            return $val;
        };
    }

    elsif ( is_regexpref( $exception ) ) {

        $wsub = sub {
            my $self = $_[0] // $wsub;
            my $val  = eval { $next->( $self ) };