view release on metacpan or  search on metacpan

Popt.xs  view on Meta::CPAN

    _CREATE_PERL_CONST(POPT_ARGFLAG_RANDOM);
    _CREATE_PERL_CONST(POPT_ARGFLAG_TOGGLE);
    _CREATE_PERL_CONST(POPT_ARGFLAG_OR);
    _CREATE_PERL_CONST(POPT_ARGFLAG_AND);
    _CREATE_PERL_CONST(POPT_ARGFLAG_XOR);
    _CREATE_PERL_CONST(POPT_ARGFLAG_NOT);
}

SV*
_new_xs (const char* classname, SV* name_sv, SV* options_ar )
    CODE:
        const char *name_const = SvOK(name_sv) ? exs_SvPVbyte_nolen(name_sv) : NULL;
        char* name_copy = _copy_str_or_null(aTHX_ name_const);

        RETVAL = exs_new_structref(perl_popt_st, classname);
        perl_popt_st* perl_popt = exs_structref_ptr(RETVAL);

        struct poptOption* options = _create_popt_options(aTHX_ perl_popt, options_ar);

        char** faux_argv;
        Newxz(faux_argv, 1 + (name_copy ? 1 : 0), char*);
        if (name_copy) {
            *faux_argv = savepv(name_copy);
        }

        *perl_popt = (perl_popt_st) {
            .name = name_copy,
            .pid = getpid(),
            .options = options,
            .callback_userdata = {
#ifdef MULTIPLICITY
                .aTHX = aTHX,
#endif
            },
        };

        _refresh_popt_ctx(aTHX_ perl_popt, name_copy ? 1 : 0, faux_argv);

    OUTPUT:
        RETVAL

void
DESTROY (SV* self_sv)
    CODE:
        perl_popt_st* perl_popt = exs_structref_ptr(self_sv);

        if (PL_dirty && perl_popt->pid == getpid()) {
            warn("DESTROYing %" SVf " at global destruction; memory leak likely!\n", self_sv);
        }

        poptFreeContext(perl_popt->popt);

        if (perl_popt->name) {
            Safefree(perl_popt->name);
        }

        _free_popt_options(aTHX_ perl_popt->options);

void
parse (SV* self_sv, ...)
    PPCODE:
        perl_popt_st* perl_popt = exs_structref_ptr(self_sv);

        // trailing NUL - self_sv = 0
        const char* stack_argv[items];
        stack_argv[items - 1] = NULL;
        for (unsigned i=1; i<items; i++) {
            stack_argv[i - 1] = exs_SvPVbyte_nolen(ST(i));
        }

        char** new_argv = _dup_argv_deep(aTHX_ stack_argv, perl_popt->name);
        _refresh_popt_ctx(aTHX_ perl_popt, items - (perl_popt->name ? 0 : 1), new_argv);

        struct poptOption* options = perl_popt->options;

        HV* named_args = newHV();

        perl_popt->callback_userdata.result = named_args;

        int rc;
        while ((rc = poptGetNextOpt(perl_popt->popt)) >= 0) {

            // The compiler should optimize this away:
            if (CALLBACK_OPTS) {
                struct poptOption* curopt = options + (rc - 1);
                _store_opt_in_hv(aTHX_ curopt, named_args);
            }
        }

        if (rc != -1) {
            SvREFCNT_dec((SV*) named_args);

            const char *opt = poptBadOption(perl_popt->popt, 0);
            const char *errdesc = poptStrerror(rc);

            SV* args[] = {
                newSVpvs("BadOption"),
                newSViv(rc),
                newSVpv(errdesc, 0),
                newSVpv(opt, 0),
                NULL,
            };

            SV* err = exs_call_method_scalar(
                newSVpvs_flags(PERL_NS "::X", SVs_TEMP),
                "create",
                args
            );

            croak_sv(err);
        }

        const char** leftovers = poptGetArgs(perl_popt->popt);
        unsigned leftovers_count = 0;

        const char** curstr_p = leftovers;

        if (leftovers != NULL) {
            while (*curstr_p++) leftovers_count++;
        }