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

use strict;
use warnings;
use Symbol;

our $VERSION = '2.113';

sub new {
   my ($class, $fh, $start, $lg) = @_;
   $start = 0 if (!$start or ($start &lt; 0));
   $lg    = 0 if (!$lg    or ($lg    &lt; 0));

   ### Create the underlying &quot;object&quot;:
   my $a = {
      FH 	=&gt; 	$fh,
      CRPOS 	=&gt; 	0,
      START	=&gt;	$start,
      LG	=&gt;	$lg,
   };

   ### Create a new filehandle tied to this object:
   $fh = gensym;
   tie(*$fh, $class, $a);
   return bless($fh, $class);
}

sub TIEHANDLE {
   my ($class, $data) = @_;
   return bless($data, $class);
}

sub DESTROY {
   my ($self) = @_;
   $self-&gt;close() if (ref($self) eq 'SCALAR');
}

sub set_length { tied(${$_[0]})-&gt;{LG} = $_[1]; }
sub get_length { tied(${$_[0]})-&gt;{LG}; }
sub add_length { tied(${$_[0]})-&gt;{LG} += $_[1]; }

sub set_start  { tied(${$_[0]})-&gt;{START} = $_[1]; }
sub get_start  { tied(${$_[0]})-&gt;{START}; }
sub set_end    { tied(${$_[0]})-&gt;{LG} =  $_[1] - tied(${$_[0]})-&gt;{START}; }
sub get_end    { tied(${$_[0]})-&gt;{LG} + tied(${$_[0]})-&gt;{START}; }

sub write    { shift-&gt;WRITE(@_) }
sub print    { shift-&gt;PRINT(@_) }
sub printf   { shift-&gt;PRINTF(@_) }
sub flush    { &quot;0 but true&quot;; }
sub fileno   { }
sub binmode  { 1; }
sub getc     { return GETC(tied(${$_[0]}) ); }
sub read     { return READ(     tied(${$_[0]}), @_[1,2,3] ); }
sub readline { return READLINE( tied(${$_[0]}) ); }

sub getline  { return READLINE( tied(${$_[0]}) ); }
sub close    { return CLOSE(tied(${$_[0]}) ); }

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

   $self-&gt;{CRPOS} = $ofs if ($whence == 0);
   $self-&gt;{CRPOS}+= $ofs if ($whence == 1);
   $self-&gt;{CRPOS} = $self-&gt;{LG} + $ofs if ($whence == 2);

   $self-&gt;{CRPOS} = 0 if ($self-&gt;{CRPOS} &lt; 0);
   $self-&gt;{CRPOS} = $self-&gt;{LG} if ($self-&gt;{CRPOS} &gt; $self-&gt;{LG});
   return 1;
}

sub tell {
    return tied(${$_[0]})-&gt;{CRPOS};
}

sub WRITE  {
    die &quot;inner files can only open for reading\n&quot;;
}

sub PRINT  {
    die &quot;inner files can only open for reading\n&quot;;
}

sub PRINTF {
    die &quot;inner files can only open for reading\n&quot;;
}

sub GETC   {
    my ($self) = @_;
    return 0 if ($self-&gt;{CRPOS} &gt;= $self-&gt;{LG});

    my $data;

    ### Save and seek...
    my $old_pos = $self-&gt;{FH}-&gt;tell;
    $self-&gt;{FH}-&gt;seek($self-&gt;{CRPOS}+$self-&gt;{START}, 0);

    ### ...read...
    my $lg = $self-&gt;{FH}-&gt;read($data, 1);
    $self-&gt;{CRPOS} += $lg;

    ### ...and restore:
    $self-&gt;{FH}-&gt;seek($old_pos, 0);

    $self-&gt;{LG} = $self-&gt;{CRPOS} unless ($lg);
    return ($lg ? $data : undef);
}

sub READ   {
    my ($self, $undefined, $lg, $ofs) = @_;
    $undefined = undef;

    return 0 if ($self-&gt;{CRPOS} &gt;= $self-&gt;{LG});
    $lg = $self-&gt;{LG} - $self-&gt;{CRPOS} if ($self-&gt;{CRPOS} + $lg &gt; $self-&gt;{LG});
    return 0 unless ($lg);

    ### Save and seek...
    my $old_pos = $self-&gt;{FH}-&gt;tell;
    $self-&gt;{FH}-&gt;seek($self-&gt;{CRPOS}+$self-&gt;{START}, 0);

    ### ...read...
    $lg = $self-&gt;{FH}-&gt;read($_[1], $lg, $_[3] );
    $self-&gt;{CRPOS} += $lg;

    ### ...and restore:
    $self-&gt;{FH}-&gt;seek($old_pos, 0);

    $self-&gt;{LG} = $self-&gt;{CRPOS} unless ($lg);
    return $lg;
}

sub READLINE {
    my ($self) = @_;
    return $self-&gt;_readline_helper() unless wantarray;
    my @arr;
    while(defined(my $line = $self-&gt;_readline_helper())) {
	    push(@arr, $line);
    }
    return @arr;
}

sub _readline_helper {
    my ($self) = @_;
    return undef if ($self-&gt;{CRPOS} &gt;= $self-&gt;{LG});

    # Handle slurp mode (CPAN ticket #72710)
    if (! defined($/)) {
	    my $text;
	    $self-&gt;READ($text, $self-&gt;{LG} - $self-&gt;{CRPOS});
	    return $text;
    }

    ### Save and seek...
    my $old_pos = $self-&gt;{FH}-&gt;tell;
    $self-&gt;{FH}-&gt;seek($self-&gt;{CRPOS}+$self-&gt;{START}, 0);

    ### ...read...
    my $text = $self-&gt;{FH}-&gt;getline;

    ### ...and restore:
    $self-&gt;{FH}-&gt;seek($old_pos, 0);

    #### If we detected a new EOF ...
    unless (defined $text) {
       $self-&gt;{LG} = $self-&gt;{CRPOS};
       return undef;
    }

    my $lg=length($text);

    $lg = $self-&gt;{LG} - $self-&gt;{CRPOS} if ($self-&gt;{CRPOS} + $lg &gt; $self-&gt;{LG});
    $self-&gt;{CRPOS} += $lg;

    return substr($text, 0,$lg);
}

sub CLOSE { %{$_[0]}=(); }


1;
__END__

__END__


=head1 NAME

IO::InnerFile - define a file inside another file

=head1 SYNOPSIS

    use strict;
    use warnings;
    use IO::InnerFile;

    # Read a subset of a file:
    my $fh = _some_file_handle;
    my $start = 10;
    my $length = 50;
    my $inner = IO::InnerFile-&gt;new($fh, $start, $length);
    while (my $line = &lt;$inner&gt;) {
        # ...
    }


=head1 DESCRIPTION

If you have a file handle that can C&lt;seek&gt; and C&lt;tell&gt;, then you
can open an L&lt;IO::InnerFile&gt; on a range of the underlying file.

=head1 CONSTRUCTORS

L&lt;IO::InnerFile&gt; implements the following constructors.

=head2 new

    my $inner = IO::InnerFile-&gt;new($fh);
    $inner = IO::InnerFile-&gt;new($fh, 10);
    $inner = IO::InnerFile-&gt;new($fh, 10, 50);

Create a new L&lt;IO::InnerFile&gt; opened on the given file handle.
The file handle supplied B&lt;MUST&gt; be able to both C&lt;seek&gt; and C&lt;tell&gt;.

The second and third parameters are start and length. Both are defaulted
to zero (C&lt;0&gt;). Negative values are silently coerced to zero.

=head1 METHODS

L&lt;IO::InnerFile&gt; implements the following methods.

=head2 add_length

    $inner-&gt;add_length(30);

Add to the virtual length of the inner file by the number given in bytes.

=head2 add_start

    $inner-&gt;add_start(30);

Add to the virtual position of the inner file by the number given in bytes.

=head2 binmode

    $inner-&gt;binmode();

This is a NOOP method just to satisfy the normal L&lt;IO::File&gt; interface.

=head2 close

=head2 fileno

    $inner-&gt;fileno();

This is a NOOP method just to satisfy the normal L&lt;IO::File&gt; interface.

=head2 flush

    $inner-&gt;flush();

This is a NOOP method just to satisfy the normal L&lt;IO::File&gt; interface.

=head2 get_end

    my $num_bytes = $inner-&gt;get_end();

Get the virtual end position of the inner file in bytes.

=head2 get_length

    my $num_bytes = $inner-&gt;get_length();

Get the virtual length of the inner file in bytes.

=head2 get_start

    my $num_bytes = $inner-&gt;get_start();

Get the virtual position of the inner file in bytes.

=head2 getc

=head2 getline

=head2 print LIST

=head2 printf

=head2 read

=head2 readline

=head2 seek

=head2 set_end

    $inner-&gt;set_end(30);

Set the virtual end of the inner file in bytes (this basically just alters the length).

=head2 set_length

    $inner-&gt;set_length(30);

Set the virtual length of the inner file in bytes.

=head2 set_start

    $inner-&gt;set_start(30);

Set the virtual start position of the inner file in bytes.

=head2 tell

=head2 write

=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>