|
Packit |
0bf95d |
# Prints messages on every chunk write.
|
|
Packit |
0bf95d |
# Usage:
|
|
Packit |
0bf95d |
# perl mfh.pl zipfile.zip
|
|
Packit |
0bf95d |
# $Revision: 1.4 $
|
|
Packit |
0bf95d |
use strict;
|
|
Packit |
0bf95d |
use Archive::Zip qw(:ERROR_CODES);
|
|
Packit |
0bf95d |
use Archive::Zip::MockFileHandle;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
package NedsFileHandle;
|
|
Packit |
0bf95d |
use vars qw(@ISA);
|
|
Packit |
0bf95d |
@ISA = qw( Archive::Zip::MockFileHandle );
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub writeHook {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $bytes = shift;
|
|
Packit |
0bf95d |
my $length = length($bytes);
|
|
Packit |
0bf95d |
printf "write %d bytes (position now %d)\n", $length, $self->tell();
|
|
Packit |
0bf95d |
return $length;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
package main;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $zip = Archive::Zip->new();
|
|
Packit |
0bf95d |
my $status = $zip->read($ARGV[0]);
|
|
Packit |
0bf95d |
exit $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $fh = NedsFileHandle->new();
|
|
Packit |
0bf95d |
$zip->writeToFileHandle($fh, 0);
|