view release on metacpan or  search on metacpan

lib/Hash/SharedMem.xs  view on Meta::CPAN

MODULE = Hash::SharedMem PACKAGE = Hash::SharedMem::Handle

PROTOTYPES: DISABLE

SV *
referential_handle(SV *classname)
CODE:
	PERL_UNUSED_VAR(classname);
	RETVAL = boolSV(likely(dirref_referential()));
OUTPUT:
	RETVAL

SV *
open(SV *classname, SV *filename, SV *mode)
CODE:
	PERL_UNUSED_VAR(classname);
	PUTBACK;
	RETVAL = shash_open(filename, mode);
	SvREFCNT_inc_simple_void_NN(RETVAL);
	SPAGAIN;
OUTPUT:
	RETVAL

BOOT:
{
	HV *fstash = gv_stashpvs("Hash::SharedMem", 0);
	HV *mstash = gv_stashpvs("Hash::SharedMem::Handle", 0);
	HE *he;
	for(hv_iterinit(fstash); (he = hv_iternext(fstash)); ) {
		STRLEN klen;
		char const *kpv = HePV(he, klen);
		if(klen > 6 && memcmp(kpv, "shash_", 6) == 0 &&
				!(klen == 24 &&
					memcmp(kpv+6, "referential_handle", 18)
							== 0) &&
				!(klen == 10 && memcmp(kpv+6, "open", 4) == 0))
			(void) hv_store(mstash, kpv+6, klen-6,
					SvREFCNT_inc_NN(HeVAL(he)), 0);
	}
}

SV *
TIEHASH(SV *classname, SV *arg0, SV *arg1 = NULL)
CODE:
	PERL_UNUSED_VAR(classname);
	if(!arg1) {
		arg_check_shash(arg0);
		RETVAL = newRV_ro_mortal_inc(SvRV(arg0));
	} else {
		PUTBACK;
		RETVAL = shash_open(arg0, arg1);
		SPAGAIN;
	}
	SvREFCNT_inc_simple_void_NN(RETVAL);
OUTPUT:
	RETVAL

void
CLEAR(SV *shash)
PPCODE:
	arg_check_shash(shash);
	croak("can't clear shared hash");

BOOT:
{
	HV *mstash = gv_stashpvs("Hash::SharedMem::Handle", 0);
	(void) hv_stores(mstash, "EXISTS",
		SvREFCNT_inc_NN(*hv_fetchs(mstash, "exists", 0)));
	(void) hv_stores(mstash, "FETCH",
		SvREFCNT_inc_NN(*hv_fetchs(mstash, "get", 0)));
	(void) newXSproto_portable("Hash::SharedMem::Handle::STORE",
		THX_xsfunc_shash_tied_store, __FILE__, "$$$");
	(void) newXSproto_portable("Hash::SharedMem::Handle::DELETE",
		THX_xsfunc_shash_tied_delete, __FILE__, "$$");
#if PERL_VERSION_GE(5,25,3)
	(void) hv_stores(mstash, "SCALAR",
		SvREFCNT_inc_NN(*hv_fetchs(mstash, "count", 0)));
#else /* <5.25.3 */
	(void) hv_stores(mstash, "SCALAR",
		SvREFCNT_inc_NN(*hv_fetchs(mstash, "occupied", 0)));
#endif /* <5.25.3 */
	(void) hv_stores(mstash, "FIRSTKEY",
		SvREFCNT_inc_NN(*hv_fetchs(mstash, "key_min", 0)));
	(void) hv_stores(mstash, "NEXTKEY",
		SvREFCNT_inc_NN(*hv_fetchs(mstash, "key_gt", 0)));
}