lib/Archive/Zip/BufferedFileHandle.pm

   1 package Archive::Zip::BufferedFileHandle;
   2
   3 # File handle that uses a string internally and can seek
   4 # This is given as a demo for getting a zip file written
   5 # to a string.
   6 # I probably should just use IO::Scalar instead.
   7 # Ned Konz, March 2000
   8
   9 use strict;
  10 use IO::File;
  11 use Carp;
  12
  13 use vars qw{$VERSION};
  14
  15 BEGIN {
  16     $VERSION = '1.26';
  17     $VERSION = eval $VERSION;
  18 }
  19
  20 sub new {
  21     my $class = shift || __PACKAGE__;
  22     $class = ref($class) || $class;
  23     my $self = bless(
  24         {
  25             content  => '',
  26             position => 0,
  27             size     => 0
  28         },
  29         $class
  30     );
  31     return $self;
  32 }
  33
  34 # Utility method to read entire file
  35 sub readFromFile {
  36     my $self     = shift;
  37     my $fileName = shift;
  38     my $fh       = IO::File->new( $fileName, "r" );
  39     CORE::binmode($fh);
  40     if ( !$fh ) {
  41         Carp::carp("Can't open $fileName: $!\n");
  42         return undef;
  43     }
  44     local $/ = undef;
  45     $self->{content} = <$fh>;
  46     $self->{size}    = length( $self->{content} );
  47     return $self;
  48 }
  49
  50 sub contents {
  51     my $self = shift;
  52     if (@_) {
  53         $self->{content} = shift;
  54         $self->{size}    = length( $self->{content} );
  55     }
  56     return $self->{content};
  57 }
  58
  59 sub binmode { 1 }
  60
  61 sub close { 1 }
  62
  63 sub opened { 1 }
  64
  65 sub eof {
  66     my $self = shift;
  67     return $self->{position} >= $self->{size};
  68 }
  69
  70 sub seek {
  71     my $self   = shift;
  72     my $pos    = shift;
  73     my $whence = shift;
  74
  75     # SEEK_SET
  76     if ( $whence == 0 ) { $self->{position} = $pos; }
  77
  78     # SEEK_CUR
  79     elsif ( $whence == 1 ) { $self->{position} += $pos; }
  80
  81     # SEEK_END
  82     elsif ( $whence == 2 ) { $self->{position} = $self->{size} + $pos; }
  83     else                   { return 0; }
  84
  85     return 1;
  86 }
  87
  88 sub tell { return shift->{position}; }
  89
  90 # Copy my data to given buffer
  91 sub read {
  92     my $self = shift;
  93     my $buf  = \( $_[0] );
  94     shift;
  95     my $len = shift;
  96     my $offset = shift || 0;
  97
  98     $$buf = '' if not defined($$buf);
  99     my $bytesRead =
 100         ( $self->{position} + $len > $self->{size} )
 101       ? ( $self->{size} - $self->{position} )
 102       : $len;
 103     substr( $$buf, $offset, $bytesRead ) =
 104       substr( $self->{content}, $self->{position}, $bytesRead );
 105     $self->{position} += $bytesRead;
 106     return $bytesRead;
 107 }
 108
 109 # Copy given buffer to me
 110 sub write {
 111     my $self = shift;
 112     my $buf  = \( $_[0] );
 113     shift;
 114     my $len = shift;
 115     my $offset = shift || 0;
 116
 117     $$buf = '' if not defined($$buf);
 118     my $bufLen = length($$buf);
 119     my $bytesWritten =
 120       ( $offset + $len > $bufLen )
 121       ? $bufLen - $offset
 122       : $len;
 123     substr( $self->{content}, $self->{position}, $bytesWritten ) =
 124       substr( $$buf, $offset, $bytesWritten );
 125     $self->{size} = length( $self->{content} );
 126     return $bytesWritten;
 127 }
 128
 129 sub clearerr() { 1 }
 130
 131 1;