view release on metacpan or  search on metacpan

lib/Archive/Libarchive/Peek.pm  view on Meta::CPAN

package Archive::Libarchive::Peek;

use strict;
use warnings;
use Archive::Libarchive 0.03 qw( ARCHIVE_OK ARCHIVE_WARN ARCHIVE_EOF );
use Ref::Util qw( is_plain_coderef is_plain_arrayref is_plain_scalarref is_ref );
use Carp ();
use Path::Tiny ();
use 5.022;
use experimental qw( signatures refaliasing postderef );

# ABSTRACT: Peek into archives without extracting them
our $VERSION = '0.04'; # VERSION


sub new ($class, %options)
{
  Carp::croak("Required option: one of filename or memory")
    unless defined $options{filename} || defined $options{memory};

  Carp::croak("Exactly one of filename or memory is required")
    if defined $options{filename} && defined $options{memory};

  if(defined $options{filename})
  {
    foreach my $filename (@{ is_plain_arrayref($options{filename}) ? $options{filename} : [$options{filename}] })
    {
      Carp::croak("Missing or unreadable: $filename")
        unless -r $filename;
    }
  }
  elsif(!(is_plain_scalarref $options{memory} && defined $options{memory}->$* && !is_ref $options{memory}->$*))
  {
    Carp::croak("Option memory must be a scalar reference to a plain non-reference scalar");
  }

  my $self = bless {
    filename   => delete $options{filename},
    passphrase => delete $options{passphrase},
    memory     => delete $options{memory},
  }, $class;

  Carp::croak("Illegal options: @{[ sort keys %options ]}")
    if %options;

  return $self;
}


sub filename ($self)
{
  return $self->{filename};
}


sub _archive ($self)
{
  my $r = Archive::Libarchive::ArchiveRead->new;
  my $e = Archive::Libarchive::Entry->new;

  $r->support_filter_all;
  $r->support_format_all;

  if($self->{passphrase})
  {
    if(is_plain_coderef $self->{passphrase})