1 /*
2 * Copyright (c) 2002, 2003, Oracle and/or its affiliates. All rights reserved.
3 *
4 * Object.xs contains XS code for exacct file manipulation.
5 */
6
7 #include <strings.h>
8 #include "../exacct_common.xh"
9
10 /* Pull in the file generated by extract_defines. */
11 #include "ObjectDefs.xi"
12
13 /* From Catalog.xs. */
14 extern char *catalog_id_str(ea_catalog_t catalog);
15
16 /*
17 * Copy an xs_ea_object_t. If the perl_obj part is null, we just copy the
18 * ea_object_t part. If the perl_obj part is not null and the Object is an
19 * Item it must be because the Item contains an embedded Object, which will be
20 * recursively copied. Otherwise the Object must be a Group, so the Group will
21 * be copied, and the list of Objects it contains will be recursively copied.
22 */
23 static SV *
24 copy_xs_ea_object(SV *src_sv)
25 {
26 xs_ea_object_t *src, *dst;
27 SV *dst_sv, *dst_rv;
28
29 /* Get the source xs_ea_object_t and make a new one. */
30 PERL_ASSERT(src_sv != NULL);
31 src_sv = SvRV(src_sv);
32 PERL_ASSERT(src_sv != NULL);
33 src = INT2PTR(xs_ea_object_t *, SvIV(src_sv));
34 PERL_ASSERT(src != NULL);
35 New(0, dst, 1, xs_ea_object_t);
36 dst->flags = src->flags;
37
38 /* If the Object is a plain Item only the ea_obj part needs copying. */
39 if (IS_PLAIN_ITEM(src)) {
40 dst->ea_obj = ea_copy_object_tree(src->ea_obj);
41 PERL_ASSERT(dst->ea_obj != NULL);
42 dst->perl_obj = NULL;
43
44 /*
45 * Otherwise if it is an Item with a perl_obj part, it means that it
46 * must be an Item containing an unpacked nested Object. In this case
47 * the nested Object can be copied by a recursive call.
48 */
49 } else if (IS_EMBED_ITEM(src)) {
50 dst->ea_obj = ea_copy_object(src->ea_obj);
51 PERL_ASSERT(dst->ea_obj != NULL);
52 dst->perl_obj = copy_xs_ea_object(src->perl_obj);
53
54 /*
55 * If we get here it must be a Group, so perl_obj will point to a tied
56 * AV. We therefore copy the exacct part then create a new tied array
57 * and recursively copy each Item individually.
58 */
59 } else {
60 MAGIC *mg;
61 AV *src_av, *dst_av, *tied_av;
62 SV *sv;
63 int i, len;
64
65 /* Copy the exacct part of the Group. */
66 dst->ea_obj = ea_copy_object(src->ea_obj);
67 PERL_ASSERT(dst->ea_obj != NULL);
68
69 /* Find the AV underlying the tie. */
70 mg = mg_find(SvRV(src->perl_obj), 'P');
71 PERL_ASSERT(mg != NULL);
72 src_av = (AV *)SvRV(mg->mg_obj);
73 PERL_ASSERT(src_av != NULL);
74
75 /* Create a new AV and copy across into it. */
76 dst_av = newAV();
77 len = av_len(src_av) + 1;
78 av_extend(dst_av, len);
79 for (i = 0; i < len; i++) {
80 SV **svp;
81
82 /* undef elements don't need copying. */
83 if ((svp = av_fetch(src_av, i, FALSE)) != NULL) {
84 sv = copy_xs_ea_object(*svp);
85 if (av_store(dst_av, i, sv) == NULL) {
86 SvREFCNT_dec(sv);
87 }
88 }
89 }
90
91 /* Create a new AV and tie the filled AV to it. */
92 sv = newRV_noinc((SV *)dst_av);
93 sv_bless(sv, Sun_Solaris_Exacct_Object__Array_stash);
94 tied_av = newAV();
95 sv_magic((SV *)tied_av, sv, 'P', Nullch, 0);
96 SvREFCNT_dec(sv);
97 dst->perl_obj = newRV_noinc((SV *)tied_av);
98 }
99
100 /* Wrap the new xs_ea_object_t in a blessed RV and return it. */
101 dst_sv = newSViv(PTR2IV(dst));
102 dst_rv = newRV_noinc(dst_sv);
103 sv_bless(dst_rv, SvSTASH(src_sv));
104 SvREADONLY_on(dst_sv);
105 return (dst_rv);
106 }
107
108 /*
109 * If an ea_xs_object_t only has the ea_obj part populated, create the
110 * corresponding perl_obj part. For plain Items this is a no-op. If the
111 * object is embedded, the embedded part will be unpacked and stored in the
112 * perl part. If the object is a Group, the linked list of Items will be
113 * wrapped in the corresponding perl structure and stored in a tied perl array.
114 */
115 static int
116 inflate_xs_ea_object(xs_ea_object_t *xs_obj)
117 {
118 ea_object_t *ea_obj;
119
120 /* Check there is not already a perl_obj part. */
121 PERL_ASSERT(xs_obj != NULL);
122 PERL_ASSERT(xs_obj->perl_obj == NULL);
123
124 /* Deal with Items containing embedded Objects. */
125 if (IS_EMBED_ITEM(xs_obj)) {
126 /* unpack & wrap in an xs_ea_object_t. */
127 if (ea_unpack_object(&ea_obj, EUP_ALLOC,
128 xs_obj->ea_obj->eo_item.ei_object,
129 xs_obj->ea_obj->eo_item.ei_size) == -1) {
130 return (0);
131 }
132 xs_obj->perl_obj = new_xs_ea_object(ea_obj);
133
134 /* Deal with Groups. */
135 } else if (IS_GROUP(xs_obj)) {
136 int i, len;
137 AV *av, *tied_av;
138 SV *rv, *sv;
139
140 /* Create a new array. */
141 av = newAV();
142 ea_obj = xs_obj->ea_obj;
143 len = ea_obj->eo_group.eg_nobjs;
144 ea_obj = ea_obj->eo_group.eg_objs;
145
146 /* Copy each object from the old array into the new array. */
147 for (i = 0; i < len; i++) {
148 rv = new_xs_ea_object(ea_obj);
149 if (av_store(av, i, rv) == NULL) {
150 SvREFCNT_dec(rv);
151 }
152 ea_obj = ea_obj->eo_next;
153 }
154
155 /* Create a new AV and tie the filled AV to it. */
156 rv = newRV_noinc((SV *)av);
157 sv_bless(rv, Sun_Solaris_Exacct_Object__Array_stash);
158 tied_av = newAV();
159 sv_magic((SV *)tied_av, rv, 'P', Nullch, 0);
160 SvREFCNT_dec(rv);
161 xs_obj->perl_obj = newRV_noinc((SV *)tied_av);
162 }
163 return (1);
164 }
165
166 /*
167 * The XS code exported to perl is below here. Note that the XS preprocessor
168 * has its own commenting syntax, so all comments from this point on are in
169 * that form.
170 */
171
172 MODULE = Sun::Solaris::Exacct::Object PACKAGE = Sun::Solaris::Exacct::Object
173 PROTOTYPES: ENABLE
174
175 #
176 # Define the stash pointers if required and create and populate @_Constants.
177 #
178 BOOT:
179 {
180 init_stashes();
181 define_constants(PKGBASE "::Object", constants);
182 }
183
184 #
185 # Return a dual-typed SV containing the type of the object.
186 #
187 SV *
188 type(self)
189 xs_ea_object_t *self;
190 CODE:
191 RETVAL = newSViv(self->ea_obj->eo_type);
192 switch (self->ea_obj->eo_type) {
193 case EO_ITEM:
194 sv_setpv(RETVAL, "EO_ITEM");
195 break;
196 case EO_GROUP:
197 sv_setpv(RETVAL, "EO_GROUP");
198 break;
199 case EO_NONE:
200 default:
201 sv_setpv(RETVAL, "EO_NONE");
202 break;
203 }
204 SvIOK_on(RETVAL);
205 OUTPUT:
206 RETVAL
207
208 #
209 # Return a copy of the catalog of the object.
210 #
211 SV *
212 catalog(self)
213 xs_ea_object_t *self;
214 CODE:
215 RETVAL = new_catalog(self->ea_obj->eo_catalog);
216 OUTPUT:
217 RETVAL
218
219 #
220 # Return the value of the object. For simple Items, a SV containing the value
221 # of the underlying exacct ea_item_t is returned. For nested Items or Groups,
222 # a reference to the nested Item or Group is returned. For Groups, in a scalar
223 # context a reference to the tied array used to store the objects in the Group
224 # is returned; in a list context the objects within the Group are returned on
225 # the perl stack as a list.
226 #
227 void
228 value(self)
229 xs_ea_object_t *self;
230 PPCODE:
231 /*
232 * For Items, return the perl representation
233 * of the underlying ea_object_t.
234 */
235 if (IS_ITEM(self)) {
236 SV *retval;
237
238 switch (self->ea_obj->eo_catalog & EXT_TYPE_MASK) {
239 case EXT_UINT8:
240 retval = newSVuv(self->ea_obj->eo_item.ei_uint8);
241 break;
242 case EXT_UINT16:
243 retval = newSVuv(self->ea_obj->eo_item.ei_uint16);
244 break;
245 case EXT_UINT32:
246 retval = newSVuv(self->ea_obj->eo_item.ei_uint32);
247 break;
248 case EXT_UINT64:
249 retval = newSVuv(self->ea_obj->eo_item.ei_uint64);
250 break;
251 case EXT_DOUBLE:
252 retval = newSVnv(self->ea_obj->eo_item.ei_double);
253 break;
254 case EXT_STRING:
255 retval = newSVpvn(self->ea_obj->eo_item.ei_string,
256 self->ea_obj->eo_item.ei_size - 1);
257 break;
258 case EXT_RAW:
259 retval = newSVpvn(self->ea_obj->eo_item.ei_raw,
260 self->ea_obj->eo_item.ei_size);
261 break;
262 /*
263 * For embedded objects and Groups, return a ref to the perl SV.
264 */
265 case EXT_EXACCT_OBJECT:
266 if (self->perl_obj == NULL) {
267 /* Make sure the object is inflated. */
268 if (! inflate_xs_ea_object(self)) {
269 XSRETURN_UNDEF;
270 }
271 }
272 retval = SvREFCNT_inc(self->perl_obj);
273 break;
274 case EXT_GROUP:
275 retval = SvREFCNT_inc(self->perl_obj);
276 break;
277 case EXT_NONE:
278 default:
279 croak("Invalid object type");
280 break;
281 }
282 EXTEND(SP, 1);
283 PUSHs(sv_2mortal(retval));
284
285 /*
286 * Now we deal with Groups.
287 */
288 } else {
289 /* Make sure the object is inflated. */
290 if (self->perl_obj == NULL) {
291 if (! inflate_xs_ea_object(self)) {
292 XSRETURN_UNDEF;
293 }
294 }
295
296 /* In a list context return the contents of the AV. */
297 if (GIMME_V == G_ARRAY) {
298 MAGIC *mg;
299 AV *av;
300 int len, i;
301
302 /* Find the AV underlying the tie. */
303 mg = mg_find(SvRV(self->perl_obj), 'P');
304 PERL_ASSERT(mg != NULL);
305 av = (AV *)SvRV(mg->mg_obj);
306 PERL_ASSERT(av != NULL);
307
308 /*
309 * Push the contents of the array onto the stack.
310 * Push undef for any empty array slots.
311 */
312 len = av_len(av) + 1;
313 EXTEND(SP, len);
314 for (i = 0; i < len; i++) {
315 SV **svp;
316
317 if ((svp = av_fetch(av, i, FALSE)) == NULL) {
318 PUSHs(&PL_sv_undef);
319 } else {
320 PERL_ASSERT(*svp != NULL);
321 PUSHs(sv_2mortal(SvREFCNT_inc(*svp)));
322 }
323 }
324
325 /* In a scalar context, return a ref to the array of Items. */
326 } else {
327 EXTEND(SP, 1);
328 PUSHs(sv_2mortal(SvREFCNT_inc(self->perl_obj)));
329 }
330 }
331
332 #
333 # Call the ea_match_catalog function.
334 #
335 int
336 match_catalog(self, catalog)
337 xs_ea_object_t *self;
338 SV *catalog;
339 CODE:
340 RETVAL = ea_match_object_catalog(self->ea_obj, catalog_value(catalog));
341 OUTPUT:
342 RETVAL
343
344 #
345 # Destroy an Object.
346 #
347 void
348 DESTROY(self)
349 xs_ea_object_t *self;
350 PREINIT:
351 ea_object_t *ea_obj;
352 SV *perl_obj;
353 CODE:
354 /*
355 * Because both libexacct and perl know about the ea_object_t, we have
356 * to make sure that they don't both end up freeing the object. First
357 * we break any link to the next ea_object_t in the chain. Next, if
358 * the object is a Group and there is an active perl_obj chain, we will
359 * let perl clean up the Objects, so we zero the eo_group chain.
360 */
361 perl_obj = self->perl_obj;
362 ea_obj = self->ea_obj;
363 ea_obj->eo_next = NULL;
364 if (IS_GROUP(self) && perl_obj != NULL) {
365 ea_obj->eo_group.eg_nobjs = 0;
366 ea_obj->eo_group.eg_objs = NULL;
367 }
368 ea_free_object(ea_obj, EUP_ALLOC);
369 if (perl_obj != NULL) {
370 SvREFCNT_dec(perl_obj);
371 }
372 Safefree(self);
373
374 MODULE = Sun::Solaris::Exacct::Object PACKAGE = Sun::Solaris::Exacct::Object::Item
375 PROTOTYPES: ENABLE
376
377 #
378 # Create a new Item.
379 #
380 xs_ea_object_t *
381 new(class, catalog, value)
382 char *class;
383 SV *catalog;
384 SV *value;
385 PREINIT:
386 ea_object_t *ea_obj;
387 HV *stash;
388 CODE:
389 /* Create a new xs_ea_object_t and subsiduary structures. */
390 New(0, RETVAL, 1, xs_ea_object_t);
391 RETVAL->ea_obj = ea_obj = ea_alloc(sizeof (ea_object_t));
392 bzero(ea_obj, sizeof (*ea_obj));
393 ea_obj->eo_type = EO_ITEM;
394 ea_obj->eo_catalog = catalog_value(catalog);
395 INIT_PLAIN_ITEM_FLAGS(RETVAL);
396 RETVAL->perl_obj = NULL;
397
398 /* Assign the Item's value. */
399 switch (ea_obj->eo_catalog & EXT_TYPE_MASK) {
400 case EXT_UINT8:
401 ea_obj->eo_item.ei_uint8 = SvIV(value);
402 ea_obj->eo_item.ei_size = sizeof (uint8_t);
403 break;
404 case EXT_UINT16:
405 ea_obj->eo_item.ei_uint16 = SvIV(value);
406 ea_obj->eo_item.ei_size = sizeof (uint16_t);
407 break;
408 case EXT_UINT32:
409 ea_obj->eo_item.ei_uint32 = SvIV(value);
410 ea_obj->eo_item.ei_size = sizeof (uint32_t);
411 break;
412 case EXT_UINT64:
413 ea_obj->eo_item.ei_uint64 = SvIV(value);
414 ea_obj->eo_item.ei_size = sizeof (uint64_t);
415 break;
416 case EXT_DOUBLE:
417 ea_obj->eo_item.ei_double = SvNV(value);
418 ea_obj->eo_item.ei_size = sizeof (double);
419 break;
420 case EXT_STRING:
421 ea_obj->eo_item.ei_string = ea_strdup(SvPV_nolen(value));
422 ea_obj->eo_item.ei_size = SvCUR(value) + 1;
423 break;
424 case EXT_RAW:
425 ea_obj->eo_item.ei_size = SvCUR(value);
426 ea_obj->eo_item.ei_raw = ea_alloc(ea_obj->eo_item.ei_size);
427 bcopy(SvPV_nolen(value), ea_obj->eo_item.ei_raw,
428 (size_t)ea_obj->eo_item.ei_size);
429 break;
430 case EXT_EXACCT_OBJECT:
431 /*
432 * The ea_obj part is initially empty, and will be populated
433 * from the perl_obj part when required.
434 */
435 stash = SvROK(value) ? SvSTASH(SvRV(value)) : NULL;
436 if (stash != Sun_Solaris_Exacct_Object_Item_stash &&
437 stash != Sun_Solaris_Exacct_Object_Group_stash) {
438 croak("value is not of type " PKGBASE "::Object");
439 }
440 RETVAL->perl_obj = copy_xs_ea_object(value);
441 ea_obj->eo_item.ei_object = NULL;
442 ea_obj->eo_item.ei_size = 0;
443 INIT_EMBED_ITEM_FLAGS(RETVAL);
444 break;
445 /*
446 * EXT_NONE is an invalid type,
447 * EXT_GROUP is created by the Group subclass constructor.
448 */
449 case EXT_NONE:
450 case EXT_GROUP:
451 default:
452 ea_free(RETVAL->ea_obj, sizeof (RETVAL->ea_obj));
453 Safefree(RETVAL);
454 croak("Invalid object type");
455 break;
456 }
457 OUTPUT:
458 RETVAL
459
460 MODULE = Sun::Solaris::Exacct::Object PACKAGE = Sun::Solaris::Exacct::Object::Group
461 PROTOTYPES: ENABLE
462
463 xs_ea_object_t *
464 new(class, catalog, ...)
465 char *class;
466 SV *catalog;
467 PREINIT:
468 ea_catalog_t tag;
469 ea_object_t *ea_obj;
470 AV *tied_av, *av;
471 SV *sv, *rv;
472 int i;
473 CODE:
474 tag = catalog_value(catalog);
475 if ((tag & EXT_TYPE_MASK) != EXT_GROUP) {
476 croak("Invalid object type");
477 }
478
479 /* Create a new xs_ea_object_t and subsiduary structures. */
480 New(0, RETVAL, 1, xs_ea_object_t);
481 RETVAL->ea_obj = ea_obj = ea_alloc(sizeof (ea_object_t));
482 bzero(ea_obj, sizeof (*ea_obj));
483 ea_obj->eo_type = EO_GROUP;
484 ea_obj->eo_catalog = tag;
485 INIT_GROUP_FLAGS(RETVAL);
486 RETVAL->perl_obj = NULL;
487
488 /* Create a new AV and copy in all the passed Items. */
489 av = newAV();
490 av_extend(av, items - 2);
491 for (i = 2; i < items; i++) {
492 HV *stash;
493 stash = SvROK(ST(i)) ? SvSTASH(SvRV(ST(i))) : NULL;
494 if (stash != Sun_Solaris_Exacct_Object_Item_stash &&
495 stash != Sun_Solaris_Exacct_Object_Group_stash) {
496 croak("item is not of type " PKGBASE "::Object");
497 }
498 av_store(av, i - 2, copy_xs_ea_object(ST(i)));
499 }
500
501 /* Bless the copied AV and tie it to a new AV */
502 rv = newRV_noinc((SV *)av);
503 sv_bless(rv, Sun_Solaris_Exacct_Object__Array_stash);
504 tied_av = newAV();
505 sv_magic((SV *)tied_av, rv, 'P', Nullch, 0);
506 SvREFCNT_dec(rv);
507 RETVAL->perl_obj = newRV_noinc((SV *)tied_av);
508 OUTPUT:
509 RETVAL
510
511 #
512 # Return the contents of the group as a hashref, using the string value of each
513 # item's catalog id as the key. There are two forms - as_hash() which stores
514 # each hash value as a scalar, and should be used when it is known the group
515 # does not contain duplicate catalog tags, and as_hashlist wich stores each
516 # hash value as an array of values, and can therefore be used when the group
517 # may contain duplicate catalog tags.
518 #
519
520 SV *
521 as_hash(self)
522 xs_ea_object_t *self;
523 ALIAS:
524 as_hashlist = 1
525 PREINIT:
526 MAGIC *mg;
527 HV *hv;
528 AV *av;
529 int len, i;
530 CODE:
531 /* Make sure the object is inflated. */
532 if (self->perl_obj == NULL) {
533 if (! inflate_xs_ea_object(self)) {
534 XSRETURN_UNDEF;
535 }
536 }
537
538 /* Find the AV underlying the tie and create the new HV. */
539 mg = mg_find(SvRV(self->perl_obj), 'P');
540 PERL_ASSERT(mg != NULL);
541 av = (AV *)SvRV(mg->mg_obj);
542 PERL_ASSERT(av != NULL);
543 hv = newHV();
544
545 /*
546 * Traverse the value array, saving the values in the hash,
547 * keyed by the string value of the catalog id field.
548 */
549 len = av_len(av) + 1;
550 for (i = 0; i < len; i++) {
551 SV **svp, *val;
552 xs_ea_object_t *xs_obj;
553 const char *key;
554
555 /* Ignore undef values. */
556 if ((svp = av_fetch(av, i, FALSE)) == NULL) {
557 continue;
558 }
559 PERL_ASSERT(*svp != NULL);
560
561 /* Figure out the key. */
562 xs_obj = INT2PTR(xs_ea_object_t *, SvIV(SvRV(*svp)));
563 key = catalog_id_str(xs_obj->ea_obj->eo_catalog);
564
565 /*
566 * For Items, save the perl representation
567 * of the underlying ea_object_t.
568 */
569 if (IS_ITEM(xs_obj)) {
570 switch (xs_obj->ea_obj->eo_catalog & EXT_TYPE_MASK) {
571 case EXT_UINT8:
572 val =
573 newSVuv(xs_obj->ea_obj->eo_item.ei_uint8);
574 break;
575 case EXT_UINT16:
576 val =
577 newSVuv(xs_obj->ea_obj->eo_item.ei_uint16);
578 break;
579 case EXT_UINT32:
580 val =
581 newSVuv(xs_obj->ea_obj->eo_item.ei_uint32);
582 break;
583 case EXT_UINT64:
584 val =
585 newSVuv(xs_obj->ea_obj->eo_item.ei_uint64);
586 break;
587 case EXT_DOUBLE:
588 val =
589 newSVnv(xs_obj->ea_obj->eo_item.ei_double);
590 break;
591 case EXT_STRING:
592 val =
593 newSVpvn(xs_obj->ea_obj->eo_item.ei_string,
594 xs_obj->ea_obj->eo_item.ei_size - 1);
595 break;
596 case EXT_RAW:
597 val =
598 newSVpvn(xs_obj->ea_obj->eo_item.ei_raw,
599 xs_obj->ea_obj->eo_item.ei_size);
600 break;
601 /*
602 * For embedded objects and Groups, return a ref
603 * to the perl SV.
604 */
605 case EXT_EXACCT_OBJECT:
606 if (xs_obj->perl_obj == NULL) {
607 /* Make sure the object is inflated. */
608 if (! inflate_xs_ea_object(xs_obj)) {
609 SvREFCNT_dec(hv);
610 XSRETURN_UNDEF;
611 }
612 }
613 val = SvREFCNT_inc(xs_obj->perl_obj);
614 break;
615 case EXT_GROUP:
616 val = SvREFCNT_inc(xs_obj->perl_obj);
617 break;
618 case EXT_NONE:
619 default:
620 croak("Invalid object type");
621 break;
622 }
623 /*
624 * Now we deal with Groups.
625 */
626 } else {
627 /* Make sure the object is inflated. */
628 if (xs_obj->perl_obj == NULL) {
629 if (! inflate_xs_ea_object(xs_obj)) {
630 SvREFCNT_dec(hv);
631 XSRETURN_UNDEF;
632 }
633 }
634 val = SvREFCNT_inc(xs_obj->perl_obj);
635 }
636
637 /*
638 * If called as as_hash(), store the value directly in the
639 * hash, if called as as_hashlist(), store the value in an
640 * array within the hash.
641 */
642 if (ix == 0) {
643 hv_store(hv, key, strlen(key), val, FALSE);
644 } else {
645 AV *ary;
646
647 /* If the key already exists in the hash. */
648 svp = hv_fetch(hv, key, strlen(key), TRUE);
649 if (SvOK(*svp)) {
650 ary = (AV *)SvRV(*svp);
651
652 /* Otherwise, add a new array to the hash. */
653 } else {
654 SV *rv;
655 ary = newAV();
656 rv = newRV_noinc((SV *)ary);
657 sv_setsv(*svp, rv);
658 SvREFCNT_dec(rv);
659 }
660 av_push(ary, val);
661 }
662 }
663 RETVAL = newRV_noinc((SV *)hv);
664 OUTPUT:
665 RETVAL
666
667 MODULE = Sun::Solaris::Exacct::Object PACKAGE = Sun::Solaris::Exacct::Object::_Array
668 PROTOTYPES: ENABLE
669
670 #
671 # Copy the passed list of xs_ea_object_t.
672 #
673 void
674 copy_xs_ea_objects(...)
675 PREINIT:
676 int i;
677 PPCODE:
678 EXTEND(SP, items);
679 for (i = 0; i < items; i++) {
680 HV *stash;
681 stash = SvROK(ST(i)) ? SvSTASH(SvRV(ST(i))) : NULL;
682 if (stash != Sun_Solaris_Exacct_Object_Item_stash &&
683 stash != Sun_Solaris_Exacct_Object_Group_stash) {
684 croak("item is not of type " PKGBASE "::Object");
685 }
686 PUSHs(sv_2mortal(copy_xs_ea_object(ST(i))));
687 }