view release on metacpan or  search on metacpan

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

use warnings;
use 5.020;
use experimental qw( postderef signatures );

package Archive::Libarchive::Compress 0.01 {

  use Carp ();
  use Path::Tiny ();
  use File::chdir;
  use Ref::Util qw( is_ref is_plain_scalarref is_plain_coderef );
  use Archive::Libarchive 0.04 qw( ARCHIVE_OK ARCHIVE_WARN );
  use FFI::C::Stat;

  # ABSTRACT: Recursively archive a directory (using libarchive)


  sub new ($class, %options) {
      Carp::croak("Required option: one of filename or memory")
        unless defined($options{filename} // $options{memory});
      Carp::croak("Exactly one of filename or memory is required")
        if defined($options{filename}) && defined($options{memory});

      if(defined $options{memory} && !(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");
      }

      Carp::croak("Entry is not a code reference")
        if defined $options{entry} && !is_plain_coderef $options{entry};

      my $self = bless {
        filename   => delete $options{filename},
        entry      => delete($options{entry}) // sub ($e) { return 1 },
        memory     => delete $options{memory},
        prep       => delete($options{prep}) // sub ($ar) { $ar->set_format_pax_restricted },
      }, $class;

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

      return $self;
  }


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

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

    $self->{prep}->($w);

    my $ret;

    if($self->filename) {
      $ret = $w->open_filename($self->filename);
    } else {
      $ret = $w->open_memory($self->{memory});
    }

    if($ret == ARCHIVE_WARN) {
      Carp::carp($w->error_string);
    } elsif($ret < ARCHIVE_WARN) {
      Carp::croak($w->error_string);
    }

    return($w,$e);
  }

  sub _iterate ($self, $w, $e, $path) {