#!/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__
[download]