File Coverage

blib/lib/Iterator/Flex/Utils.pm

Criterion	Covered	Total	%
statement	156	162	96.3
branch	21	30	70.0
condition	0	3	0.0
subroutine	38	38	100.0
pod	5	8	62.5
total	220	241	91.2

package Iterator::Flex::Utils;

# ABSTRACT: Internal utilities

use v5.28;
use strict;
use warnings;

use experimental 'signatures', 'postderef';

our $VERSION = '0.34';

use Scalar::Util qw( refaddr );
use Ref::Util    qw( is_hashref );
use Exporter 'import';
use experimental 'declared_refs';
use Module::Runtime;

our %REGISTRY;

sub mk_indices {
    my $idx = 0;
    return { map { $_ => $idx++ } @_ };
}

sub mk_lc {
    return { map { $_ => lc $_ } @_ };
}

use constant ITER_ATTRS => qw(
  CLASS CURRENT FREEZE METHODS NEXT PREV RESET REWIND STATE _DEPENDS _NAME _ROLES _SELF
);
use constant mk_lc ITER_ATTRS;
use constant REGISTRY_ITERATION_INDICES => map { 'REG_ITER_' . $_ } ITER_ATTRS, 'MAY_METHOD';
use constant mk_indices REGISTRY_ITERATION_INDICES;
our \%RegIterationIndexMap = mk_indices map { lc } ITER_ATTRS;

use constant EXHAUSTED_METHODS => qw( IS_EXHAUSTED SET_EXHAUSTED  );
use constant mk_lc EXHAUSTED_METHODS;

use constant ITER_STATES => qw( IterState_CLEAR IterState_EXHAUSTED IterState_ERROR );
use constant mk_indices ITER_STATES;

use constant REGISTRY_INDICES => qw( REG_ITERATOR REG_GENERAL REG_METHODS );
use constant mk_indices REGISTRY_INDICES;

use constant EXHAUSTION_ACTIONS => qw[ THROW RETURN PASSTHROUGH ];
use constant mk_lc EXHAUSTION_ACTIONS;

# these duplicate ITER_ATTRS. combine?
use constant INTERFACE_PARAMETERS =>
  qw( CURRENT FREEZE METHODS NEXT PREV RESET REWIND STATE _DEPENDS _NAME _ROLES _SELF );
use constant INTERFACE_PARAMETER_VALUES => map { lc $_ } INTERFACE_PARAMETERS;
use constant mk_lc INTERFACE_PARAMETERS;


use constant SIGNAL_PARAMETERS       => qw( INPUT_EXHAUSTION EXHAUSTION ERROR );
use constant SIGNAL_PARAMETER_VALUES => map { lc $_ } SIGNAL_PARAMETERS;
use constant mk_lc SIGNAL_PARAMETERS;

use constant GENERAL_PARAMETERS      => ( INTERFACE_PARAMETERS, SIGNAL_PARAMETERS );
use constant REGISTRY_GENPAR_INDICES => map { 'REG_GP_' . $_ } GENERAL_PARAMETERS;
use constant mk_indices REGISTRY_GENPAR_INDICES;

our \%RegGeneralParameterIndexMap = mk_indices map { lc } GENERAL_PARAMETERS;

our %EXPORT_TAGS = (
    ExhaustionActions => [EXHAUSTION_ACTIONS],
    ExhaustedMethods  => [EXHAUSTED_METHODS],
    RegistryIndices   => [
        REGISTRY_INDICES,        REGISTRY_ITERATION_INDICES,
        '%RegIterationIndexMap', REGISTRY_GENPAR_INDICES,
        '%RegGeneralParameterIndexMap',
    ],
    IterAttrs           => [ITER_ATTRS],
    IterStates          => [ITER_STATES],
    SignalParameters    => [ SIGNAL_PARAMETERS,    'SIGNAL_PARAMETER_VALUES' ],
    InterfaceParameters => [ INTERFACE_PARAMETERS, 'INTERFACE_PARAMETER_VALUES' ],
    GeneralParameters   => [ GENERAL_PARAMETERS, ],
    Functions           => [ qw(
          throw_failure
          parse_pars
          can_meth
          resolve_meth
          load_role
        ),
    ],
    default => [qw( %REGISTRY refaddr )],
);

$EXPORT_TAGS{':all'} = [ map { $_->@* } values %EXPORT_TAGS ];

## no critic ( AutomaticExportation )
our @EXPORT = @{ $EXPORT_TAGS{default} };    # ??? is this needed?

our @EXPORT_OK = ( map { $_->@* } values %EXPORT_TAGS, );


sub throw_failure ( $failure, $msg ) {
    require Iterator::Flex::Failure;
    local @Iterator::Flex::Role::Utils::CARP_NOT = scalar caller;
    my $type = join( q{::}, 'Iterator::Flex::Failure', $failure );
    $type->throw( { msg => $msg, trace => Iterator::Flex::Failure->croak_trace } );
}













sub parse_pars ( @args ) {

    my %pars = do {

        if ( @args == 1 ) {
            is_hashref( $args[0] )
              or throw_failure( parameter => 'expected a hashref' );
            $args[0]->%*;
        }

        else {
            @args % 2
              and throw_failure( parameter => 'expected an even number of arguments for hash' );
            @args;
        }
    };

    my %ipars = delete %pars{ grep exists $pars{$_}, INTERFACE_PARAMETER_VALUES };
    my %spars = delete %pars{ grep exists $pars{$_}, SIGNAL_PARAMETER_VALUES };

    return ( \%pars, \%ipars, \%spars );
}


































sub can_meth ( $obj, @methods ) {

    my $par = Ref::Util::is_hashref( $methods[-1] ) ? pop @methods : {};

    for my $method ( @methods ) {
        throw_failure( parameter => q{'method' parameters must be a string} )
          if Ref::Util::is_ref( $method );

        my $sub;
        foreach ( "__${method}__", $method ) {
            if ( defined( $sub = $obj->can( $_ ) ) ) {
                my @ret = ( ( !!$par->{name} ? $_ : () ), ( !!$par->{code} ? $sub : () ) );
                push @ret, $sub unless @ret;
                return @ret > 1 ? @ret : $ret[0];
            }
        }
    }

    return undef;
}


















sub resolve_meth ( $target, $method, @fallbacks ) {

    my $code = do {

        if ( defined $method ) {
            Ref::Util::is_coderef( $method )
              ? $method
              : $target->can( $method )
              // throw_failure( parameter => qq{method '$method' is not provided by the object} );
        }

        else {
            can_meth( $target, @fallbacks );
        }
    };

    return $code;
}
















sub load_module ( $path, @namespaces ) {

    if ( substr( $path, 0, 1 ) eq q{+} ) {
        my $module = substr( $path, 1 );
        return $module if eval { Module::Runtime::require_module( $module ) };
        throw_failure( class => "unable to load $module" );
    }
    else {
        for my $namespace ( @namespaces ) {
            my $module = $namespace . q{::} . $path;
            return $module if eval { Module::Runtime::require_module( $module ) };
        }
    }

    throw_failure(
        class => join q{ },
        "unable to find a module for '$path' in @{[ join( ', ', @namespaces ) ]}",
    );
}











sub load_role ( $role, @namespaces ) {
    load_module( $role, @namespaces );
}


1;

#
# This file is part of Iterator-Flex
#
# This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__