File Coverage

blib/lib/File/fgets.pm
Criterion Covered Total %
statement 38 38 100.0
branch 16 16 100.0
condition 2 3 66.6
subroutine 8 8 100.0
pod 1 2 50.0
total 65 67 97.0


line stmt bran cond sub pod time code
1             package File::fgets;
2              
3 3     3   1884 use strict;
  3         6  
  3         89  
4 3     3   13 use warnings;
  3         6  
  3         66  
5              
6 3     3   2471 use version; our $VERSION = qv("v0.0.4");
  3         8209  
  3         18  
7              
8 3     3   282 use XSLoader;
  3         6  
  3         153  
9             XSLoader::load __PACKAGE__, $VERSION;
10              
11 3     3   23 use base qw(Exporter);
  3         5  
  3         482  
12             our @EXPORT = qw(fgets);
13              
14 3     3   17 use Carp;
  3         6  
  3         1160  
15              
16              
17             =head1 NAME
18              
19             File::fgets - Read either one line or X characters from a file
20              
21             =head1 SYNOPSIS
22              
23             use File::fgets;
24              
25             open my $fh, $file;
26              
27             # Read either one line or the first 10 characters, which ever comes first
28             my $line = fgets($fh, 10);
29              
30             =head1 DESCRIPTION
31              
32             An implementation of the C fgets() function.
33              
34             =head3 fgets
35              
36             my $string = fgets($fh, $limit);
37              
38             Reads either one line or at most $limit bytes from the $fh.
39              
40             Returns undef at end of file.
41              
42             NOTE: unlike C's fgets, this will read $limit characters not $limit -
43             1. Perl doesn't have to leave room for a null byte.
44              
45             =cut
46              
47             sub fgets {
48 29     29 1 3644 my($fh, $limit) = @_;
49              
50 29 100       1418 croak "Invalid filehandle supplied to fgets()" unless defined $fh;
51 28 100       202 croak "No limit supplied to fgets()" unless defined $limit;
52 27 100       26 croak "fgets() on closed filehandle" if do { tell($fh) == -1; };
  27         98  
53 26 100       92 return if eof $fh;
54              
55             # fgets() is often buggy, returning garbage or silently reading
56             # one character. Let's just not get it involved.
57 24 100       48 return "" if $limit == 0;
58              
59 23         27 my $fd = eval { fileno($fh) };
  23         35  
60 23   66     75 my $has_fd = $fd && $fd != -1;
61 23 100       159 return $has_fd ? xs_fgets($fh, $limit) : perl_fgets($fh, $limit);
62             }
63              
64             # For dealing with filehandles that aren't real file descriptors
65             sub perl_fgets {
66 2     2 0 3 my($fh, $limit) = @_;
67              
68 2         1 my $char; # avoid reallocating it every iteration
69 2         3 my $str = '';
70 2         8 for(1..$limit) {
71 8         16 $char = getc $fh;
72 8 100       18 last unless defined $char;
73 7         8 $str .= $char;
74 7 100       16 last if $char eq "\n";
75             }
76              
77 2         10 return $str;
78             }
79              
80             1;
81              
82             =head1 EXAMPLE
83              
84             The following example demonstrates using fgets() to read in at most 5
85             characters at a time.
86              
87             use File::fgets;
88              
89             open my $write_fh, ">", $file;
90             print $write_fh <
91             this is
92             an example
93             of use
94             END
95             close $write_fh;
96              
97             open my $fh, "<", $file;
98             while( my $string = fgets($fh, 5) ) {
99             $string =~ s{\n}{\\n}; # make newlines show up
100             print "--$string--\n";
101             }
102              
103             The result will be:
104              
105             --this --
106             --is\n--
107             --an ex--
108             --ample--
109             --\n--
110             --of us--
111             --e\n--
112              
113              
114             =head1 NOTES
115              
116             This is implemented as a wrapper around the C fgets() function and is
117             extremely efficient UNLESS the filehandle does not have an underlying
118             fileno. For example, if its given a tied filehandle. Then it falls
119             back to a Perl implementation.
120              
121             =head1 LICENSE
122              
123             Copyright 2010 by Michael G Schwern Eschwern@pobox.comE.
124              
125             This program is free software; you can redistribute it and/or
126             modify it under the same terms as Perl itself.
127              
128             See F
129              
130             Send bugs, feedback, ideas and suggestions via
131             L or
132             Ebugs-File-fgets@rt.cpan.orgE
133              
134             The latest version of this software can be found at L
135              
136             =head1 SEE ALSO
137              
138             L
139              
140             =cut