view release on metacpan or  search on metacpan

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

package Archive::Libarchive::Lib;

use strict;
use warnings;
use 5.020;
use FFI::CheckLib 0.30 qw( find_lib_or_die );
use Encode qw( decode );
use experimental qw( signatures );

# ABSTRACT: Private class for Archive::Libarchive
our $VERSION = '0.09'; # VERSION


sub lib
{
  $ENV{ARCHIVE_LIBARCHIVE_LIB_DLL} // find_lib_or_die( lib => 'archive', symbol => ['archive_read_free','archive_write_free','archive_free'], alien => ['Alien::Libarchive3'] );
}

sub ffi
{
  state $ffi;
  $ffi ||= do {
    require FFI::Platypus;
    FFI::Platypus->VERSION('1.00');
    my $ffi = FFI::Platypus->new( api => 1 );

    # use libarchive dynamic lib
    $ffi->lib(__PACKAGE__->lib);
    # use libc
    $ffi->lib(undef);

    $ffi->load_custom_type( '::WideString', 'wstring', access => 'read' );

    # type
    $ffi->load_custom_type( '::PtrObject', 'archive'            => 'Archive::Libarchive::Archive'      );
    $ffi->load_custom_type( '::PtrObject', 'archive_read'       => 'Archive::Libarchive::ArchiveRead'  );
    $ffi->load_custom_type( '::PtrObject', 'archive_write'      => 'Archive::Libarchive::ArchiveWrite' );
    $ffi->load_custom_type( '::PtrObject', 'archive_match'      => 'Archive::Libarchive::Match' );
    $ffi->load_custom_type( '::PtrObject', 'archive_read_disk'  => 'Archive::Libarchive::DiskRead'     );
    $ffi->load_custom_type( '::PtrObject', 'archive_write_disk' => 'Archive::Libarchive::DiskWrite'    );
    $ffi->load_custom_type( '::PtrObject', 'archive_entry'      => 'Archive::Libarchive::Entry'        );

    $ffi->type( 'object(Archive::Libarchive::EntryLinkResolver)' => 'archive_entry_linkresolver' );

    $ffi->attach_cast( '_ptr_to_str', opaque => 'string' );

    $ffi->custom_type(string_utf8 => {
      native_type => 'opaque',
      native_to_perl => sub ($ptr,$) {
        my $raw = _ptr_to_str($ptr);
        decode('UTF-8', $raw, Encode::FB_CROAK);
      },
    });

    require FFI::C::Stat;
    $ffi->type('object(FFI::C::Stat)' => 'stat');

    # callbacks for both read/write
    $ffi->type('(opaque,opaque)->int'    => 'archive_open_callback'                 );
    $ffi->type('(opaque,opaque)->int'    => 'archive_close_callback'                );
    $ffi->type('(opaque,opaque)->opaque' => 'archive_passphrase_callback'           );  # actually returns a string :/

    # callbacks for write
    $ffi->type('(opaque,opaque,opaque,size_t)->ssize_t' => 'archive_write_callback' );

    # callbacks for read
    $ffi->type('(opaque,opaque,opaque)->ssize_t'    => 'archive_read_callback'      );
    $ffi->type('(opaque,opaque,sint64)->ssize_t'    => 'archive_skip_callback'      );
    $ffi->type('(opaque,opaque,sint64,int)->sint64' => 'archive_seek_callback'      );

    if($Archive::Libarchive::no_gen)
    {
      $ffi->type('int', $_) for qw( archive_entry_digest_t archive_filter_t archive_format_t );
    }
    else
    {
      $ffi->attach( [ memcpy => 'Archive::Libarchive::ArchiveRead::_memcpy' ] => [ 'opaque', 'opaque[1]', 'size_t' ] => 'void' );
      require Archive::Libarchive::Lib::Constants;
      Archive::Libarchive::Lib::Constants->_enums($ffi);
    }

    $ffi;
  };
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Archive::Libarchive::Lib - Private class for Archive::Libarchive

=head1 VERSION

version 0.09

=head1 SYNOPSIS

 perldoc Archive::Libarchive

=head1 DESCRIPTION

There is nothing to see here.  Please see the main documentation page at
L<Archive::Libarchive>.

=head1 SEE ALSO

=over 4

=item L<Archive::Libarchive::Peek>

Provides an interface for listing and retrieving entries from an archive without extracting them to the local filesystem.

=item L<Archive::Libarchive::Extract>

Provides an interface for extracting arbitrary archives of any format/filter supported by C<libarchive>.

=item L<Archive::Libarchive::Unwrap>

Decompresses / unwraps files that have been compressed or wrapped in any of the filter formats supported by C<libarchive>