#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

typedef SV* SVREF;

static int
autoweak_set(pTHX_ SV* const sv, MAGIC* const mg){
	PERL_UNUSED_ARG(mg);

	if(!SvWEAKREF(sv)){
		sv_rvweaken(sv);
	}

	return 0; /* success */
}

const MGVTBL autoweaker_vtbl = {
	NULL, /* get */
	autoweak_set,
	NULL, /* len */
	NULL, /* clear */
	NULL, /* free */
	NULL, /* copy */
	NULL, /* dup */
#ifdef MGf_LOCAL
	NULL,  /* local */
#endif
};


static bool
isautoweak(pTHX_ SV* const sv){
	if(SvMAGICAL(sv)){
		const MAGIC* mg;
		for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
			if(mg->mg_virtual == &autoweaker_vtbl){
				return TRUE;
			}
		}
	}
	return FALSE;
}

MODULE = WeakRef::Auto	PACKAGE = WeakRef::Auto

PROTOTYPES: DISABLE

void
autoweaken(SVREF value)
PROTOTYPE: \$
CODE:
	SvGETMAGIC(value);

	if(SvREADONLY(value)){
		Perl_croak(aTHX_ PL_no_modify);
	}

	if(!isautoweak(aTHX_ value)){
		if(SvTIED_mg(value, PERL_MAGIC_tiedscalar) || SvTIED_mg(value, PERL_MAGIC_tiedelem)){
			if(ckWARN(WARN_MISC))
				Perl_warner(aTHX_ packWARN(WARN_MISC), "autoweaken() does not work with tied variables");
			XSRETURN_EMPTY;
		}

		sv_magicext(value, NULL, PERL_MAGIC_ext, &autoweaker_vtbl, NULL, 0);
		SvSETMAGIC(value);
	}