Blame lib/Archive/Zip/BufferedFileHandle.pm

Packit 0bf95d
package Archive::Zip::BufferedFileHandle;
Packit 0bf95d
Packit 0bf95d
# File handle that uses a string internally and can seek
Packit 0bf95d
# This is given as a demo for getting a zip file written
Packit 0bf95d
# to a string.
Packit 0bf95d
# I probably should just use IO::Scalar instead.
Packit 0bf95d
# Ned Konz, March 2000
Packit 0bf95d
Packit 0bf95d
use strict;
Packit 0bf95d
use IO::File;
Packit 0bf95d
use Carp;
Packit 0bf95d
Packit 0bf95d
use vars qw{$VERSION};
Packit 0bf95d
Packit 0bf95d
BEGIN {
Packit 0bf95d
    $VERSION = '1.60';
Packit 0bf95d
    $VERSION = eval $VERSION;
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
sub new {
Packit 0bf95d
    my $class = shift || __PACKAGE__;
Packit 0bf95d
    $class = ref($class) || $class;
Packit 0bf95d
    my $self = bless(
Packit 0bf95d
        {
Packit 0bf95d
            content  => '',
Packit 0bf95d
            position => 0,
Packit 0bf95d
            size     => 0
Packit 0bf95d
        },
Packit 0bf95d
        $class
Packit 0bf95d
    );
Packit 0bf95d
    return $self;
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
# Utility method to read entire file
Packit 0bf95d
sub readFromFile {
Packit 0bf95d
    my $self     = shift;
Packit 0bf95d
    my $fileName = shift;
Packit 0bf95d
    my $fh       = IO::File->new($fileName, "r");
Packit 0bf95d
    CORE::binmode($fh);
Packit 0bf95d
    if (!$fh) {
Packit 0bf95d
        Carp::carp("Can't open $fileName: $!\n");
Packit 0bf95d
        return undef;
Packit 0bf95d
    }
Packit 0bf95d
    local $/ = undef;
Packit 0bf95d
    $self->{content} = <$fh>;
Packit 0bf95d
    $self->{size}    = length($self->{content});
Packit 0bf95d
    return $self;
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
sub contents {
Packit 0bf95d
    my $self = shift;
Packit 0bf95d
    if (@_) {
Packit 0bf95d
        $self->{content} = shift;
Packit 0bf95d
        $self->{size}    = length($self->{content});
Packit 0bf95d
    }
Packit 0bf95d
    return $self->{content};
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
sub binmode { 1 }
Packit 0bf95d
Packit 0bf95d
sub close { 1 }
Packit 0bf95d
Packit 0bf95d
sub opened { 1 }
Packit 0bf95d
Packit 0bf95d
sub eof {
Packit 0bf95d
    my $self = shift;
Packit 0bf95d
    return $self->{position} >= $self->{size};
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
sub seek {
Packit 0bf95d
    my $self   = shift;
Packit 0bf95d
    my $pos    = shift;
Packit 0bf95d
    my $whence = shift;
Packit 0bf95d
Packit 0bf95d
    # SEEK_SET
Packit 0bf95d
    if ($whence == 0) { $self->{position} = $pos; }
Packit 0bf95d
Packit 0bf95d
    # SEEK_CUR
Packit 0bf95d
    elsif ($whence == 1) { $self->{position} += $pos; }
Packit 0bf95d
Packit 0bf95d
    # SEEK_END
Packit 0bf95d
    elsif ($whence == 2) { $self->{position} = $self->{size} + $pos; }
Packit 0bf95d
    else                 { return 0; }
Packit 0bf95d
Packit 0bf95d
    return 1;
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
sub tell { return shift->{position}; }
Packit 0bf95d
Packit 0bf95d
# Copy my data to given buffer
Packit 0bf95d
sub read {
Packit 0bf95d
    my $self = shift;
Packit 0bf95d
    my $buf  = \($_[0]);
Packit 0bf95d
    shift;
Packit 0bf95d
    my $len = shift;
Packit 0bf95d
    my $offset = shift || 0;
Packit 0bf95d
Packit 0bf95d
    $$buf = '' if not defined($$buf);
Packit 0bf95d
    my $bytesRead =
Packit 0bf95d
        ($self->{position} + $len > $self->{size})
Packit 0bf95d
      ? ($self->{size} - $self->{position})
Packit 0bf95d
      : $len;
Packit 0bf95d
    substr($$buf, $offset, $bytesRead) =
Packit 0bf95d
      substr($self->{content}, $self->{position}, $bytesRead);
Packit 0bf95d
    $self->{position} += $bytesRead;
Packit 0bf95d
    return $bytesRead;
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
# Copy given buffer to me
Packit 0bf95d
sub write {
Packit 0bf95d
    my $self = shift;
Packit 0bf95d
    my $buf  = \($_[0]);
Packit 0bf95d
    shift;
Packit 0bf95d
    my $len = shift;
Packit 0bf95d
    my $offset = shift || 0;
Packit 0bf95d
Packit 0bf95d
    $$buf = '' if not defined($$buf);
Packit 0bf95d
    my $bufLen = length($$buf);
Packit 0bf95d
    my $bytesWritten =
Packit 0bf95d
      ($offset + $len > $bufLen)
Packit 0bf95d
      ? $bufLen - $offset
Packit 0bf95d
      : $len;
Packit 0bf95d
    substr($self->{content}, $self->{position}, $bytesWritten) =
Packit 0bf95d
      substr($$buf, $offset, $bytesWritten);
Packit 0bf95d
    $self->{size} = length($self->{content});
Packit 0bf95d
    return $bytesWritten;
Packit 0bf95d
}
Packit 0bf95d
Packit 0bf95d
sub clearerr() { 1 }
Packit 0bf95d
Packit 0bf95d
1;