File-Raw-Archive
view release on metacpan or search on metacpan
fd = (int)fd_iv;
if (!SvOK(path_sv))
croak("File::Raw::Archive::_send_job_xs: path required");
path = SvPV(path_sv, path_len);
if (SvOK(content_sv)) {
content = SvPV(content_sv, content_len);
}
if (SvROK(xattrs_sv) && SvTYPE(SvRV(xattrs_sv)) == SVt_PVHV) {
HV *xh = (HV *)SvRV(xattrs_sv);
hv_iterinit(xh);
HE *he;
while ((he = hv_iternext(xh)) && xn < sizeof xbuf / sizeof xbuf[0]) {
I32 klen_i;
const char *k = hv_iterkey(he, &klen_i);
SV *v = hv_iterval(xh, he);
STRLEN vlen;
const char *vp = SvPV(v, vlen);
xbuf[xn].key = k;
xbuf[xn].key_len = (size_t)klen_i;
xbuf[xn].value = vp;
xbuf[xn].value_len = vlen;
xn++;
}
}
if (marshal_job(path, path_len,
content, content_len,
(uint32_t)mode_iv,
(uint64_t)mtime_iv, (uint32_t)mtime_ns_iv,
(uint32_t)uid_iv, (uint32_t)gid_iv,
(int)apply_xattrs_iv,
xbuf, xn,
&buf, &buf_len) < 0) {
croak("File::Raw::Archive::_send_job_xs: out of memory");
}
if (marshal_send(fd, buf, buf_len) < 0) {
int saved = errno;
free(buf);
errno = saved;
croak("File::Raw::Archive::_send_job_xs: pipe write: %s",
strerror(saved));
}
free(buf);
void
_worker_loop_xs(job_fd_iv, err_fd_iv)
IV job_fd_iv
IV err_fd_iv
CODE:
do_worker_loop((int)job_fd_iv, (int)err_fd_iv);
# ====================================================================
# Public top-level class methods. Each one owns the open + work + close
# lifecycle: the user never sees a Reader/Writer handle for these. The
# handle is freed via SAVEDESTRUCTOR_X so a croak inside the work
# helper cleanly closes the fd and frees the cursor.
# ====================================================================
void
list(...)
PPCODE:
{
if (items < 2)
croak("Usage: \\$class->list(\\$path, %%opts)");
if ((items - 2) % 2 != 0)
croak("File::Raw::Archive::list: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(2), items - 2);
archive_handle_t *h = open_reader(aTHX_ ST(1), opts);
SAVEDESTRUCTOR_X(free_handle_destructor, h);
SV *result = do_list(aTHX_ h);
XPUSHs(sv_2mortal(result));
XSRETURN(1);
}
IV
extract(...)
PPCODE:
{
if (items < 4)
croak("Usage: \\$class->extract(\\$path, \\$name, \\$dest, %%opts)");
if ((items - 4) % 2 != 0)
croak("File::Raw::Archive::extract: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(4), items - 4);
int apply_xattrs = 1;
SV **xv = hv_fetchs(opts, "xattrs", 0);
if (xv && *xv && SvOK(*xv)) apply_xattrs = SvTRUE(*xv) ? 1 : 0;
archive_handle_t *h = open_reader(aTHX_ ST(1), opts);
SAVEDESTRUCTOR_X(free_handle_destructor, h);
STRLEN match_len;
const char *match_name = SvPV(ST(2), match_len);
const char *dest_path = SvPV_nolen(ST(3));
IV rc = do_extract_one(aTHX_ h, match_name, match_len, dest_path,
apply_xattrs);
XPUSHs(sv_2mortal(newSViv(rc)));
XSRETURN(1);
}
IV
extract_all(...)
PPCODE:
{
if (items < 3)
croak("Usage: \\$class->extract_all(\\$path, \\$dest, %%opts)");
if ((items - 3) % 2 != 0)
croak("File::Raw::Archive::extract_all: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(3), items - 3);
int apply_xattrs = 1;
int unsafe_paths = 0;
int parallel = 1;
SV *filter = NULL;
SV **xv;
xv = hv_fetchs(opts, "xattrs", 0);
if (xv && *xv && SvOK(*xv)) apply_xattrs = SvTRUE(*xv) ? 1 : 0;
xv = hv_fetchs(opts, "unsafe_paths", 0);
if (xv && *xv && SvOK(*xv)) unsafe_paths = SvTRUE(*xv) ? 1 : 0;
xv = hv_fetchs(opts, "entry_filter", 0);
if (xv && *xv && SvOK(*xv)) filter = *xv;
xv = hv_fetchs(opts, "parallel", 0);
if (xv && *xv && SvOK(*xv)) parallel = (int)SvIV(*xv);
if (parallel > 1 && !parallel_supported()) {
warn("File::Raw::Archive: parallel extract not supported on this "
"platform; falling back to sequential\n");
parallel = 1;
}
archive_handle_t *h = open_reader(aTHX_ ST(1), opts);
SAVEDESTRUCTOR_X(free_handle_destructor, h);
STRLEN dest_len;
const char *dest = SvPV(ST(2), dest_len);
if (parallel > 1) {
do_extract_all_parallel(aTHX_ h, dest, dest_len,
parallel, apply_xattrs,
filter, unsafe_paths);
} else {
do_extract_all_seq(aTHX_ h, dest, dest_len,
apply_xattrs, unsafe_paths, filter);
}
XPUSHs(sv_2mortal(newSViv(1)));
XSRETURN(1);
}
void
each(...)
PPCODE:
{
if (items < 3)
croak("Usage: \\$class->each(\\$path, %%opts, sub { ... })");
SV *cb_sv = ST(items - 1);
if (!SvROK(cb_sv) || SvTYPE(SvRV(cb_sv)) != SVt_PVCV)
croak("File::Raw::Archive::each: last arg must be a coderef");
int opts_end = items - 1;
if ((opts_end - 2) % 2 != 0)
croak("File::Raw::Archive::each: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(2), opts_end - 2);
SV *filter = NULL;
SV **xv = hv_fetchs(opts, "entry_filter", 0);
if (xv && *xv && SvOK(*xv)) filter = *xv;
archive_handle_t *h = open_reader(aTHX_ ST(1), opts);
/* Build a Reader AV equivalent to what File::Raw::Archive->open
* returns. The Entry objects we hand to the callback link back to
* this so $entry->slurp / $entry->_skip work the same as on the
* iterator API. The Reader's DESTROY (XSUB) frees `h` via
* maybe_free_handle when the AV refcount hits zero - either at
* XSUB exit (if no Entry stashed it) or whenever the last stashed
* Entry is collected. */
AV *reader_av = newAV();
av_extend(reader_av, R_SLOT_COUNT - 1);
av_store(reader_av, R_HANDLE,
new_handle_obj(aTHX_ h, "File::Raw::Archive::Reader"));
av_store(reader_av, R_CONSUMED, newSViv(1));
av_store(reader_av, R_CLOSED, newSViv(0));
SV *reader_sv = sv_2mortal(newRV_noinc((SV *)reader_av));
sv_bless(reader_sv, gv_stashpv("File::Raw::Archive::Reader", GV_ADD));
do_each(aTHX_ h, reader_sv, cb_sv, filter);
XSRETURN_EMPTY;
}
SV *
open(...)
PPCODE:
{
if (items < 2)
croak("Usage: \\$class->open(\\$path, %%opts)");
if ((items - 2) % 2 != 0)
croak("File::Raw::Archive::open: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(2), items - 2);
archive_handle_t *h = open_reader(aTHX_ ST(1), opts);
SV *handle_sv = new_handle_obj(aTHX_ h, "File::Raw::Archive::Reader");
AV *self = newAV();
av_extend(self, R_SLOT_COUNT - 1);
av_store(self, R_HANDLE, handle_sv); /* takes ownership */
av_store(self, R_CONSUMED, newSViv(1));
av_store(self, R_CLOSED, newSViv(0));
/* R_CUR_ENTRY left empty until the first ->next. */
SV *obj = sv_bless(newRV_noinc((SV *)self),
gv_stashpv("File::Raw::Archive::Reader", GV_ADD));
XPUSHs(sv_2mortal(obj));
XSRETURN(1);
}
SV *
create(...)
PPCODE:
{
if (items < 2)
croak("Usage: \\$class->create(\\$path, %%opts)");
if ((items - 2) % 2 != 0)
croak("File::Raw::Archive::create: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(2), items - 2);
archive_handle_t *h = open_writer(aTHX_ ST(1), opts);
SV *handle_sv = new_handle_obj(aTHX_ h, "File::Raw::Archive::Writer");
AV *self = newAV();
av_extend(self, W_SLOT_COUNT - 1);
av_store(self, W_HANDLE, handle_sv);
av_store(self, W_CLOSED, newSViv(0));
SV *obj = sv_bless(newRV_noinc((SV *)self),
gv_stashpv("File::Raw::Archive::Writer", GV_ADD));
XPUSHs(sv_2mortal(obj));
XSRETURN(1);
}
# ====================================================================
MODULE = File::Raw::Archive PACKAGE = File::Raw::Archive::Reader
# ====================================================================
SV *
next(self_sv)
SV *self_sv
PREINIT:
AV *self;
SV *handle_sv;
archive_handle_t *h;
SV **handle_ref, **closed_ref, **cur_entry_ref, **consumed_ref;
CODE:
if (!SvROK(self_sv) || SvTYPE(SvRV(self_sv)) != SVt_PVAV)
croak("File::Raw::Archive::Reader::next: invalid invocant");
self = (AV *)SvRV(self_sv);
closed_ref = av_fetch(self, R_CLOSED, 0);
if (closed_ref && *closed_ref && SvTRUE(*closed_ref))
croak("File::Raw::Archive::Reader::next: reader is closed");
handle_ref = av_fetch(self, R_HANDLE, 0);
if (!handle_ref || !*handle_ref)
croak("File::Raw::Archive::Reader::next: missing handle");
handle_sv = *handle_ref;
h = unwrap_handle(aTHX_ handle_sv);
if (!h || h->is_writer)
croak("File::Raw::Archive::Reader::next: invalid handle");
/* Drain previous entry's payload if not consumed. */
cur_entry_ref = av_fetch(self, R_CUR_ENTRY, 0);
consumed_ref = av_fetch(self, R_CONSUMED, 0);
if (cur_entry_ref && *cur_entry_ref && SvOK(*cur_entry_ref) &&
(!consumed_ref || !*consumed_ref || !SvTRUE(*consumed_ref))) {
char buf[16 * 1024];
int n;
while ((n = h->plugin->read_data(aTHX_ h->plugin, h->cursor,
buf, sizeof buf)) > 0) {}
if (n < 0)
croak("File::Raw::Archive::Reader::next: read_data failed");
}
void
_mark_consumed(self_sv)
SV *self_sv
PREINIT:
AV *self;
CODE:
if (!SvROK(self_sv) || SvTYPE(SvRV(self_sv)) != SVt_PVAV) return;
self = (AV *)SvRV(self_sv);
av_store(self, R_CONSUMED, newSViv(1));
void
close(self_sv)
SV *self_sv
PREINIT:
AV *self;
SV **closed_ref, **handle_ref;
CODE:
if (!SvROK(self_sv)) return;
if (SvTYPE(SvRV(self_sv)) != SVt_PVAV) {
/* Bare blessed-IV-ref form: close it directly. */
maybe_free_handle(aTHX_ self_sv);
return;
}
self = (AV *)SvRV(self_sv);
closed_ref = av_fetch(self, R_CLOSED, 0);
if (closed_ref && *closed_ref && SvTRUE(*closed_ref)) return;
av_store(self, R_CLOSED, newSViv(1));
/* Clear cur_entry so any stashed entry's slurp fails cleanly
* rather than reading from a freed handle. */
av_store(self, R_CUR_ENTRY, &PL_sv_undef);
handle_ref = av_fetch(self, R_HANDLE, 0);
if (handle_ref && *handle_ref) maybe_free_handle(aTHX_ *handle_ref);
av_store(self, R_HANDLE, &PL_sv_undef);
void
DESTROY(self_sv)
SV *self_sv
PREINIT:
AV *self;
SV **closed_ref, **handle_ref;
CODE:
if (!SvROK(self_sv)) return;
if (SvTYPE(SvRV(self_sv)) != SVt_PVAV) {
/* Bare blessed-IV-ref handle: free underlying C struct now. */
maybe_free_handle(aTHX_ self_sv);
return;
}
self = (AV *)SvRV(self_sv);
closed_ref = av_fetch(self, R_CLOSED, 0);
if (closed_ref && *closed_ref && SvTRUE(*closed_ref)) return;
handle_ref = av_fetch(self, R_HANDLE, 0);
if (handle_ref && *handle_ref) maybe_free_handle(aTHX_ *handle_ref);
# ====================================================================
MODULE = File::Raw::Archive PACKAGE = File::Raw::Archive::Writer
# ====================================================================
void
add(...)
PPCODE:
{
if (items < 1)
croak("Usage: \\$writer->add(name => ..., content => ..., ...)");
SV *self_sv = ST(0);
if (!SvROK(self_sv) || SvTYPE(SvRV(self_sv)) != SVt_PVAV)
croak("File::Raw::Archive::Writer::add: invalid invocant");
AV *self = (AV *)SvRV(self_sv);
if ((items - 1) % 2 != 0)
croak("File::Raw::Archive::Writer::add: odd number of fields");
HV *fields = newHV();
sv_2mortal((SV *)fields);
SV *content_sv = NULL;
int i;
for (i = 1; i + 1 < items; i += 2) {
STRLEN klen;
const char *kp = SvPV(ST(i), klen);
if (klen == 7 && memcmp(kp, "content", 7) == 0) {
content_sv = ST(i + 1);
} else {
hv_store(fields, kp, klen, newSVsv(ST(i + 1)), 0);
}
}
/* Default type by name suffix or link_target presence. */
{
SV **type_ref = hv_fetchs(fields, "type", 0);
if (!type_ref || !*type_ref || !SvOK(*type_ref)) {
int type = AE_FILE;
SV **name_ref = hv_fetchs(fields, "name", 0);
SV **link_ref = hv_fetchs(fields, "link_target", 0);
int has_link = (link_ref && *link_ref && SvOK(*link_ref));
if (name_ref && *name_ref && SvOK(*name_ref)) {
STRLEN nl;
const char *np = SvPV(*name_ref, nl);
if (nl > 0 && np[nl - 1] == '/') type = AE_DIR;
else if (has_link) type = AE_SYMLINK;
else type = AE_FILE;
} else if (has_link) {
type = AE_SYMLINK;
}
hv_stores(fields, "type", newSViv(type));
}
}
/* Default mode by type. */
{
SV **mode_ref = hv_fetchs(fields, "mode", 0);
if (!mode_ref || !*mode_ref || !SvOK(*mode_ref)) {
SV **t = hv_fetchs(fields, "type", 0);
int type = (t && *t) ? (int)SvIV(*t) : AE_FILE;
IV mode = (type == AE_DIR ? 0755
: type == AE_SYMLINK ? 0777
: 0644);
hv_stores(fields, "mode", newSViv(mode));
}
}
SV **handle_ref = av_fetch(self, W_HANDLE, 0);
if (!handle_ref || !*handle_ref)
croak("File::Raw::Archive::Writer::add: missing handle");
_skip(self_sv)
SV *self_sv
ALIAS:
File::Raw::Archive::Entry::_skip = 0
File::Raw::Archive::Entry::_drain = 1
PREINIT:
AV *self, *reader_av;
SV **reader_ref, **handle_ref, **consumed_ref;
archive_handle_t *h;
char buf[16 * 1024];
int n;
CODE:
PERL_UNUSED_VAR(ix);
if (!SvROK(self_sv) || SvTYPE(SvRV(self_sv)) != SVt_PVAV) return;
self = (AV *)SvRV(self_sv);
reader_ref = av_fetch(self, E_READER, 0);
if (!reader_ref || !*reader_ref || !SvROK(*reader_ref)
|| SvTYPE(SvRV(*reader_ref)) != SVt_PVAV) return;
reader_av = (AV *)SvRV(*reader_ref);
consumed_ref = av_fetch(reader_av, R_CONSUMED, 0);
if (consumed_ref && *consumed_ref && SvTRUE(*consumed_ref)) return;
handle_ref = av_fetch(reader_av, R_HANDLE, 0);
if (!handle_ref || !*handle_ref) return;
h = unwrap_handle(aTHX_ *handle_ref);
if (!h) return;
while ((n = h->plugin->read_data(aTHX_ h->plugin, h->cursor,
buf, sizeof buf)) > 0) {}
if (n < 0)
croak("File::Raw::Archive::Entry::_skip: read_data failed");
av_store(reader_av, R_CONSUMED, newSViv(1));
SV *
_new(class_sv, reader_sv, meta_sv)
SV *class_sv
SV *reader_sv
SV *meta_sv
PREINIT:
AV *self;
const char *cls;
CODE:
cls = SvPV_nolen(class_sv);
self = newAV();
av_extend(self, E_SLOT_COUNT - 1);
av_store(self, E_READER, SvREFCNT_inc(reader_sv));
av_store(self, E_META, SvREFCNT_inc(meta_sv));
RETVAL = sv_bless(newRV_noinc((SV *)self), gv_stashpv(cls, GV_ADD));
OUTPUT:
RETVAL
# ====================================================================
MODULE = File::Raw::Archive PACKAGE = File::Raw::Archive
# ====================================================================
#
# Function-style entry points: callable as plain functions instead of
# class methods, so they slot into File::Raw's `file_<verb>` family.
# Same semantics as the matching class methods minus the leading
# `$class` arg. Imported into the caller's package via `import` below.
SV *
file_archive_open(...)
PPCODE:
{
if (items < 1)
croak("Usage: file_archive_open(\\$path, %%opts)");
if ((items - 1) % 2 != 0)
croak("file_archive_open: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(1), items - 1);
archive_handle_t *h = open_reader(aTHX_ ST(0), opts);
SV *handle_sv = new_handle_obj(aTHX_ h, "File::Raw::Archive::Reader");
AV *self = newAV();
av_extend(self, R_SLOT_COUNT - 1);
av_store(self, R_HANDLE, handle_sv);
av_store(self, R_CONSUMED, newSViv(1));
av_store(self, R_CLOSED, newSViv(0));
SV *obj = sv_bless(newRV_noinc((SV *)self),
gv_stashpv("File::Raw::Archive::Reader", GV_ADD));
XPUSHs(sv_2mortal(obj));
XSRETURN(1);
}
SV *
file_archive_create(...)
PPCODE:
{
if (items < 1)
croak("Usage: file_archive_create(\\$path, %%opts)");
if ((items - 1) % 2 != 0)
croak("file_archive_create: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(1), items - 1);
archive_handle_t *h = open_writer(aTHX_ ST(0), opts);
SV *handle_sv = new_handle_obj(aTHX_ h, "File::Raw::Archive::Writer");
AV *self = newAV();
av_extend(self, W_SLOT_COUNT - 1);
av_store(self, W_HANDLE, handle_sv);
av_store(self, W_CLOSED, newSViv(0));
SV *obj = sv_bless(newRV_noinc((SV *)self),
gv_stashpv("File::Raw::Archive::Writer", GV_ADD));
XPUSHs(sv_2mortal(obj));
XSRETURN(1);
}
SV *
file_archive_list(...)
PPCODE:
{
if (items < 1)
croak("Usage: file_archive_list(\\$path, %%opts)");
if ((items - 1) % 2 != 0)
croak("file_archive_list: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(1), items - 1);
archive_handle_t *h = open_reader(aTHX_ ST(0), opts);
SAVEDESTRUCTOR_X(free_handle_destructor, h);
SV *result = do_list(aTHX_ h);
XPUSHs(sv_2mortal(result));
XSRETURN(1);
}
IV
file_archive_extract(...)
PPCODE:
{
if (items < 3)
croak("Usage: file_archive_extract(\\$path, \\$name, \\$dest, %%opts)");
if ((items - 3) % 2 != 0)
croak("file_archive_extract: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(3), items - 3);
int apply_xattrs = 1;
SV **xv = hv_fetchs(opts, "xattrs", 0);
if (xv && *xv && SvOK(*xv)) apply_xattrs = SvTRUE(*xv) ? 1 : 0;
archive_handle_t *h = open_reader(aTHX_ ST(0), opts);
SAVEDESTRUCTOR_X(free_handle_destructor, h);
STRLEN match_len;
const char *match_name = SvPV(ST(1), match_len);
const char *dest_path = SvPV_nolen(ST(2));
IV rc = do_extract_one(aTHX_ h, match_name, match_len, dest_path,
apply_xattrs);
XPUSHs(sv_2mortal(newSViv(rc)));
XSRETURN(1);
}
IV
file_archive_extract_all(...)
PPCODE:
{
if (items < 2)
croak("Usage: file_archive_extract_all(\\$path, \\$dest, %%opts)");
if ((items - 2) % 2 != 0)
croak("file_archive_extract_all: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(2), items - 2);
int apply_xattrs = 1;
int unsafe_paths = 0;
int parallel = 1;
SV *filter = NULL;
SV **xv;
xv = hv_fetchs(opts, "xattrs", 0);
if (xv && *xv && SvOK(*xv)) apply_xattrs = SvTRUE(*xv) ? 1 : 0;
xv = hv_fetchs(opts, "unsafe_paths", 0);
if (xv && *xv && SvOK(*xv)) unsafe_paths = SvTRUE(*xv) ? 1 : 0;
xv = hv_fetchs(opts, "entry_filter", 0);
if (xv && *xv && SvOK(*xv)) filter = *xv;
xv = hv_fetchs(opts, "parallel", 0);
if (xv && *xv && SvOK(*xv)) parallel = (int)SvIV(*xv);
if (parallel > 1 && !parallel_supported()) {
warn("File::Raw::Archive: parallel extract not supported on this "
"platform; falling back to sequential\n");
parallel = 1;
}
archive_handle_t *h = open_reader(aTHX_ ST(0), opts);
SAVEDESTRUCTOR_X(free_handle_destructor, h);
STRLEN dest_len;
const char *dest = SvPV(ST(1), dest_len);
if (parallel > 1) {
do_extract_all_parallel(aTHX_ h, dest, dest_len,
parallel, apply_xattrs,
filter, unsafe_paths);
} else {
do_extract_all_seq(aTHX_ h, dest, dest_len,
apply_xattrs, unsafe_paths, filter);
}
XPUSHs(sv_2mortal(newSViv(1)));
XSRETURN(1);
}
void
file_archive_each(...)
PPCODE:
{
if (items < 2)
croak("Usage: file_archive_each(\\$path, %%opts, sub { ... })");
SV *cb_sv = ST(items - 1);
if (!SvROK(cb_sv) || SvTYPE(SvRV(cb_sv)) != SVt_PVCV)
croak("file_archive_each: last arg must be a coderef");
int opts_end = items - 1;
if ((opts_end - 1) % 2 != 0)
croak("file_archive_each: odd number of options");
HV *opts = build_opts_from_args(aTHX_ &ST(1), opts_end - 1);
SV *filter = NULL;
SV **xv = hv_fetchs(opts, "entry_filter", 0);
if (xv && *xv && SvOK(*xv)) filter = *xv;
archive_handle_t *h = open_reader(aTHX_ ST(0), opts);
/* Build a Reader AV equivalent so Entry objects can call back. */
AV *reader_av = newAV();
av_extend(reader_av, R_SLOT_COUNT - 1);
av_store(reader_av, R_HANDLE,
new_handle_obj(aTHX_ h, "File::Raw::Archive::Reader"));
av_store(reader_av, R_CONSUMED, newSViv(1));
av_store(reader_av, R_CLOSED, newSViv(0));
SV *reader_sv = sv_2mortal(newRV_noinc((SV *)reader_av));
sv_bless(reader_sv, gv_stashpv("File::Raw::Archive::Reader", GV_ADD));
do_each(aTHX_ h, reader_sv, cb_sv, filter);
XSRETURN_EMPTY;
}
# Public surface installer. Called as
# use File::Raw::Archive qw(import); # all six
# or use File::Raw::Archive qw(each list); # specific subset
# Walks the requested name list and aliases each into the caller's
# stash as `file_archive_<name>`.
void
import(...)
PPCODE:
{
/* ST(0) is the class. The rest are export-tag style names. */
static const char * const known_names[] = {
"open", "create", "list", "each", "extract", "extract_all", NULL
};
HV *caller_stash;
{
const char *caller_pkg = NULL;
#if PERL_VERSION_GE(5, 14, 0)
/* caller_cx available since 5.13.5; tie to 5.14 (first stable release) */
const PERL_CONTEXT *cx = caller_cx(0, NULL);
if (cx && CxTYPE(cx) == CXt_SUB) {
caller_pkg = HvNAME_get(CopSTASH(cx->blk_oldcop));
}
#else
/* On older Perls, PL_curcop inside an XSUB is still the caller's cop */
if (PL_curcop)
caller_pkg = HvNAME(CopSTASH(PL_curcop));
#endif
if (!caller_pkg) caller_pkg = "main";
caller_stash = gv_stashpv(caller_pkg, GV_ADD);
}
/* If only the bareword "import" is requested, install all known
* names. Otherwise install just the requested subset. */
int install_all = 0;
int i;
for (i = 1; i < items; i++) {
if (!SvOK(ST(i))) continue;
STRLEN nl;
const char *np = SvPV(ST(i), nl);
if ((nl == 6 && memcmp(np, "import", 6) == 0)
|| (nl == 4 && memcmp(np, ":all", 4) == 0)) {
install_all = 1;
break;
}
}
int n;
for (n = 0; known_names[n]; n++) {
const char *name = known_names[n];
int wanted = install_all;
if (!wanted) {
int j;
for (j = 1; j < items; j++) {
if (!SvOK(ST(j))) continue;
STRLEN nl;
const char *np = SvPV(ST(j), nl);
if (nl == strlen(name) && memcmp(np, name, nl) == 0) {
wanted = 1;
break;
}
}
}
if (!wanted) continue;
/* Source CV: File::Raw::Archive::file_archive_<name> */
char src_full[128];
snprintf(src_full, sizeof src_full,
"File::Raw::Archive::file_archive_%s", name);
( run in 2.338 seconds using v1.01-cache-2.11-cpan-4e7a2411597 )