view release on metacpan or  search on metacpan

xs/file/file.c  view on Meta::CPAN

    file_lines_close(idx);
    hv_store(hash, "_idx", 4, newSViv(-1), 0);
    XSRETURN_EMPTY;
}

static XS(xs_lines_iter_DESTROY) {
    dXSARGS;
    HV *hash;
    SV **idx_sv;
    IV idx;

    PERL_UNUSED_VAR(items);

    if (PL_dirty) XSRETURN_EMPTY;

    if (!SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVHV) {
        XSRETURN_EMPTY;
    }

    hash = (HV*)SvRV(ST(0));
    idx_sv = hv_fetch(hash, "_idx", 4, 0);
    idx = idx_sv ? SvIV(*idx_sv) : -1;

    if (idx >= 0) {
        file_lines_close(idx);
    }
    XSRETURN_EMPTY;
}

/* ============================================
   Callback registry for line processing
   Allows C-level predicates for maximum speed
   ============================================ */

/* Predicate function type for line processing */
typedef bool (*file_line_predicate)(pTHX_ SV *line);

/* Registered callback entry */
typedef struct {
    file_line_predicate predicate;  /* C function pointer (NULL for Perl-only) */
    SV *perl_callback;              /* Perl callback (for fallback or custom) */
} FileLineCallback;

/* Global callback registry */
static HV *g_file_callback_registry = NULL;

/* Built-in C predicates */
static bool pred_is_blank(pTHX_ SV *line) {
    STRLEN len;
    const char *s = SvPV(line, len);
    STRLEN i;
    for (i = 0; i < len; i++) {
        if (s[i] != ' ' && s[i] != '\t' && s[i] != '\r' && s[i] != '\n') {
            return FALSE;
        }
    }
    return TRUE;
}

static bool pred_is_not_blank(pTHX_ SV *line) {
    return !pred_is_blank(aTHX_ line);
}

static bool pred_is_empty(pTHX_ SV *line) {
    return SvCUR(line) == 0;
}

static bool pred_is_not_empty(pTHX_ SV *line) {
    return SvCUR(line) > 0;
}

static bool pred_is_comment(pTHX_ SV *line) {
    STRLEN len;
    const char *s = SvPV(line, len);
    /* Skip leading whitespace */
    while (len > 0 && (*s == ' ' || *s == '\t')) {
        s++;
        len--;
    }
    return len > 0 && *s == '#';
}

static bool pred_is_not_comment(pTHX_ SV *line) {
    return !pred_is_comment(aTHX_ line);
}

/* Cleanup callback registry during global destruction */
static void file_cleanup_callback_registry(pTHX_ void *data) {
    PERL_UNUSED_ARG(data);

    /* During global destruction, just NULL out pointers.
     * Perl handles SV cleanup; trying to free them ourselves
     * can cause crashes due to destruction order. */
    if (PL_dirty) {
        g_file_callback_registry = NULL;
        return;
    }

    /* Normal cleanup - not during global destruction */
    g_file_callback_registry = NULL;
}

static void file_init_callback_registry(pTHX) {
    SV *sv;
    FileLineCallback *cb;

    if (g_file_callback_registry) return;
    g_file_callback_registry = newHV();

    /* Register built-in predicates with both naming conventions */
    /* blank / is_blank */
    Newxz(cb, 1, FileLineCallback);
    cb->predicate = pred_is_blank;
    cb->perl_callback = NULL;
    sv = newSViv(PTR2IV(cb));
    hv_store(g_file_callback_registry, "blank", 5, sv, 0);
    hv_store(g_file_callback_registry, "is_blank", 8, SvREFCNT_inc(sv), 0);

    /* not_blank / is_not_blank */
    Newxz(cb, 1, FileLineCallback);
    cb->predicate = pred_is_not_blank;
    cb->perl_callback = NULL;
    sv = newSViv(PTR2IV(cb));
    hv_store(g_file_callback_registry, "not_blank", 9, sv, 0);
    hv_store(g_file_callback_registry, "is_not_blank", 12, SvREFCNT_inc(sv), 0);

    /* empty / is_empty */
    Newxz(cb, 1, FileLineCallback);
    cb->predicate = pred_is_empty;
    cb->perl_callback = NULL;
    sv = newSViv(PTR2IV(cb));
    hv_store(g_file_callback_registry, "empty", 5, sv, 0);
    hv_store(g_file_callback_registry, "is_empty", 8, SvREFCNT_inc(sv), 0);

    /* not_empty / is_not_empty */
    Newxz(cb, 1, FileLineCallback);
    cb->predicate = pred_is_not_empty;
    cb->perl_callback = NULL;
    sv = newSViv(PTR2IV(cb));
    hv_store(g_file_callback_registry, "not_empty", 9, sv, 0);
    hv_store(g_file_callback_registry, "is_not_empty", 12, SvREFCNT_inc(sv), 0);

    /* comment / is_comment */
    Newxz(cb, 1, FileLineCallback);
    cb->predicate = pred_is_comment;
    cb->perl_callback = NULL;
    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;
}