view release on metacpan or  search on metacpan

Exacct.xs  view on Meta::CPAN

	/* Fetch the correct id subhash if the catalog has changed. */
	if (cat_val != cat) {
		snprintf(key, sizeof (key), "%d", cat);
		PERL_ASSERT(IdValueHash != NULL);
		svp = hv_fetch(IdValueHash, key, strlen(key), FALSE);
		if (svp == NULL) {
			cat_val = ~0U;
			cat_hash = NULL;
		} else {
			HV *hv;

			cat_val = cat;
			hv = (HV *)SvRV(*svp);
			PERL_ASSERT(hv != NULL);
			svp = hv_fetch(hv, "value", 5, FALSE);
			PERL_ASSERT(svp != NULL);
			cat_hash = (HV *)SvRV(*svp);
			PERL_ASSERT(cat_hash != NULL);
		}
	}

	/* If we couldn't find the hash, it is a catalog we don't know about. */
	if (cat_hash == NULL) {
		return ("UNKNOWN_ID");
	}

	/* Fetch the value from the selected catalog and return it. */
	snprintf(key, sizeof (key), "%d", id);
	svp = hv_fetch(cat_hash, key, strlen(key), TRUE);
	if (svp == NULL) {
		return ("UNKNOWN_ID");
	}
	return (SvPVX(*svp));
}

/*
 * Create a new ::Object by wrapping an ea_object_t in a perl SV.  This is used
 * to wrap exacct records that have been read from a file, or packed records
 * that have been inflated.
 */
SV *
new_xs_ea_object(ea_object_t *ea_obj)
{
	xs_ea_object_t	*xs_obj;
	SV		*sv_obj;

	/* Allocate space - use perl allocator. */
	New(0, xs_obj, 1, xs_ea_object_t);
	PERL_ASSERT(xs_obj != NULL);
	xs_obj->ea_obj = ea_obj;
	xs_obj->perl_obj = NULL;
	sv_obj = NEWSV(0, 0);
	PERL_ASSERT(sv_obj != NULL);

	/*
	 * Initialise according to the type of the passed exacct object,
	 * and bless the perl object into the appropriate class.
	 */
	if (ea_obj->eo_type == EO_ITEM) {
		if ((ea_obj->eo_catalog & EXT_TYPE_MASK) == EXT_EXACCT_OBJECT) {
			INIT_EMBED_ITEM_FLAGS(xs_obj);
		} else {
			INIT_PLAIN_ITEM_FLAGS(xs_obj);
		}
		sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
		sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Item_stash);
	} else {
		INIT_GROUP_FLAGS(xs_obj);
		sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
		sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Group_stash);
	}

	/*
	 * We are passing back a pointer masquerading as a perl IV,
	 * so make sure it can't be modified.
	 */
	SvREADONLY_on(SvRV(sv_obj));
	return (sv_obj);
}

/*
 * Convert the perl form of an ::Object into the corresponding exacct form.
 * This is used prior to writing an ::Object to a file, or passing it to
 * putacct.  This is only required for embedded items and groups - for normal
 * items it is a no-op.
 */
ea_object_t *
deflate_xs_ea_object(SV *sv)
{
	xs_ea_object_t	*xs_obj;
	ea_object_t	*ea_obj;

	/* Get the source xs_ea_object_t. */
	PERL_ASSERT(sv != NULL);
	sv = SvRV(sv);
	PERL_ASSERT(sv != NULL);
	xs_obj = INT2PTR(xs_ea_object_t *, SvIV(sv));
	PERL_ASSERT(xs_obj != NULL);
	ea_obj = xs_obj->ea_obj;
	PERL_ASSERT(ea_obj != NULL);

	/* Break any list this object is a part of. */
	ea_obj->eo_next = NULL;

	/* Deal with Items containing embedded Objects. */
	if (IS_EMBED_ITEM(xs_obj)) {
		xs_ea_object_t	*child_xs_obj;
		SV		*perl_obj;
		size_t		bufsz;

		/* Get the underlying perl object an deflate that in turn. */
		perl_obj = xs_obj->perl_obj;
		PERL_ASSERT(perl_obj != NULL);
		deflate_xs_ea_object(perl_obj);
		perl_obj = SvRV(perl_obj);
		PERL_ASSERT(perl_obj != NULL);
		child_xs_obj = INT2PTR(xs_ea_object_t *, SvIV(perl_obj));
		PERL_ASSERT(child_xs_obj->ea_obj != NULL);

		/* Free any existing object contents. */
		if (ea_obj->eo_item.ei_object != NULL) {
			ea_free(ea_obj->eo_item.ei_object,
			    ea_obj->eo_item.ei_size);
			ea_obj->eo_item.ei_object = NULL;
			ea_obj->eo_item.ei_size = 0;
		}

		/*  Pack the object. */
		while (1) {
			/* Use the last buffer size as a best guess. */
			if (last_bufsz != 0) {
				ea_obj->eo_item.ei_object =
				    ea_alloc(last_bufsz);
				PERL_ASSERT(ea_obj->eo_item.ei_object != NULL);
			} else {
				ea_obj->eo_item.ei_object = NULL;
			}

			/*
			 * Pack the object.  If the buffer is too small,
			 * we will go around again with the correct size.
			 * If unsucessful, we will bail.
			 */
			if ((bufsz = ea_pack_object(child_xs_obj->ea_obj,
			    ea_obj->eo_item.ei_object, last_bufsz)) == -1) {
				ea_free(ea_obj->eo_item.ei_object, last_bufsz);
				ea_obj->eo_item.ei_object = NULL;
				return (NULL);
			} else if (bufsz > last_bufsz) {
				ea_free(ea_obj->eo_item.ei_object, last_bufsz);
				last_bufsz = bufsz;
				continue;
			} else {
				ea_obj->eo_item.ei_size = bufsz;
				break;
			}
		}

	/* Deal with Groups. */
	} else if (IS_GROUP(xs_obj)) {
		MAGIC		*mg;
		AV		*av;
		int		len, i;
		xs_ea_object_t	*ary_xs;
		ea_object_t	*ary_ea, *prev_ea;