YenForYang has asked for the wisdom of the Perl Monks concerning the following question:

I'm currently having trouble translating this Perl "complete extractor" example to one that extracts to a directory specified (and if the directory specified doesn't exist, create it)

Here's the example from Archive::Libarchive::XS (which is translated from a Libarchive wiki page on Github):

use strict; use warnings; use Archive::Libarchive::XS ':all'; # this is a translation to Perl for this: # https://github.com/libarchive/libarchive/wiki/Examples#wiki-A_Comple +te_Extractor my $filename = shift @ARGV; unless(defined $filename) { warn "reading archive from standard in"; } my $r; my $flags = ARCHIVE_EXTRACT_TIME | ARCHIVE_EXTRACT_PERM | ARCHIVE_EXTRACT_ACL | ARCHIVE_EXTRACT_FFLAGS; my $a = archive_read_new(); archive_read_support_filter_all($a); archive_read_support_format_all($a); my $ext = archive_write_disk_new(); archive_write_disk_set_options($ext, $flags); archive_write_disk_set_standard_lookup($ext); $r = archive_read_open_filename($a, $filename, 10240); if($r != ARCHIVE_OK) { die "error opening $filename: ", archive_error_string($a); } while(1) { $r = archive_read_next_header($a, my $entry); if($r == ARCHIVE_EOF) { last; } if($r != ARCHIVE_OK) { print archive_error_string($a), "\n"; } if($r < ARCHIVE_WARN) { exit 1; } $r = archive_write_header($ext, $entry); if($r != ARCHIVE_OK) { print archive_error_string($ext), "\n"; } elsif(archive_entry_size($entry) > 0) { copy_data($a, $ext); } } archive_read_close($a); archive_read_free($a); archive_write_close($ext); archive_write_free($ext); sub copy_data { my($ar, $aw) = @_; my $r; while(1) { $r = archive_read_data_block($ar, my $buff, my $offset); if($r == ARCHIVE_EOF) { return; } if($r != ARCHIVE_OK) { die archive_error_string($ar), "\n"; } $r = archive_write_data_block($aw, $buff, $offset); if($r != ARCHIVE_OK) { die archive_error_string($aw), "\n"; } } }

The old Archive::Extract::Libarchive has the functionality I'm looking for written in XS code, and doesn't use Archive::Libarchive::XS (as far as I know):

The problem is I'm not familiar with XS at all (nor really C--I'm fairly new to programming in general), and am unsure of how to "map" the XS code to Archive::Libarchive::XS:

#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include <archive.h> #include <archive_entry.h> #include "ppport.h" int DEBUG = 0; typedef struct archive* Archive__Peek__Libarchive; struct archive* _open_file(const char * filename) { struct archive *a; int r; a = archive_read_new(); archive_read_support_compression_all(a); archive_read_support_format_all(a); if ((r = archive_read_open_file(a, filename, 10240))) { croak(archive_error_string(a)); } return a; } void _close_file(struct archive* a) { archive_read_close(a); archive_read_finish(a); } static int _copy_data(struct archive *ar, struct archive *aw) { int r; const void *buff; size_t size; off_t offset; for (;;) { r = archive_read_data_block(ar, &buff, &size, &offset); if (r == ARCHIVE_EOF) return (ARCHIVE_OK); if (r != ARCHIVE_OK) return (r); r = archive_write_data_block(aw, buff, size, offset); if (r != ARCHIVE_OK) { warn("archive_write_data_block()", archive_error_string(aw)); return (r); } } } MODULE = Archive::Extract::Libarchive PACKAGE = Archive::Extract::Libarchive void _extract(const char * filename, const char * path) PPCODE: struct archive *a; struct archive *ext; struct archive_entry *entry; SV *path_sv; int r; int flags; a = _open_file(filename); flags = ARCHIVE_EXTRACT_TIME | ARCHIVE_EXTRACT_PERM | ARCHIVE_EXTRACT_ACL | ARCHIVE_EXTRACT_FFLAGS; ext = archive_write_disk_new(); archive_write_disk_set_options(ext, flags); archive_write_disk_set_standard_lookup(ext); for (;;) { r = archive_read_next_header(a, &entry); if (r == ARCHIVE_EOF) break; if (r != ARCHIVE_OK) croak(archive_error_string(a)); if (archive_entry_filetype(entry) == AE_IFREG) { mXPUSHs(newSVpv(archive_entry_pathname(entry), 0)); } path_sv = newSVpv(path, 0); sv_catpvs(path_sv, "/"); sv_catpv(path_sv, archive_entry_pathname(entry)); archive_entry_set_pathname(entry, SvPV_nolen(path_sv)); sv_free(path_sv); r = archive_write_header(ext, entry); if (r != ARCHIVE_OK) croak(archive_error_string(ext)); _copy_data(a, ext); r = archive_write_finish_entry(ext); if (r != ARCHIVE_OK) croak(archive_error_string(ext)); } _close_file(a); archive_write_close(ext); archive_write_finish(ext);

Note the high similarity between the XS code from Archive::Extract::Libarchive and the Perl code from Archive::Libarchive::XS.

I'm trying to replace my usage of Archive::Extract::Libarchive with Archive::Libarchive::XS (which is favorable for many reasons).

Thanks.

EDIT:

I think I've found the critical part in the XS code that does what I want:

path_sv = newSVpv(path, 0); sv_catpvs(path_sv, "/"); sv_catpv(path_sv, archive_entry_pathname(entry)); archive_entry_set_pathname(entry, SvPV_nolen(path_sv)); sv_free(path_sv);

By the way, if anyone is familiar with libarchive and knows how I can condense the Perl code somewhat to be more concise (using "convenience functions" like archive_read_extract or something like that), let me know. I can't find any extraction code beyond the examples on Github.

Replies are listed 'Best First'.
Re: Extracting to a specific directory using Archive::Libarchive::XS
by YenForYang (Beadle) on Dec 03, 2017 at 20:48 UTC

    Alright guys I ended up just inserting archive_entry_set_pathname($entry, $path . '/' . archive_entry_pathname($entry)); before archive_write_header().

    If anyone has any tips or changes that could improve the original complete_extractor.pl, please feel free to let me know.