home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 December / PCpro_2006_12.ISO / ossdvd / server / Perl2 / site / lib / Archive / Zip / BufferedFileHandle.pm next >
Encoding:
Text File  |  2001-07-13  |  2.4 KB  |  127 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.3 $
  8.  
  9. use strict;
  10. package Archive::Zip::BufferedFileHandle;
  11. use FileHandle ();
  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 = FileHandle->new($fileName, "r");
  32.     if (! $fh)
  33.     {
  34.         Carp::carp("Can't open $fileName: $!\n");
  35.         return undef;
  36.     }
  37.     local $/ = undef;
  38.     $self->{content} = <$fh>;
  39.     $self->{size} = length($self->{content});
  40.     return $self;
  41. }
  42.  
  43. sub contents
  44. {
  45.     my $self = shift;
  46.     if (@_)
  47.     {
  48.         $self->{content} = shift;
  49.         $self->{size} = length($self->{content});
  50.     }
  51.     return $self->{content};
  52. }
  53.  
  54. sub binmode
  55. { 1 }
  56.  
  57. sub close
  58. { 1 }
  59.  
  60. sub eof
  61. {
  62.     my $self = shift;
  63.     return $self->{position} >= $self->{size};
  64. }
  65.  
  66. sub seek
  67. {
  68.     my $self = shift;
  69.     my $pos = shift;
  70.     my $whence = shift;
  71.  
  72.     # SEEK_SET
  73.     if ($whence == 0) { $self->{position} = $pos; }
  74.     # SEEK_CUR
  75.     elsif ($whence == 1) { $self->{position} += $pos; }
  76.     # SEEK_END
  77.     elsif ($whence == 2) { $self->{position} = $self->{size} + $pos; }
  78.     else { return 0; }
  79.  
  80.     return 1;
  81. }
  82.  
  83. sub tell
  84. { return shift->{position}; }
  85.  
  86. # Copy my data to given buffer
  87. sub read
  88. {
  89.     my $self = shift;
  90.     my $buf = \($_[0]); shift;
  91.     my $len = shift;
  92.     my $offset = shift || 0;
  93.  
  94.     $$buf = '' if not defined($$buf);
  95.     my $bytesRead = ($self->{position} + $len > $self->{size})
  96.         ? ($self->{size} - $self->{position})
  97.         : $len;
  98.     substr($$buf, $offset, $bytesRead) 
  99.         = substr($self->{content}, $self->{position}, $bytesRead);
  100.     $self->{position} += $bytesRead;
  101.     return $bytesRead;
  102. }
  103.  
  104. # Copy given buffer to me
  105. sub write
  106. {
  107.     my $self = shift;
  108.     my $buf = \($_[0]); shift;
  109.     my $len = shift;
  110.     my $offset = shift || 0;
  111.  
  112.     $$buf = '' if not defined($$buf);
  113.     my $bufLen = length($$buf);
  114.     my $bytesWritten = ($offset + $len > $bufLen)
  115.         ? $bufLen - $offset
  116.         : $len;
  117.     substr($self->{content}, $self->{position}, $bytesWritten)
  118.         = substr($$buf, $offset, $bytesWritten);
  119.     $self->{size} = length($self->{content});
  120.     return $bytesWritten;
  121. }
  122.  
  123. sub clearerr() { 1 }
  124.  
  125. # vim: ts=4 sw=4
  126. 1;
  127.