git.maemo.org Git - dh-make-perl/blob - dev/arm/libio-stringy-perl/io-stringy-2.110/lib/IO/Lines.pm

   1 package IO::Lines;
   2
   3
   4 =head1 NAME
   5
   6 IO::Lines - IO:: interface for reading/writing an array of lines
   7
   8
   9 =head1 SYNOPSIS
  10
  11     use IO::Lines;
  12
  13     ### See IO::ScalarArray for details
  14
  15
  16 =head1 DESCRIPTION
  17
  18 This class implements objects which behave just like FileHandle
  19 (or IO::Handle) objects, except that you may use them to write to
  20 (or read from) an array of lines.  They can be tiehandle'd as well.
  21
  22 This is a subclass of L<IO::ScalarArray|IO::ScalarArray>
  23 in which the underlying
  24 array has its data stored in a line-oriented-format: that is,
  25 every element ends in a C<"\n">, with the possible exception of the
  26 final element.  This makes C<getline()> I<much> more efficient;
  27 if you plan to do line-oriented reading/printing, you want this class.
  28
  29 The C<print()> method will enforce this rule, so you can print
  30 arbitrary data to the line-array: it will break the data at
  31 newlines appropriately.
  32
  33 See L<IO::ScalarArray> for full usage and warnings.
  34
  35 =cut
  36
  37 use Carp;
  38 use strict;
  39 use IO::ScalarArray;
  40 use vars qw($VERSION @ISA);
  41
  42 # The package version, both in 1.23 style *and* usable by MakeMaker:
  43 $VERSION = "2.110";
  44
  45 # Inheritance:
  46 @ISA = qw(IO::ScalarArray);     ### also gets us new_tie  :-)
  47
  48
  49 #------------------------------
  50 #
  51 # getline
  52 #
  53 # Instance method, override.
  54 # Return the next line, or undef on end of data.
  55 # Can safely be called in an array context.
  56 # Currently, lines are delimited by "\n".
  57 #
  58 sub getline {
  59     my $self = shift;
  60
  61     if (!defined $/) {
  62         return join( '', $self->_getlines_for_newlines );
  63     }
  64     elsif ($/ eq "\n") {
  65         if (!*$self->{Pos}) {      ### full line...
  66             return *$self->{AR}[*$self->{Str}++];
  67         }
  68         else {                     ### partial line...
  69             my $partial = substr(*$self->{AR}[*$self->{Str}++], *$self->{Pos});
  70             *$self->{Pos} = 0;
  71             return $partial;
  72         }
  73     }
  74     else {
  75         croak 'unsupported $/: must be "\n" or undef';
  76     }
  77 }
  78
  79 #------------------------------
  80 #
  81 # getlines
  82 #
  83 # Instance method, override.
  84 # Return an array comprised of the remaining lines, or () on end of data.
  85 # Must be called in an array context.
  86 # Currently, lines are delimited by "\n".
  87 #
  88 sub getlines {
  89     my $self = shift;
  90     wantarray or croak("can't call getlines in scalar context!");
  91
  92     if ((defined $/) and ($/ eq "\n")) {
  93         return $self->_getlines_for_newlines(@_);
  94     }
  95     else {         ### slow but steady
  96         return $self->SUPER::getlines(@_);
  97     }
  98 }
  99
 100 #------------------------------
 101 #
 102 # _getlines_for_newlines
 103 #
 104 # Instance method, private.
 105 # If $/ is newline, do fast getlines.
 106 # This CAN NOT invoke getline!
 107 #
 108 sub _getlines_for_newlines {
 109     my $self = shift;
 110     my ($rArray, $Str, $Pos) = @{*$self}{ qw( AR Str Pos ) };
 111     my @partial = ();
 112
 113     if ($Pos) {                         ### partial line...
 114         @partial = (substr( $rArray->[ $Str++ ], $Pos ));
 115         *$self->{Pos} = 0;
 116     }
 117     *$self->{Str} = scalar @$rArray;    ### about to exhaust @$rArray
 118     return (@partial,
 119             @$rArray[ $Str .. $#$rArray ]);     ### remaining full lines...
 120 }
 121
 122 #------------------------------
 123 #
 124 # print ARGS...
 125 #
 126 # Instance method, override.
 127 # Print ARGS to the underlying line array.
 128 #
 129 sub print {
 130     if (defined $\ && $\ ne "\n") {
 131         croak 'unsupported $\: must be "\n" or undef';
 132     }
 133
 134     my $self = shift;
 135     ### print STDERR "\n[[ARRAY WAS...\n", @{*$self->{AR}}, "<<EOF>>\n";
 136     my @lines = split /^/, join('', @_); @lines or return 1;
 137
 138     ### Did the previous print not end with a newline?
 139     ### If so, append first line:
 140     if (@{*$self->{AR}} and (*$self->{AR}[-1] !~ /\n\Z/)) {
 141         *$self->{AR}[-1] .= shift @lines;
 142     }
 143     push @{*$self->{AR}}, @lines;       ### add the remainder
 144     ### print STDERR "\n[[ARRAY IS NOW...\n", @{*$self->{AR}}, "<<EOF>>\n";
 145     1;
 146 }
 147
 148 #------------------------------
 149 1;
 150
 151 __END__
 152
 153
 154 =head1 VERSION
 155
 156 $Id: Lines.pm,v 1.3 2005/02/10 21:21:53 dfs Exp $
 157
 158
 159 =head1 AUTHORS
 160
 161
 162 =head2 Primary Maintainer
 163
 164 David F. Skoll (F<dfs@roaringpenguin.com>).
 165
 166 =head2 Principal author
 167
 168 Eryq (F<eryq@zeegee.com>).
 169 President, ZeeGee Software Inc (F<http://www.zeegee.com>).
 170
 171
 172 =head2 Other contributors
 173
 174 Thanks to the following individuals for their invaluable contributions
 175 (if I've forgotten or misspelled your name, please email me!):
 176
 177 I<Morris M. Siegel,>
 178 for his $/ patch and the new C<getlines()>.
 179
 180 I<Doug Wilson,>
 181 for the IO::Handle inheritance and automatic tie-ing.
 182
 183 =cut
 184