view release on metacpan or  search on metacpan

Object/Object.xs  view on Meta::CPAN

 */

MODULE = Sun::Solaris::Exacct::Object PACKAGE = Sun::Solaris::Exacct::Object
PROTOTYPES: ENABLE

 #
 # Define the stash pointers if required and create and populate @_Constants.
 #
BOOT:
	{
	init_stashes();
	define_constants(PKGBASE "::Object", constants);
	}

 #
 # Return a dual-typed SV containing the type of the object.
 #
SV *
type(self)
	xs_ea_object_t	*self;
CODE:
	RETVAL = newSViv(self->ea_obj->eo_type);
	switch (self->ea_obj->eo_type) {
	case EO_ITEM:
		sv_setpv(RETVAL, "EO_ITEM");
		break;
	case EO_GROUP:
		sv_setpv(RETVAL, "EO_GROUP");
		break;
	case EO_NONE:
	default:
		sv_setpv(RETVAL, "EO_NONE");
		break;
	}
	SvIOK_on(RETVAL);
OUTPUT:
	RETVAL

 #
 # Return a copy of the catalog of the object.
 #
SV *
catalog(self)
	xs_ea_object_t	*self;
CODE:
	RETVAL = new_catalog(self->ea_obj->eo_catalog);
OUTPUT:
	RETVAL

 #
 # Return the value of the object.  For simple Items, a SV containing the value
 # of the underlying exacct ea_item_t is returned.  For nested Items or Groups,
 # a reference to the nested Item or Group is returned.  For Groups, in a scalar
 # context a reference to the tied array used to store the objects in the Group
 # is returned; in a list context the objects within the Group are returned on
 # the perl stack as a list.
 #
void
value(self)
	xs_ea_object_t	*self;
PPCODE:
	/*
	 * For Items, return the perl representation
	 * of the underlying ea_object_t.
	 */
	if (IS_ITEM(self)) {
		SV	*retval;

		switch (self->ea_obj->eo_catalog & EXT_TYPE_MASK) {
		case EXT_UINT8:
			retval = newSVuv(self->ea_obj->eo_item.ei_uint8);
			break;
		case EXT_UINT16:
			retval = newSVuv(self->ea_obj->eo_item.ei_uint16);
			break;
		case EXT_UINT32:
			retval = newSVuv(self->ea_obj->eo_item.ei_uint32);
			break;
		case EXT_UINT64:
			retval = newSVuv(self->ea_obj->eo_item.ei_uint64);
			break;
		case EXT_DOUBLE:
			retval = newSVnv(self->ea_obj->eo_item.ei_double);
			break;
		case EXT_STRING:
			retval = newSVpvn(self->ea_obj->eo_item.ei_string,
			    self->ea_obj->eo_item.ei_size - 1);
			break;
		case EXT_RAW:
			retval = newSVpvn(self->ea_obj->eo_item.ei_raw,
			    self->ea_obj->eo_item.ei_size);
			break;
		/*
		 * For embedded objects and Groups, return a ref to the perl SV.
		 */
		case EXT_EXACCT_OBJECT:
			if (self->perl_obj == NULL) {
				/* Make sure the object is inflated. */
				if (! inflate_xs_ea_object(self)) {
					XSRETURN_UNDEF;
				}
			}
			retval = SvREFCNT_inc(self->perl_obj);
			break;
		case EXT_GROUP:
			retval = SvREFCNT_inc(self->perl_obj);
			break;
		case EXT_NONE:
		default:
			croak("Invalid object type");
			break;
		}
		EXTEND(SP, 1);
		PUSHs(sv_2mortal(retval));

	/*
	 * Now we deal with Groups.
	 */
	} else {
		/* Make sure the object is inflated. */
		if (self->perl_obj == NULL) {

Object/Object.xs  view on Meta::CPAN

				break;
			case EXT_NONE:
			default:
				croak("Invalid object type");
				break;
			}
		/*
		 * Now we deal with Groups.
		 */
		} else {
			/* Make sure the object is inflated. */
			if (xs_obj->perl_obj == NULL) {
				if (! inflate_xs_ea_object(xs_obj)) {
					SvREFCNT_dec(hv);
					XSRETURN_UNDEF;
				}
			}
			val = SvREFCNT_inc(xs_obj->perl_obj);
		}

		/*
		 * If called as as_hash(), store the value directly in the
		 * hash, if called as as_hashlist(), store the value in an
		 * array within the hash.
		 */
		if (ix == 0) {
			hv_store(hv, key, strlen(key), val, FALSE);
		} else {
			AV *ary;

			/* If the key already exists in the hash. */
			svp = hv_fetch(hv, key, strlen(key), TRUE);
			if (SvOK(*svp)) {
				ary = (AV *)SvRV(*svp);

			/* Otherwise, add a new array to the hash. */
			} else {
				SV *rv;
				ary = newAV();
				rv = newRV_noinc((SV *)ary);
				sv_setsv(*svp, rv);
				SvREFCNT_dec(rv);
			}
			av_push(ary, val);
		}
	}
	RETVAL = newRV_noinc((SV *)hv);
OUTPUT:
	RETVAL

MODULE = Sun::Solaris::Exacct::Object PACKAGE = Sun::Solaris::Exacct::Object::_Array
PROTOTYPES: ENABLE

 #
 # Copy the passed list of xs_ea_object_t.
 #
void
copy_xs_ea_objects(...)
PREINIT:
	int	i;
PPCODE:
	EXTEND(SP, items);
	for (i = 0; i < items; i++) {
		HV	*stash;
		stash = SvROK(ST(i)) ? SvSTASH(SvRV(ST(i))) : NULL;
		if (stash != Sun_Solaris_Exacct_Object_Item_stash &&
		    stash != Sun_Solaris_Exacct_Object_Group_stash) {
			croak("item is not of type " PKGBASE "::Object");
		}
		PUSHs(sv_2mortal(copy_xs_ea_object(ST(i))));
	}