Ancient

 view release on metacpan or  search on metacpan

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

    /* 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;
}

/* 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) {

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

            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);

    result = newAV();
    if (g_file_callback_registry) {
        hv_iterinit(g_file_callback_registry);
        while ((entry = hv_iternext(g_file_callback_registry))) {
            av_push(result, newSVsv(hv_iterkeysv(entry)));
        }
    }

    ST(0) = sv_2mortal(newRV_noinc((SV*)result));
    XSRETURN(1);
}

/* ============================================
   Hook registration XS functions
   ============================================ */

/* Register a Perl read hook */
static XS(xs_register_read_hook) {
    dXSARGS;
    SV *coderef;
    FileHookEntry *entry;

    if (items != 1) croak("Usage: file::register_read_hook(\\&coderef)");

    coderef = ST(0);
    if (!SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
        croak("file::register_read_hook: argument must be a coderef");
    }

    /* Use the hook list for Perl callbacks */
    Newxz(entry, 1, FileHookEntry);
    entry->name = "perl_read_hook";
    entry->c_func = NULL;
    entry->perl_callback = newSVsv(coderef);
    entry->priority = FILE_HOOK_PRIORITY_NORMAL;
    entry->user_data = NULL;
    entry->next = g_file_hooks[FILE_HOOK_PHASE_READ];
    g_file_hooks[FILE_HOOK_PHASE_READ] = entry;

    XSRETURN_YES;
}

/* Register a Perl write hook */
static XS(xs_register_write_hook) {
    dXSARGS;
    SV *coderef;
    FileHookEntry *entry;

    if (items != 1) croak("Usage: file::register_write_hook(\\&coderef)");

    coderef = ST(0);
    if (!SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
        croak("file::register_write_hook: argument must be a coderef");
    }

    /* Use the hook list for Perl callbacks */
    Newxz(entry, 1, FileHookEntry);
    entry->name = "perl_write_hook";
    entry->c_func = NULL;
    entry->perl_callback = newSVsv(coderef);
    entry->priority = FILE_HOOK_PRIORITY_NORMAL;
    entry->user_data = NULL;
    entry->next = g_file_hooks[FILE_HOOK_PHASE_WRITE];
    g_file_hooks[FILE_HOOK_PHASE_WRITE] = entry;

    XSRETURN_YES;
}

/* Clear all hooks for a phase */
static XS(xs_clear_hooks) {
    dXSARGS;
    const char *phase_name;
    FileHookPhase phase;
    FileHookEntry *entry, *next;

    if (items != 1) croak("Usage: file::clear_hooks($phase)");

    phase_name = SvPV_nolen(ST(0));

    if (strcmp(phase_name, "read") == 0) {
        phase = FILE_HOOK_PHASE_READ;
        g_file_read_hook = NULL;
        g_file_read_hook_data = NULL;
    } else if (strcmp(phase_name, "write") == 0) {
        phase = FILE_HOOK_PHASE_WRITE;
        g_file_write_hook = NULL;
        g_file_write_hook_data = NULL;
    } else if (strcmp(phase_name, "open") == 0) {
        phase = FILE_HOOK_PHASE_OPEN;
    } else if (strcmp(phase_name, "close") == 0) {
        phase = FILE_HOOK_PHASE_CLOSE;
    } else {
        croak("file::clear_hooks: unknown phase '%s' (use read, write, open, close)", phase_name);
    }

    /* Free hook list */
    entry = g_file_hooks[phase];
    while (entry) {
        next = entry->next;
        if (entry->perl_callback) {
            SvREFCNT_dec(entry->perl_callback);
        }
        Safefree(entry);
        entry = next;
    }
    g_file_hooks[phase] = NULL;

    XSRETURN_YES;
}

/* Check if hooks are registered for a phase */
static XS(xs_has_hooks) {
    dXSARGS;
    const char *phase_name;
    FileHookPhase phase;
    int has;

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

        cv_set_call_checker(cv, file_call_checker_1arg, ckobj);

        cv = newXS("file::dirname", xs_dirname, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_dirname));
        cv_set_call_checker(cv, file_call_checker_1arg, ckobj);

        cv = newXS("file::extname", xs_extname, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_extname));
        cv_set_call_checker(cv, file_call_checker_1arg, ckobj);

        cv = newXS("file::slurp", xs_slurp, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_slurp));
        cv_set_call_checker(cv, file_call_checker_1arg, ckobj);

        cv = newXS("file::slurp_raw", xs_slurp_raw, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_slurp_raw));
        cv_set_call_checker(cv, file_call_checker_1arg, ckobj);

        cv = newXS("file::lines", xs_lines, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_lines));
        cv_set_call_checker(cv, file_call_checker_1arg, ckobj);

        cv = newXS("file::readdir", xs_readdir, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_readdir));
        cv_set_call_checker(cv, file_call_checker_1arg, ckobj);

        /* 2-arg functions with call checker */
        cv = newXS("file::spew", xs_spew, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_spew));
        cv_set_call_checker(cv, file_call_checker_2arg, ckobj);

        cv = newXS("file::append", xs_append, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_append));
        cv_set_call_checker(cv, file_call_checker_2arg, ckobj);

        cv = newXS("file::copy", xs_copy, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_copy));
        cv_set_call_checker(cv, file_call_checker_2arg, ckobj);

        cv = newXS("file::move", xs_move, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_move));
        cv_set_call_checker(cv, file_call_checker_2arg, ckobj);

        cv = newXS("file::chmod", xs_chmod, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_chmod));
        cv_set_call_checker(cv, file_call_checker_2arg, ckobj);

        cv = newXS("file::atomic_spew", xs_atomic_spew, __FILE__);
        ckobj = newSViv(PTR2IV(pp_file_atomic_spew));
        cv_set_call_checker(cv, file_call_checker_2arg, ckobj);
    }

    /* Functions without custom op optimization */
    newXS("file::join", xs_join, __FILE__);
    newXS("file::each_line", xs_each_line, __FILE__);
    newXS("file::grep_lines", xs_grep_lines, __FILE__);
    newXS("file::count_lines", xs_count_lines, __FILE__);
    newXS("file::find_line", xs_find_line, __FILE__);
    newXS("file::map_lines", xs_map_lines, __FILE__);
    newXS("file::register_line_callback", xs_register_line_callback, __FILE__);
    newXS("file::list_line_callbacks", xs_list_line_callbacks, __FILE__);

    /* File hooks */
    newXS("file::register_read_hook", xs_register_read_hook, __FILE__);
    newXS("file::register_write_hook", xs_register_write_hook, __FILE__);
    newXS("file::clear_hooks", xs_clear_hooks, __FILE__);
    newXS("file::has_hooks", xs_has_hooks, __FILE__);

    /* Head and tail */
    newXS("file::head", xs_head, __FILE__);
    newXS("file::tail", xs_tail, __FILE__);

    /* Import function */
    newXS("file::import", XS_file_import, __FILE__);

    /* Memory-mapped files */
    newXS("file::mmap_open", xs_mmap_open, __FILE__);
    newXS("file::mmap::data", xs_mmap_data, __FILE__);
    newXS("file::mmap::sync", xs_mmap_sync, __FILE__);
    newXS("file::mmap::close", xs_mmap_close, __FILE__);
    newXS("file::mmap::DESTROY", xs_mmap_DESTROY, __FILE__);

    /* Line iterators */
    newXS("file::lines_iter", xs_lines_iter, __FILE__);
    newXS("file::lines::next", xs_lines_iter_next, __FILE__);
    newXS("file::lines::eof", xs_lines_iter_eof, __FILE__);
    newXS("file::lines::close", xs_lines_iter_close, __FILE__);
    newXS("file::lines::DESTROY", xs_lines_iter_DESTROY, __FILE__);

    /* Register cleanup for global destruction */
    Perl_call_atexit(aTHX_ file_cleanup_callback_registry, NULL);

    Perl_xs_boot_epilog(aTHX_ ax);
}