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