Ancient
view release on metacpan or search on metacpan
xs/file/file.c view on Meta::CPAN
if (curr->perl_callback) {
SvREFCNT_dec(curr->perl_callback);
}
Safefree(curr);
return 1;
}
prev = curr;
curr = curr->next;
}
return 0;
}
SV* file_run_hooks(pTHX_ FileHookPhase phase, const char *path, SV *data) {
FileHookContext ctx;
FileHookEntry *entry;
SV *result = data;
file_hook_func simple_hook = NULL;
void *simple_data = NULL;
/* Check simple hooks first */
if (phase == FILE_HOOK_PHASE_READ && g_file_read_hook) {
simple_hook = g_file_read_hook;
simple_data = g_file_read_hook_data;
} else if (phase == FILE_HOOK_PHASE_WRITE && g_file_write_hook) {
simple_hook = g_file_write_hook;
simple_data = g_file_write_hook_data;
}
/* Run simple hook if present */
if (simple_hook) {
ctx.path = path;
ctx.data = result;
ctx.phase = phase;
ctx.user_data = simple_data;
ctx.cancel = 0;
result = simple_hook(aTHX_ &ctx);
if (!result || ctx.cancel) return NULL;
}
/* Run hook chain */
for (entry = g_file_hooks[phase]; entry; entry = entry->next) {
ctx.path = path;
ctx.data = result;
ctx.phase = phase;
ctx.user_data = entry->user_data;
ctx.cancel = 0;
if (entry->c_func) {
result = entry->c_func(aTHX_ &ctx);
} else if (entry->perl_callback) {
/* Call Perl callback */
dSP;
int count;
ENTER;
SAVETMPS;
PUSHMARK(SP);
mXPUSHs(newSVpv(path, 0));
mXPUSHs(SvREFCNT_inc(result));
PUTBACK;
count = call_sv(entry->perl_callback, G_SCALAR);
SPAGAIN;
if (count > 0) {
SV *ret = POPs;
if (SvOK(ret)) {
result = newSVsv(ret);
} else {
ctx.cancel = 1;
}
}
PUTBACK;
FREETMPS;
LEAVE;
}
if (!result || ctx.cancel) return NULL;
}
return result;
}
/* ============================================
Custom op support for compile-time optimization
============================================ */
/* Custom op registrations */
static XOP file_slurp_xop;
static XOP file_spew_xop;
static XOP file_exists_xop;
static XOP file_size_xop;
static XOP file_is_file_xop;
static XOP file_is_dir_xop;
static XOP file_lines_xop;
static XOP file_unlink_xop;
static XOP file_mkdir_xop;
static XOP file_rmdir_xop;
static XOP file_basename_xop;
static XOP file_dirname_xop;
static XOP file_extname_xop;
static XOP file_touch_xop;
static XOP file_mtime_xop;
static XOP file_atime_xop;
static XOP file_ctime_xop;
static XOP file_mode_xop;
static XOP file_is_link_xop;
static XOP file_is_readable_xop;
static XOP file_is_writable_xop;
static XOP file_is_executable_xop;
static XOP file_readdir_xop;
static XOP file_slurp_raw_xop;
static XOP file_copy_xop;
static XOP file_move_xop;
static XOP file_chmod_xop;
static XOP file_append_xop;
static XOP file_atomic_spew_xop;
/* Forward declarations for internal functions */
static SV* file_slurp_internal(pTHX_ const char *path);
static SV* file_slurp_raw_internal(pTHX_ const char *path);
static int file_spew_internal(pTHX_ const char *path, SV *data);
static int file_append_internal(pTHX_ const char *path, SV *data);
static IV file_size_internal(const char *path);
static IV file_mtime_internal(const char *path);
static IV file_atime_internal(const char *path);
static IV file_ctime_internal(const char *path);
static IV file_mode_internal(const char *path);
static int file_exists_internal(const char *path);
static int file_is_file_internal(const char *path);
static int file_is_dir_internal(const char *path);
static int file_is_link_internal(const char *path);
static int file_is_readable_internal(const char *path);
static int file_is_writable_internal(const char *path);
static int file_is_executable_internal(const char *path);
static AV* file_split_lines(pTHX_ SV *content);
static int file_unlink_internal(const char *path);
static int file_copy_internal(pTHX_ const char *src, const char *dst);
static int file_move_internal(pTHX_ const char *src, const char *dst);
static int file_mkdir_internal(const char *path, int mode);
static int file_rmdir_internal(const char *path);
static int file_touch_internal(const char *path);
static int file_chmod_internal(const char *path, int mode);
static AV* file_readdir_internal(pTHX_ const char *path);
static int file_atomic_spew_internal(pTHX_ const char *path, SV *data);
static SV* file_basename_internal(pTHX_ const char *path);
static SV* file_dirname_internal(pTHX_ const char *path);
static SV* file_extname_internal(pTHX_ const char *path);
/* Typedef for pp functions */
typedef OP* (*file_ppfunc)(pTHX);
/* ============================================
Custom OP implementations - fastest path
============================================ */
/* pp_file_slurp: single path arg on stack */
static OP* pp_file_slurp(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
SV *result = file_slurp_internal(aTHX_ path);
PUSHs(sv_2mortal(result));
PUTBACK;
return NORMAL;
}
/* pp_file_spew: path and data on stack */
static OP* pp_file_spew(pTHX) {
dSP;
SV *data = POPs;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
if (file_spew_internal(aTHX_ path, data)) {
PUSHs(&PL_sv_yes);
} else {
PUSHs(&PL_sv_no);
}
PUTBACK;
return NORMAL;
}
/* pp_file_exists: single path arg on stack */
static OP* pp_file_exists(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_exists_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_size: single path arg on stack */
static OP* pp_file_size(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(newSViv(file_size_internal(path))));
PUTBACK;
return NORMAL;
}
/* pp_file_is_file: single path arg on stack */
static OP* pp_file_is_file(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_is_file_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_is_dir: single path arg on stack */
static OP* pp_file_is_dir(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_is_dir_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_lines: single path arg on stack */
static OP* pp_file_lines(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
SV *content = file_slurp_internal(aTHX_ path);
AV *lines;
if (content == &PL_sv_undef) {
lines = newAV();
} else {
lines = file_split_lines(aTHX_ content);
SvREFCNT_dec(content);
}
PUSHs(sv_2mortal(newRV_noinc((SV*)lines)));
PUTBACK;
return NORMAL;
}
/* pp_file_unlink: single path arg on stack */
static OP* pp_file_unlink(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_unlink_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_mkdir: single path arg on stack (mode defaults to 0755) */
static OP* pp_file_mkdir(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_mkdir_internal(path, 0755) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_rmdir: single path arg on stack */
static OP* pp_file_rmdir(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_rmdir_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_touch: single path arg on stack */
static OP* pp_file_touch(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_touch_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_basename: single path arg on stack */
static OP* pp_file_basename(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(file_basename_internal(aTHX_ path)));
PUTBACK;
return NORMAL;
}
/* pp_file_dirname: single path arg on stack */
static OP* pp_file_dirname(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(file_dirname_internal(aTHX_ path)));
PUTBACK;
return NORMAL;
}
/* pp_file_extname: single path arg on stack */
static OP* pp_file_extname(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(file_extname_internal(aTHX_ path)));
PUTBACK;
return NORMAL;
}
/* pp_file_mtime: single path arg on stack */
static OP* pp_file_mtime(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(newSViv(file_mtime_internal(path))));
PUTBACK;
return NORMAL;
}
/* pp_file_atime: single path arg on stack */
static OP* pp_file_atime(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(newSViv(file_atime_internal(path))));
PUTBACK;
return NORMAL;
}
/* pp_file_ctime: single path arg on stack */
static OP* pp_file_ctime(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(newSViv(file_ctime_internal(path))));
PUTBACK;
return NORMAL;
}
/* pp_file_mode: single path arg on stack */
static OP* pp_file_mode(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(sv_2mortal(newSViv(file_mode_internal(path))));
PUTBACK;
return NORMAL;
}
/* pp_file_is_link: single path arg on stack */
static OP* pp_file_is_link(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_is_link_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_is_readable: single path arg on stack */
static OP* pp_file_is_readable(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_is_readable_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_is_writable: single path arg on stack */
static OP* pp_file_is_writable(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_is_writable_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_is_executable: single path arg on stack */
static OP* pp_file_is_executable(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_is_executable_internal(path) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_readdir: single path arg on stack */
static OP* pp_file_readdir(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
AV *result = file_readdir_internal(aTHX_ path);
PUSHs(sv_2mortal(newRV_noinc((SV*)result)));
PUTBACK;
return NORMAL;
}
/* pp_file_slurp_raw: single path arg on stack (bypasses hooks) */
static OP* pp_file_slurp_raw(pTHX) {
dSP;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
SV *result = file_slurp_raw_internal(aTHX_ path);
PUSHs(sv_2mortal(result));
PUTBACK;
return NORMAL;
}
/* pp_file_copy: src and dst on stack */
static OP* pp_file_copy(pTHX) {
dSP;
SV *dst_sv = POPs;
SV *src_sv = POPs;
const char *src = SvPV_nolen(src_sv);
const char *dst = SvPV_nolen(dst_sv);
PUSHs(file_copy_internal(aTHX_ src, dst) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_move: src and dst on stack */
static OP* pp_file_move(pTHX) {
dSP;
SV *dst_sv = POPs;
SV *src_sv = POPs;
const char *src = SvPV_nolen(src_sv);
const char *dst = SvPV_nolen(dst_sv);
PUSHs(file_move_internal(aTHX_ src, dst) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_chmod: path and mode on stack */
static OP* pp_file_chmod(pTHX) {
dSP;
SV *mode_sv = POPs;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
int mode = SvIV(mode_sv);
PUSHs(file_chmod_internal(path, mode) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_append: path and data on stack */
static OP* pp_file_append(pTHX) {
dSP;
SV *data = POPs;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_append_internal(aTHX_ path, data) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* pp_file_atomic_spew: path and data on stack */
static OP* pp_file_atomic_spew(pTHX) {
dSP;
SV *data = POPs;
SV *path_sv = POPs;
const char *path = SvPV_nolen(path_sv);
PUSHs(file_atomic_spew_internal(aTHX_ path, data) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
return NORMAL;
}
/* ============================================
Call checkers for compile-time optimization
============================================ */
/* 1-arg call checker (slurp, exists, size, is_file, is_dir, lines) */
static OP* file_call_checker_1arg(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
file_ppfunc ppfunc = (file_ppfunc)SvIVX(ckobj);
OP *pushop, *cvop, *argop;
OP *newop;
PERL_UNUSED_ARG(namegv);
/* Navigate to first child */
pushop = cUNOPx(entersubop)->op_first;
if (!OpHAS_SIBLING(pushop)) {
pushop = cUNOPx(pushop)->op_first;
}
/* Get the args: pushmark -> arg -> cv */
argop = OpSIBLING(pushop);
if (!argop) return entersubop;
cvop = OpSIBLING(argop);
if (!cvop) return entersubop;
/* Verify exactly 1 arg */
if (OpSIBLING(argop) != cvop) return entersubop;
/* Detach arg from tree */
OpMORESIB_set(pushop, cvop);
OpLASTSIB_set(argop, NULL);
/* Create unary custom op with arg as child */
newop = newUNOP(OP_CUSTOM, 0, argop);
newop->op_ppaddr = ppfunc;
op_free(entersubop);
return newop;
}
/* 2-arg call checker (spew, append) */
static OP* file_call_checker_2arg(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
file_ppfunc ppfunc = (file_ppfunc)SvIVX(ckobj);
OP *pushop, *cvop, *pathop, *dataop;
OP *newop;
PERL_UNUSED_ARG(namegv);
/* Navigate to first child */
pushop = cUNOPx(entersubop)->op_first;
if (!OpHAS_SIBLING(pushop)) {
pushop = cUNOPx(pushop)->op_first;
}
/* Get the args: pushmark -> path -> data -> cv */
pathop = OpSIBLING(pushop);
if (!pathop) return entersubop;
xs/file/file.c view on Meta::CPAN
sv = newSViv(PTR2IV(cb));
hv_store(g_file_callback_registry, "comment", 7, sv, 0);
hv_store(g_file_callback_registry, "is_comment", 10, SvREFCNT_inc(sv), 0);
/* not_comment / is_not_comment */
Newxz(cb, 1, FileLineCallback);
cb->predicate = pred_is_not_comment;
cb->perl_callback = NULL;
sv = newSViv(PTR2IV(cb));
hv_store(g_file_callback_registry, "not_comment", 11, sv, 0);
hv_store(g_file_callback_registry, "is_not_comment", 14, SvREFCNT_inc(sv), 0);
}
static FileLineCallback* file_get_callback(pTHX_ const char *name) {
SV **svp;
if (!g_file_callback_registry) return NULL;
svp = hv_fetch(g_file_callback_registry, name, strlen(name), 0);
if (svp && SvIOK(*svp)) {
return INT2PTR(FileLineCallback*, SvIVX(*svp));
}
return NULL;
}
/* Process lines with callback - MULTICALL optimized */
static XS(xs_each_line) {
dXSARGS;
const char *path;
SV *callback;
IV idx;
SV *line;
CV *block_cv;
if (items != 2) croak("Usage: file::each_line(path, callback)");
path = SvPV_nolen(ST(0));
callback = ST(1);
if (!SvROK(callback) || SvTYPE(SvRV(callback)) != SVt_PVCV) {
croak("Second argument must be a code reference");
}
block_cv = (CV*)SvRV(callback);
idx = file_lines_open(aTHX_ path);
if (idx < 0) {
XSRETURN_EMPTY;
}
/* Process each line with the callback */
/* Set both $_ and pass as argument so callbacks can use either style */
{
SV *old_defsv = DEFSV;
SAVESPTR(DEFSV); /* Automatically restore $_ on scope exit */
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
dSP;
ENTER;
SAVETMPS;
DEFSV_set(line); /* Set $_ */
PUSHMARK(SP);
XPUSHs(line); /* Don't mortalise - line is freed by file_lines_close or DEFSV restore */
PUTBACK;
call_sv(callback, G_DISCARD);
FREETMPS;
LEAVE;
SvREFCNT_dec(line); /* Release our reference after callback completes */
}
}
file_lines_close(idx);
XSRETURN_EMPTY;
}
/* Grep lines with callback or registered predicate name */
static XS(xs_grep_lines) {
dXSARGS;
const char *path;
SV *predicate;
IV idx;
SV *line;
AV *result;
CV *block_cv = NULL;
FileLineCallback *fcb = NULL;
if (items != 2) croak("Usage: file::grep_lines(path, &predicate or $name)");
path = SvPV_nolen(ST(0));
predicate = ST(1);
result = newAV();
/* Check if predicate is a name or coderef */
if (SvROK(predicate) && SvTYPE(SvRV(predicate)) == SVt_PVCV) {
block_cv = (CV*)SvRV(predicate);
} else {
const char *name = SvPV_nolen(predicate);
fcb = file_get_callback(aTHX_ name);
if (!fcb) {
croak("file::grep_lines: unknown predicate '%s'", name);
}
}
idx = file_lines_open(aTHX_ path);
if (idx < 0) {
ST(0) = sv_2mortal(newRV_noinc((SV*)result));
XSRETURN(1);
}
/* C predicate path - fastest */
if (fcb && fcb->predicate) {
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
if (fcb->predicate(aTHX_ line)) {
av_push(result, line);
} else {
SvREFCNT_dec(line);
}
}
file_lines_close(idx);
ST(0) = sv_2mortal(newRV_noinc((SV*)result));
XSRETURN(1);
}
/* Call Perl callback - set both $_ and pass as argument */
{
SV *cb_sv = fcb ? fcb->perl_callback : (SV*)block_cv;
SV *old_defsv = DEFSV;
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
dSP;
IV count;
SV *result_sv;
bool matches = FALSE;
DEFSV_set(line); /* Set $_ */
PUSHMARK(SP);
XPUSHs(line);
PUTBACK;
count = call_sv(cb_sv, G_SCALAR);
SPAGAIN;
if (count > 0) {
result_sv = POPs;
matches = SvTRUE(result_sv);
}
PUTBACK;
if (matches) {
av_push(result, line);
} else {
SvREFCNT_dec(line);
}
}
DEFSV_set(old_defsv);
}
file_lines_close(idx);
ST(0) = sv_2mortal(newRV_noinc((SV*)result));
XSRETURN(1);
}
/* Count lines matching predicate */
static XS(xs_count_lines) {
dXSARGS;
const char *path;
SV *predicate = NULL;
IV idx;
SV *line;
IV count = 0;
CV *block_cv = NULL;
FileLineCallback *fcb = NULL;
if (items < 1 || items > 2) croak("Usage: file::count_lines(path, [&predicate or $name])");
path = SvPV_nolen(ST(0));
/* If no predicate, just count all lines */
if (items == 1) {
idx = file_lines_open(aTHX_ path);
if (idx < 0) {
ST(0) = sv_2mortal(newSViv(0));
XSRETURN(1);
}
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
count++;
SvREFCNT_dec(line);
}
file_lines_close(idx);
ST(0) = sv_2mortal(newSViv(count));
XSRETURN(1);
}
predicate = ST(1);
/* Check if predicate is a name or coderef */
if (SvROK(predicate) && SvTYPE(SvRV(predicate)) == SVt_PVCV) {
block_cv = (CV*)SvRV(predicate);
} else {
const char *name = SvPV_nolen(predicate);
fcb = file_get_callback(aTHX_ name);
if (!fcb) {
croak("file::count_lines: unknown predicate '%s'", name);
}
}
idx = file_lines_open(aTHX_ path);
if (idx < 0) {
ST(0) = sv_2mortal(newSViv(0));
XSRETURN(1);
}
/* C predicate path - fastest */
if (fcb && fcb->predicate) {
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
if (fcb->predicate(aTHX_ line)) {
count++;
}
SvREFCNT_dec(line);
}
file_lines_close(idx);
ST(0) = sv_2mortal(newSViv(count));
XSRETURN(1);
}
/* Call Perl callback - set both $_ and pass as argument */
{
SV *cb_sv = fcb ? fcb->perl_callback : (SV*)block_cv;
SV *old_defsv = DEFSV;
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
dSP;
IV n;
SV *result_sv;
bool matches = FALSE;
DEFSV_set(line); /* Set $_ */
PUSHMARK(SP);
XPUSHs(line);
PUTBACK;
n = call_sv(cb_sv, G_SCALAR);
SPAGAIN;
if (n > 0) {
result_sv = POPs;
matches = SvTRUE(result_sv);
}
PUTBACK;
if (matches) {
count++;
}
SvREFCNT_dec(line);
}
DEFSV_set(old_defsv);
}
file_lines_close(idx);
ST(0) = sv_2mortal(newSViv(count));
XSRETURN(1);
}
/* Find first line matching predicate */
static XS(xs_find_line) {
dXSARGS;
const char *path;
SV *predicate;
IV idx;
SV *line;
CV *block_cv = NULL;
FileLineCallback *fcb = NULL;
if (items != 2) croak("Usage: file::find_line(path, &predicate or $name)");
path = SvPV_nolen(ST(0));
predicate = ST(1);
/* Check if predicate is a name or coderef */
if (SvROK(predicate) && SvTYPE(SvRV(predicate)) == SVt_PVCV) {
block_cv = (CV*)SvRV(predicate);
} else {
const char *name = SvPV_nolen(predicate);
fcb = file_get_callback(aTHX_ name);
if (!fcb) {
croak("file::find_line: unknown predicate '%s'", name);
}
}
idx = file_lines_open(aTHX_ path);
if (idx < 0) {
XSRETURN_UNDEF;
}
/* C predicate path - fastest */
if (fcb && fcb->predicate) {
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
if (fcb->predicate(aTHX_ line)) {
file_lines_close(idx);
ST(0) = sv_2mortal(line);
XSRETURN(1);
}
SvREFCNT_dec(line);
}
file_lines_close(idx);
XSRETURN_UNDEF;
}
/* Call Perl callback - set both $_ and pass as argument */
{
SV *cb_sv = fcb ? fcb->perl_callback : (SV*)block_cv;
SV *old_defsv = DEFSV;
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
dSP;
IV n;
SV *result_sv;
bool matches = FALSE;
DEFSV_set(line); /* Set $_ */
PUSHMARK(SP);
XPUSHs(line);
PUTBACK;
n = call_sv(cb_sv, G_SCALAR);
SPAGAIN;
if (n > 0) {
result_sv = POPs;
matches = SvTRUE(result_sv);
}
PUTBACK;
if (matches) {
DEFSV_set(old_defsv);
file_lines_close(idx);
ST(0) = sv_2mortal(line);
XSRETURN(1);
}
SvREFCNT_dec(line);
}
DEFSV_set(old_defsv);
}
file_lines_close(idx);
XSRETURN_UNDEF;
}
/* Map lines with callback */
static XS(xs_map_lines) {
dXSARGS;
const char *path;
SV *callback;
IV idx;
SV *line;
AV *result;
CV *block_cv;
if (items != 2) croak("Usage: file::map_lines(path, &callback)");
path = SvPV_nolen(ST(0));
callback = ST(1);
result = newAV();
if (!SvROK(callback) || SvTYPE(SvRV(callback)) != SVt_PVCV) {
croak("Second argument must be a code reference");
}
block_cv = (CV*)SvRV(callback);
idx = file_lines_open(aTHX_ path);
if (idx < 0) {
ST(0) = sv_2mortal(newRV_noinc((SV*)result));
XSRETURN(1);
}
/* Call Perl callback - set both $_ and pass as argument */
{
SV *old_defsv = DEFSV;
while ((line = file_lines_next(aTHX_ idx)) != &PL_sv_undef) {
dSP;
IV count;
SV *result_sv;
DEFSV_set(line); /* Set $_ */
PUSHMARK(SP);
XPUSHs(sv_2mortal(line));
PUTBACK;
count = call_sv(callback, G_SCALAR);
SPAGAIN;
if (count > 0) {
result_sv = POPs;
av_push(result, SvREFCNT_inc(result_sv));
}
PUTBACK;
}
DEFSV_set(old_defsv);
}
file_lines_close(idx);
ST(0) = sv_2mortal(newRV_noinc((SV*)result));
XSRETURN(1);
}
/* Register a Perl callback */
static XS(xs_register_line_callback) {
dXSARGS;
const char *name;
STRLEN name_len;
SV *coderef;
FileLineCallback *cb;
SV *sv;
if (items != 2) croak("Usage: file::register_line_callback($name, \\&coderef)");
name = SvPV(ST(0), name_len);
coderef = ST(1);
if (!SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
croak("file::register_line_callback: second argument must be a coderef");
}
file_init_callback_registry(aTHX);
/* If already registered, just update the perl_callback in place */
{
FileLineCallback *existing = file_get_callback(aTHX_ name);
if (existing) {
/* Update existing - free old perl_callback and set new one */
if (existing->perl_callback) {
SvREFCNT_dec(existing->perl_callback);
}
existing->perl_callback = newSVsv(coderef);
existing->predicate = NULL; /* Clear any C predicate */
XSRETURN_YES;
}
}
Newxz(cb, 1, FileLineCallback);
cb->predicate = NULL; /* No C function */
cb->perl_callback = newSVsv(coderef);
sv = newSViv(PTR2IV(cb));
hv_store(g_file_callback_registry, name, name_len, sv, 0);
XSRETURN_YES;
}
/* List registered callbacks */
static XS(xs_list_line_callbacks) {
dXSARGS;
AV *result;
HE *entry;
PERL_UNUSED_VAR(items);
( run in 0.494 second using v1.01-cache-2.11-cpan-13bb782fe5a )