File Coverage

lib/IO/Lines.pm
Criterion Covered Total %
statement 38 43 88.3
branch 12 18 66.6
condition 5 9 55.5
subroutine 7 7 100.0
pod 3 3 100.0
total 65 80 81.2


line stmt bran cond sub pod time code
1             package IO::Lines;
2              
3 2     2   1789 use strict;
  2         8  
  2         48  
4 2     2   8 use Carp;
  2         2  
  2         120  
5 2     2   347 use IO::ScalarArray;
  2         1551  
  2         836  
6              
7             # The package version, both in 1.23 style *and* usable by MakeMaker:
8             our $VERSION = "2.112";
9              
10             # Inheritance:
11             our @ISA = qw(IO::ScalarArray); ### also gets us new_tie :-)
12              
13              
14             =head1 NAME
15              
16             IO::Lines - IO:: interface for reading/writing an array of lines
17              
18              
19             =head1 SYNOPSIS
20              
21             use IO::Lines;
22              
23             ### See IO::ScalarArray for details
24              
25              
26             =head1 DESCRIPTION
27              
28             This class implements objects which behave just like FileHandle
29             (or IO::Handle) objects, except that you may use them to write to
30             (or read from) an array of lines. They can be tiehandle'd as well.
31              
32             This is a subclass of L
33             in which the underlying
34             array has its data stored in a line-oriented-format: that is,
35             every element ends in a C<"\n">, with the possible exception of the
36             final element. This makes C I more efficient;
37             if you plan to do line-oriented reading/printing, you want this class.
38              
39             The C method will enforce this rule, so you can print
40             arbitrary data to the line-array: it will break the data at
41             newlines appropriately.
42              
43             See L for full usage and warnings.
44              
45             =cut
46              
47              
48             #------------------------------
49             #
50             # getline
51             #
52             # Instance method, override.
53             # Return the next line, or undef on end of data.
54             # Can safely be called in an array context.
55             # Currently, lines are delimited by "\n".
56             #
57             sub getline {
58 29     29 1 853 my $self = shift;
59              
60 29 100       54 if (!defined $/) {
    50          
61 2         20 return join( '', $self->_getlines_for_newlines );
62             }
63             elsif ($/ eq "\n") {
64 27 100       48 if (!*$self->{Pos}) { ### full line...
65 26         78 return *$self->{AR}[*$self->{Str}++];
66             }
67             else { ### partial line...
68 1         5 my $partial = substr(*$self->{AR}[*$self->{Str}++], *$self->{Pos});
69 1         3 *$self->{Pos} = 0;
70 1         3 return $partial;
71             }
72             }
73             else {
74 0         0 croak 'unsupported $/: must be "\n" or undef';
75             }
76             }
77              
78             #------------------------------
79             #
80             # getlines
81             #
82             # Instance method, override.
83             # Return an array comprised of the remaining lines, or () on end of data.
84             # Must be called in an array context.
85             # Currently, lines are delimited by "\n".
86             #
87             sub getlines {
88 2     2 1 6 my $self = shift;
89 2 50       3 wantarray or croak("can't call getlines in scalar context!");
90              
91 2 50 33     10 if ((defined $/) and ($/ eq "\n")) {
92 2         5 return $self->_getlines_for_newlines(@_);
93             }
94             else { ### slow but steady
95 0         0 return $self->SUPER::getlines(@_);
96             }
97             }
98              
99             #------------------------------
100             #
101             # _getlines_for_newlines
102             #
103             # Instance method, private.
104             # If $/ is newline, do fast getlines.
105             # This CAN NOT invoke getline!
106             #
107             sub _getlines_for_newlines {
108 4     4   6 my $self = shift;
109 4         5 my ($rArray, $Str, $Pos) = @{*$self}{ qw( AR Str Pos ) };
  4         10  
110 4         6 my @partial = ();
111              
112 4 50       18 if ($Pos) { ### partial line...
113 0         0 @partial = (substr( $rArray->[ $Str++ ], $Pos ));
114 0         0 *$self->{Pos} = 0;
115             }
116 4         8 *$self->{Str} = scalar @$rArray; ### about to exhaust @$rArray
117 4         28 return (@partial,
118             @$rArray[ $Str .. $#$rArray ]); ### remaining full lines...
119             }
120              
121             #------------------------------
122             #
123             # print ARGS...
124             #
125             # Instance method, override.
126             # Print ARGS to the underlying line array.
127             #
128             sub print {
129 7 50 33 7 1 100 if (defined $\ && $\ ne "\n") {
130 0         0 croak 'unsupported $\: must be "\n" or undef';
131             }
132              
133 7         7 my $self = shift;
134             ### print STDERR "\n[[ARRAY WAS...\n", @{*$self->{AR}}, "<>\n";
135 7 50       27 my @lines = split /^/, join('', @_); @lines or return 1;
  7         22  
136              
137             ### Did the previous print not end with a newline?
138             ### If so, append first line:
139 7 100 100     10 if (@{*$self->{AR}} and (*$self->{AR}[-1] !~ /\n\Z/)) {
  7         36  
140 4         10 *$self->{AR}[-1] .= shift @lines;
141             }
142 7         8 push @{*$self->{AR}}, @lines; ### add the remainder
  7         17  
143             ### print STDERR "\n[[ARRAY IS NOW...\n", @{*$self->{AR}}, "<>\n";
144 7         14 1;
145             }
146              
147             #------------------------------
148             1;
149              
150             __END__