view release on metacpan or  search on metacpan

lib/Archive/SCS/Zip.pm  view on Meta::CPAN

use v5.34;
use warnings;
use Object::Pad 0.73;

class Archive::SCS::Zip 1.09
  :isa( Archive::SCS::Mountable );

use builtin::compat qw( blessed true );
use stable 0.031 'isa';

use Archive::SCS::CityHash 'cityhash64';
use Archive::SCS::DirIndex;
use Carp 'croak';
use IO::Compress::Zip qw( :constants $ZipError );
use IO::Uncompress::Unzip qw( $UnzipError );
use Path::Tiny 0.054 ();

our @CARP_NOT = qw( Archive::SCS );

my $LOCAL_HEADER_SIGNATURE = "PK\x03\x04";

field $path :param :reader;
field $zip;

field %entries;
field @dirs;
field @files;

ADJUST {
  $path isa Path::Tiny && $path->exists or croak
    "Param file must be a valid Path::Tiny object";
}


method handles_path :common ($path, $header) {
  $header =~ /^\Q$LOCAL_HEADER_SIGNATURE\E/
  # According to the "appnote" spec, ZIP files don't begin with magic. Instead,
  # we'd need to scan the file's last 66 KB for the "end of central directory
  # record" signature, then heuristically determine if it looks like a ZIP file.
  # However, in practice, the overwhelming majority of ZIP files starts with a
  # "local file header" signature, which we can simply check for here.
}


method mount () {
  my $filename = $path->basename;
  $self->is_mounted and croak sprintf "%s: Already mounted", $filename;

  $zip = IO::Uncompress::Unzip->new( "$path", Append => 1 ) or croak
    "$filename: IO::Uncompress init: $UnzipError";

  my $status = 1;
  while ($status > 0) {
    my $entry = $zip->getHeaderInfo;

    my $name = $entry->{Name};
    my $is_empty = blessed $entry->{UncompressedLength} # type seems to vary by version
      ? $entry->{UncompressedLength}->isZero
      : $entry->{UncompressedLength} == 0;

    $entry->{is_dir} = $is_empty && $name =~ s|/\z||;
    $entries{ cityhash64 $name } = $entry;

    if ($entry->{is_dir}) {
      push @dirs, $name;
      next;
    }
    push @files, $name;

    $entry->{__data} = '';
    $status = $zip->read($entry->{__data}) while $status > 0;
    $status < 0 and croak
      "$filename: IO::Uncompress read ($entry->{Name}): $UnzipError ($status $!)";
  }
  continue {
    $status = $zip->nextStream;
    $status < 0 and croak
      "$filename: IO::Uncompress nextStream: $UnzipError ($!)";
  }
  $zip->close;

  return $self;
}


method unmount () {
  undef $zip;
  undef %entries;
  undef @dirs;
  undef @files;
}


method is_mounted () {
  !! $zip
}


method read_dir_tree (@roots) {