Iterator-Flex
view release on metacpan or search on metacpan
lib/Iterator/Flex/Freeze.pm view on Meta::CPAN
package Iterator::Flex::Freeze;
# ABSTRACT: Freeze an iterator after every next
use v5.28;
use strict;
use warnings;
use experimental 'signatures';
our $VERSION = '0.34';
use Iterator::Flex::Factory 'to_iterator';
use Iterator::Flex::Utils
qw( RETURN EXHAUSTION :IterAttrs :ExhaustedMethods can_meth load_role throw_failure );
use parent 'Iterator::Flex::Base';
use Scalar::Util;
use Ref::Util;
use namespace::clean;
sub new ( $class, $code, $iterator, $pars = {} ) {
throw_failure( parameter => q{'serialize' parameter is not a coderef} )
unless Ref::Util::is_coderef( $code );
throw_failure( parameter => "iterator (@{[ $iterator->_name ]}) must provide a freeze method" )
unless can_meth( $iterator, FREEZE );
throw_failure(
parameter => "iterator (@{[ $iterator->_name ]}) must provide set_exhausted/is_exhausted methods" )
unless can_meth( $iterator, SET_EXHAUSTED )
&& can_meth( $iterator, IS_EXHAUSTED );
$class->SUPER::new( { serialize => $code, src => $iterator }, $pars );
}
sub construct ( $class, $state ) {
throw_failure( parameter => q{'state' parameter must be a HASH reference} )
unless Ref::Util::is_hashref( $state );
my ( $serialize, $src ) = @{$state}{qw( serialize src )};
throw_failure( parameter => q{'serialize' must be a CODE reference} )
unless Ref::Util::is_coderef( $serialize );
# wrap the source iterator so that it returns undef on exhaustion.
$src
= to_iterator( $src, { ( +EXHAUSTION ) => RETURN } );
my $self;
my %params = (
( +_NAME ) => 'freeze',
( +_SELF ) => \$self,
( +_DEPENDS ) => $src,
( +NEXT ) => sub {
my $value = $src->();
local $_ = $src->freeze;
&$serialize();
$value = $self->signal_exhaustion if $src->is_exhausted;
return $value;
},
);
Scalar::Util::weaken $src;
$params{ +_ROLES } = [];
for my $meth ( PREV, CURRENT, REWIND, RESET ) {
next unless $src->may( $meth );
my $sub = $src->can( $meth );
Scalar::Util::weaken $sub;
$params{$meth} = sub {
$src->$sub();
};
# figure out which role was used to describe the capability
my $Umeth = ucfirst $meth;
my $role;
for my $suffix ( 'Closure', 'Method' ) {
$role
= eval { load_role( $suffix ? $Umeth . q{::} . $suffix : $Umeth, $class->_role_namespaces ); };
next if $@ ne q{};
last if $src->does( $role );
undef $role;
}
throw_failure( class => "unable to find role for '$meth' capability for @{[ $src->_name ]}" )
unless defined $role;
# need '+' as role names are fully qualified
push $params{ +_ROLES }->@*, q{+} . $role;
}
return \%params;
}
__PACKAGE__->_add_roles( qw[
State::Registry
Next::ClosedSelf
] );
1;
( run in 0.536 second using v1.01-cache-2.11-cpan-98e64b0badf )