path: root/src/perl/PMDA/PMDA.xs

/*
 * Copyright (c) 2013-2014 Red Hat.
 * Copyright (c) 2008-2012 Aconex.  All Rights Reserved.
 * Copyright (c) 2004 Silicon Graphics, Inc.  All Rights Reserved.
 * 
 * This program is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the
 * Free Software Foundation; either version 2 of the License, or (at your
 * option) any later version.
 * 
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 * for more details.
 */

#include "local.h"
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

static pmdaInterface dispatch;
static pmdaMetric *metrictab;
static int mtab_size;
static __pmnsTree *pmns;
static int need_refresh;
static pmdaIndom *indomtab;
static int itab_size;
static int *clustertab;
static int ctab_size;

static HV *metric_names;
static HV *metric_oneline;
static HV *metric_helptext;
static HV *indom_helptext;
static HV *indom_oneline;

static SV *fetch_func;
static SV *refresh_func;
static SV *instance_func;
static SV *store_cb_func;
static SV *fetch_cb_func;

int
clustertab_lookup(int cluster)
{
    int i, found = 0;

    for (i = 0; i < ctab_size; i++) {
	if (cluster == clustertab[i]) {
	    found = 1;
	    break;
	}
    }
    return found;
}

void
clustertab_replace(int index, int cluster)
{
    if (index >= 0 && index < ctab_size)
	clustertab[index] = cluster;
    else
	warn("invalid cluster table replacement requested");
}

void
clustertab_scratch()
{
    memset(clustertab, -1, sizeof(int) * ctab_size);
}

void
clustertab_refresh(int index)
{
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSVuv(clustertab[index])));
    PUTBACK;

    perl_call_sv(refresh_func, G_VOID);

    SPAGAIN;
    PUTBACK;
    FREETMPS;
    LEAVE;
}

void
refresh(int numpmid, pmID *pmidlist)
{
    int i, numclusters = 0;
    __pmID_int *pmid;

    /* Create list of affected clusters from pmidlist
     * Note: we overwrite the initial cluster array here, to avoid
     * allocating memory.  The initial array contains all possible
     * clusters whereas we (possibly) construct a subset here.  We
     * do not touch ctab_size at all, however, which lets us reuse
     * the preallocated array space on every fetch.
     */
    clustertab_scratch();
    for (i = 0; i < numpmid; i++) {
	pmid = (__pmID_int *) &pmidlist[i];
	if (clustertab_lookup(pmid->cluster) == 0)
	    clustertab_replace(numclusters++, pmid->cluster);
    }

    /* For each unique cluster, call the cluster refresh method */
    for (i = 0; i < numclusters; i++)
	clustertab_refresh(i);
}

void
pmns_refresh(void)
{
    char *pmid, *next;
    I32 idsize;
    SV *metric;
    int sts;

    if (pmns)
	__pmFreePMNS(pmns);

    if ((sts = __pmNewPMNS(&pmns)) < 0)
	croak("failed to create namespace root: %s", pmErrStr(sts));

    hv_iterinit(metric_names);
    while ((metric = hv_iternextsv(metric_names, &pmid, &idsize)) != NULL) {
	unsigned int domain, cluster, item, id;

	domain = strtoul(pmid, &next, 10);
	cluster = strtoul(next+1, &next, 10);
	item = strtoul(next+1, &next, 10);
	id = pmid_build(domain, cluster, item);
	if ((sts = __pmAddPMNSNode(pmns, id, SvPV_nolen(metric))) < 0)
	    croak("failed to add metric %s(%s) to namespace: %s",
		SvPV_nolen(metric), pmIDStr(id), pmErrStr(sts));
    }

    pmdaTreeRebuildHash(pmns, mtab_size); /* for reverse (pmid->name) lookups */
    need_refresh = 0;
}

int
pmns_desc(pmID pmid, pmDesc *desc, pmdaExt *ep)
{
    if (need_refresh)
	pmns_refresh();
    return pmdaDesc(pmid, desc, ep);
}

int
pmns_pmid(const char *name, pmID *pmid, pmdaExt *pmda)
{
    if (need_refresh)
	pmns_refresh();
    return pmdaTreePMID(pmns, name, pmid);
}

int
pmns_name(pmID pmid, char ***nameset, pmdaExt *pmda)
{
    if (need_refresh)
	pmns_refresh();
    return pmdaTreeName(pmns, pmid, nameset);
}

int
pmns_children(const char *name, int traverse, char ***kids, int **sts, pmdaExt *pmda)
{
    if (need_refresh)
	pmns_refresh();
    return pmdaTreeChildren(pmns, name, traverse, kids, sts);
}

void
pmns_write(void)
{
    __pmnsNode *node;
    char *pppenv = getenv("PCP_PERL_PMNS");
    int root = pppenv ? strcmp(pppenv, "root") == 0 : 0;
    char *prefix = root ? "\t" : "";

    pmns_refresh();

    if (root)
	printf("root {\n");
    for (node = pmns->root->first; node != NULL; node = node->next)
	printf("%s%s\t%u:*:*\n", prefix, node->name, dispatch.domain);
    if (root)
	printf("}\n");
}

void
domain_write(void)
{
    char *p, name[512] = { 0 };
    int i, len = strlen(pmProgname);

    if (len >= sizeof(name) - 1)
	len = sizeof(name) - 2;
    p = pmProgname;
    if (strncmp(pmProgname, "pmda", 4) == 0)
	p += 4;
    for (i = 0; i < len; i++)
	name[i] = toupper(p[i]);
    printf("#define %s %u\n", name, dispatch.domain);
}

void
prefetch(void)
{
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(sp);
    PUTBACK;

    perl_call_sv(fetch_func, G_VOID|G_NOARGS);

    SPAGAIN;
    PUTBACK;
    FREETMPS;
    LEAVE;
}

int
fetch(int numpmid, pmID *pmidlist, pmResult **rp, pmdaExt *pmda)
{
    if (need_refresh)
	pmns_refresh();
    if (fetch_func)
	prefetch();
    if (refresh_func)
	refresh(numpmid, pmidlist);
    return pmdaFetch(numpmid, pmidlist, rp, pmda);
}

int
instance_index(pmInDom indom)
{
    int i;

    for (i = 0; i < itab_size; i++)
	if (indomtab[i].it_indom == indom)
	    return i;
    return PM_INDOM_NULL;
}

void
preinstance(pmInDom indom)
{
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSVuv(indom)));
    PUTBACK;

    perl_call_sv(instance_func, G_VOID);

    SPAGAIN;
    PUTBACK;
    FREETMPS;
    LEAVE;
}

int
instance(pmInDom indom, int a, char *b, __pmInResult **rp, pmdaExt *pmda)
{
    if (need_refresh)
	pmns_refresh();
    if (instance_func)
	preinstance(instance_index(indom));
    return pmdaInstance(indom, a, b, rp, pmda);
}

void
timer_callback(int afid, void *data)
{
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSViv(local_timer_get_cookie(afid))));
    PUTBACK;

    perl_call_sv(local_timer_get_callback(afid), G_VOID);

    SPAGAIN;
    PUTBACK;
    FREETMPS;
    LEAVE;
}

void
input_callback(SV *input_cb_func, int data, char *string)
{
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSViv(data)));
    XPUSHs(sv_2mortal(newSVpv(string,0)));
    PUTBACK;

    perl_call_sv(input_cb_func, G_VOID);

    SPAGAIN;
    PUTBACK;
    FREETMPS;
    LEAVE;
}

int
fetch_callback(pmdaMetric *metric, unsigned int inst, pmAtomValue *atom)
{
    dSP;
    __pmID_int	*pmid;
    int		sts;
    STRLEN	n_a;	/* required by older Perl versions, used in POPpx */

    ENTER;
    SAVETMPS;	/* allows us to tidy our perl stack changes later */

    (void)n_a;
    pmid = (__pmID_int *) &metric->m_desc.pmid;

    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSVuv(pmid->cluster)));
    XPUSHs(sv_2mortal(newSVuv(pmid->item)));
    XPUSHs(sv_2mortal(newSVuv(inst)));
    PUTBACK;

    sts = perl_call_sv(fetch_cb_func, G_ARRAY);
    SPAGAIN;	/* refresh local perl stack pointer after call */
    if (sts != 2) {
	croak("fetch CB error (returned %d values, expected 2)", sts); 
	sts = -EINVAL;
	goto fetch_end;
    }
    sts = POPi;		/* pop function return status */
    if (sts < 0) {
	goto fetch_end;
    }
    else if (sts == 0) {
	sts = POPi;
	goto fetch_end;
    }

    sts = PMDA_FETCH_STATIC;
    switch (metric->m_desc.type) {	/* pop result value */
	case PM_TYPE_32:	atom->l = POPi; break;
	case PM_TYPE_U32:	atom->ul = POPi; break;
	case PM_TYPE_64:	atom->ll = POPl; break;
	case PM_TYPE_U64:	atom->ull = POPl; break;
	case PM_TYPE_FLOAT:	atom->f = POPn; break;
	case PM_TYPE_DOUBLE:	atom->d = POPn; break;
	case PM_TYPE_STRING:	{
	    atom->cp = strdup(POPpx);
	    sts = PMDA_FETCH_DYNAMIC;
	    break;
	}
    }

fetch_end:
    PUTBACK;
    FREETMPS;
    LEAVE;	/* fix up the perl stack, freeing anything we created */
    return sts;
}

int
store_callback(__pmID_int *pmid, unsigned int inst, pmAtomValue av, int type)
{
    dSP;
    int sts;
    ENTER;
    SAVETMPS;
    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSVuv(pmid->cluster)));
    XPUSHs(sv_2mortal(newSVuv(pmid->item)));
    XPUSHs(sv_2mortal(newSVuv(inst)));
    switch (type) {
	case PM_TYPE_32:     XPUSHs(sv_2mortal(newSViv(av.l))); break;
	case PM_TYPE_U32:    XPUSHs(sv_2mortal(newSVuv(av.ul))); break;
	case PM_TYPE_64:     XPUSHs(sv_2mortal(newSVuv(av.ll))); break;
	case PM_TYPE_U64:    XPUSHs(sv_2mortal(newSVuv(av.ull))); break;
	case PM_TYPE_FLOAT:  XPUSHs(sv_2mortal(newSVnv(av.f))); break;
	case PM_TYPE_DOUBLE: XPUSHs(sv_2mortal(newSVnv(av.d))); break;
	case PM_TYPE_STRING: XPUSHs(sv_2mortal(newSVpv(av.cp,0)));break;
    }
    PUTBACK;

    sts = perl_call_sv(store_cb_func, G_SCALAR);
    SPAGAIN;	/* refresh local perl stack pointer after call */
    if (sts != 1) {
	croak("store CB error (returned %d values, expected 1)", sts); 
	sts = -EINVAL;
	goto store_end;
    }
    sts = POPi;				/* pop function return status */

store_end:
    PUTBACK;
    FREETMPS;
    LEAVE;	/* fix up the perl stack, freeing anything we created */
    return sts;
}

int
store(pmResult *result, pmdaExt *pmda)
{
    int		i, j;
    int		type;
    int		sts;
    pmAtomValue	av;
    pmValueSet	*vsp;
    __pmID_int	*pmid;

    if (need_refresh)
	pmns_refresh();

    for (i = 0; i < result->numpmid; i++) {
	vsp = result->vset[i];
	pmid = (__pmID_int *)&vsp->pmid;

	/* need to find the type associated with this PMID */
	for (j = 0; j < mtab_size; j++)
	    if (metrictab[j].m_desc.pmid == *(pmID *)pmid)
		break;
	if (j == mtab_size)
	    return PM_ERR_PMID;
	type = metrictab[j].m_desc.type;

	for (j = 0; j < vsp->numval; j++) {
	    sts = pmExtractValue(vsp->valfmt, &vsp->vlist[j],type, &av, type);
	    if (sts < 0)
		return sts;
	    sts = store_callback(pmid, vsp->vlist[j].inst, av, type);
	    if (sts < 0)
		return sts;
	}
    }
    return 0;
}

int
text(int ident, int type, char **buffer, pmdaExt *pmda)
{
    const char *hash;
    int size;
    SV **sv;

    if (need_refresh)
	pmns_refresh();

    if ((type & PM_TEXT_PMID) == PM_TEXT_PMID) {
	hash = pmIDStr((pmID)ident);
	size = strlen(hash);
	if (type & PM_TEXT_ONELINE)
	    sv = hv_fetch(metric_oneline, hash, size, 0);
	else
	    sv = hv_fetch(metric_helptext, hash, size, 0);
    }
    else {
	hash = pmInDomStr((pmInDom)ident);
	size = strlen(hash);
	if (type & PM_TEXT_ONELINE)
	    sv = hv_fetch(indom_oneline, hash, size, 0);
	else
	    sv = hv_fetch(indom_helptext, hash, size, 0);
    }

    if (sv && (*sv))
	*buffer = SvPV_nolen(*sv);
    return (*buffer == NULL) ? PM_ERR_TEXT : 0;
}

/*
 * Converts Perl hash ref like {'foo' => \&data, 'boo' => \&data}
 * into an instance structure (indom).
 */
static int
update_hash_indom(SV *insts, pmInDom indom)
{
    int sts;
    SV *data;
    I32 instsize;
    char *instance;
    HV *ihash = (HV *) SvRV(insts);

    sts = pmdaCacheOp(indom, PMDA_CACHE_INACTIVE);
    if (sts < 0)
	warn("pmda cache inactivation failed: %s", pmErrStr(sts));

    hv_iterinit(ihash);
    while ((data = hv_iternextsv(ihash, &instance, &instsize)) != NULL)
	pmdaCacheStore(indom, PMDA_CACHE_ADD, instance, SvREFCNT_inc(data));

    sts = pmdaCacheOp(indom, PMDA_CACHE_SAVE);
    if (sts < 0)
	warn("pmda cache persistance failed: %s", pmErrStr(sts));

    return 0;
}

/*
 * Free all memory associated with a Perl list based indom
 */
static void
release_list_indom(pmdaInstid *instances, int numinst)
{
    int i;

    if (instances && numinst > 0) {
	for (i = 0; i < numinst; i++)
	    free(instances[i].i_name);	/* update_list_indom strdup */
	free(instances);	/* update_list_indom calloc */
    }
}

/*
 * Converts Perl list ref like [a => 'foo', b => 'boo'] into an indom.
 */
static int
update_list_indom(SV *insts, pmdaInstid **set)
{
    int	i, len;
    SV **id;
    SV **name;
    AV *ilist = (AV *) SvRV(insts);
    pmdaInstid *instances;

    if ((len = av_len(ilist)) == -1) {	/* empty */
	*set = NULL;
	return 0;
    }
    if (len++ % 2 == 0) {
	warn("invalid instance list (length must be a multiple of 2)");
	return -1;
    }

    len /= 2;
    instances = (pmdaInstid *) calloc(len, sizeof(pmdaInstid));
    if (instances == NULL) {
	warn("insufficient memory for instance array");
	return -1;
    }
    for (i = 0; i < len; i++) {
	id = av_fetch(ilist,i*2,0);
	name = av_fetch(ilist,i*2+1,0);
	instances[i].i_inst = SvIV(*id);
	instances[i].i_name = strdup(SvPV_nolen(*name));
	if (instances[i].i_name == NULL) {
	    release_list_indom(instances, i);
	    warn("insufficient memory for instance array names");
	    return -1;
	}
    }
    *set = instances;
    return len;
}

/*
 * Converts a Perl instance reference into a populated indom.
 * This interface handles either the hash or list formats.
 */
static int
update_indom(SV *insts, pmInDom indom, pmdaInstid **set)
{
    SV *rv = (SV *) SvRV(insts);
    pmdaInstid *instances;

    if (! SvROK(insts)) {
	warn("expected a reference for instances argument");
	return -1;
    }
    if (SvTYPE(rv) == SVt_PVAV)
	return update_list_indom(insts, set);
    if (SvTYPE(rv) == SVt_PVHV)
	return update_hash_indom(insts, indom);
    warn("instance argument is neither an array nor hash reference");
    return -1;
}


MODULE = PCP::PMDA		PACKAGE = PCP::PMDA


pmdaInterface *
new(CLASS,name,domain)
	char *	CLASS
	char *	name
	int	domain
    PREINIT:
	int	sep;
	char *	p;
	char *	logfile;
	char *	pmdaname;
	char	helpfile[256];
    CODE:
	pmProgname = name;
	RETVAL = &dispatch;
	logfile = local_strdup_suffix(name, ".log");
	pmdaname = local_strdup_prefix("pmda", name);
	__pmSetProgname(pmdaname);
	sep = __pmPathSeparator();
	if ((p = getenv("PCP_PERL_DEBUG")) != NULL)
	    if ((pmDebug = __pmParseDebug(p)) < 0)
		pmDebug = 0;
#ifndef IS_MINGW
	setsid();
#endif
	atexit(&local_atexit);
	snprintf(helpfile, sizeof(helpfile), "%s%c%s%c" "help",
			pmGetConfig("PCP_PMDAS_DIR"), sep, name, sep);
	if (access(helpfile, R_OK) != 0) {
	    pmdaDaemon(&dispatch, PMDA_INTERFACE_5, pmdaname, domain,
			logfile, NULL);
	    dispatch.version.four.text = text;
	}
	else {
	    pmdaDaemon(&dispatch, PMDA_INTERFACE_5, pmdaname, domain,
			logfile, strdup(helpfile));
	}
	dispatch.version.four.fetch = fetch;
	dispatch.version.four.instance = instance;
	dispatch.version.four.desc = pmns_desc;
	dispatch.version.four.pmid = pmns_pmid;
	dispatch.version.four.name = pmns_name;
	dispatch.version.four.children = pmns_children;

	if (!getenv("PCP_PERL_PMNS") && !getenv("PCP_PERL_DOMAIN")) {
	    pmdaOpenLog(&dispatch);
	}
	metric_names = newHV();
	metric_oneline = newHV();
	metric_helptext = newHV();
	indom_helptext = newHV();
	indom_oneline = newHV();
    OUTPUT:
	RETVAL

int
pmda_pmid(cluster,item)
	unsigned int	cluster
	unsigned int	item
    CODE:
	RETVAL = pmid_build(dispatch.domain, cluster, item);
    OUTPUT:
	RETVAL

SV *
pmda_pmid_name(cluster,item)
	unsigned int	cluster
	unsigned int	item
    PREINIT:
	const char	*name;
	SV		**rval;
    CODE:
	name = pmIDStr(pmid_build(dispatch.domain, cluster, item));
	rval = hv_fetch(metric_names, name, strlen(name), 0);
	if (!rval || !(*rval))
	    XSRETURN_UNDEF;
	RETVAL = newSVsv(*rval);
    OUTPUT:
	RETVAL

SV *
pmda_pmid_text(cluster,item)
	unsigned int	cluster
	unsigned int	item
    PREINIT:
	const char	*name;
	SV		**rval;
    CODE:
	name = pmIDStr(pmid_build(dispatch.domain, cluster, item));
	rval = hv_fetch(metric_oneline, name, strlen(name), 0);
	if (!rval || !(*rval))
	    XSRETURN_UNDEF;
	RETVAL = newSVsv(*rval);
    OUTPUT:
	RETVAL

SV *
pmda_inst_name(index,instance)
	unsigned int	index
	int		instance
    PREINIT:
	int		i;
	pmdaIndom *	p;
	pmdaInstid	*instp;
    CODE:
	if (index >= itab_size)	/* is this a valid indom */
	    XSRETURN_UNDEF;
	p = indomtab + index;
	if (!p->it_set)	/* was this indom previously setup via a hash? */
	    XSRETURN_UNDEF;

	/* Optimistic (fast) direct lookup first, then iterate */
	i = instance;
	if (i > p->it_numinst || i < 0 || instance != p->it_set[i].i_inst) {
	    for (i = 0; i < p->it_numinst; i++)
		if (instance == p->it_set[i].i_inst)
		    break;
	    if (i == p->it_numinst)
		XSRETURN_UNDEF;
	}
	RETVAL = newSVpv(p->it_set[i].i_name,0);
    OUTPUT:
	RETVAL

SV *
pmda_inst_lookup(index,instance)
	unsigned int	index
	int		instance
    PREINIT:
	pmdaIndom *	p;
	SV *		svp;
	int		i, sts;
    CODE:
	if (index >= itab_size)	/* is this a valid indom */
	    XSRETURN_UNDEF;
	p = indomtab + index;
	if (p->it_set)	/* was this indom previously setup via an array? */
	    XSRETURN_UNDEF;
	sts = pmdaCacheLookup(p->it_indom, instance, NULL, (void *)&svp);
	if (sts != PMDA_CACHE_ACTIVE)
	    XSRETURN_UNDEF;
	RETVAL = SvREFCNT_inc(svp);
    OUTPUT:
	RETVAL

int
pmda_units(dim_space,dim_time,dim_count,scale_space,scale_time,scale_count)
	unsigned int	dim_space
	unsigned int	dim_time
	unsigned int	dim_count
	unsigned int	scale_space
	unsigned int	scale_time
	unsigned int	scale_count
    PREINIT:
	pmUnits	units;
    CODE:
	units.pad = 0;
	units.dimSpace = dim_space;	units.scaleSpace = scale_space;
	units.dimTime = dim_time;	units.scaleTime = scale_time;
	units.dimCount = dim_count;	units.scaleCount = scale_count;
	RETVAL = *(int *)(&units);
    OUTPUT:
	RETVAL

char *
pmda_config(name)
	char * name
    CODE:
	RETVAL = pmGetConfig(name);
	if (!RETVAL)
	    XSRETURN_UNDEF;
    OUTPUT:
	RETVAL

char *
pmda_uptime(now)
	int	now
    PREINIT:
	static char s[32];
	size_t sz = sizeof(s);
	int days, hours, mins, secs;
    CODE:
	days = now / (60 * 60 * 24);
	now %= (60 * 60 * 24);
	hours = now / (60 * 60);
	now %= (60 * 60);
	mins = now / 60;
	now %= 60;
	secs = now;

	if (days > 1)
	    snprintf(s, sz, "%ddays %02d:%02d:%02d", days, hours, mins, secs);
	else if (days == 1)
	    snprintf(s, sz, "%dday %02d:%02d:%02d", days, hours, mins, secs);
	else
	    snprintf(s, sz, "%02d:%02d:%02d", hours, mins, secs);
	RETVAL = s;
    OUTPUT:
	RETVAL

int
pmda_long()
    CODE:
	RETVAL = (sizeof(long) == 4) ? PM_TYPE_32 : PM_TYPE_64;
    OUTPUT:
	RETVAL

int
pmda_ulong()
    CODE:
	RETVAL = (sizeof(unsigned long) == 4) ? PM_TYPE_32 : PM_TYPE_64;
    OUTPUT:
	RETVAL


void
error(self,message)
	pmdaInterface *self
	char *	message
    CODE:
	__pmNotifyErr(LOG_ERR, "%s", message);

int
set_user(self,username)
	pmdaInterface *self
	char * username
    CODE:
	RETVAL = __pmSetProcessIdentity(username);
    OUTPUT:
	RETVAL

void
set_fetch(self,function)
	pmdaInterface *self
	SV *	function
    CODE:
	if (function != (SV *)NULL) {
	    fetch_func = newSVsv(function);
	}

void
set_refresh(self,function)
	pmdaInterface *self
	SV *	function
    CODE:
	if (function != (SV *)NULL) {
	    refresh_func = newSVsv(function);
	}

void
set_instance(self,function)
	pmdaInterface *self
	SV *	function
    CODE:
	if (function != (SV *)NULL) {
	    instance_func = newSVsv(function);
	}

void
set_store_callback(self,cb_function)
	pmdaInterface *self
	SV *	cb_function
    CODE:
	if (cb_function != (SV *)NULL) {
	    store_cb_func = newSVsv(cb_function);
	    self->version.four.store = store;
	}

void
set_fetch_callback(self,cb_function)
	pmdaInterface *self
	SV *	cb_function
    CODE:
	if (cb_function != (SV *)NULL) {
	    fetch_cb_func = newSVsv(cb_function);
	    pmdaSetFetchCallBack(self, fetch_callback);
	}

void
set_inet_socket(self,port)
	pmdaInterface *self
	int	port
    CODE:
	self->version.four.ext->e_io = pmdaInet;
	self->version.four.ext->e_port = port;

void
set_ipv6_socket(self,port)
	pmdaInterface *self
	int	port
    CODE:
	self->version.four.ext->e_io = pmdaIPv6;
	self->version.four.ext->e_port = port;

void
set_unix_socket(self,socket_name)
	pmdaInterface *self
	char *	socket_name
    CODE:
	self->version.four.ext->e_io = pmdaUnix;
	self->version.four.ext->e_sockname = socket_name;

void
clear_metrics(self)
	pmdaInterface *self
    CODE:
	need_refresh = 1;
	if (clustertab)
	    free(clustertab);
	ctab_size = 0;
	if (metrictab)
	    free(metrictab);
	mtab_size = 0;
	clearHV(metric_names);
	clearHV(metric_oneline);
	clearHV(metric_helptext);

void
add_metric(self,pmid,type,indom,sem,units,name,help,longhelp)
	pmdaInterface *self
	int	pmid
	int	type
	int	indom
	int	sem
	int	units
	char *	name
	char *	help
	char *	longhelp
    PREINIT:
	pmdaMetric * p;
	__pmID_int * pmidp;
	const char * hash;
	int          size;
    CODE:
	(void)self;
	need_refresh = 1;
	pmidp = (__pmID_int *)&pmid;
	if (!clustertab_lookup(pmidp->cluster)) {
	    size = sizeof(int) * (ctab_size + 1);
	    clustertab = (int *)realloc(clustertab, size);
	    if (clustertab)
		clustertab[ctab_size++] = pmidp->cluster;
	    else {
		warn("unable to allocate memory for cluster table");
		ctab_size = 0;
		XSRETURN_UNDEF;
	    }
	}

	size = sizeof(pmdaMetric) * (mtab_size + 1);
	metrictab = (pmdaMetric *)realloc(metrictab, size);
	if (metrictab == NULL) {
	    warn("unable to allocate memory for metric table");
	    mtab_size = 0;
	    XSRETURN_UNDEF;
	}

	p = metrictab + mtab_size++;
	p->m_user = NULL;	p->m_desc.pmid = *(pmID *)&pmid;
	p->m_desc.type = type;	p->m_desc.indom = *(pmInDom *)&indom;
	p->m_desc.sem = sem;	p->m_desc.units = *(pmUnits *)&units;

	hash = pmIDStr(pmid);
	size = strlen(hash);
	hv_store(metric_names, hash, size, newSVpv(name,0), 0);
	if (help)
	    hv_store(metric_oneline, hash, size, newSVpv(help,0), 0);
	if (longhelp)
	    hv_store(metric_helptext, hash, size, newSVpv(longhelp,0), 0);

void
clear_indoms(self)
	pmdaInterface *self
    CODE:
	if (indomtab)
	    free(indomtab);
	itab_size = 0;
	if (metrictab)
	    free(metrictab);
	mtab_size = 0;
	clearHV(indom_oneline);
	clearHV(indom_helptext);

int
add_indom(self,indom,insts,help,longhelp)
	pmdaInterface *	self
	int	indom
	SV *	insts
	char *	help
	char *	longhelp
    PREINIT:
	pmdaIndom  * p;
	const char * hash;
	int          sts, size;
    CODE:
	size = sizeof(pmdaIndom) * (itab_size + 1);
	indomtab = (pmdaIndom *)realloc(indomtab, size);
	if (indomtab == NULL) {
	    warn("unable to allocate memory for indom table");
	    itab_size = 0;
	    XSRETURN_UNDEF;
	}

	p = indomtab + itab_size;
	memset(p, 0, sizeof(pmdaIndom));
	p->it_indom = pmInDom_build(self->domain, indom);

	sts = update_indom(insts, p->it_indom, &p->it_set);
	if (sts < 0)
	    XSRETURN_UNDEF;
	if (p->it_set)
	    p->it_numinst = sts;
	RETVAL = itab_size++;	/* used in calls to replace_indom() */

	hash = pmInDomStr(indom);
	size = strlen(hash);
	if (help)
	    hv_store(indom_oneline, hash, size, newSVpv(help,0), 0);
	if (longhelp)
	    hv_store(indom_helptext, hash, size, newSVpv(longhelp,0), 0);
    OUTPUT:
	RETVAL

int
replace_indom(self,index,insts)
	pmdaInterface *	self
	unsigned int	index
	SV *		insts
    PREINIT:
	pmdaIndom *	p;
	int		sts;
    CODE:
	if (index >= itab_size) {
	    warn("attempt to replace non-existent instance domain");
	    XSRETURN_UNDEF;
	}
	else {
	    p = indomtab + index;
	    /* was this indom previously setup via an array? */
	    if (p->it_set)
		release_list_indom(p->it_set, p->it_numinst);
	    sts = update_indom(insts, p->it_indom, &p->it_set);
	    if (sts < 0)
		XSRETURN_UNDEF;
	    if (p->it_set)
		p->it_numinst = sts;
	    RETVAL = sts;
	}
    OUTPUT:
	RETVAL

int
add_timer(self,timeout,callback,data)
	pmdaInterface *	self
	double	timeout
	SV *	callback
	int	data
    CODE:
	if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback)
	    XSRETURN_UNDEF;
	RETVAL = local_timer(timeout, newSVsv(callback), data);
    OUTPUT:
	RETVAL

int
add_pipe(self,command,callback,data)
	pmdaInterface *self
	char *	command
	SV *	callback
	int	data
    CODE:
	if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback)
	    XSRETURN_UNDEF;
	RETVAL = local_pipe(command, newSVsv(callback), data);
    OUTPUT:
	RETVAL

int
add_tail(self,filename,callback,data)
	pmdaInterface *self
	char *	filename
	SV *	callback
	int	data
    CODE:
	if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback)
	    XSRETURN_UNDEF;
	RETVAL = local_tail(filename, newSVsv(callback), data);
    OUTPUT:
	RETVAL

int
add_sock(self,hostname,port,callback,data)
	pmdaInterface *self
	char *	hostname
	int	port
	SV *	callback
	int	data
    CODE:
	if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback)
	    XSRETURN_UNDEF;
	RETVAL = local_sock(hostname, port, newSVsv(callback), data);
    OUTPUT:
	RETVAL

int
put_sock(self,id,output)
	pmdaInterface *self
	int	id
	char *	output
    CODE:
	size_t	length = strlen(output);
	RETVAL = __pmWrite(local_files_get_descriptor(id), output, length);
    OUTPUT:
	RETVAL

void
log(self,message)
	pmdaInterface *self
	char *	message
    CODE:
	__pmNotifyErr(LOG_INFO, "%s", message);

void
err(self,message)
	pmdaInterface *self
	char *	message
    CODE:
	__pmNotifyErr(LOG_ERR, "%s", message);

void
connect_pmcd(self)
	pmdaInterface *self
    CODE:
	/*
	 * Need to mimic the same special cases handled in run()
	 * that explicitly do NOT connect to pmcd and treat these
	 * as no-ops here
	 *
	 * Otherwise call pmdaConnet() to complete the PMDA's IPC
	 * channel setup and complete the connection handshake with
	 * pmcd.
	 */
	if (getenv("PCP_PERL_PMNS") != NULL)
	    ;
	else if (getenv("PCP_PERL_DOMAIN") != NULL)
	    ;
	else {
	    /*
	     * On success pmdaConnect sets PMDA_EXT_CONNECTED in e_flags ...
	     * this used in the guard below to stop run() calling
	     * pmdaConnect() again.
	     */
	    pmdaConnect(self);
	}

void
run(self)
	pmdaInterface *self
    CODE:
	if (getenv("PCP_PERL_PMNS") != NULL)
	    pmns_write();	/* generate ascii namespace */
	else if (getenv("PCP_PERL_DOMAIN") != NULL)
	    domain_write();	/* generate the domain header */
	else {		/* or normal operating mode ... */
	    pmns_refresh();
	    pmdaInit(self, indomtab, itab_size, metrictab, mtab_size);
	    if ((self->version.any.ext->e_flags & PMDA_EXT_CONNECTED) != PMDA_EXT_CONNECTED) {
		/*
		 * connect_pmcd() not called before, so need pmdaConnect()
		 * here before falling into the PDU-driven mainloop
		 */
		pmdaConnect(self);
	    }
	    local_pmdaMain(self);
	}

void
debug_metric(self)
	pmdaInterface *self
    PREINIT:
	int	i;
    CODE:
	/* NB: debugging only (used in test.pl to verify state) */
	fprintf(stderr, "metric table size = %d\n", mtab_size);
	for (i = 0; i < mtab_size; i++) {
	    fprintf(stderr, "metric idx = %d\n\tpmid = %s\n\ttype = %u\n"
			"\tindom= %d\n\tsem  = %u\n\tunits= %u\n",
		i, pmIDStr(metrictab[i].m_desc.pmid), metrictab[i].m_desc.type,
		(int)metrictab[i].m_desc.indom, metrictab[i].m_desc.sem,
		*(unsigned int *)&metrictab[i].m_desc.units);
	}
	(void)self;

void
debug_indom(self)
	pmdaInterface *self
    PREINIT:
	int	i,j;
    CODE:
	/* NB: debugging only (used in test.pl to verify state) */
	fprintf(stderr, "indom table size = %d\n", itab_size);
	for (i = 0; i < itab_size; i++) {
	    fprintf(stderr, "indom idx = %d\n\tindom = %d\n"
			    "\tninst = %u\n\tiptr = 0x%p\n",
		    i, *(int *)&indomtab[i].it_indom, indomtab[i].it_numinst,
		    indomtab[i].it_set);
	    for (j = 0; j < indomtab[i].it_numinst; j++) {
		fprintf(stderr, "\t\tid=%d name=%s\n",
		    indomtab[i].it_set[j].i_inst, indomtab[i].it_set[j].i_name);
	    }
	}
	(void)self;

void
debug_init(self)
	pmdaInterface *self
    CODE:
	/* NB: debugging only (used in test.pl to verify state) */
	pmdaInit(self, indomtab, itab_size, metrictab, mtab_size);