1/*
2 * Copyright (c) 2002, Oracle and/or its affiliates. All rights reserved.
3 */
4
5/*
6 * Catalog.xs contains XS code for exacct catalog tag manipulation.  This
7 * consists of code to create the @_Constants array and %_Constants hash used
8 * for defining constants on the fly via AUTOLOAD, and utility functions for
9 * creaing double-typed SVs.
10 */
11
12#include "../exacct_common.xh"
13
14/* Pull in the file generated by extract_defines. */
15#include "CatalogDefs.xi"
16
17/*
18 * This function populates the %_Constants hash and @_Constants array based on
19 * the values extracted from the exacct header files by the extract_defines
20 * script and written to the .xi file which is included above.  It also creates
21 * a const sub for each constant that returns the associcated value.  It should
22 * be called from the BOOT section of this module.  The structure of the
23 * %_Constants hash is given below - this is used to map between the symbolic
24 * and numeric values of the various EX[CTD] constants.  The register() method
25 * extends the %_Constants hash with values for the foreign catalog, so that it
26 * can be handled in exactly the same way as the built-in catalog.
27 *
28 * $Constants{catlg}{name}{EXC_DEFAULT} => 0
29 *                  ...
30 *                  {value}{0} => 'EXC_DEFAULT'
31 *                  ...
32 *                           *A*
33 *           {id}{name}{EXD}{name}{EXD_CREATOR} => 3
34 *                          ...
35 *                          {value}{3} => 'EXD_CREATOR'
36 *                          ...
37 *               {value}{0} => *A*
38 *               ...
39 *           {other}{name}{EXC_CATALOG_MASK} => 251658240
40 *                  ...
41 *                  {value}{251658240} => 'EXC_CATALOG_MASK'
42 *                  ...
43 *           {type}{name}{EXT_DOUBLE} => 1342177280
44 *                 ...
45 *                 {value}{1342177280} => 'EXT_DOUBLE'
46 *                 ...
47 */
48#define	CONST_NAME "::Catalog::_Constants"
49static void
50define_catalog_constants()
51{
52	HV		*const_hash, *hv1, *hv2, *hv3;
53	AV		*const_ary;
54	HV		*type_by_name,  *type_by_value;
55	HV		*catlg_by_name, *catlg_by_value;
56	HV		*id_by_name,    *id_by_value;
57	HV		*other_by_name, *other_by_value;
58	constval_t	*cvp;
59
60	/* Create the two new perl variables. */
61	const_hash = perl_get_hv(PKGBASE CONST_NAME, TRUE);
62	const_ary = perl_get_av(PKGBASE CONST_NAME, TRUE);
63
64	/* Create the 'type' subhash. */
65	type_by_name = newHV();
66	type_by_value = newHV();
67	hv1 = newHV();
68	hv_store(const_hash, "type", 4, newRV_noinc((SV*)hv1), 0);
69	hv_store(hv1, "name", 4, newRV_noinc((SV*)type_by_name), 0);
70	hv_store(hv1, "value", 5, newRV_noinc((SV*)type_by_value), 0);
71
72	/* Create the 'catlg' subhash. */
73	catlg_by_name = newHV();
74	catlg_by_value = newHV();
75	hv1 = newHV();
76	hv_store(const_hash, "catlg", 5, newRV_noinc((SV*)hv1), 0);
77	hv_store(hv1, "name", 4, newRV_noinc((SV*)catlg_by_name), 0);
78	hv_store(hv1, "value", 5, newRV_noinc((SV*)catlg_by_value), 0);
79
80	/*
81	 * The 'id' subhash has an extra level of name/value subhashes,
82	 * where the upper level is indexed by the catalog prefix (EXD for
83	 * the default catalog).  The lower two levels are actually the same
84	 * hashes referenced by two parents, and hold the catalog id numeric
85	 * values and corresponding string values.
86	 */
87	id_by_name = newHV();
88	id_by_value = newHV();
89	hv1 = newHV();
90	hv_store(const_hash, "id", 2, newRV_noinc((SV*)hv1), 0);
91	hv2 = newHV();
92	hv_store(hv1, "name", 4, newRV_noinc((SV*)hv2), 0);
93	hv3 = newHV();
94	hv_store(hv2, "EXD", 3, newRV_noinc((SV*)hv3), 0);
95	hv_store(hv3, "name", 4, newRV_noinc((SV*)id_by_name), 0);
96	hv_store(hv3, "value", 5, newRV_noinc((SV*)id_by_value), 0);
97	IdValueHash = newHV();
98	hv_store(hv1, "value", 5, newRV_noinc((SV*)IdValueHash), 0);
99	hv_store_ent(IdValueHash, newSVuv(EXC_DEFAULT), newRV_inc((SV*)hv3), 0);
100
101	/* Create the 'other' subhash, for non-catalog #defines. */
102	other_by_name = newHV();
103	other_by_value = newHV();
104	hv1 = newHV();
105	hv_store(const_hash, "other", 5, newRV_noinc((SV*)hv1), 0);
106	hv_store(hv1, "name", 4, newRV_noinc((SV*)other_by_name), 0);
107	hv_store(hv1, "value", 5, newRV_noinc((SV*)other_by_value), 0);
108
109	/*
110	 * Populate %_Constants and %_Constants from the contents of the
111	 * generated constants array.
112	 */
113	for (cvp = constants; cvp->name != NULL; cvp++) {
114		HV	*name_hv, *value_hv;
115		SV	*name, *value;
116
117		/* Create the name/value SVs, save the name in @_Constants. */
118		name = newSVpvn((char *)cvp->name, cvp->len);
119		value = newSVuv(cvp->value);
120		av_push(const_ary, SvREFCNT_inc(name));
121
122		/*
123		 * Decide which hash the name/value belong in,
124		 * based on consttype .
125		 */
126		switch (cvp->consttype) {
127		case type:
128			name_hv  = type_by_name;
129			value_hv = type_by_value;
130			break;
131		case catlg:
132			name_hv = catlg_by_name;
133			/* Special case for duplicated-value EXC_NONE tag. */
134			if (cvp->value == EXC_NONE &&
135			    strcmp(cvp->name, "EXC_NONE") == 0) {
136				value_hv = NULL;
137			} else {
138				value_hv = catlg_by_value;
139			}
140			break;
141		case id:
142			name_hv  = id_by_name;
143			value_hv = id_by_value;
144			break;
145		case other:
146			name_hv  = other_by_name;
147			value_hv = other_by_value;
148			break;
149		}
150
151		/* Store in the appropriate name & value hashes. */
152		if (name_hv) {
153			hv_store_ent(name_hv, name, value, 0);
154		}
155		if (value_hv) {
156			hv_store_ent(value_hv, value, name, 0);
157		}
158
159		/* Free the name and/or value if they weren't used. */
160		if (! name_hv) {
161			SvREFCNT_dec(value);
162		}
163		if (! value_hv) {
164			SvREFCNT_dec(name);
165		}
166	}
167}
168#undef CONST_NAME
169
170/*
171 * The XS code exported to perl is below here.  Note that the XS preprocessor
172 * has its own commenting syntax, so all comments from this point on are in
173 * that form.
174 *
175 * All the following are private functions.
176 */
177
178MODULE = Sun::Solaris::Exacct::Catalog PACKAGE = Sun::Solaris::Exacct::Catalog
179PROTOTYPES: ENABLE
180
181 #
182 # Define the stash pointers if required and create and populate @_Constants.
183 #
184BOOT:
185	init_stashes();
186	define_catalog_constants();
187
188 #
189 # Create and return a double-typed SV.
190 #
191SV*
192_double_type(i, c)
193	unsigned int	i;
194	char		*c;
195CODE:
196	RETVAL = newSVuv(i);
197	sv_setpv(RETVAL, c);
198	SvIOK_on(RETVAL);
199OUTPUT:
200	RETVAL
201
202 #
203 # Return true if the SV contains an IV.
204 #
205int
206_is_iv(sv)
207	SV	*sv;
208CODE:
209	RETVAL = SvIOK(sv);
210OUTPUT:
211	RETVAL
212
213 #
214 # Return true if the SV contains a PV.
215 #
216int
217_is_pv(sv)
218	SV	*sv;
219CODE:
220	RETVAL = SvPOK(sv);
221OUTPUT:
222	RETVAL
223
224 #
225 # Return a blessed reference to a readonly copy of the passed IV
226 #
227SV*
228_new_catalog(sv)
229	SV	*sv;
230CODE:
231	RETVAL = new_catalog(SvUV(sv));
232OUTPUT:
233	RETVAL
234
235 #
236 # Return the integer catalog value from the passed object or SV.
237 #
238int
239_catalog_value(sv)
240	SV	*sv;
241CODE:
242	RETVAL = catalog_value(sv);
243OUTPUT:
244	RETVAL
245