Archive::Lha::Stream::Base - Archive::Lha::Stream::Base documentation

Archive-Lha documentation

Contained in the Archive-Lha distribution.

Index

NAME
DESCRIPTION
METHODS
- new
- open
- close
- eof
- tell
- seek
- read
- search_header
SEE ALSO
AUTHOR
COPYRIGHT AND LICENSE

Code Index:

package Archive::Lha::Stream::Base
- new
- open
- close
- search_header
- eof
- seek
- tell
- read
__END__
EOF

NAME

Archive::Lha::Stream::Base

DESCRIPTION

This is a base class for ::Stream subclasses.

METHODS

new

creates an object, and optionally opens the target.

open

takes a hash as an argument and does appropriate things for the subclass.

close

does appropriate things for the subclass.

eof

sees if the position reached end of the file/string/array.

tell

returns the current position.

seek

takes an offset as an argument and sets the position from the top.

read

takes a length as an argument and returns the chunks of the length (in bytes).

search_header

searches for the next lzh header.

SEE ALSO

Archive::Lha::Stream

AUTHOR

Kenichi Ishigaki, <ishigaki@cpan.org>

COPYRIGHT AND LICENSE

Copyright (C) 2007 by Kenichi Ishigaki.

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

Archive-Lha documentation

Contained in the Archive-Lha distribution.

package Archive::Lha::Stream::Base;

use strict;
use warnings;
use Carp;

sub new {
  my $class = shift;
  my $self  = bless {}, $class;
  $self->open(@_);
  $self;
}

sub open { croak "override" }

sub close { return }

sub search_header {
  my $self = shift;

  my $str   = '';
  my $count = 0;
  my $pos   = $self->tell;
  until ( $self->eof ) {
    $str .= $self->read(1024);
    my ($method, $level) = $str =~ /.{2}\-(lh[0567])\-.{13}(.)/s;
    if ( defined $level ) {
      $level = ord( $level );
      if ( $method && $level =~ /^(?:[0-2])$/) {
        $self->seek( $pos );
        return $level;
      }
    }
    $str = substr( $str, -21 );
    last if ++$count > 63;  # further check would be fruitless
  }
  return;
}

sub eof {
  my $self = shift;

  $self->{pos} >= $self->{length};
}

sub seek {
  my ($self, $offset) = @_;
  $self->{pos} = $offset;
}

sub tell { shift->{pos} }

sub read { croak "override" }

1;

__END__