/*
*
* Exacct.xs contains XS code for creating various exacct-related constants,
* and for providing wrappers around exacct error handling and
* accounting-related system calls. It also contains commonly-used utility
* code shared by its sub-modules.
*/
#include <string.h>
#include "exacct_common.xh"
/*
* Pull in the file generated by extract_defines. This contains a table
* of numeric constants and their string equivalents which have been extracted
* from the various exacct header files by the extract_defines script.
*/
#include "ExacctDefs.xi"
/*
* Object stash pointers - caching these speeds up the creation and
* typechecking of perl objects by removing the need to do a hash lookup.
* The peculiar variable names are so that typemaps can generate the correct
* package name using the typemap '$Package' variable as the root of the name.
*/
/*
* Pointer to part of the hash tree built by define_catalog_constants in
* Catalog.xs. This is used by catalog_id_str() when mapping from a catalog
* to an id string.
*/
/*
* Last buffer size used for packing and unpacking exacct objects.
*/
static int last_bufsz = 0;
/*
* Common utility code. This is placed here instead of in the sub-modules to
* reduce the number of cross-module linker dependencies that are required,
* although most of the code more properly belongs in the sub-modules.
*/
/*
* This function populates the various stash pointers used by the ::Exacct
* module. It is called from each of the module BOOT sections to ensure the
* stash pointers are initialised on startup.
*/
void
init_stashes(void)
{
if (Sun_Solaris_Exacct_Catalog_stash == NULL) {
}
}
/*
* This function populates the @_Constants array in the specified package
* based on the values extracted from the exacct header files by the
* extract_defines script and written to the .xi file which is included above.
* It also creates a const sub for each constant that returns the associcated
* value. It should be called from the BOOT sections of modules that export
* constants.
*/
#define CONST_NAME "::_Constants"
void
{
char *name;
/* Create the new perl @_Constants variable. */
/* Populate @_Constants from the contents of the generated array. */
}
}
/*
* Return a new Catalog object - only accepts an integer catalog value.
* Use this purely for speed when creating Catalog objects from other XS code.
* All other Catalog object creation should be done with the perl new() method.
*/
SV*
{
return (ref);
}
/*
* Return the integer catalog value from the passed Catalog or IV.
* Calls croak() if the SV is not of the correct type.
*/
{
/* If a reference, dereference and check it is a Catalog. */
} else {
croak("Parameter is not a Catalog or integer");
}
/* For a plain IV, just return the value. */
/* Anything else is an error */
} else {
croak("Parameter is not a Catalog or integer");
}
}
/*
* Return the string value of the id subfield of an ea_catalog_t.
*/
char *
{
static ea_catalog_t cat_val = ~0U;
/* Fetch the correct id subhash if the catalog has changed. */
cat_val = ~0U;
} else {
}
}
/* If we couldn't find the hash, it is a catalog we don't know about. */
return ("UNKNOWN_ID");
}
/* Fetch the value from the selected catalog and return it. */
return ("UNKNOWN_ID");
}
}
/*
* 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 *
{
/* Allocate space - use perl allocator. */
/*
* Initialise according to the type of the passed exacct object,
* and bless the perl object into the appropriate class.
*/
} else {
}
} else {
}
/*
* We are passing back a pointer masquerading as a perl IV,
* so make sure it can't be modified.
*/
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.
*/
{
/* Get the source xs_ea_object_t. */
/* Break any list this object is a part of. */
/* Deal with Items containing embedded Objects. */
if (IS_EMBED_ITEM(xs_obj)) {
/* Get the underlying perl object an deflate that in turn. */
/* Free any existing object contents. */
}
/* Pack the object. */
while (1) {
/* Use the last buffer size as a best guess. */
if (last_bufsz != 0) {
} else {
}
/*
* Pack the object. If the buffer is too small,
* we will go around again with the correct size.
* If unsucessful, we will bail.
*/
return (NULL);
} else if (bufsz > last_bufsz) {
last_bufsz = bufsz;
continue;
} else {
break;
}
}
/* Deal with Groups. */
int len, i;
/* Find the AV underlying the tie. */
/*
* Step along the AV, deflating each object and linking it into
* the exacct group item list.
*/
for (i = 0; i < len; i++) {
/*
* Get the source xs_ea_object_t. If the current slot
* in the array is empty, skip it.
*/
continue;
}
/* Deflate it. */
/* Link into the list. */
}
}
}
}
return (ea_obj);
}
/*
* Private Sun::Solaris::Exacct utility code.
*/
/*
* Return a string representation of an ea_error.
*/
static const char *
{
switch (eno) {
case EXR_OK:
return ("no error");
case EXR_SYSCALL_FAIL:
return ("system call failed");
case EXR_CORRUPT_FILE:
return ("corrupt file");
case EXR_EOF:
return ("end of file");
case EXR_NO_CREATOR:
return ("no creator");
case EXR_INVALID_BUF:
return ("invalid buffer");
case EXR_NOTSUPP:
return ("not supported");
case EXR_UNKN_VERSION:
return ("unknown version");
case EXR_INVALID_OBJ:
return ("invalid object");
default:
return ("unknown error");
}
}
/*
* The XS code exported to perl is below here. Note that the XS preprocessor
* has its own commenting syntax, so all comments from this point on are in
* that form.
*/
#
#
BOOT:
init_stashes();
#
#
SV*
ea_error()
int eno;
const char *msg;
CODE:
#
#
char*
int eno;
CODE:
if (eno == EXR_SYSCALL_FAIL) {
RETVAL = "unknown system error";
}
} else {
}
#
#
SV*
int bufsz;
char *buf;
CODE:
/* Get the required accounting buffer. */
while (1) {
/* Use the last buffer size as a best guess. */
if (last_bufsz != 0) {
} else {
}
/*
* get the accounting record. If the buffer is too small,
* we will go around again with the correct size.
* If unsucessful, we will bail.
*/
if (last_bufsz != 0) {
}
} else if (bufsz > last_bufsz) {
last_bufsz = bufsz;
continue;
} else {
break;
}
}
/* Unpack the buffer. */
}
#
#
SV*
unsigned int bufsz;
char *buf;
CODE:
/* If it is an ::Object::Item or ::Object::Group, pack it. */
if (stash == Sun_Solaris_Exacct_Object_Item_stash ||
/* Deflate the object. */
}
/* Pack the object. */
while (1) {
/* Use the last buffer size as a best guess. */
if (last_bufsz != 0) {
} else {
}
/*
* Pack the object. If the buffer is too small, we
* will go around again with the correct size.
* If unsucessful, we will bail.
*/
== -1) {
if (last_bufsz != 0) {
}
} else if (bufsz > last_bufsz) {
last_bufsz = bufsz;
continue;
} else {
break;
}
}
/* Otherwise treat it as normal SV - convert to a string. */
} else {
}
/* Call putacct to write the buffer */
/* Clean up if we allocated a buffer. */
if (flags == EP_EXACCT_OBJECT) {
}
#
#
int
int flags;