use 5.10.0;
our $VERSION = '0.18';
:default
:ExhaustionActions
:RegistryKeys
:IterAttrs
:IterStates
check_invalid_interface_parameters
check_invalid_signal_parameters
);
use overload ( '<>' => sub ( $self, $, $ ) { &{$self}() }, fallback => 1 );sub new ( $class, $state = undef, $general = {} ) {
return $class->new_from_state( $state, $general );
}
sub new_from_state ( $class, $state, $general ) {
return $class->new_from_attrs( $class->construct( $state ), $general );
}
sub new_from_attrs ( $class, $in_ipar = {}, $in_gpar = {} ) {
my %ipar = $in_ipar->%*;
my %gpar = $in_gpar->%*;
$class->_validate_interface_pars( \%ipar );
$class->_validate_signal_pars( \%gpar );
my @roles = ( delete( $ipar{ +_ROLES } ) // [] )->@*;
$gpar{ +ERROR } //= [ ( +THROW ) ];
$gpar{ +ERROR } = [ $gpar{ +ERROR } ]
unless Ref::Util::is_arrayref( $gpar{ +ERROR } );
if ( $gpar{ +ERROR }[0] eq +THROW ) {
push @roles, 'Error::Throw';
}
else {
$class->_throw( "unknown specification of iterator error signaling behavior:", $gpar{ +ERROR }[0] );
}
my $exhaustion_action = $gpar{ +EXHAUSTION } // [ ( +RETURN ) => undef ];
my @exhaustion_action
= Ref::Util::is_arrayref( $exhaustion_action )
? ( $exhaustion_action->@* )
: ( $exhaustion_action );
$gpar{ +EXHAUSTION } = \@exhaustion_action;
if ( $exhaustion_action[0] eq +RETURN ) {
push @roles, 'Exhaustion::Return';
}
elsif ( $exhaustion_action[0] eq +THROW ) {
push @roles,
@exhaustion_action > 1 && $exhaustion_action[1] eq +PASSTHROUGH
? 'Exhaustion::PassthroughThrow'
: 'Exhaustion::Throw';
}
else {
$class->_throw( parameter => "unknown exhaustion action: $exhaustion_action[0]" );
}
if ( defined( my $par = $ipar{ +METHODS } ) ) {
$class->_throw( parameter => "value for methods parameter must be a hash reference" )
unless Ref::Util::is_hashref( $par );
for my $name ( keys $par->%* ) {
my $code = $par->{$name};
$class->_throw( parameter => "value for 'methods' parameter key '$name' must be a code reference" )
unless Ref::Util::is_coderef( $code );
my $role = eval { Iterator::Flex::Method::Maker( $name, name => $name ) };
if ( $@ ne '' ) {
my $error = $@;
die $error
unless Ref::Util::is_blessed_ref( $error )
&& $error->isa( 'Iterator::Flex::Failure::RoleExists' );
$role = $error->payload;
}
push @roles, '+' . $role;
}
}
@roles = map { $class->_load_role( $_ ) } @roles;
$class = Role::Tiny->create_class_with_roles( $class, @roles );
unless ( $class->can( '_construct_next' ) ) {
throw_failure(
class => "Constructed class '$class' does not provide the required _construct_next method\n" );
}
unless ( $class->does( 'Iterator::Flex::Role::State' ) ) {
throw_failure( class => "Constructed class '$class' does not provide a State role\n" );
}
$ipar{ +_NAME } //= $class;
my $self = bless $class->_construct_next( \%ipar, \%gpar ), $class;
$class->_throw(
parameter => "attempt to register an iterator subroutine which has already been registered." )
if exists $REGISTRY{ refaddr $self };
$REGISTRY{ refaddr $self }
= { ( +ITERATOR ) => \%ipar, ( +GENERAL ) => \%gpar };
$self->_clear_state;
return $self;
}
sub _validate_interface_pars ( $class, $pars ) {
my @bad = check_invalid_interface_parameters( [ keys $pars->%* ] );
$class->_throw( parameter => "unknown interface parameters: @{[ join ', ', @bad ]}" )
if @bad;
$class->_throw( parameter => "@{[ +_ROLES ]} must be an arrayref" )
if defined $pars->{ +_ROLES } && !Ref::Util::is_arrayref( $pars->{ +_ROLES } );
if ( defined( my $par = $pars->{ +_DEPENDS } ) ) {
$pars->{ +_DEPENDS } = $par = [$par] unless Ref::Util::is_arrayref( $par );
$class->_throw( parameter => "dependency #$_ is not an iterator object" )
unless List::Util::all { $class->_is_iterator( $_ ) } $par->@*;
}
return;
}
sub _validate_signal_pars ( $class, $pars ) {
my @bad = check_invalid_signal_parameters( [ keys $pars->%* ] );
$class->_throw( parameter => "unknown signal parameters: @{[ join ', ', @bad ]}" )
if @bad;
}
sub DESTROY ( $self ) {
if ( defined $self ) {
delete $REGISTRY{ refaddr $self };
}
}
sub _name ( $self ) {
$REGISTRY{ refaddr $self }{ +ITERATOR }{ +_NAME };
}
sub _is_iterator ( $, $obj ) {
return Ref::Util::is_blessed_ref( $obj ) && $obj->isa( __PACKAGE__ );
}
sub __iter__ ( $self ) {
return $REGISTRY{ refaddr $self }{ +ITERATOR }{ +NEXT };
}
sub may ( $self, $meth, $attributes = $self->__regentry( +ITERATOR ) ) {
return $attributes->{"_may_$meth"}
//= defined $attributes->{ +_DEPENDS }
? !List::Util::first { !$_->may( $meth ) } $attributes->{ +_DEPENDS }->@*
: 1;
}
sub _namespaces {
return 'Iterator::Flex';
}
sub _role_namespaces {
return 'Iterator::Flex::Role';
}
sub _add_roles ( $class, @roles ) {
Role::Tiny->apply_roles_to_package( $class, map { $class->_load_role( $_ ) } @roles );
}
sub _apply_method_to_depends ( $self, $meth ) {
if ( defined( my $depends = $REGISTRY{ refaddr $self }{ +ITERATOR }{ +_DEPENDS } ) ) {
my $cant = List::Util::first { !$_->can( $meth ) } $depends->@*;
$self->_throw( Unsupported => "dependency: @{[ $cant->_name ]} does not have a '$meth' method" )
if $cant;
$_->$meth foreach $depends->@*;
}
}
sub is_exhausted ( $self ) {
$self->get_state == +IterState_EXHAUSTED;
}
sub set_exhausted ( $self ) {
$self->set_state( +IterState_EXHAUSTED );
}
sub _clear_state ( $self ) {
$self->set_state( +IterState_CLEAR );
}
sub is_error ( $self ) {
$self->get_state == +IterState_ERROR;
}
sub set_error ( $self ) {
$self->set_state( +IterState_ERROR );
}
sub __regentry ( $self, @keys ) {
my $entry = $REGISTRY{ refaddr $self };
$entry = $entry->{ shift @keys } while @keys;
return $entry;
}
1;