<commit_before>#include "perl_xmmsclient.h"

#define xmmsc_result_propdict_t xmmsc_result_t

void
perl_xmmsclient_extract_keys_from_propdict (const void *key,
                                            xmmsc_result_value_type_t type,
                                            const void *value,
                                            const char *source,
                                            void *user_data)
{
	HV *keys = (HV *)user_data;

	if (!hv_store (keys, key, strlen (key), &PL_sv_undef, 0)) {
		croak ("Failed to extract propdict keys");
	}
}

HV *
perl_xmmsclient_get_keys_if_needed (SV *sv)
{
	HV *keys;
	SV **hash_elem;
	int ret = 0;
	MAGIC *mg = NULL;
	xmmsc_result_propdict_t *res = NULL;

	hash_elem = hv_fetch ((HV *)SvRV (sv), "keys", 4, 0);

	if (hash_elem == NULL || *hash_elem == NULL) {
		if (!(mg = perl_xmmsclient_get_magic_from_sv (sv, "Audio::XMMSClient::Result::PropDict::Tie"))) {
			croak ("This is a bug!");
		}

		res = (xmmsc_result_propdict_t *)mg->mg_ptr;

		keys = newHV ();
		ret = xmmsc_result_propdict_foreach (res, perl_xmmsclient_extract_keys_from_propdict, keys);

		hash_elem = hv_store ((HV *)SvRV (sv), "keys", 4, newRV_noinc ((SV *)keys), 0);
	}

	keys = (HV *)SvRV (*hash_elem);
	return keys;
}

MODULE = Audio::XMMSClient::Result::PropDict::Tie	PACKAGE = Audio::XMMSClient::Result::PropDict::Tie

SV *
FIRSTKEY (sv)
		SV *sv
	PREINIT:
		HV *keys;
		HE *iter;
		char *key;
		I32 key_len;
	CODE:
		keys = perl_xmmsclient_get_keys_if_needed (sv);

		hv_iterinit (keys);
		iter = hv_iternext (keys);
		key  = hv_iterkey (iter, &key_len);

		RETVAL = newSVpv (key, key_len);
	OUTPUT:
		RETVAL

SV *
NEXTKEY (sv, lastkey)
		SV *sv
	PREINIT:
		HV *keys;
		HE *iter;
		char *key;
		I32 key_len;
	CODE:
		keys = perl_xmmsclient_get_keys_if_needed (sv);

		iter = hv_iternext (keys);

		if (iter == NULL) {
			RETVAL = &PL_sv_undef;
		}
		else {
			key  = hv_iterkey (iter, &key_len);
			RETVAL = newSVpv (key, key_len);
		}
	OUTPUT:
		RETVAL

SV *
FETCH (res, key)
		xmmsc_result_propdict_t *res
		char *key
	PREINIT:
		int ret = 0;
		uint32_t uint32_val;
		int32_t int32_val;
		const char *string_val;
		SV **he;
	CODE:
		switch (xmmsc_result_get_dict_entry_type (res, key)) {
			case XMMS_OBJECT_CMD_ARG_UINT32:
				ret = xmmsc_result_get_dict_entry_uint (res, key, &uint32_val);

				RETVAL = newSVuv (uint32_val);
				break;
			case XMMS_OBJECT_CMD_ARG_INT32:
				ret = xmmsc_result_get_dict_entry_int (res, key, &int32_val);
				RETVAL = newSViv (int32_val);
				break;
			case XMMS_OBJECT_CMD_ARG_STRING:
				ret = xmmsc_result_get_dict_entry_string (res, key, &string_val);
				RETVAL = newSVpv (string_val, 0);
				break;
			default:
				croak ("invalid arg type");
		}

		if (ret != 1) {
			XSRETURN_UNDEF;
		}

		he = hv_fetch ((HV *)SvRV (ST (0)), "field", 5, 0);
		if (he && *he) {
			char *key;
			STRLEN key_len;
			HV *perl_constants;

			key = SvPV (*he, key_len);
			he = hv_fetch ((HV *)SvRV (ST (0)), "constants", 9, 0);

			if (!he || !*he) {
				croak ("constants not available");
			}

			perl_constants = (HV *)SvRV (*he);

			key = SvPV (RETVAL, key_len);
			he = hv_fetch (perl_constants, key, key_len, 0);

			if (he && *he) {
				sv_2mortal (RETVAL);
				RETVAL = newSVsv (*he);
			}
		}
	OUTPUT:
		RETVAL

BOOT:
	PERL_UNUSED_VAR (items);
<commit_msg>OTHER: Don't croak on accessing propdicts with non-existing keys.<commit_after>#include "perl_xmmsclient.h"

#define xmmsc_result_propdict_t xmmsc_result_t

void
perl_xmmsclient_extract_keys_from_propdict (const void *key,
                                            xmmsc_result_value_type_t type,
                                            const void *value,
                                            const char *source,
                                            void *user_data)
{
	HV *keys = (HV *)user_data;

	if (!hv_store (keys, key, strlen (key), &PL_sv_undef, 0)) {
		croak ("Failed to extract propdict keys");
	}
}

HV *
perl_xmmsclient_get_keys_if_needed (SV *sv)
{
	HV *keys;
	SV **hash_elem;
	int ret = 0;
	MAGIC *mg = NULL;
	xmmsc_result_propdict_t *res = NULL;

	hash_elem = hv_fetch ((HV *)SvRV (sv), "keys", 4, 0);

	if (hash_elem == NULL || *hash_elem == NULL) {
		if (!(mg = perl_xmmsclient_get_magic_from_sv (sv, "Audio::XMMSClient::Result::PropDict::Tie"))) {
			croak ("This is a bug!");
		}

		res = (xmmsc_result_propdict_t *)mg->mg_ptr;

		keys = newHV ();
		ret = xmmsc_result_propdict_foreach (res, perl_xmmsclient_extract_keys_from_propdict, keys);

		hash_elem = hv_store ((HV *)SvRV (sv), "keys", 4, newRV_noinc ((SV *)keys), 0);
	}

	keys = (HV *)SvRV (*hash_elem);
	return keys;
}

MODULE = Audio::XMMSClient::Result::PropDict::Tie	PACKAGE = Audio::XMMSClient::Result::PropDict::Tie

SV *
FIRSTKEY (sv)
		SV *sv
	PREINIT:
		HV *keys;
		HE *iter;
		char *key;
		I32 key_len;
	CODE:
		keys = perl_xmmsclient_get_keys_if_needed (sv);

		hv_iterinit (keys);
		iter = hv_iternext (keys);
		key  = hv_iterkey (iter, &key_len);

		RETVAL = newSVpv (key, key_len);
	OUTPUT:
		RETVAL

SV *
NEXTKEY (sv, lastkey)
		SV *sv
	PREINIT:
		HV *keys;
		HE *iter;
		char *key;
		I32 key_len;
	CODE:
		keys = perl_xmmsclient_get_keys_if_needed (sv);

		iter = hv_iternext (keys);

		if (iter == NULL) {
			RETVAL = &PL_sv_undef;
		}
		else {
			key  = hv_iterkey (iter, &key_len);
			RETVAL = newSVpv (key, key_len);
		}
	OUTPUT:
		RETVAL

SV *
FETCH (res, key)
		xmmsc_result_propdict_t *res
		char *key
	PREINIT:
		int ret = 0;
		uint32_t uint32_val;
		int32_t int32_val;
		const char *string_val;
		SV **he;
	CODE:
		switch (xmmsc_result_get_dict_entry_type (res, key)) {
			case XMMS_OBJECT_CMD_ARG_UINT32:
				ret = xmmsc_result_get_dict_entry_uint (res, key, &uint32_val);

				RETVAL = newSVuv (uint32_val);
				break;
			case XMMS_OBJECT_CMD_ARG_INT32:
				ret = xmmsc_result_get_dict_entry_int (res, key, &int32_val);
				RETVAL = newSViv (int32_val);
				break;
			case XMMS_OBJECT_CMD_ARG_STRING:
				ret = xmmsc_result_get_dict_entry_string (res, key, &string_val);
				RETVAL = newSVpv (string_val, 0);
				break;
			default:
				XSRETURN_UNDEF;
		}

		if (ret != 1) {
			XSRETURN_UNDEF;
		}

		he = hv_fetch ((HV *)SvRV (ST (0)), "field", 5, 0);
		if (he && *he) {
			char *key;
			STRLEN key_len;
			HV *perl_constants;

			key = SvPV (*he, key_len);
			he = hv_fetch ((HV *)SvRV (ST (0)), "constants", 9, 0);

			if (!he || !*he) {
				croak ("constants not available");
			}

			perl_constants = (HV *)SvRV (*he);

			key = SvPV (RETVAL, key_len);
			he = hv_fetch (perl_constants, key, key_len, 0);

			if (he && *he) {
				sv_2mortal (RETVAL);
				RETVAL = newSVsv (*he);
			}
		}
	OUTPUT:
		RETVAL

BOOT:
	PERL_UNUSED_VAR (items);

{'fraction_non_alphanumeric': 0.1319796954314721, 'fraction_numerical': 0.01224246043595103, 'mean_word_length': 3.055084745762712, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 16, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '930134', 'n_tokens_mistral': 3103, 'n_tokens_neox': 2724, 'n_words': 633}