view release on metacpan or  search on metacpan

src/modules/perl/modperl_util.c  view on Meta::CPAN

    }

    free(handles);
}

/* XXX: There is no XS accessible splice() */
static void modperl_av_remove_entry(pTHX_ AV *av, I32 index)
{
    I32 i;
    AV *tmpav = newAV();

    /* stash the entries _before_ the item to delete */
    for (i=0; i<=index; i++) {
        av_store(tmpav, i, SvREFCNT_inc(av_shift(av)));
    }

    /* make size at the beginning of the array */
    av_unshift(av, index-1);

    /* add stashed entries back */
    for (i=0; i<index; i++) {
        av_store(av, i, *av_fetch(tmpav, i, 0));
    }

    sv_free((SV *)tmpav);
}

static void modperl_package_unload_dynamic(pTHX_ const char *package,
                                           I32 dl_index)
{
    AV *librefs = get_av(dl_librefs, 0);
    SV *libref = *av_fetch(librefs, dl_index, 0);

    modperl_sys_dlclose(INT2PTR(void *, SvIV(libref)));

    /* remove package from @dl_librefs and @dl_modules */
    modperl_av_remove_entry(aTHX_ get_av(dl_librefs, 0), dl_index);
    modperl_av_remove_entry(aTHX_ get_av(dl_modules, 0), dl_index);

    return;
}

static int modperl_package_is_dynamic(pTHX_ const char *package,
                                      I32 *dl_index)
{
   I32 i;
   AV *modules = get_av(dl_modules, FALSE);

   for (i=0; i<av_len(modules); i++) {
        SV *module = *av_fetch(modules, i, 0);
        if (strEQ(package, SvPVX(module))) {
            *dl_index = i;
            return TRUE;
        }
    }
    return FALSE;
}

modperl_cleanup_data_t *modperl_cleanup_data_new(apr_pool_t *p, void *data)
{
    modperl_cleanup_data_t *cdata =
        (modperl_cleanup_data_t *)apr_pcalloc(p, sizeof(*cdata));
    cdata->pool = p;
    cdata->data = data;
    return cdata;
}

MP_INLINE void modperl_perl_av_push_elts_ref(pTHX_ AV *dst, AV *src)
{
    I32 i, j, src_fill = AvFILLp(src), dst_fill = AvFILLp(dst);

    av_extend(dst, src_fill);
    AvFILLp(dst) += src_fill+1;

    for (i=dst_fill+1, j=0; j<=AvFILLp(src); i++, j++) {
        AvARRAY(dst)[i] = SvREFCNT_inc(AvARRAY(src)[j]);
    }
}

/*
 * similar to hv_fetch_ent, but takes string key and key len rather than SV
 * also skips magic and utf8 fu, since we are only dealing with internal tables
 */
HE *modperl_perl_hv_fetch_he(pTHX_ HV *hv,
                             register char *key,
                             register I32 klen,
                             register U32 hash)
{
    register XPVHV *xhv;
    register HE *entry;

    xhv = (XPVHV *)SvANY(hv);
    if (!HvARRAY(hv)) {
        return 0;
    }

#ifdef HvREHASH
    if (HvREHASH(hv)) {
        PERL_HASH_INTERNAL(hash, key, klen);
    }
    else
#endif
    if (!hash) {
        PERL_HASH(hash, key, klen);
    }

    entry = ((HE**)HvARRAY(hv))[hash & (I32)xhv->xhv_max];

    for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash) {
            continue;
        }
        if (HeKLEN(entry) != klen) {
            continue;
        }
        if (HeKEY(entry) != key && memNE(HeKEY(entry), key, klen)) {
            continue;
        }
        return entry;
    }

    return 0;
}

void modperl_str_toupper(char *str)