File Coverage

blib/lib/Iterator/Flex/Freeze.pm
Criterion Covered Total %
statement 74 77 96.1
branch 13 22 59.0
condition 1 3 33.3
subroutine 14 14 100.0
pod 1 2 50.0
total 103 118 87.2


line stmt bran cond sub pod time code
1             package Iterator::Flex::Freeze;
2              
3             # ABSTRACT: Freeze an iterator after every next
4              
5 2     2   326567 use v5.28;
  2         9  
6 2     2   9 use strict;
  2         4  
  2         48  
7 2     2   14 use warnings;
  2         4  
  2         120  
8 2     2   627 use experimental 'signatures';
  2         2021  
  2         10  
9              
10             our $VERSION = '0.33';
11              
12 2     2   1088 use Iterator::Flex::Factory 'to_iterator';
  2         5  
  2         185  
13             use Iterator::Flex::Utils
14 2     2   12 qw( RETURN EXHAUSTION :IterAttrs :ExhaustedMethods can_meth load_role throw_failure );
  2         3  
  2         402  
15 2     2   13 use parent 'Iterator::Flex::Base';
  2         3  
  2         22  
16 2     2   126 use Scalar::Util;
  2         4  
  2         57  
17 2     2   6 use Ref::Util;
  2         3  
  2         51  
18              
19 2     2   5 use namespace::clean;
  2         4  
  2         7  
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54 4     4 0 6 sub new ( $class, $code, $iterator, $pars = {} ) {
  4         7  
  4         7  
  4         5  
  4         7  
  4         5  
55              
56 4 50       11 throw_failure( parameter => q{'serialize' parameter is not a coderef} )
57             unless Ref::Util::is_coderef( $code );
58              
59 4 100       15 throw_failure( parameter => "iterator (@{[ $iterator->_name ]}) must provide a freeze method" )
  1         8  
60             unless can_meth( $iterator, FREEZE );
61              
62 3 50 33     8 throw_failure(
63 0         0 parameter => "iterator (@{[ $iterator->_name ]}) must provide set_exhausted/is_exhausted methods" )
64             unless can_meth( $iterator, SET_EXHAUSTED )
65             && can_meth( $iterator, IS_EXHAUSTED );
66              
67 3         16 $class->SUPER::new( { serialize => $code, src => $iterator }, $pars );
68             }
69              
70              
71 3     3 1 5 sub construct ( $class, $state ) {
  3         4  
  3         4  
  3         4  
72              
73 3 50       8 throw_failure( parameter => q{'state' parameter must be a HASH reference} )
74             unless Ref::Util::is_hashref( $state );
75              
76 3         6 my ( $serialize, $src ) = @{$state}{qw( serialize src )};
  3         7  
77              
78 3 50       8 throw_failure( parameter => q{'serialize' must be a CODE reference} )
79             unless Ref::Util::is_coderef( $serialize );
80              
81             # wrap the source iterator so that it returns undef on exhaustion.
82 3         16 $src
83             = to_iterator( $src, { ( +EXHAUSTION ) => RETURN } );
84              
85 3         5 my $self;
86             my %params = (
87             ( +_NAME ) => 'freeze',
88              
89             ( +_SELF ) => \$self,
90              
91             ( +_DEPENDS ) => $src,
92             ( +NEXT ) => sub {
93 24     24   101 my $value = $src->();
94 24         44 local $_ = $src->freeze;
95 24         46 &$serialize();
96 24 100       52 $value = $self->signal_exhaustion if $src->is_exhausted;
97 24         84 return $value;
98             },
99 3         22 );
100              
101 3         6 Scalar::Util::weaken $src;
102 3         6 $params{ +_ROLES } = [];
103 3         6 for my $meth ( PREV, CURRENT, REWIND, RESET ) {
104 12 50       28 next unless $src->may( $meth );
105 12         37 my $sub = $src->can( $meth );
106 12         14 Scalar::Util::weaken $sub;
107             $params{$meth} = sub {
108 25     25   48 $src->$sub();
109 12         33 };
110              
111             # figure out which role was used to describe the capability
112 12         19 my $Umeth = ucfirst $meth;
113 12         14 my $role;
114 12         13 for my $suffix ( 'Closure', 'Method' ) {
115             $role
116 12 50       12 = eval { load_role( $suffix ? $Umeth . q{::} . $suffix : $Umeth, $class->_role_namespaces ); };
  12         27  
117 12 50       236 next if $@ ne q{};
118 12 50       18 last if $src->does( $role );
119 0         0 undef $role;
120             }
121              
122 12 50       118 throw_failure( class => "unable to find role for '$meth' capability for @{[ $src->_name ]}" )
  0         0  
123             unless defined $role;
124              
125              
126             # need '+' as role names are fully qualified
127 12         23 push $params{ +_ROLES }->@*, q{+} . $role;
128             }
129              
130              
131 3         11 return \%params;
132             }
133              
134             __PACKAGE__->_add_roles( qw[
135             State::Registry
136             Next::ClosedSelf
137             ] );
138              
139             1;
140              
141             #
142             # This file is part of Iterator-Flex
143             #
144             # This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
145             #
146             # This is free software, licensed under:
147             #
148             # The GNU General Public License, Version 3, June 2007
149             #
150              
151             __END__