File Coverage

blib/lib/IO/ReadHandle/Include.pm
Criterion Covered Total %
statement 29 215 13.4
branch 0 92 0.0
condition 0 37 0.0
subroutine 10 31 32.2
pod 10 10 100.0
total 49 385 12.7


line stmt bran cond sub pod time code
1             package IO::ReadHandle::Include;
2              
3 1     1   48437 use 5.006;
  1         3  
4 1     1   4 use strict;
  1         1  
  1         16  
5 1     1   3 use warnings;
  1         2  
  1         31  
6              
7 1     1   5 use Carp;
  1         3  
  1         47  
8 1     1   373 use Path::Class qw(file);
  1         30100  
  1         54  
9 1     1   7 use Scalar::Util qw(blessed reftype);
  1         1  
  1         34  
10 1     1   4 use Symbol qw(gensym);
  1         2  
  1         33  
11              
12 1     1   4 use parent qw(IO::Handle);
  1         1  
  1         3  
13              
14             =head1 NAME
15              
16             B - A filehandle for reading with include
17             facility
18              
19             =head1 VERSION
20              
21             Version 1.1
22              
23             =cut
24              
25 1     1   376 use version; our $VERSION = version->declare('v1.1');
  1         1398  
  1         4  
26              
27             =head1 SYNOPSIS
28              
29             use IO::ReadHandle::Include;
30              
31             open $ofh1, '>', 'extra.txt';
32             print $ofh1 "Extra, extra! Read all about it!\n";
33             close $ofh1;
34              
35             open $ofh2, '>', 'file.txt';
36             print $ofh2 <
37             The paperboy said:
38             #include extra.txt
39             and then he ran off.
40             EOD
41             close $ofh2;
42              
43             $ifh = IO::ReadHandle::Include
44             ->new({ source => 'file.txt',
45             include => qr/^#include (.*)$/) });
46             print while <$ifh>;
47             close $ifh;
48              
49             # prints:
50             #
51             # The paperboy said:
52             # Extra, extra! Read all about it!
53             # and then he ran off.
54              
55             =head1 DESCRIPTION
56              
57             This module produces filehandles for reading from a source text file
58             and any number of included files, identified from include directives
59             found in the read text.
60              
61             Filehandle functions/methods associated with writing cannot be used
62             with an B object.
63              
64             =head2 INCLUDE DIRECTIVES AND THE READLINE FUNCTION
65              
66             The include directives are identified through a regular expression
67             (L).
68              
69             $ifh = IO::ReadHandle::Include->new({ include => $regex, ... });
70              
71             If the text read from the source file matches the regular expression,
72             then, in the output, the part of the text matching the regular
73             expression is replaced with the contents of the identified include
74             file, if that include file exists. This works recursively: The
75             included file can itself include other files, using the same format
76             for include directives. If an include file does not exist, then the
77             include directive naming that file is not replaced.
78              
79             The include file is identified by the text corresponding to a
80             particular capture group (C<< (?...) >> or C<$1>) of the
81             regular expression. For example, given the two lines of text
82              
83             #include foo.txt
84             #include "bar.txt"
85              
86             the regular expression
87              
88             qr/^#include (?|"(.*?)"|(.*))$/
89              
90             identifies C and C as the include files through
91             C<$1>, and the regular expression
92              
93             qr/^#include ("?)(?.*?)\g{1}$/
94              
95             does the same through C<$+{include}>.
96              
97             The text is transformed if a transformation code reference is defined
98             (L). The final text is interpreted as the path to the
99             file to include at this point.
100              
101             Text is read from the source file and the included files piece by
102             piece. If you're unlucky, then the piece most recently read ends in
103             the middle of an include directive, and then the current module cannot
104             detect that include directive because it isn't complete yet.
105              
106             To resolve this problem, the current module assumes that if the
107             regular expression matches the input record separator, then it must be
108             at the very end of the regular expression. If any piece of text
109             ending with the input record separator does not match the regular
110             expression, then the current module concludes that that piece of text
111             does not contain an include directive.
112              
113             This means that an include directive should not contain an input
114             record separator L<$E|perlvar/"$/"> (by default a newline),
115             except perhaps at the very end. Otherwise the include directive may
116             not always be recognized.
117              
118             This works well for the L function,
119             for the L and L methods, and for the angle
120             brackets operator (C<< <$ih> >>), which read text up to and including
121             the input record separator (or the end of the data, whichever comes
122             first).
123              
124             =head2 INCLUDE DIRECTIVES AND THE READ FUNCTION
125              
126             Function L and method L read up to a
127             user-selected number of characters from the source. The read chunk of
128             text does not necessarily end with the input record separator, so it
129             might end in the middle of an include directive, and then the include
130             directive cannot be recognized.
131              
132             To resolve this problem, the L function/method when called on
133             an IO::ReadHandle::Include object by default quietly read beyond the
134             requested number of characters until the next input record separator
135             or the end of the data is seen, so it can properly detect and resolve
136             any include directives. It then returns only up to the requested
137             number of characters, and remembers the remainder for the next call.
138              
139             This means that if the source file or an include file contains no
140             input record separator at all and is read using the L
141             function/method, then the entire contents of the source and/or include
142             file are read into memory at once.
143              
144             When using the L function/method to read the text, you don't
145             know beforehand how many lines of text you get. This can be a problem
146             if the transformation of include path names from later lines of text
147             may depend on something seen in earlier lines of text. Any change
148             that gets made to the transformation (via L) can apply
149             only to include directives that haven't been resolved yet -- so they
150             cannot apply to any include directives that were resolved while
151             processing the L call that produced the text that indicates the
152             need to change the transformation.
153              
154             In such a case, use the L method to indicate that
155             you want L to return text that does not extend beyond the first
156             input record separator -- i.e., at most one line of text. You may
157             then get fewer characters from a call to L than you asked for,
158             even if there is still more text in the source.
159              
160             =head2 LINE NUMBER
161              
162             The value of the line number special variable L<$.|perlvar/$.> is
163             supposed to be equal to the number of lines read through the last used
164             filehandle, but for an B, that value is not
165             trustworthy. It takes a lot more bookkeeping to make it trustworthy.
166              
167             =head2 PRIVATE FIELDS
168              
169             B objects support the use of private fields
170             stored within the object. L sets such a field,
171             L queries it, and L removes it again.
172              
173             These fields can be used, for example, to pass information from the
174             application using the object to the include path transformation code
175             (L) to guide the transformation.
176              
177             The fields are private in the sense that an B
178             object does not itself access them, so they're all yours.
179              
180             =head1 SUBROUTINES/METHODS
181              
182             =head2 new
183              
184             $ifh = IO::ReadHandle::Include->new({ source => $source,
185             include => $regex,
186             transform => $coderef });
187              
188             Creates an object that can be used as a filehandle for reading, with
189             include files.
190              
191             The C<$source> is the path to the main file to read from, if it is a
192             scalar. If it is a filehandle, then the main contents are read from
193             that filehandle.
194              
195             The C<$regex> is a regular expression that identifies an include
196             directive. If the regular expression defines a capture group called
197             C (C<< (?...) >>), then its value identifies the
198             file to include. Otherwise, the first capture group identifies the
199             file to include. If the include file path is relative, then it is
200             interpreted relative to the path of the file from which the include
201             directive was read.
202              
203             The C<$coderef>, if specified, must be a reference to code,
204             i.e. C<\&foo> for a reference to function C, or C
205             for a reference to an anonymous block of code. That code is used to
206             transform the path name of the include file. The reference gets
207             called as
208              
209             $path = $coderef->($path, $ifh);
210              
211             where C<$path> is the path name extracted from the include directive,
212             and C<$ifh> is the B object. You can use the
213             latter, for example, to access the private area of the
214             B to assist the transformation
215             (L). The result of executing the code reference is used
216             as the path of the include file to open.
217              
218             =cut
219              
220             sub new {
221 0     0 1   my ( $class, @args ) = @_;
222 0   0       my $self = bless gensym(), ref($class) || $class;
223 0           tie *$self, $self;
224 0           return $self->open(@args);
225             }
226              
227             # for Tie::Handle
228             sub TIEHANDLE {
229 0 0   0     return $_[0] if ref( $_[0] );
230 0           my ( $class, @args ) = @_;
231 0           my $self = bless gensym(), $class;
232 0           return $self->open(@args);
233             }
234              
235             # gets the specified field from the module's hash in the GLOB's hash
236             # part
237             sub _get {
238 0     0     my ( $self, $field ) = @_;
239 0           my $pkg = __PACKAGE__;
240 0           return *$self->{$pkg}->{$field};
241             }
242              
243             # sets the specified field in the module's hash in the GLOB's hash
244             # part to the specified value
245             sub _set {
246 0     0     my ( $self, $field, $value ) = @_;
247 0           my $pkg = __PACKAGE__;
248 0           my $old_value = *$self->{$pkg}->{$field};
249 0           *$self->{$pkg}->{$field} = $value;
250 0           return $self;
251             }
252              
253             # if the $field is defined, then deletes the specified field from the
254             # module's hash in the object's hash part. Otherwise, deletes the
255             # module's hash from the GLOB's hash part.
256             sub _delete {
257 0     0     my ( $self, $field ) = @_;
258 0           my $pkg = __PACKAGE__;
259 0 0         if ( defined $field ) {
260 0           delete *$self->{$pkg}->{$field};
261             }
262             else {
263 0           delete *$self->{$pkg};
264             }
265 0           return $self;
266             }
267              
268             =head2 close
269              
270             $ifh->close;
271             close $ifh;
272              
273             Closes the B. Closes any internal
274             filehandles that the instance was using, but if the main source was
275             passed as a filehandle then that filehandle is not closed.
276              
277             =cut
278              
279             # for Tie::Handle, close the handle
280             sub CLOSE {
281 0     0     my ($self) = @_;
282              
283             # close any included files
284 0           1 while $self->_end_include;
285              
286 0 0         if ( reftype( $self->_get('main_source') ) eq '' ) {
287              
288             # the main source was passed as a scalar, so we opened its
289             # filehandle
290 0           my $ifh = $self->_get('ifh');
291 0 0         if ($ifh) {
292 0           close $ifh;
293             }
294             } # otherwise the main source was passed as a filehandle; we don't
295             # close it because we did not open it, either.
296 0           $self->_delete;
297             }
298              
299             =head2 current_source
300              
301             $current_source = $ifh->current_source;
302              
303             Returns text describing the main source or include file that the next
304             input through B will come from, or (at the
305             end of the stream) that the last input came from.
306              
307             For a main source specified as a path name, or for an included file,
308             returns the path name.
309              
310             For a main source specified as a filehandle, returns the result of
311             calling the C method on that filehandle, unless it
312             returns the undefined value or the filehandle doesn't support the
313             C method, in which case the current method returns the
314             stringified version of the filehandle.
315              
316             NOTE: The result of this method is not always accurate. Currently, it
317             in fact describes the source that data will be I next, but
318             that is not always the source of the data that is I next,
319             because in some circumstances data gets buffered and returned only
320             later, when the source from where it came may already have run dry.
321              
322             The results of this method are only accurate if (1) all of the data is
323             read by lines, and (2) the include directive always comes at the very
324             end of a line.
325              
326             Making this method always accurate requires a lot more internal
327             bookkeeping.
328              
329             =cut
330              
331             sub current_source {
332 0     0 1   my ($self) = @_;
333 0           my $source = $self->_get('source');
334 0 0         return unless defined $source;
335 0 0         if ( ref $source ) {
336 0 0         if ( reftype($source) eq 'GLOB' ) {
337 0           my $s = eval { $source->current_source };
  0            
338 0 0         return defined($s) ? $s : "$source";
339             }
340             }
341 0           return $source;
342             }
343              
344             =head2 eof
345              
346             $end_of_data = eof $ifh;
347             $end_of_data = $ifh->eof;
348              
349             Returns 1 when there is no (more) data to read through the
350             B, and C<''> otherwise, similar to
351             L and L.
352              
353             =cut
354              
355             sub eof {
356 0     0 1   return EOF(@_);
357             }
358              
359             # for Tie::Handle: are we at the end of the data?
360             sub EOF {
361 0     0     my ($self) = @_;
362 0           my $buffer = $self->_get('buffer');
363 0 0         return '' if $buffer;
364              
365 0           my $ifh = $self->_get('ifh');
366 0 0 0       return '' if $ifh # we've started reading
367             && not( $ifh->eof ); # and aren't at the end of the current source
368              
369             # If we get here, then either we hadn't started reading yet, or else
370             # we're at the end of the current source.
371              
372 0 0         if ($ifh) { # we had started reading already,
373             # so the current source is exhausted.
374 0 0         if ( not $self->_end_include ) {
375              
376             # we were reading from the main file
377 0           return 1;
378             } # otherwise we were inside an include file and have now reverted
379             # to the including file, and need to check if it is at EOF
380             }
381             else { # haven't opened the main source yet, Do it now and
382             # initialize appropriately
383 0           my $source = $self->_get('source');
384 0 0 0       if ( ref($source) && reftype($source) eq 'GLOB' ) {
385 0           $ifh = $source;
386             }
387             else {
388 0 0         CORE::open $ifh, '<', $source
389             or croak "Cannot open '$source' for reading: $!";
390             }
391 0           $self->_set( ifh => $ifh )->_set( ifhs => [] )->_set( suffixes => [] )
392             ->_set( sources => [] )->_set( buffer => '' );
393             }
394 0           return $self->EOF;
395             }
396              
397             =head2 get_field
398              
399             $value = $ifh->get_field($field);
400             $value = $ifh->get_field($field, $default);
401              
402             Returns the value of the private field C<$field> from the filehandle.
403              
404             If that field does not yet exist, and if C<$default> is not specified,
405             then does not modify the object and returns the undefined value.
406              
407             If the field does not yet exist but C<$default> is specified, then
408             creates the field, assigns it the value C<$default>, and then returns
409             that value.
410              
411             =cut
412              
413             sub get_field {
414 0     0 1   my ( $self, $field, $default ) = @_;
415 0           my $href = $self->_get('_');
416 0 0         if ( @_ >= 3 ) { # $default specified
417 0 0         if ( not $href ) {
418 0           $href = {};
419 0           $self->_set( '_', $href );
420             }
421 0   0       $href->{$field} //= $default;
422             }
423             else { # no $default specified
424 0 0         return unless $href;
425             }
426 0           return $href->{$field};
427             }
428              
429             =head2 getline
430              
431             $line = $ifh->getline;
432             $line = <$ifh>;
433             $line = readline $ifh;
434              
435             Reads the next line from the B. The input
436             record separator (L<$E|perlvar/"$/">) or end-of-data mark the end
437             of the line.
438              
439             =head2 getlines
440              
441             @lines = $ifh->getlines;
442             @lines = <$ifh>;
443              
444             Reads all remaining lines from the B. The
445             input record separator (L<$E|perlvar/"$/">) or end-of-data mark
446             the end of each line.
447              
448             =cut
449              
450             # for Tie::Handle, read a line
451             sub READLINE {
452 0     0     my ($self) = @_;
453 0 0         if (wantarray) {
454 0           my @lines = ();
455 0           while ( my $line = $self->READLINE ) {
456 0           push @lines, $line;
457             }
458 0           return @lines;
459             }
460             else {
461 0 0         return if $self->EOF;
462              
463 0           my $line = $self->_getline;
464 0           while ( $line !~ m#$/$# ) {
465              
466             # no input record separator at the end; we must have reached the
467             # end of the file -- maybe an included file.
468 0 0         last if $self->EOF;
469 0           $line .= $self->_getline;
470             }
471 0 0         if ( $line =~ $self->_get('include') ) {
472              
473             # the regex matched: include another file
474 1   0 1   1024 my $path = $+{include} // $1;
  1         304  
  1         963  
  0            
475 0 0         croak "No include file path detected" unless $path;
476 0           my $coderef = $self->_get('transform');
477 0 0         if ($coderef) {
478 0           $path = $coderef->( $path, $self );
479             }
480 0           $path = file($path);
481 0 0         if ( $path->is_relative ) {
482              
483             # the path is relative; it is relative to the directory of the
484             # including file
485 0           $path = file( file( $self->_get('source') )->parent, $path );
486             }
487 0 0         if ( CORE::open my $newifh, '<', "$path" ) {
488 0           my $suffix = substr( $line, $+[0] ); # text beyond the regex match
489 0           push @{ $self->_get('suffixes') }, $suffix; # save for later
  0            
490              
491 0           push @{ $self->_get('ifhs') }, $self->_get('ifh'); # save for later
  0            
492 0           push @{ $self->_get('sources') },
  0            
493             $self->_get('source'); # save for later
494              
495 0           $self->_set( ifh => $newifh ) # current source is included file
496             ->_set( source => $path ); # current source
497 0           $line = substr( $line, 0, $-[0] ) # text before the regex match
498             . $self->READLINE; # append first line from included file
499             } # otherwise we leave the original text
500             }
501 0           return $line;
502             }
503             }
504              
505             =head2 input_line_number
506              
507             $line_number = $ifh->input_line_number;
508             $line_number = $.;
509              
510             Returns the number of lines read through the
511             B (first example) or through the last used
512             filehandle (second example).
513              
514             NOTE: The result of this method is not always accurate, because the
515             current module may need to read ahead and buffer some data in order to
516             properly detect and resolve include directives.
517              
518             The results of this method are accurate if (1) all of the data is read
519             by lines, and (2) the include directive always comes at the very end
520             of a line.
521              
522             =head2 open
523              
524             $ih->open({ source => $source,
525             include => $regex,
526             transform => $coderef });
527              
528             (Re)opens the B object. See L for
529             details about the arguments.
530              
531             =cut
532              
533             sub open {
534 0     0 1   my ( $self, @args ) = @_;
535 0           my $source;
536             my $regex;
537 0           my $coderef;
538 0 0 0       if ( @args == 1 && ref( $args[0] ) && reftype( $args[0] ) eq 'HASH' ) {
      0        
539 0           $source = $args[0]->{source};
540 0           $regex = $args[0]->{include};
541 0           $coderef = $args[0]->{transform};
542             }
543             else {
544 0           croak "Expected a single argument, a reference to a hash.";
545             }
546 0 0 0       croak "Source must be a scalar or filehandle"
547             if ref($source) ne ''
548             and reftype($source) ne 'GLOB';
549 0 0 0       croak "Include specification must be a regular expression"
550             if not($regex)
551             or reftype($regex) ne 'REGEXP';
552 0 0 0       croak "Transform, if set, must be a code reference"
553             if $coderef and reftype($coderef) ne 'CODE';
554 0           $self->_set( source => $source )->_set( main_source => $source )
555             ->_set( include => $regex )->_set( transform => $coderef );
556 0           return $self;
557             }
558              
559             # If we're reading from an included file, then act as if that included
560             # file is exhausted: close it, revert to the including file, and
561             # return 1. Otherwise return 0.
562             sub _end_include {
563 0     0     my ($self) = @_;
564 0           my $ifh = $self->_get('ifh');
565 0 0         if ($ifh) { # already reading
566 0           my $ifhs = $self->_get('ifhs');
567 0 0         if (@$ifhs) { # inside an include file
568 0           close $ifh; # close the included file
569 0           $self->_set( ifh => pop @{$ifhs} ) # revert to including file
570             ->_set(
571 0           buffer => $self->_get('buffer') . pop @{ $self->_get('suffixes') } )
572 0           ->_set( source => pop @{ $self->_get('sources') } );
  0            
573 0           return 1;
574             } # otherwise we're in the main file
575             } # otherwise it's a no-op
576 0           return 0;
577             }
578              
579             # returns the next line of input, taking into account any buffered
580             # input.
581             sub _getline {
582 0     0     my ($self) = @_;
583 0           my $line = '';
584 0           my $buffer = $self->_get('buffer');
585 0 0         if ($buffer) {
586 0           $line = $buffer;
587 0           $self->_set( buffer => '' );
588 0 0         if ( $line =~ m#$/$# ) {
589 0           return $line;
590             }
591             }
592 0           my $ifh = $self->_get('ifh');
593 0 0         if ( not CORE::eof($ifh) ) {
594              
595             # If I combine the next two statements into one, then <$ifh> is
596             # evaluated in list context (i.e., read all remaining lines) and
597             # then converted to scalar context (i.e., yield the number of
598             # lines read). This is not what we want, so keep them separate.
599 0           my $nextline = <$ifh>;
600 0           $line .= $nextline;
601             }
602 0           return $line;
603             }
604              
605             =head2 read
606              
607             $ifh->read($buffer, $length, $offset);
608             read $ifh, $buffer, $length, $offset;
609              
610             Read up to C<$length> characters from the B
611             into the C<$buffer> at offset C<$offset>, similar to the
612             L function. Returns the number of
613             characters read, or 0 when there are no more characters.
614              
615             If L is active, then the reading stops after the
616             first encountered input record separator (L<$E|perlvar/"$/">),
617             even if the requested number of characters has not been reached yet.
618              
619             =cut
620              
621             # for Tie::Handle, read bytes
622             sub READ {
623 0     0     my ( $self, undef, $length, $offset ) = @_;
624 0           my $bufref = \$_[1];
625 0   0       $offset //= 0;
626              
627             # Adjust buffer for appending at $offset: Any previous contents
628             # beyond that offset are lost. If the buffer is not that long, then
629             # pad with \0 until it is long enough. (This is what CORE::read
630             # does, too.)
631              
632 0           my $l = length($$bufref);
633 0 0         if ( $offset < 0 ) {
634 0           $offset = $l - $offset;
635 0 0         if ( $offset < 0 ) {
636              
637             # TODO: what does CORE::read do in this case?
638 0           $offset = 0;
639             }
640             }
641 0 0         if ( $offset < $l ) {
    0          
642              
643             # chop off everything beyond $offset
644 0           substr $$bufref, $offset, $l - $offset, '';
645             }
646             elsif ( $offset > $l ) {
647              
648             # pad \0 until the offset
649 0           $$bufref .= '\x0' x ( $offset - $l );
650             }
651              
652 0 0         if ( $self->EOF ) {
653 0           return 0;
654             }
655              
656             # we obtain data using READLINE, because only then can we reliably
657             # detect include directives. See main POD for an explanation.
658              
659             # calling READLINE updates the line number, which READ isn't
660             # supposed to do. Remember the current value, so we can restore it
661             # later.
662 0           my $old_dot = $.;
663              
664 0           my $line;
665             my $n;
666 0 0         if ( $self->_get('read_by_line') ) {
667              
668             # return at most a single line
669 0           $line = $self->READLINE;
670 0           $n = length($line);
671             }
672             else {
673             # return data until the requested number of characters is reached
674             # or the data runs out.
675 0           $line = '';
676 0           $n = 0;
677 0   0       while ( $n < $length && not $self->EOF ) {
678 0           $line .= $self->READLINE;
679 0           $n = length($line);
680             }
681             }
682              
683             # restore old line number
684 0           $. = $old_dot;
685              
686 0 0         if ( $n > $length ) {
687              
688             # we read more than was requested. Remember the excess for next
689             # time (managed by READLINE). We divide $line into a first part
690             # with the desired $length, and a second part beyond that length,
691             # which we prepend to the buffer.
692 0           $self->_set(
693             buffer => substr( $line, $length, $n, '' ) . $self->_get('buffer') );
694 0           $n = $length;
695             }
696 0           $$bufref .= $line;
697 0           return $n;
698             }
699              
700             =head2 remove_field
701              
702             $cfh->remove_field($field);
703              
704             Removes the filehandle's private field with the specified name, if it
705             exists. Returns the filehandle.
706              
707             =cut
708              
709             sub remove_field {
710 0     0 1   my ( $self, $field ) = @_;
711 0           my $href = $self->_get('_');
712 0 0         if ($href) {
713 0           delete $href->{$field};
714             }
715 0           return $self;
716             }
717              
718             =head2 seek
719              
720             seek $ifh, $pos, $whence;
721             $ifh->seek($pos, $whence);
722              
723             Sets the B filehandle's position, similar to
724             the L function -- but at present the support
725             is very limited.
726              
727             C<$whence> indicates relative to what the target position C<$pos> is
728             specified. This can be 0 for the beginning of the data, 1 for the
729             current position, or 2 for the end of the data.
730              
731             C<$pos> says how many bytes beyond the position indicated by
732             C<$whence> to set the filehandle to. At present, C<$pos> must be
733             equal to 0, otherwise the method croaks. So, the position can only be
734             set to the very beginning, the very end, or the current position.
735             Supporting more requires a lot more bookkeeping.
736              
737             Returns 1 on success, false otherwise.
738              
739             =cut
740              
741             sub seek {
742 0     0 1   return SEEK(@_);
743             }
744              
745             # for Tie::Handle, seek. We support only seeking to the beginning,
746             # end, or current position. For anything else we'd need to do a lot
747             # of additional bookkeeping.
748             sub SEEK {
749 0     0     my ( $self, $position, $whence ) = @_;
750 0 0         if ( $position == 0 ) {
751 0 0         if ( $whence != 1 ) {
752              
753             # seek to the very beginning or end
754              
755             # close any included files
756 0           1 while $self->_end_include;
757 0           return CORE::seek( $self->_get('ifh'), $position, $whence );
758             } # otherwise we seek to where we already are: a no-op
759             }
760             else {
761 0           croak
762             "Cannot seek to anywhere except here or the beginning or the end via a "
763             . blessed($self);
764             }
765 0           return 1;
766             }
767              
768             =head2 set_field
769              
770             $ifh->set_field($field, $value);
771              
772             Sets the filehandle's private field with key C<$field> to the
773             specified C<$value>. Returns the filehandle.
774              
775             =cut
776              
777             sub set_field {
778 0     0 1   my ( $self, $field, $value ) = @_;
779 0           my $href = $self->_get('_');
780 0 0         if ( not $href ) {
781 0           $self->_set( '_', $href = {} );
782             }
783 0           $href->{$field} = $value;
784 0           return $self;
785             }
786              
787             =head2 set_read_by_line
788              
789             $ifh->set_read_by_line($value);
790             $ifh->set_read_by_line;
791              
792             Configures whether L can return more than a single line's worth
793             of data per call.
794              
795             By default, a single L call reads and returns data until the
796             requested number of characters has been read or until it runs out of
797             data, whichever comes first. If C is called without
798             an argument or with an argument that is a true value (e.g., 1), then
799             subsequent calls of L return at most the next line, as defined
800             by the input record separator L<$E|perlvar/"S/"> -- or less, if
801             the requested number of characters has been reached. If
802             C is called with an argument that is a false value
803             (e.g., 0), then L reverts to its default behavior.
804              
805             =cut
806              
807             sub set_read_by_line {
808 0     0 1   my ( $self, $value ) = @_;
809 0   0       $value //= 1;
810 0           $self->_set( 'read_by_line', $value );
811             }
812              
813             =head2 set_transform
814              
815             $ifh->set_transform($coderef);
816              
817             Sets the transformation code reference, with the same purpose as the
818             C parameter of L. Returns the object.
819              
820             =cut
821              
822             sub set_transform {
823 0     0 1   my ( $self, $coderef ) = @_;
824 0 0         croak "Transform must be a code reference"
825             unless ref($coderef) eq 'CODE';
826 0           $self->_set( transform => $coderef );
827 0           return $self;
828             }
829              
830             =head1 AUTHOR
831              
832             Louis Strous, C<< >>
833              
834             =head1 BUGS
835              
836             =head2 KNOWN BUGS
837              
838             Resolving these bugs requires much more bookkeeping.
839              
840             =over
841              
842             =item
843              
844             The result of L (and L<$.|perlvar/$.>) may not be
845             accurate.
846              
847             =item
848              
849             The result of L may not be accurate.
850              
851             =item
852              
853             L can only be used to go to the very beginning, the current
854             position, or the very end of the stream.
855              
856             =item
857              
858             L cannot be used on an B.
859              
860             =back
861              
862             =head2 REPORT BUGS
863              
864             Please report any bugs or feature requests to
865             C, or through the web
866             interface at
867             L.
868             I will be notified, and then you'll automatically be notified of
869             progress on your bug as I make changes.
870              
871             =head1 SUPPORT
872              
873             You can find documentation for this module with the perldoc command.
874              
875             perldoc IO::ReadHandle::Include
876              
877              
878             You can also look for information at:
879              
880             =over 4
881              
882             =item * RT: CPAN's request tracker (report bugs here)
883              
884             L
885              
886             =item * AnnoCPAN: Annotated CPAN documentation
887              
888             L
889              
890             =item * CPAN Ratings
891              
892             L
893              
894             =item * Search CPAN
895              
896             L
897              
898             =back
899              
900             =head1 LICENSE AND COPYRIGHT
901              
902             Copyright 2018 Louis Strous.
903              
904             This program is free software; you can redistribute it and/or modify it
905             under the terms of the the Artistic License (2.0). You may obtain a
906             copy of the full license at:
907              
908             L
909              
910             Any use, modification, and distribution of the Standard or Modified
911             Versions is governed by this Artistic License. By using, modifying or
912             distributing the Package, you accept this license. Do not use, modify,
913             or distribute the Package, if you do not accept this license.
914              
915             If your Modified Version has been derived from a Modified Version made
916             by someone other than you, you are nevertheless required to ensure that
917             your Modified Version complies with the requirements of this license.
918              
919             This license does not grant you the right to use any trademark, service
920             mark, tradename, or logo of the Copyright Holder.
921              
922             This license includes the non-exclusive, worldwide, free-of-charge
923             patent license to make, have made, use, offer to sell, sell, import and
924             otherwise transfer the Package with respect to any patent claims
925             licensable by the Copyright Holder that are necessarily infringed by the
926             Package. If you institute patent litigation (including a cross-claim or
927             counterclaim) against any party alleging that the Package constitutes
928             direct or contributory patent infringement, then this Artistic License
929             to you shall terminate on the date that such litigation is filed.
930              
931             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
932             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
933             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
934             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
935             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
936             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
937             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
938             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
939              
940             =head1 SEE ALSO
941              
942             L.
943              
944             =cut
945              
946             1; # End of IO::ReadHandle::Include