File Coverage

blib/lib/Crypt/Random/Source/Base/Handle.pm
Criterion Covered Total %
statement 43 46 93.4
branch 9 12 75.0
condition 11 18 61.1
subroutine 14 16 87.5
pod 5 7 71.4
total 82 99 82.8


line stmt bran cond sub pod time code
1             package Crypt::Random::Source::Base::Handle;
2             # ABSTRACT: L based random data sources
3              
4             our $VERSION = '0.12';
5              
6 6     6   39270 use Moo;
  6         19131  
  6         23  
7 6     6   4874 use Types::Standard qw(Bool);
  6         141039  
  6         43  
8              
9 6     6   3320 use Errno;
  6         1778  
  6         215  
10              
11 6     6   21 use Carp qw(croak);
  6         8  
  6         206  
12 6     6   523 use IO::Handle;
  6         4541  
  6         165  
13 6     6   875 use namespace::clean;
  6         15872  
  6         26  
14              
15             extends qw(Crypt::Random::Source::Base);
16              
17             has allow_under_read => (
18             isa => Bool,
19             is => "rw",
20             default => 0,
21             );
22              
23             has reread_attempts => (
24             is => "rw",
25             default => 1,
26             );
27              
28             has handle => (
29             is => "rw",
30             lazy => 1,
31             builder => 1,
32             predicate => "has_handle",
33             clearer => "clear_handle",
34             );
35              
36 2     2 1 5862 sub blocking { shift->handle->blocking(@_) }
37 12     12 1 194 sub read { shift->handle->read(@_) }
38 0     0 0 0 sub opened { shift->handle->opened(@_) }
39              
40             sub DEMOLISH {
41 9     9 0 10961 my $self = shift;
42 9         48 $self->close;
43             }
44              
45             sub _build_handle {
46 4     4   991 my ( $self, @args ) = @_;
47 4         19 $self->open_handle;
48             }
49              
50             sub open_handle {
51 0     0 1 0 die "open_handle is an abstract method";
52             }
53              
54             sub get {
55 12     12 1 7361 my ( $self, $n, @args ) = @_;
56              
57 12 50       40 croak "How many bytes would you like to read?" unless $n;
58              
59 12         211 return $self->_read($self->handle, $n, @args);
60             }
61              
62             sub _read {
63 12     12   59 my ( $self, $handle, $n, @args) = @_;
64              
65 12         14 my $buf;
66 12         28 my $got = $self->read($buf, $n);
67              
68 12 100 100     1728 if ( defined($got) && $got == $n || $!{EWOULDBLOCK} || $!{EAGAIN} ) {
      66        
      66        
69 9         128 return $buf;
70             } else {
71 3 50       47 croak "read error: $!" unless defined $got;
72 3         11 return $self->_read_too_short($buf, $got, $n, @args);
73             }
74             }
75              
76             sub _read_too_short {
77 3     3   5 my ( $self, $buf, $got, $req, %args ) = @_;
78              
79 3 100       24 if ( $self->allow_under_read ) {
80 1         10 return $buf;
81             } else {
82 2 50 50     1024 if ( ($self->reread_attempts || 0) >= ($args{reread_attempt} || 0) ) {
      50        
83 2         38 croak "Source failed to read enough bytes (requested $req, got $got)";
84             } else {
85 0   0     0 return $buf . $self->_read( $req - $got, reread_attempt => 1 + ( $args{reread_attempt} || 0 ) );
86             }
87             }
88             }
89              
90             sub close {
91 9     9 1 9 my $self = shift;
92              
93             # During global destruction, $self->handle can be undef already,
94             # so we need to also check if it is defined.
95 9 100 66     189 if ( $self->has_handle and $self->handle ) {
96 6         143 $self->handle->close; # or die "close: $!"; # open "-|" returns exit status on close
97 6         302 $self->clear_handle;
98             }
99             }
100              
101             1;
102              
103             =pod
104              
105             =encoding UTF-8
106              
107             =head1 NAME
108              
109             Crypt::Random::Source::Base::Handle - L based random data sources
110              
111             =head1 VERSION
112              
113             version 0.12
114              
115             =head1 SYNOPSIS
116              
117             use Moo;
118             extends qw(Crypt::Random::Source::Base::Handle);
119              
120             sub open_handle {
121             # invoked as needed
122             }
123              
124              
125             # this class can also be used directly
126             Crypt::Random::Source::Base::Handle->new( handle => $file_handle );
127              
128              
129             # it supports some standard methods:
130              
131             $p->blocking(0);
132              
133             $p->read( my $buf, $n ); # no error handling here
134              
135             =head1 DESCRIPTION
136              
137             This is a concrete base class for all L based random data sources.
138              
139             It implements error handling
140              
141             =head1 ATTRIBUTES
142              
143             =head2 handle
144              
145             An L or file handle to read from.
146              
147             =head2 blocking
148              
149             This is actually handled by C, and is documented in L.
150              
151             =head2 allow_under_read
152              
153             Whether or not under reading is considered an error.
154              
155             Defaults to false.
156              
157             =head2 reread_attempts
158              
159             The number of attempts to make at rereading if the handle did not provide
160             enough bytes on the first attempt.
161              
162             Defaults to 1.
163              
164             Only used if C is enabled.
165              
166             =head1 METHODS
167              
168             =head2 get
169              
170             See L.
171              
172             When C or C are set to a true value this method may
173             return fewer bytes than requested.
174              
175             =head2 read
176              
177             This delegates directly to C.
178              
179             It B provide the same validation as C would have, so no checking
180             for underreads is done.
181              
182             =head2 close
183              
184             Close the handle and clear it.
185              
186             =head2 _read
187              
188             C<< $self->handle->read >> but with additional error checking and different
189             calling conventions.
190              
191             =head2 _read_too_short
192              
193             Called by C<_read> when not enough data was read from the handle. Normally it
194             will either die with an error or attempt to reread. When C is
195             true it will just return the partial buffer.
196              
197             =head2 open_handle
198              
199             Abstract method, should return an L to use.
200              
201             =head1 SUPPORT
202              
203             Bugs may be submitted through L
204             (or L).
205              
206             =head1 AUTHOR
207              
208             יובל קוג'מן (Yuval Kogman)
209              
210             =head1 COPYRIGHT AND LICENCE
211              
212             This software is copyright (c) 2008 by Yuval Kogman.
213              
214             This is free software; you can redistribute it and/or modify it under
215             the same terms as the Perl 5 programming language system itself.
216              
217             =cut
218              
219             __END__