Seems to work for me , naturally it doesn't chmod/umask, not throughly tested, assumes utf8 (no easy flag I could see that signals utf8), and its a monkeypatch , unzipwin32unicode.pl
#!/usr/bin/perl --
use utf8;
use strict;
use warnings;
use Win32::Unicode();
use Archive::Zip qw(:ERROR_CODES);
my $zip = Archive::Zip->new();
my $zipName = shift || 'meat.zip';
my $status = $zip->read($zipName);
die "Read of $zipName failed\n" if $status != AZ_OK;
$zip->extractTree();
exit( 0 );
# $zip->extractTree( $root, $dest [, $volume] );
#
# $root and $dest are Unix-style.
# $volume is in local FS format.
#
sub Archive::Zip::Archive::extractTree {
package Archive::Zip::Archive;
my $self = shift;
my ( $root, $dest, $volume );
if ( ref( $_[0] ) eq 'HASH' ) {
$root = $_[0]->{root};
$dest = $_[0]->{zipName};
$volume = $_[0]->{volume};
}
else {
( $root, $dest, $volume ) = @_;
}
$root = '' unless defined($root);
$dest = './' unless defined($dest);
my $pattern = "^\Q$root";
my @members = $self->membersMatching($pattern);
foreach my $member (@members) {
my $fileName = $member->fileName(); # in Unix format
$fileName =~ s{$pattern}{$dest}; # in Unix format
# convert to platform form
+at:
$fileName = Archive::Zip::_asLocalName( $fileName, $volume );
#~ ::dd( 'fileName' => $fileName );
my $status = $member->extractToFileNamed($fileName);
return $status if $status != AZ_OK;
}
return AZ_OK;
}
sub Archive::Zip::DirectoryMember::extractToFileNamed {
package Archive::Zip::DirectoryMember;
my $self = shift;
my $name = shift; # local FS na
+me
my $attribs = $self->unixFileAttributes() & 07777;
#~ ::dd( 'name' => $name );
#~ mkpath( $name, 0, $attribs ); # croaks o
+n error
#~ utime( $self->lastModTime(), $self->lastModTime(), $name );
use Encode();
$name = Encode::decode('UTF-8', $name );
Win32::Unicode::mkpathW( $name ) or die "Cannot mkpathW( $name ):
+$!";
Win32::Unicode::utimeW( $self->lastModTime(), $self->lastModTime()
+, $name );
return AZ_OK;
}
sub Archive::Zip::Member::extractToFileNamed {
package Archive::Zip::Member;
my $self = shift;
# local FS name
my $name = ( ref( $_[0] ) eq 'HASH' ) ? $_[0]->{name} : $_[0];
$self->{'isSymbolicLink'} = 0;
# Check if the file / directory is a symbolic link or not
if ( $self->{'externalFileAttributes'} == 0xA1FF0000 ) {
$self->{'isSymbolicLink'} = 1;
$self->{'newName'} = $name;
#~ ::dd( 'newName' => $name );
#~ my ( $status, $fh ) = _newFileHandle( $name, 'r' );
#~ my $retval = $self->extractToFileHandle($fh);
my $fh = Win32::Unicode::File->new( '<', $name ); ## WHATEVER
$fh->binmode;
my $retval = $self->extractToFileHandle($fh);
$fh->close();
} else {
#return _writeSymbolicLink($self, $name) if $self->isSymbolicL
+ink();
return _error("encryption unsupported") if $self->isEncrypted(
+);
#~
#~ ::dd( 'dirname' => dirname($name) );
#~ mkpath( dirname($name) ); # croaks on error
#~ my ( $status, $fh ) = _newFileHandle( $name, 'w' );
#~ return _ioError("Can't open file $name for write") unless $
+status;
#~ my $retval = $self->extractToFileHandle($fh);
#~ $fh->close();
#~ chmod ($self->unixFileAttributes(), $name)
#~ or return _error("Can't chmod() ${name}: $!");
#~ utime( $self->lastModTime(), $self->lastModTime(), $name );
#~ return $retval;
use Encode();
$name = Encode::decode('UTF-8', $name );
my $dir = dirname($name);
Win32::Unicode::mkpathW( $dir ) or die "Cannot mkpathW( $dir):
+ $!";
my $fh = Win32::Unicode::File->new( '>', $name )
or return _ioError("Can't open file $name for write: $!");
$fh->binmode;
my $retval = $self->extractToFileHandle($fh);
$fh->close();
Win32::Unicode::utimeW( $self->lastModTime(), $self->lastModTi
+me(), $name );
return $retval;
}
}
# If I already exist, extraction is a no-op.
sub Archive::Zip::NewFileMember::extractToFileNamed {
package Archive::Zip::NewFileMember;
my $self = shift;
my $name = shift; # local FS name
#~ if ( File::Spec->rel2abs($name) eq
#~ File::Spec->rel2abs( $self->externalFileName() ) and -r $na
+me )
if ( Win32::Unicode::Util::rel2abs($name) eq
Win32::Unicode::Util::rel2abs( $self->externalFileName() )
and Win32::Unicode::File->new( '<', $name )
)
{
return AZ_OK;
}
else {
return $self->SUPER::extractToFileNamed( $name, @_ );
}
}
# Return an opened IO::Handle
# my ( $status, fh ) = _newFileHandle( 'fileName', 'w' );
# Can take a filename, file handle, or ref to GLOB
# Or, if given something that is a ref but not an IO::Handle,
# passes back the same thing.
sub Archive::Zip::_newFileHandle {
package Archive::Zip;
my $fd = shift;
my $status = 1;
my $handle;
if ( ref($fd) ) {
if ( _ISA($fd, 'IO::Scalar') or _ISA($fd, 'IO::String') ) {
$handle = $fd;
} elsif ( _ISA($fd, 'IO::Handle') or ref($fd) eq 'GLOB' ) {
$handle = IO::File->new;
$status = $handle->fdopen( $fd, @_ );
} else {
$handle = $fd;
}
} else {
#~ $handle = IO::File->new;
#~ $status = $handle->open( $fd, @_ );
my( $mode ) = @_;
my $name = Encode::decode('UTF-8', $fd );
$handle = Win32::Unicode::File->new( $mode, $name ) or do { $s
+tatus = $!; };
}
return ( $status, $handle );
}
__END__