X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Fi386%2Flibio-stringy-perl%2Fio-stringy-2.110%2Flib%2FIO%2FInnerFile.pm;fp=dev%2Fi386%2Flibio-stringy-perl%2Fio-stringy-2.110%2Flib%2FIO%2FInnerFile.pm;h=2023e42b8aa2e91b1260937a41409117cba3561c;hp=0000000000000000000000000000000000000000;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hpb=df794b845212301ea0d267c919232538bfef356a diff --git a/dev/i386/libio-stringy-perl/io-stringy-2.110/lib/IO/InnerFile.pm b/dev/i386/libio-stringy-perl/io-stringy-2.110/lib/IO/InnerFile.pm new file mode 100644 index 0000000..2023e42 --- /dev/null +++ b/dev/i386/libio-stringy-perl/io-stringy-2.110/lib/IO/InnerFile.pm @@ -0,0 +1,282 @@ +package IO::InnerFile; + +=head1 NAME + +IO::InnerFile - define a file inside another file + + +=head1 SYNOPSIS + + + ### Read a subset of a file: + $inner = IO::InnerFile->new($fh, $start, $length); + while (<$inner>) { + ... + } + + +=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 +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 < 0)); + $lg = 0 if (!$lg or ($lg < 0)); + + ### Create the underlying "object": + my $a = { + FH => $fh, + CRPOS => 0, + START => $start, + LG => $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->close() if (ref($self) eq 'SCALAR'); +} + +#------------------------------ + +=item set_length LENGTH + +=item get_length + +=item add_length NBYTES + +I +Get/set the virtual length of the inner file. + +=cut + +sub set_length { tied(${$_[0]})->{LG} = $_[1]; } +sub get_length { tied(${$_[0]})->{LG}; } +sub add_length { tied(${$_[0]})->{LG} += $_[1]; } + +#------------------------------ + +=item set_start START + +=item get_start + +=item add_start NBYTES + +I +Get/set the virtual start position of the inner file. + +=cut + +sub set_start { tied(${$_[0]})->{START} = $_[1]; } +sub get_start { tied(${$_[0]})->{START}; } +sub set_end { tied(${$_[0]})->{LG} = $_[1] - tied(${$_[0]})->{START}; } +sub get_end { tied(${$_[0]})->{LG} + tied(${$_[0]})->{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 +Standard filehandle methods. + +=cut + +sub write { shift->WRITE(@_) } +sub print { shift->PRINT(@_) } +sub printf { shift->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->{CRPOS} = $ofs if ($whence == 0); + $self->{CRPOS}+= $ofs if ($whence == 1); + $self->{CRPOS} = $self->{LG} + $ofs if ($whence == 2); + + $self->{CRPOS} = 0 if ($self->{CRPOS} < 0); + $self->{CRPOS} = $self->{LG} if ($self->{CRPOS} > $self->{LG}); + return 1; +} + +sub tell { + return tied(${$_[0]})->{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->{CRPOS} >= $self->{LG}); + + my $data; + + ### Save and seek... + my $old_pos = $self->{FH}->tell; + $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); + + ### ...read... + my $lg = $self->{FH}->read($data, 1); + $self->{CRPOS} += $lg; + + ### ...and restore: + $self->{FH}->seek($old_pos, 0); + + $self->{LG} = $self->{CRPOS} unless ($lg); + return ($lg ? $data : undef); +} + +sub READ { + my ($self, $undefined, $lg, $ofs) = @_; + $undefined = undef; + + return 0 if ($self->{CRPOS} >= $self->{LG}); + $lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG}); + return 0 unless ($lg); + + ### Save and seek... + my $old_pos = $self->{FH}->tell; + $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); + + ### ...read... + $lg = $self->{FH}->read($_[1], $lg, $_[3] ); + $self->{CRPOS} += $lg; + + ### ...and restore: + $self->{FH}->seek($old_pos, 0); + + $self->{LG} = $self->{CRPOS} unless ($lg); + return $lg; +} + +sub READLINE { + my ($self) = @_; + return undef if ($self->{CRPOS} >= $self->{LG}); + + ### Save and seek... + my $old_pos = $self->{FH}->tell; + $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); + + ### ...read... + my $text = $self->{FH}->getline; + + ### ...and restore: + $self->{FH}->seek($old_pos, 0); + + #### If we detected a new EOF ... + unless (defined $text) { + $self->{LG} = $self->{CRPOS}; + return undef; + } + + my $lg=length($text); + + $lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG}); + $self->{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 + +