home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Lines.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-14  |  4.2 KB  |  177 lines
  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 = substr q$Revision: 2.103 $, 10;
  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.     my $self = shift;
  131.     ### print STDERR "\n[[ARRAY WAS...\n", @{*$self->{AR}}, "<<EOF>>\n";
  132.     my @lines = split /^/, join('', @_); @lines or return 1;
  133.  
  134.     ### Did the previous print not end with a newline?  
  135.     ### If so, append first line:
  136.     if (@{*$self->{AR}} and (*$self->{AR}[-1] !~ /\n\Z/)) {
  137.     *$self->{AR}[-1] .= shift @lines;
  138.     }
  139.     push @{*$self->{AR}}, @lines;       ### add the remainder
  140.     ### print STDERR "\n[[ARRAY IS NOW...\n", @{*$self->{AR}}, "<<EOF>>\n";
  141.     1;
  142. }
  143.  
  144. #------------------------------
  145. 1;
  146.  
  147. __END__
  148.  
  149.  
  150. =head1 VERSION
  151.  
  152. $Id: Lines.pm,v 2.103 2001/08/09 08:04:44 eryq Exp $
  153.  
  154.  
  155. =head1 AUTHORS
  156.  
  157.  
  158. =head2 Principal author
  159.  
  160. Eryq (F<eryq@zeegee.com>).
  161. President, ZeeGee Software Inc (F<http://www.zeegee.com>).
  162.  
  163.  
  164. =head2 Other contributors
  165.  
  166. Thanks to the following individuals for their invaluable contributions
  167. (if I've forgotten or misspelled your name, please email me!):
  168.  
  169. I<Morris M. Siegel,>
  170. for his $/ patch and the new C<getlines()>.
  171.  
  172. I<Doug Wilson,>
  173. for the IO::Handle inheritance and automatic tie-ing.
  174.  
  175. =cut
  176.  
  177.