git.maemo.org Git - dh-make-perl/blob - dev/i386/libarchive-zip-perl/libarchive-zip-perl-1.18/examples/mfh.pl

   1 # Prints messages on every chunk write.
   2 # Usage:
   3 # perl mfh.pl zipfile.zip
   4 # $Revision: 1.4 $
   5 use strict;
   6 use Archive::Zip qw(:ERROR_CODES);
   7 use Archive::Zip::MockFileHandle;
   8
   9 package NedsFileHandle;
  10 use vars qw(@ISA);
  11 @ISA = qw( Archive::Zip::MockFileHandle );
  12
  13 sub writeHook
  14 {
  15         my $self = shift;
  16         my $bytes = shift;
  17         my $length = length($bytes);
  18         printf "write %d bytes (position now %d)\n", $length, $self->tell();
  19         return $length;
  20 }
  21
  22 package main;
  23
  24 my $zip = Archive::Zip->new();
  25 my $status = $zip->read($ARGV[0]);
  26 exit $status if $status != AZ_OK;
  27
  28 my $fh = NedsFileHandle->new();
  29 $zip->writeToFileHandle($fh, 0);