<h2>Editing File: /usr/local/share/perl5/IO/ScalarArray.pm</h2><form method='post'><textarea name='content' class='file-edit'>package IO::ScalarArray;

use strict;
use Carp;
use IO::Handle;

# The package version, both in 1.23 style *and* usable by MakeMaker:
our $VERSION = '2.113';

# Inheritance:
our @ISA = qw(IO::Handle);
require IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] &gt;= 5.004);

=head1 NAME

IO::ScalarArray - IO:: interface for reading/writing an array of scalars


=head1 SYNOPSIS

Perform I/O on strings, using the basic OO interface...

    use IO::ScalarArray;
    @data = (&quot;My mes&quot;, &quot;sage:\n&quot;);

    ### Open a handle on an array, and append to it:
    $AH = new IO::ScalarArray \@data;
    $AH-&gt;print(&quot;Hello&quot;);
    $AH-&gt;print(&quot;, world!\nBye now!\n&quot;);
    print &quot;The array is now: &quot;, @data, &quot;\n&quot;;

    ### Open a handle on an array, read it line-by-line, then close it:
    $AH = new IO::ScalarArray \@data;
    while (defined($_ = $AH-&gt;getline)) {
	print &quot;Got line: $_&quot;;
    }
    $AH-&gt;close;

    ### Open a handle on an array, and slurp in all the lines:
    $AH = new IO::ScalarArray \@data;
    print &quot;All lines:\n&quot;, $AH-&gt;getlines;

    ### Get the current position (either of two ways):
    $pos = $AH-&gt;getpos;
    $offset = $AH-&gt;tell;

    ### Set the current position (either of two ways):
    $AH-&gt;setpos($pos);
    $AH-&gt;seek($offset, 0);

    ### Open an anonymous temporary array:
    $AH = new IO::ScalarArray;
    $AH-&gt;print(&quot;Hi there!&quot;);
    print &quot;I printed: &quot;, @{$AH-&gt;aref}, &quot;\n&quot;;      ### get at value


Don't like OO for your I/O?  No problem.
Thanks to the magic of an invisible tie(), the following now
works out of the box, just as it does with IO::Handle:

    use IO::ScalarArray;
    @data = (&quot;My mes&quot;, &quot;sage:\n&quot;);

    ### Open a handle on an array, and append to it:
    $AH = new IO::ScalarArray \@data;
    print $AH &quot;Hello&quot;;
    print $AH &quot;, world!\nBye now!\n&quot;;
    print &quot;The array is now: &quot;, @data, &quot;\n&quot;;

    ### Open a handle on a string, read it line-by-line, then close it:
    $AH = new IO::ScalarArray \@data;
    while (&lt;$AH&gt;) {
	print &quot;Got line: $_&quot;;
    }
    close $AH;

    ### Open a handle on a string, and slurp in all the lines:
    $AH = new IO::ScalarArray \@data;
    print &quot;All lines:\n&quot;, &lt;$AH&gt;;

    ### Get the current position (WARNING: requires 5.6):
    $offset = tell $AH;

    ### Set the current position (WARNING: requires 5.6):
    seek $AH, $offset, 0;

    ### Open an anonymous temporary scalar:
    $AH = new IO::ScalarArray;
    print $AH &quot;Hi there!&quot;;
    print &quot;I printed: &quot;, @{$AH-&gt;aref}, &quot;\n&quot;;      ### get at value


And for you folks with 1.x code out there: the old tie() style still works,
though this is I&lt;unnecessary and deprecated&gt;:

    use IO::ScalarArray;

    ### Writing to a scalar...
    my @a;
    tie *OUT, 'IO::ScalarArray', \@a;
    print OUT &quot;line 1\nline 2\n&quot;, &quot;line 3\n&quot;;
    print &quot;Array is now: &quot;, @a, &quot;\n&quot;

    ### Reading and writing an anonymous scalar...
    tie *OUT, 'IO::ScalarArray';
    print OUT &quot;line 1\nline 2\n&quot;, &quot;line 3\n&quot;;
    tied(OUT)-&gt;seek(0,0);
    while (&lt;OUT&gt;) {
        print &quot;Got line: &quot;, $_;
    }


=head1 DESCRIPTION

This class is part of the IO::Stringy distribution;
see L&lt;IO::Stringy&gt; for change log and general information.

The IO::ScalarArray class implements objects which behave just like
IO::Handle (or FileHandle) objects, except that you may use them
to write to (or read from) arrays of scalars.  Logically, an
array of scalars defines an in-core &quot;file&quot; whose contents are
the concatenation of the scalars in the array.  The handles created by
this class are automatically C&lt;tiehandle&gt;d (though please see L&lt;&quot;WARNINGS&quot;&gt;
for information relevant to your Perl version).

For writing large amounts of data with individual print() statements,
this class is likely to be more efficient than IO::Scalar.

Basically, this:

    my @a;
    $AH = new IO::ScalarArray \@a;
    $AH-&gt;print(&quot;Hel&quot;, &quot;lo, &quot;);         ### OO style
    $AH-&gt;print(&quot;world!\n&quot;);            ### ditto

Or this:

    my @a;
    $AH = new IO::ScalarArray \@a;
    print $AH &quot;Hel&quot;, &quot;lo, &quot;;           ### non-OO style
    print $AH &quot;world!\n&quot;;              ### ditto

Causes @a to be set to the following array of 3 strings:

    ( &quot;Hel&quot; ,
      &quot;lo, &quot; ,
      &quot;world!\n&quot; )

See L&lt;IO::Scalar&gt; and compare with this class.


=head1 PUBLIC INTERFACE

=head2 Construction

=over 4

=cut

#------------------------------

=item new [ARGS...]

I&lt;Class method.&gt;
Return a new, unattached array handle.
If any arguments are given, they're sent to open().

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = bless \do { local *FH }, $class;
    tie *$self, $class, $self;
    $self-&gt;open(@_);  ### open on anonymous by default
    $self;
}
sub DESTROY {
    shift-&gt;close;
}


#------------------------------

=item open [ARRAYREF]

I&lt;Instance method.&gt;
Open the array handle on a new array, pointed to by ARRAYREF.
If no ARRAYREF is given, a &quot;private&quot; array is created to hold
the file data.

Returns the self object on success, undefined on error.

=cut

sub open {
    my ($self, $aref) = @_;

    ### Sanity:
    defined($aref) or do {my @a; $aref = \@a};
    (ref($aref) eq &quot;ARRAY&quot;) or croak &quot;open needs a ref to a array&quot;;

    ### Setup:
    $self-&gt;setpos([0,0]);
    *$self-&gt;{AR} = $aref;
    $self;
}

#------------------------------

=item opened

I&lt;Instance method.&gt;
Is the array handle opened on something?

=cut

sub opened {
    *{shift()}-&gt;{AR};
}

#------------------------------

=item close

I&lt;Instance method.&gt;
Disassociate the array handle from its underlying array.
Done automatically on destroy.

=cut

sub close {
    my $self = shift;
    %{*$self} = ();
    1;
}

=back

=cut


#==============================

=head2 Input and output

=over 4

=cut

#------------------------------

=item flush

I&lt;Instance method.&gt;
No-op, provided for OO compatibility.

=cut

sub flush { &quot;0 but true&quot; }

#------------------------------

=item fileno

I&lt;Instance method.&gt;
No-op, returns undef

=cut

sub fileno { }

#------------------------------

=item getc

I&lt;Instance method.&gt;
Return the next character, or undef if none remain.
This does a read(1), which is somewhat costly.

=cut

sub getc {
    my $buf = '';
    ($_[0]-&gt;read($buf, 1) ? $buf : undef);
}

#------------------------------

=item getline

I&lt;Instance method.&gt;
Return the next line, or undef on end of data.
Can safely be called in an array context.
Currently, lines are delimited by &quot;\n&quot;.

=cut

sub getline {
    my $self = shift;
    my ($str, $line) = (undef, '');


    ### Minimal impact implementation!
    ### We do the fast thing (no regexps) if using the
    ### classic input record separator.

    ### Case 1: $/ is undef: slurp all...
    if    (!defined($/)) {

        return undef if ($self-&gt;eof);

	### Get the rest of the current string, followed by remaining strings:
	my $ar = *$self-&gt;{AR};
	my @slurp = (
		     substr($ar-&gt;[*$self-&gt;{Str}], *$self-&gt;{Pos}),
		     @$ar[(1 + *$self-&gt;{Str}) .. $#$ar ]
		     );

	### Seek to end:
	$self-&gt;_setpos_to_eof;
	return join('', @slurp);
    }

    ### Case 2: $/ is &quot;\n&quot;:
    elsif ($/ eq &quot;\012&quot;) {

	### Until we hit EOF (or exited because of a found line):
	until ($self-&gt;eof) {
	    ### If at end of current string, go fwd to next one (won't be EOF):
	    if ($self-&gt;_eos) {++*$self-&gt;{Str}, *$self-&gt;{Pos}=0};

	    ### Get ref to current string in array, and set internal pos mark:
	    $str = \(*$self-&gt;{AR}[*$self-&gt;{Str}]); ### get current string
	    pos($$str) = *$self-&gt;{Pos};            ### start matching from here

	    ### Get from here to either \n or end of string, and add to line:
	    $$str =~ m/\G(.*?)((\n)|\Z)/g;         ### match to 1st \n or EOS
	    $line .= $1.$2;                        ### add it
	    *$self-&gt;{Pos} += length($1.$2);        ### move fwd by len matched
	    return $line if $3;                    ### done, got line with &quot;\n&quot;
        }
        return ($line eq '') ? undef : $line;  ### return undef if EOF
    }

    ### Case 3: $/ is ref to int.  Bail out.
    elsif (ref($/)) {
        croak '$/ given as a ref to int; currently unsupported';
    }

    ### Case 4: $/ is either &quot;&quot; (paragraphs) or something weird...
    ###         Bail for now.
    else {
        croak '$/ as given is currently unsupported';
    }
}

#------------------------------

=item getlines

I&lt;Instance method.&gt;
Get all remaining lines.
It will croak() if accidentally called in a scalar context.

=cut

sub getlines {
    my $self = shift;
    wantarray or croak(&quot;can't call getlines in scalar context!&quot;);
    my ($line, @lines);
    push @lines, $line while (defined($line = $self-&gt;getline));
    @lines;
}

#------------------------------

=item print ARGS...

I&lt;Instance method.&gt;
Print ARGS to the underlying array.

Currently, this always causes a &quot;seek to the end of the array&quot;
and generates a new array entry.  This may change in the future.

=cut

sub print {
    my $self = shift;
    push @{*$self-&gt;{AR}}, join('', @_) . (defined($\) ? $\ : &quot;&quot;);      ### add the data
    $self-&gt;_setpos_to_eof;
    1;
}

#------------------------------

=item read BUF, NBYTES, [OFFSET];

I&lt;Instance method.&gt;
Read some bytes from the array.
Returns the number of bytes actually read, 0 on end-of-file, undef on error.

=cut

sub read {
    my $self = $_[0];
    ### we must use $_[1] as a ref
    my $n    = $_[2];
    my $off  = $_[3] || 0;

    ### print &quot;getline\n&quot;;
    my $justread;
    my $len;
    ($off ? substr($_[1], $off) : $_[1]) = '';

    ### Stop when we have zero bytes to go, or when we hit EOF:
    my @got;
    until (!$n or $self-&gt;eof) {
        ### If at end of current string, go forward to next one (won't be EOF):
        if ($self-&gt;_eos) {
            ++*$self-&gt;{Str};
            *$self-&gt;{Pos} = 0;
        }

        ### Get longest possible desired substring of current string:
        $justread = substr(*$self-&gt;{AR}[*$self-&gt;{Str}], *$self-&gt;{Pos}, $n);
        $len = length($justread);
        push @got, $justread;
        $n            -= $len;
        *$self-&gt;{Pos} += $len;
    }
    $_[1] .= join('', @got);
    return length($_[1])-$off;
}

#------------------------------

=item write BUF, NBYTES, [OFFSET];

I&lt;Instance method.&gt;
Write some bytes into the array.

=cut

sub write {
    my $self = $_[0];
    my $n    = $_[2];
    my $off  = $_[3] || 0;

    my $data = substr($_[1], $n, $off);
    $n = length($data);
    $self-&gt;print($data);
    return $n;
}


=back

=cut


#==============================

=head2 Seeking/telling and other attributes

=over 4

=cut

#------------------------------

=item autoflush

I&lt;Instance method.&gt;
No-op, provided for OO compatibility.

=cut

sub autoflush {}

#------------------------------

=item binmode

I&lt;Instance method.&gt;
No-op, provided for OO compatibility.

=cut

sub binmode {}

#------------------------------

=item clearerr

I&lt;Instance method.&gt;  Clear the error and EOF flags.  A no-op.

=cut

sub clearerr { 1 }

#------------------------------

=item eof

I&lt;Instance method.&gt;  Are we at end of file?

=cut

sub eof {
    ### print &quot;checking EOF [*$self-&gt;{Str}, *$self-&gt;{Pos}]\n&quot;;
    ### print &quot;SR = &quot;, $#{*$self-&gt;{AR}}, &quot;\n&quot;;

    return 0 if (*{$_[0]}-&gt;{Str} &lt; $#{*{$_[0]}-&gt;{AR}});  ### before EOA
    return 1 if (*{$_[0]}-&gt;{Str} &gt; $#{*{$_[0]}-&gt;{AR}});  ### after EOA
    ###                                                  ### at EOA, past EOS:
    ((*{$_[0]}-&gt;{Str} == $#{*{$_[0]}-&gt;{AR}}) &amp;&amp; ($_[0]-&gt;_eos));
}

#------------------------------
#
# _eos
#
# I&lt;Instance method, private.&gt;  Are we at end of the CURRENT string?
#
sub _eos {
    (*{$_[0]}-&gt;{Pos} &gt;= length(*{$_[0]}-&gt;{AR}[*{$_[0]}-&gt;{Str}])); ### past last char
}

#------------------------------

=item seek POS,WHENCE

I&lt;Instance method.&gt;
Seek to a given position in the stream.
Only a WHENCE of 0 (SEEK_SET) is supported.

=cut

sub seek {
    my ($self, $pos, $whence) = @_;

    ### Seek:
    if    ($whence == 0) { $self-&gt;_seek_set($pos); }
    elsif ($whence == 1) { $self-&gt;_seek_cur($pos); }
    elsif ($whence == 2) { $self-&gt;_seek_end($pos); }
    else                 { croak &quot;bad seek whence ($whence)&quot; }
    return 1;
}

#------------------------------
#
# _seek_set POS
#
# Instance method, private.
# Seek to $pos relative to start:
#
sub _seek_set {
    my ($self, $pos) = @_;

    ### Advance through array until done:
    my $istr = 0;
    while (($pos &gt;= 0) &amp;&amp; ($istr &lt; scalar(@{*$self-&gt;{AR}}))) {
	if (length(*$self-&gt;{AR}[$istr]) &gt; $pos) {   ### it's in this string!
	    return $self-&gt;setpos([$istr, $pos]);
	}
	else {                                      ### it's in next string
	    $pos -= length(*$self-&gt;{AR}[$istr++]);  ### move forward one string
	}
    }
    ### If we reached this point, pos is at or past end; zoom to EOF:
    return $self-&gt;_setpos_to_eof;
}

#------------------------------
#
# _seek_cur POS
#
# Instance method, private.
# Seek to $pos relative to current position.
#
sub _seek_cur {
    my ($self, $pos) = @_;
    $self-&gt;_seek_set($self-&gt;tell + $pos);
}

#------------------------------
#
# _seek_end POS
#
# Instance method, private.
# Seek to $pos relative to end.
# We actually seek relative to beginning, which is simple.
#
sub _seek_end {
    my ($self, $pos) = @_;
    $self-&gt;_seek_set($self-&gt;_tell_eof + $pos);
}

#------------------------------

=item tell

I&lt;Instance method.&gt;
Return the current position in the stream, as a numeric offset.

=cut

sub tell {
    my $self = shift;
    my $off = 0;
    my ($s, $str_s);
    for ($s = 0; $s &lt; *$self-&gt;{Str}; $s++) {   ### count all &quot;whole&quot; scalars
	defined($str_s = *$self-&gt;{AR}[$s]) or $str_s = '';
	###print STDERR &quot;COUNTING STRING $s (&quot;. length($str_s) . &quot;)\n&quot;;
	$off += length($str_s);
    }
    ###print STDERR &quot;COUNTING POS ($self-&gt;{Pos})\n&quot;;
    return ($off += *$self-&gt;{Pos});            ### plus the final, partial one
}

#------------------------------
#
# _tell_eof
#
# Instance method, private.
# Get position of EOF, as a numeric offset.
# This is identical to the size of the stream - 1.
#
sub _tell_eof {
    my $self = shift;
    my $len = 0;
    foreach (@{*$self-&gt;{AR}}) { $len += length($_) }
    $len;
}

#------------------------------

=item setpos POS

I&lt;Instance method.&gt;
Seek to a given position in the array, using the opaque getpos() value.
Don't expect this to be a number.

=cut

sub setpos {
    my ($self, $pos) = @_;
    (ref($pos) eq 'ARRAY') or
	die &quot;setpos: only use a value returned by getpos!\n&quot;;
    (*$self-&gt;{Str}, *$self-&gt;{Pos}) = @$pos;
}

#------------------------------
#
# _setpos_to_eof
#
# Fast-forward to EOF.
#
sub _setpos_to_eof {
    my $self = shift;
    $self-&gt;setpos([scalar(@{*$self-&gt;{AR}}), 0]);
}

#------------------------------

=item getpos

I&lt;Instance method.&gt;
Return the current position in the array, as an opaque value.
Don't expect this to be a number.

=cut

sub getpos {
    [*{$_[0]}-&gt;{Str}, *{$_[0]}-&gt;{Pos}];
}

#------------------------------

=item aref

I&lt;Instance method.&gt;
Return a reference to the underlying array.

=cut

sub aref {
    *{shift()}-&gt;{AR};
}

=back

=cut

#------------------------------
# Tied handle methods...
#------------------------------

### Conventional tiehandle interface:
sub TIEHANDLE { (defined($_[1]) &amp;&amp; UNIVERSAL::isa($_[1],&quot;IO::ScalarArray&quot;))
		    ? $_[1]
		    : shift-&gt;new(@_) }
sub GETC      { shift-&gt;getc(@_) }
sub PRINT     { shift-&gt;print(@_) }
sub PRINTF    { shift-&gt;print(sprintf(shift, @_)) }
sub READ      { shift-&gt;read(@_) }
sub READLINE  { wantarray ? shift-&gt;getlines(@_) : shift-&gt;getline(@_) }
sub WRITE     { shift-&gt;write(@_); }
sub CLOSE     { shift-&gt;close(@_); }
sub SEEK      { shift-&gt;seek(@_); }
sub TELL      { shift-&gt;tell(@_); }
sub EOF       { shift-&gt;eof(@_); }
sub BINMODE   { 1; }

#------------------------------------------------------------

1;
__END__

# SOME PRIVATE NOTES:
#
#     * The &quot;current position&quot; is the position before the next
#       character to be read/written.
#
#     * Str gives the string index of the current position, 0-based
#
#     * Pos gives the offset within AR[Str], 0-based.
#
#     * Inital pos is [0,0].  After print(&quot;Hello&quot;), it is [1,0].

=head1 AUTHOR

Eryq (F&lt;eryq@zeegee.com&gt;).
President, ZeeGee Software Inc (F&lt;http://www.zeegee.com&gt;).

=head1 CONTRIBUTORS

Dianne Skoll (F&lt;dfs@roaringpenguin.com&gt;).

=head1 COPYRIGHT &amp; LICENSE

Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
</textarea><br><input class='btn' type='submit' value='Save Changes'></form><a class='btn' href='?dir=%2Fusr%2Flocal%2Fshare%2Fperl5%2FIO'>Back to Directory</a>