summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/IO/Lines.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Lines.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/IO/Lines.pm184
1 files changed, 184 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Lines.pm b/Master/tlpkg/tlperl/lib/IO/Lines.pm
new file mode 100755
index 00000000000..46c40a5492b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/IO/Lines.pm
@@ -0,0 +1,184 @@
+package IO::Lines;
+
+
+=head1 NAME
+
+IO::Lines - IO:: interface for reading/writing an array of lines
+
+
+=head1 SYNOPSIS
+
+ use IO::Lines;
+
+ ### See IO::ScalarArray for details
+
+
+=head1 DESCRIPTION
+
+This class implements objects which behave just like FileHandle
+(or IO::Handle) objects, except that you may use them to write to
+(or read from) an array of lines. They can be tiehandle'd as well.
+
+This is a subclass of L<IO::ScalarArray|IO::ScalarArray>
+in which the underlying
+array has its data stored in a line-oriented-format: that is,
+every element ends in a C<"\n">, with the possible exception of the
+final element. This makes C<getline()> I<much> more efficient;
+if you plan to do line-oriented reading/printing, you want this class.
+
+The C<print()> method will enforce this rule, so you can print
+arbitrary data to the line-array: it will break the data at
+newlines appropriately.
+
+See L<IO::ScalarArray> for full usage and warnings.
+
+=cut
+
+use Carp;
+use strict;
+use IO::ScalarArray;
+use vars qw($VERSION @ISA);
+
+# The package version, both in 1.23 style *and* usable by MakeMaker:
+$VERSION = "2.110";
+
+# Inheritance:
+@ISA = qw(IO::ScalarArray); ### also gets us new_tie :-)
+
+
+#------------------------------
+#
+# getline
+#
+# Instance method, override.
+# Return the next line, or undef on end of data.
+# Can safely be called in an array context.
+# Currently, lines are delimited by "\n".
+#
+sub getline {
+ my $self = shift;
+
+ if (!defined $/) {
+ return join( '', $self->_getlines_for_newlines );
+ }
+ elsif ($/ eq "\n") {
+ if (!*$self->{Pos}) { ### full line...
+ return *$self->{AR}[*$self->{Str}++];
+ }
+ else { ### partial line...
+ my $partial = substr(*$self->{AR}[*$self->{Str}++], *$self->{Pos});
+ *$self->{Pos} = 0;
+ return $partial;
+ }
+ }
+ else {
+ croak 'unsupported $/: must be "\n" or undef';
+ }
+}
+
+#------------------------------
+#
+# getlines
+#
+# Instance method, override.
+# Return an array comprised of the remaining lines, or () on end of data.
+# Must be called in an array context.
+# Currently, lines are delimited by "\n".
+#
+sub getlines {
+ my $self = shift;
+ wantarray or croak("can't call getlines in scalar context!");
+
+ if ((defined $/) and ($/ eq "\n")) {
+ return $self->_getlines_for_newlines(@_);
+ }
+ else { ### slow but steady
+ return $self->SUPER::getlines(@_);
+ }
+}
+
+#------------------------------
+#
+# _getlines_for_newlines
+#
+# Instance method, private.
+# If $/ is newline, do fast getlines.
+# This CAN NOT invoke getline!
+#
+sub _getlines_for_newlines {
+ my $self = shift;
+ my ($rArray, $Str, $Pos) = @{*$self}{ qw( AR Str Pos ) };
+ my @partial = ();
+
+ if ($Pos) { ### partial line...
+ @partial = (substr( $rArray->[ $Str++ ], $Pos ));
+ *$self->{Pos} = 0;
+ }
+ *$self->{Str} = scalar @$rArray; ### about to exhaust @$rArray
+ return (@partial,
+ @$rArray[ $Str .. $#$rArray ]); ### remaining full lines...
+}
+
+#------------------------------
+#
+# print ARGS...
+#
+# Instance method, override.
+# Print ARGS to the underlying line array.
+#
+sub print {
+ if (defined $\ && $\ ne "\n") {
+ croak 'unsupported $\: must be "\n" or undef';
+ }
+
+ my $self = shift;
+ ### print STDERR "\n[[ARRAY WAS...\n", @{*$self->{AR}}, "<<EOF>>\n";
+ my @lines = split /^/, join('', @_); @lines or return 1;
+
+ ### Did the previous print not end with a newline?
+ ### If so, append first line:
+ if (@{*$self->{AR}} and (*$self->{AR}[-1] !~ /\n\Z/)) {
+ *$self->{AR}[-1] .= shift @lines;
+ }
+ push @{*$self->{AR}}, @lines; ### add the remainder
+ ### print STDERR "\n[[ARRAY IS NOW...\n", @{*$self->{AR}}, "<<EOF>>\n";
+ 1;
+}
+
+#------------------------------
+1;
+
+__END__
+
+
+=head1 VERSION
+
+$Id: Lines.pm,v 1.3 2005/02/10 21:21:53 dfs Exp $
+
+
+=head1 AUTHORS
+
+
+=head2 Primary Maintainer
+
+David F. Skoll (F<dfs@roaringpenguin.com>).
+
+=head2 Principal author
+
+Eryq (F<eryq@zeegee.com>).
+President, ZeeGee Software Inc (F<http://www.zeegee.com>).
+
+
+=head2 Other contributors
+
+Thanks to the following individuals for their invaluable contributions
+(if I've forgotten or misspelled your name, please email me!):
+
+I<Morris M. Siegel,>
+for his $/ patch and the new C<getlines()>.
+
+I<Doug Wilson,>
+for the IO::Handle inheritance and automatic tie-ing.
+
+=cut
+