<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package IO::InnerFile;

=head1 NAME

IO::InnerFile - define a file inside another file


=head1 SYNOPSIS


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


=head1 DESCRIPTION

If you have a filehandle that can seek() and tell(), then you 
can open an IO::InnerFile on a range of the underlying file.


=head1 PUBLIC INTERFACE

=over

=cut

use Symbol;

# The package version, both in 1.23 style *and* usable by MakeMaker:
$VERSION = "2.110";

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

=item new FILEHANDLE, [START, [LENGTH]]

I&lt;Class method, constructor.&gt;
Create a new inner-file opened on the given FILEHANDLE,
from bytes START to START+LENGTH.  Both START and LENGTH
default to 0; negative values are silently coerced to zero.

Note that FILEHANDLE must be able to seek() and tell(), in addition
to whatever other methods you may desire for reading it.

=cut

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 "object":
   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'); 
}

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

=item set_length LENGTH

=item get_length 

=item add_length NBYTES

I&lt;Instance methods.&gt;
Get/set the virtual length of the inner file.

=cut

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

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

=item set_start START

=item get_start 

=item add_start NBYTES

I&lt;Instance methods.&gt;
Get/set the virtual start position of the inner file.

=cut

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}; }


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

=item binmode

=item close

=item flush

=item getc

=item getline

=item print LIST

=item printf LIST

=item read BUF, NBYTES

=item readline

=item seek OFFFSET, WHENCE

=item tell

=item write ARGS...

I&lt;Instance methods.&gt;
Standard filehandle methods.

=cut

sub write    { shift-&gt;WRITE(@_) }
sub print    { shift-&gt;PRINT(@_) }
sub printf   { shift-&gt;PRINTF(@_) }
sub flush    { "0 but true"; }
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 "inner files can only open for reading\n";
}

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

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

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 undef if ($self-&gt;{CRPOS} &gt;= $self-&gt;{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...
    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__

=back


=head1 VERSION

$Id: InnerFile.pm,v 1.4 2005/02/10 21:21:53 dfs Exp $


=head1 AUTHOR

Original version by Doru Petrescu (pdoru@kappa.ro).

Documentation and by Eryq (eryq@zeegee.com).

Currently maintained by David F. Skoll (dfs@roaringpenguin.com).

=cut


</pre></body></html>