/*****************************************************************************
**	File:	API.xs
**	Type:	interface library (for Perl and friends)
**	Author:	David Oberholtzer, (daveo@obernet.com)
**			Copyright (c)2005, David Oberholtzer
**	Date:	2001/03/23
**	Rev:	$Id: API.xs,v 1.1 2003/06/18 02:01:57 daveo Exp daveo $
**	Use:	Access to  FAME functions in other platforms.
**	Mod:	2005/03/15 daveo: modified the Missing Value functions to
**			return HBCNTX and don't even try to implement them.
******************************************************************************
**	This library is an abstraction layer for FAME C-HLI functions
**
**	NOTE: The most obvious difference between CHLI functions and FameHLI::API
**		functions is moving 'status' from 'argument' status to being the
**		'return value' of the function.
**
**		The second difference is in the handling of missing values.  In 'C'
**		there are special values with some rather odd properties.  In Perl
**		missing values are handled as references to the strings "NA", "NC"
**		and "ND" (with the standard meanings).
**
**		The last major difference is that 'length' attributes have been
**		let fall by the wayside.  To be really Perl-ish, the library takes
**		care of the lengths incoming and outgoing.
**
******************************************************************************
**	To Do?
**		Reads & Writes: fix translation tables.
**
*****************************************************************************/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "hli.h"
#include "API.h"

//***************************************************************************
//	This may not be a good idea, but everybody has at least one vice...
#define	DEF_CENT				1900


//***************************************************************************
//***************************************************************************
//	G L O B A L   V A R I A B L E S
//***************************************************************************
//***************************************************************************
static	int		status = 0;
static	int		cfmini_status = 0;


//***************************************************************************
//***************************************************************************
//		E x t e n s i o n   F u n c t i o n ( s )
//***************************************************************************
//***************************************************************************

//===========================================================================
//		N E W   S T R I N G
//===========================================================================
char	*newString(char *src)
{
int		len;
char	*ptr;

		if (src) {
			len = strlen(src) + 1;
			New(0, ptr, len, char);
			strcpy(ptr, src);
		} else {
			New(0, ptr, 1, char);
			*ptr = '\0';
		}
		return(ptr);
}





//***************************************************************************
//***************************************************************************
//	P E R L - H L I   M O D U L E   S T A R T S
//***************************************************************************
//**************************************************************************/

MODULE = FameHLI::API		PACKAGE = FameHLI::API		PREFIX = perl_

BOOT:
		status = HSUCC;
		cfmini_status = HSUCC;
		cfmini(&cfmini_status);


##
##
##	P U B L I C   F U N C T I O N S
##
##

##***************************************************************************
##***************************************************************************
##		P E R L   H E L P E R   F U N C T I O N S
##***************************************************************************
##***************************************************************************


##***************************************************************************
##***************************************************************************
##		U s i n g   t h e   H L I
##***************************************************************************
##***************************************************************************


##===========================================================================
##		cfmini		F A M E   L I B R A R Y   I N I T I A L I Z A T I O N
##===========================================================================
##		This function allows people to re-initialize the HLI if necessary
##		(e.g. FAME environment variable needs setting inside the perl
##		script) but also so that it isn't necessary to call cfmini in the
##		common case of having everything set up first.
##=========================================================================*/
int
perl_Cfmini()
	CODE:
		if (cfmini_status != HSUCC) {
			cfmini(&cfmini_status);
		}
		RETVAL = cfmini_status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmver
##===========================================================================
##		Tested	2000/10/10
##=========================================================================*/
int
perl_Cfmver(sv_ver)
SV		*sv_ver

	PREINIT:
float	version;

	CODE:
		cfmver(&status, &version);
		sv_setnv(sv_ver, version);
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_ver


##===========================================================================
##		cfmfin		F A M E   L I B R A R Y   C L O S E / T E R M I N A T I O N
##===========================================================================
##		Tested	2000/10/10
##=========================================================================*/
int
perl_Cfmfin()

	CODE:
		cfmfin(&status);
		RETVAL = status;

	OUTPUT:
		RETVAL


##***************************************************************************
##***************************************************************************
##		S e t t i n g   O p t i o n s   i n   t h e   H L I
##***************************************************************************
##***************************************************************************

##===========================================================================
##		cfmsopt
##===========================================================================
##		Tested 2000/10/17
##===========================================================================
int
perl_Cfmsopt(optname, optval)
char	*optname
char	*optval

	CODE:
		cfmsopt(&status, optname, optval);
		RETVAL = status;

	OUTPUT:
		RETVAL



##***************************************************************************
##***************************************************************************
##		S e t t i n g   R a n g e s
##***************************************************************************
##***************************************************************************


##===========================================================================
##		cfmsrng
##===========================================================================
int
perl_Cfmsrng(freq, sv_syear, sv_sprd, sv_eyear, sv_eprd, range, sv_numobs)
int		freq
SV		*sv_syear
SV		*sv_sprd
SV		*sv_eyear
SV		*sv_eprd
SV		*range
SV		*sv_numobs

	PREINIT:
int		syear;
int		sprd;
int		eyear;
int		eprd;
int		rng[3];
int		numobs;
int		i;
I32		ix;
AV		*rngarray;
SV		*sv;

	CODE:
##		----------------------------------------------------------------------
##		Check to see if we have been given anything valid.  If so, use it.
##		----------------------------------------------------------------------
		if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
			rngarray = (AV *)SvRV(range);
			av_clear(rngarray);
				
##		----------------------------------------------------------------------
##		It isn't a refrence or an array.  For now, blow away the old thing 
##		and create a new reference.
##		----------------------------------------------------------------------
		} else {
			rngarray = newAV();
			SvREFCNT_dec(range);
			range = newRV_inc((SV *)rngarray);
		}
		syear = SvIV(sv_syear);
		sprd = SvIV(sv_sprd);
		eyear = SvIV(sv_eyear);
		eprd = SvIV(sv_eprd);
		numobs = SvIV(sv_numobs);

		cfmsrng(&status, freq, &syear, &sprd, &eyear, &eprd, rng, &numobs);
		if (status == HSUCC) {
			sv_setiv(sv_syear, syear);
			sv_setiv(sv_sprd, sprd);
			sv_setiv(sv_eyear, eyear);
			sv_setiv(sv_eprd, eprd);
			for (i=0; i<3; i++) {
				sv = newSViv(rng[i]);
				av_push(rngarray, sv);
			}
			sv_setiv(sv_numobs, numobs);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_syear
		sv_sprd
		sv_eyear
		sv_eprd
		range
		sv_numobs


##===========================================================================
##		cfmsfis
##===========================================================================
int
perl_Cfmsfis(freq, sv_syear, sv_sprd, sv_eyear, sv_eprd, range, sv_numobs, fmonth=HDEC, flabel=HFYFST)
int		freq
SV		*sv_syear
SV		*sv_sprd
SV		*sv_eyear
SV		*sv_eprd
SV		*range
SV		*sv_numobs
int		fmonth
int		flabel

	PREINIT:
int		syear;
int		sprd;
int		eyear;
int		eprd;
int		rng[3];
int		numobs;
int		i;
I32		ix;
AV		*rngarray;
SV		*sv;

	CODE:
##		----------------------------------------------------------------------
##		Check to see if we have been given anything valid.  If so, use it.
##		----------------------------------------------------------------------
		if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
			rngarray = (AV *)SvRV(range);
			av_clear(rngarray);
				
##		----------------------------------------------------------------------
##		It isn't a refrence or an array.  For now, blow away the old thing 
##		and create a new reference.
##		----------------------------------------------------------------------
		} else {
			rngarray = newAV();
			SvREFCNT_dec(range);
			range = newRV_inc((SV *)rngarray);
		}

		syear = SvIV(sv_syear);
		sprd = SvIV(sv_sprd);
		eyear = SvIV(sv_eyear);
		eprd = SvIV(sv_eprd);
		numobs = SvIV(sv_numobs);

		cfmsfis(&status, freq, &syear, &sprd, &eyear, &eprd,
				rng, &numobs, fmonth, flabel);
		if (status == HSUCC) {
			sv_setiv(sv_syear, syear);
			sv_setiv(sv_sprd, sprd);
			sv_setiv(sv_eyear, eyear);
			sv_setiv(sv_eprd, eprd);
			for (i=0; i<3; i++) {
				sv = newSViv(rng[i]);
				av_push(rngarray, sv);
			}
			sv_setiv(sv_numobs, numobs);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_syear
		sv_sprd
		sv_eyear
		sv_eprd
		range
		sv_numobs


##***************************************************************************
##***************************************************************************
##		H a n d l i n g   C o n n e c t i o n s
##***************************************************************************
##**************************************************************************/

##===========================================================================
##		cfmopcn		Open connection
##===========================================================================
##		Tested
##=========================================================================*/
int
perl_Cfmopcn(sv_connkey, service="mcadbs", hostname="localhost", username="", password="")
SV		*sv_connkey
char	*service
char	*hostname
char	*username
char	*password

	PREINIT:
int		connkey;

	CODE:
		cfmopcn(&status, &connkey, service, hostname, username, password);
		
		if (status == HSUCC) {
			sv_setiv(sv_connkey, connkey);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_connkey


##===========================================================================
##		cfmgcid		Get channel id
##=========================================================================*/
int
perl_Cfmgcid(dbkey, sv_connkey)
int		dbkey
SV		*sv_connkey

	PREINIT:
int		connkey;

	CODE:
		cfmgcid(&status, dbkey, &connkey);
		if (status == HSUCC) {
			sv_setiv(sv_connkey, connkey);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_connkey


##===========================================================================
##		cfmcmmt		Commit unit of work
##=========================================================================*/
int
perl_Cfmcmmt(connkey)
int		connkey

	CODE:
		cfmcmmt(&status, connkey);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmabrt		Abort unit of work
##=========================================================================*/
int
perl_Cfmabrt(connkey)
int		connkey

	CODE:
		cfmabrt(&status, connkey);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmclcn
##===========================================================================
int
perl_Cfmclcn(connkey)
int		connkey

	CODE:
		cfmclcn(&status, connkey);
		RETVAL = status;

	OUTPUT:
		RETVAL


##***************************************************************************
##***************************************************************************
##		H a n d l i n g   D a t a b a s e s
##***************************************************************************
##**************************************************************************/

##===========================================================================
##		cfmopdb		O P E N   F A M E   D A T A B A S E
##===========================================================================
##		Tested	HCMODE, HUMODE
##=========================================================================*/
int
perl_Cfmopdb(sv_dbkey, dbname, mode=HRMODE)
SV		*sv_dbkey
char	*dbname
int		mode

	PREINIT:
int		dbkey;
char	name[SMALLBUF];
int		key;

	CODE:
		strcpy(name, dbname);
		cfmopdb(&status, &dbkey, name, mode);
		if (status == HSUCC) {
			sv_setiv(sv_dbkey, dbkey);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_dbkey


##===========================================================================
##		cfmspos		P O S T / R E S T O R E   S W I T C H
##===========================================================================
##		Enable/Disable the post/restore mechanism for databases.  Use with
##		extreme caution.  If a process dies without posting or closing a
##		database, the result will be a corrupt and unusable database.
##===========================================================================
##===========================================================================
int
perl_Cfmspos(flag)
int		flag

	CODE:
		cfmspos(&status, flag);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmcldb		C L O S E   F A M E   D A T A B A S E
##===========================================================================
##		Tested
##=========================================================================*/
int
perl_Cfmcldb(key)
int		key

	CODE:
		cfmcldb(&status, key);
		RETVAL = status;

	OUTPUT:
		RETVAL

##===========================================================================
##		cfmpodb		P O S T   D A T A B A S E
##===========================================================================
##		Tested
##=========================================================================*/
int
perl_Cfmpodb(dbkey)
int		dbkey

	CODE:
		cfmpodb(&status, dbkey);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmrsdb		R E S T O R E   D A T A B A S E
##=========================================================================*/
int
perl_Cfmrsdb(dbkey)
int		dbkey

	CODE:
		cfmrsdb(&status, dbkey);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmpack		P A C K   D A T A B A S E
##=========================================================================*/
int
perl_Cfmpack(dbkey)
int		dbkey

	CODE:
		cfmpack(&status, dbkey);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmopdc		O P E N   D A T A B A S E   C O N N E C T I O N
##=========================================================================*/
int
perl_Cfmopdc(sv_dbkey, dbname, mode, connkey)
SV		*sv_dbkey
char	*dbname
int		mode
int		connkey

	PREINIT:
int		dbkey;

	CODE:
		cfmopdc(&status, &dbkey, dbname, mode, connkey);
		if (status == HSUCC) {
			sv_setiv(sv_dbkey, dbkey);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_dbkey


##***************************************************************************
##***************************************************************************
##		H a n d l i n g   D a t a b a s e   I n f o r m a t i o n
##					A n d   A t t r i b u t e s
##***************************************************************************
##**************************************************************************/

##===========================================================================
##		cfmddes
##===========================================================================
int
perl_Cfmddes(dbkey, desc)
int		dbkey
char	*desc

	CODE:
		cfmddes(&status, dbkey, desc);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmddoc
##===========================================================================
int
perl_Cfmddoc(dbkey, doc)
int dbkey
char *doc

	CODE:
		cfmddoc(&status, dbkey, doc);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmgdba
##===========================================================================
##		Tested
##=========================================================================*/
int
perl_Cfmgdba(dbkey, sv_cyear, sv_cmonth, sv_cday, sv_myear, sv_mmonth, sv_mday, sv_desc, sv_doc)
int		dbkey
SV		*sv_cyear
SV		*sv_cmonth
SV		*sv_cday
SV		*sv_myear
SV		*sv_mmonth
SV		*sv_mday
SV		*sv_desc
SV		*sv_doc

	PREINIT:
int		cyear;
int		cmonth;
int		cday;
int		myear;
int		mmonth;
int		mday;
char	*desc;
char	*doc;
int		deslen, doclen, i;

	CODE:
		cfmglen(&status, dbkey, &deslen, &doclen);
		if (status == HSUCC) {
			New(0, desc, deslen+1, char);
			for (i=0; i<deslen; i++) {
				desc[i] = ' ';
			}

			New(0, doc, doclen+1, char);
			for (i=0; i<doclen; i++) {
				doc[i] = ' ';
			}

			cfmgdba(&status, dbkey, &cyear, &cmonth, &cday, 
									&myear, &mmonth, &mday, 
									desc, doc);
		}
		if (status == HSUCC) {
			sv_setiv(sv_cyear, cyear);
			sv_setiv(sv_cmonth, cmonth);
			sv_setiv(sv_cday, cday);
			sv_setiv(sv_myear, myear);
			sv_setiv(sv_mmonth, mmonth);
			sv_setiv(sv_mday, mday);
			sv_setpv(sv_desc, desc);
			sv_setpv(sv_doc, doc);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_cyear
		sv_cmonth
		sv_cday
		sv_myear
		sv_mmonth
		sv_mday
		sv_desc
		sv_doc


##===========================================================================
##		cfmgdbd		Get database's creation/modification dates at FREQ
##=========================================================================*/
int
perl_Cfmgdbd(dbkey, freq, sv_cdate, sv_mdate)
int		dbkey
int		freq
SV		*sv_cdate
SV		*sv_mdate

	PREINIT:
int		cdate;
int		mdate;

	CODE:
		cfmgdbd(&status, dbkey, freq, &cdate, &mdate);
		if (status == HSUCC) {
			sv_setiv(sv_cdate, cdate);
			sv_setiv(sv_mdate, mdate);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_cdate
		sv_mdate


##***************************************************************************
##***************************************************************************
##		H a n d l i n g   D a t a   O b j e c t s
##***************************************************************************
##**************************************************************************/

##===========================================================================
##		cfmnwob		C R E A T E   O B J E C T
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmnwob(dbkey, objnam, class=HSERIE, freq=HBUSNS, type=HNUMRC, basis=HBSDAY, observ=HOBEND)
int		dbkey
char	*objnam
int		class
int		freq
int		type
int		basis
int		observ

	CODE:
		cfmnwob(&status, dbkey, objnam, class, freq, type, basis, observ);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmalob		A L L O C A T E   O B J E C T
##=========================================================================*/
##=========================================================================*/
int
perl_Cfmalob(dbkey, objnam, class=HSERIE, freq=HBUSNS, type=HNUMRC, basis=HBSDAY, observ=HOBEND, numobs=20, numchr=1024, growth=0.15)
int		dbkey
char	*objnam
int		class
int		freq
int		type
int		basis
int		observ
int		numobs
int		numchr
double	growth

	CODE:
		cfmalob(&status, dbkey, objnam, class, freq, type, 
					basis, observ, numobs, numchr, growth);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmcpob		C O P Y   O B J E C T
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmcpob(srckey, tarkey, srcnam, tarnam)
int		srckey
int		tarkey
char	*srcnam
char	*tarnam

	CODE:
		cfmcpob(&status, srckey, tarkey, srcnam, tarnam);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmdlob		D E L E T E   O B J E C T
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmdlob(dbkey, objnam)
int dbkey
char *objnam

	CODE:
		cfmdlob(&status, dbkey, objnam);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmrnob		R E N A M E   O B J E C T
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmrnob(dbkey, oldname, newname)
int		dbkey
char	*oldname
char	*newname

	CODE:
		cfmrnob(&status, dbkey, oldname, newname);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmasrt		A S S E R T   S o m e t h i n g
##=========================================================================*/
int
perl_Cfmasrt(connkey, assert_type, assertion, perspective, grouping, dblist)
int		connkey
int		assert_type
char	*assertion
int		perspective
int		grouping
int		dblist

	CODE:
		cfmasrt(&status, connkey, assert_type, assertion, 
					perspective, grouping, &dblist);
		RETVAL = status;
	OUTPUT:
		RETVAL



##***************************************************************************
##***************************************************************************
##		H a n d l i n g   D a t a   O b j e c t s   I n f o r m a t i o n
##						a n d   A t t r i b u t e s
##***************************************************************************
##**************************************************************************/

##===========================================================================
##		cfmosiz		Get the size of an object
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmosiz(dbkey, objname, sv_class, sv_type, sv_freq, sv_fyear, sv_fprd, sv_lyear, sv_lprd)
int		dbkey
char	*objname
SV		*sv_class
SV		*sv_type
SV		*sv_freq
SV		*sv_fyear
SV		*sv_fprd
SV		*sv_lyear
SV		*sv_lprd

	PREINIT:
int		class;
int		type;
int		freq;
int		fyear;
int		fprd;
int		lyear;
int		lprd;

	CODE:
		cfmosiz(&status, dbkey, objname, &class, &type, &freq,
					&fyear, &fprd, &lyear, &lprd);
		if (status == HSUCC) {
			sv_setiv(sv_class, class);
			sv_setiv(sv_type, type);
			sv_setiv(sv_freq, freq);
			sv_setiv(sv_fyear, fyear);
			sv_setiv(sv_fprd, fprd);
			sv_setiv(sv_lyear, lyear);
			sv_setiv(sv_lprd, lprd);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_class
		sv_type
		sv_freq
		sv_fyear
		sv_fprd
		sv_lyear
		sv_lprd


##===========================================================================
##		cfmgdat		Get an objects creation, mod dates at FREQ
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmgdat(dbkey, objnam, freq, sv_cdate, sv_mdate)
int		dbkey
char	*objnam
int		freq
SV		*sv_cdate
SV		*sv_mdate

	PREINIT:
int		cdate;
int		mdate;

	CODE:
		cfmgdat(&status, dbkey, objnam, freq, &cdate, &mdate);
		if (status == HSUCC) {
			sv_setiv(sv_cdate, cdate);
			sv_setiv(sv_mdate, mdate);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_cdate
		sv_mdate


##===========================================================================
##		cfmwhat		Get lots of info
##===========================================================================
##		Tested 2001/02/14
##		doclen bug fixed 2005/02/08 (Thanks Ken K)
##===========================================================================
int
perl_Cfmwhat(dbkey, objnam, sv_class, sv_type, sv_freq, sv_basis, sv_observ, sv_fyear, sv_fprd, sv_lyear, sv_lprd, sv_cyear, sv_cmonth, sv_cday, sv_myear, sv_mmonth, sv_mday, sv_desc, sv_doc)
int		dbkey
char	*objnam
SV		*sv_class
SV		*sv_type
SV		*sv_freq
SV		*sv_basis
SV		*sv_observ
SV		*sv_fyear
SV		*sv_fprd
SV		*sv_lyear
SV		*sv_lprd
SV		*sv_cyear
SV		*sv_cmonth
SV		*sv_cday
SV		*sv_myear
SV		*sv_mmonth
SV		*sv_mday
SV		*sv_desc
SV		*sv_doc

	PREINIT:
int		class, type, freq, basis, observ;
int		fyear, fprd, lyear, lprd;
int		cyear, cmonth, cday, myear, mmonth, mday;
int		deslen, doclen, i;
char	*desc;
char	*doc;

	CODE:
		cfmdlen(&status, dbkey, objnam, &deslen, &doclen);
		if (status == HSUCC) {
			New(0, desc, deslen+1, char);
			for (i=0; i<deslen; i++) {
				desc[i] = ' ';
			}
			desc[deslen] = '\0';

			New(0, doc, doclen+1, char);
			for (i=0; i<doclen; i++) {
				doc[i] = ' ';
			}
			doc[doclen] = '\0';

			cfmwhat(&status, dbkey, objnam,
				&class, &type, &freq, &basis, &observ, 
				&fyear, &fprd, &lyear, &lprd, &cyear, &cmonth, &cday,
				&myear, &mmonth, &mday, desc, doc);
		}
		if (status == HSUCC) {
			sv_setiv(sv_class, class);
			sv_setiv(sv_type, type);
			sv_setiv(sv_freq, freq);
			sv_setiv(sv_basis, basis);
			sv_setiv(sv_observ, observ);
			sv_setiv(sv_fyear, fyear);
			sv_setiv(sv_fprd, fprd);
			sv_setiv(sv_lyear, lyear);
			sv_setiv(sv_lprd, lprd);
			sv_setiv(sv_cyear, cyear);
			sv_setiv(sv_cmonth, cmonth);
			sv_setiv(sv_cday, cday);
			sv_setiv(sv_myear, myear);
			sv_setiv(sv_mmonth, mmonth);
			sv_setiv(sv_mday, mday);
			sv_setpv(sv_desc, desc);
			sv_setpv(sv_doc, doc);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_class
		sv_type
		sv_freq
		sv_basis
		sv_observ
		sv_fyear
		sv_fprd
		sv_lyear
		sv_lprd
		sv_cyear
		sv_cmonth
		sv_cday
		sv_myear
		sv_mmonth
		sv_mday
		sv_desc
		sv_doc


##===========================================================================
##		cfmncnt		Get the length of a namelist
##=========================================================================*/
int
perl_Cfmncnt(dbkey, objnam, sv_length)
int		dbkey
char	*objnam
SV		*sv_length

	PREINIT:
int		length;

	CODE:
		cfmncnt(&status, dbkey, objnam, &length);
		if (status == HSUCC) {
			sv_setiv(sv_length, length);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_length


##===========================================================================
##		cfmsdes		Set NAMELIST desc field
##=========================================================================*/
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmsdes(dbkey, objnam, desc)
int		dbkey
char	*objnam
char	*desc

	CODE:
		cfmsdes(&status, dbkey, objnam, desc);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmsdoc		Set NAMELIST doc field
##=========================================================================*/
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmsdoc(dbkey, objnam, doc)
int		dbkey
char	*objnam
char	*doc

	CODE:
		cfmsdoc(&status, dbkey, objnam, doc);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmsbas		Set objects BASIS attribute
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmsbas(dbkey, objnam, basis)
int dbkey
char *objnam
int basis

	CODE:
		cfmsbas(&status, dbkey, objnam, basis);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmsobs		Set objects OBSERVED attribute
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmsobs(dbkey, objnam, observ)
int		dbkey
char	*objnam
int		observ

	CODE:
		cfmsobs(&status, dbkey, objnam, observ);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		U s e r - D e f i n e d   A t t r i b u t e s
##===========================================================================
##		Since it is easier to use a specific type of function than it
##		is to pass a varient data-type, we just create a seperate function
##		for each data type.
##===========================================================================

##===========================================================================
##		cfmgtatt	Get User defined attribute value
##=========================================================================*/
##		Tested
##			Boolean		2001/03/21
##			Numeric		2001/03/22
##			Precision	2001/03/22
##			NameList	2001/03/22
##			String		2001/03/22
##			Date		2001/03/22
##===========================================================================
int
perl_Cfmgtatt(dbkey, objnam, sv_atttype, attnam, sv_value, xinlen=0, xoutlen=0)
int		dbkey
char	*objnam
SV		*sv_atttype
char	*attnam
SV		*sv_value
int		xinlen
int		xoutlen

	PREINIT:
int		worked	=	TRUE;
int		atttype;
int		inlen;
int		outlen;
float	f_value;
double	d_value;
int		i_value;
char	*s_value;
float	*valptr;

	CODE:
		atttype = SvIV(sv_atttype);
		switch (atttype) {
		  case HNUMRC:
			valptr = &f_value;
			break;
		  case HPRECN:
			valptr = (float *)(&d_value);
			break;
		  case HNAMEL:
		  case HSTRNG:
			cfmlatt(&status, dbkey, objnam, atttype, attnam, &inlen);
			if (status != HSUCC) {
				worked = FALSE;
			}
			if (worked) {
				New(0, s_value, inlen+1, char);
				valptr = (float *)s_value;
			}
			break;
		  case HBOOLN:
		  case HDATE:
			valptr = (float *)(&i_value);
			break;
		  default:
			printf("Cfmgtatt: Invalid Attribute Type\n");
			worked = FALSE;
			break;
		}

		if (worked) {
			cfmgtatt(&status, dbkey, objnam, &atttype, attnam, valptr, 
					inlen, &outlen);
			worked = (status == HSUCC || status == HTRUNC);
		}

##		--------------------------------------------------------------
##		The theory here is that "If it isn't one of the other data
##		types, it must be a Date Frequency.  Since it is an existing
##		object, we will assume that this will hold here.
##		--------------------------------------------------------------
		if (worked) {
			switch(atttype) {
			  case HNUMRC:
				sv_setnv(sv_value, f_value);
				break;
			  case HPRECN:
				sv_setnv(sv_value, d_value);
				break;
			  case HNAMEL:
			  case HSTRNG:
				sv_setpv(sv_value, s_value);
				break;
			  case HBOOLN:
			  case HDATE:
			  default:
				sv_setiv(sv_value, i_value);
				break;
			}
			sv_setiv(sv_atttype, atttype);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_value
		sv_atttype


##===========================================================================
##		cfmsatt		Set the value of a user defined attribute
##=========================================================================*/
##		Attribute type should be a valid datatype.  Instead of checking
##		all valid date frequencies, we just use cfmufrq to see if we have
##		any valid freq.
##=========================================================================*/
##		Tested
##			Boolean		2001/03/22
##			Numeric		2001/03/22
##			Precision	2001/03/22
##			NameList	2001/03/22
##			String		2001/03/22
##			Date		2001/03/22
##===========================================================================
int
perl_Cfmsatt(dbkey, objnam, atttype, attnam, sv_value)
int		dbkey
char	*objnam
int		atttype
char	*attnam
SV		*sv_value

	PREINIT:
int		i_value;
float	f_value;
double	d_value;
char	*s_value;
float	*valptr;
int		xlen;
int		worked	=	TRUE;

	CODE:
		switch (atttype) {
		  case HNUMRC:
			f_value = SvNV(sv_value);
			valptr = &f_value;
			break;
		  case HPRECN:
			d_value = SvNV(sv_value);
			valptr = (float *)(&d_value);
			break;
		  case HNAMEL:
		  case HSTRNG:
			s_value = SvPV(sv_value, xlen);
			valptr = (float *)(s_value);
			break;
		  case HBOOLN:
		  default:
			i_value = SvIV(sv_value);
			valptr = (float *)(&i_value);
			break;
		}
		cfmsatt(&status, dbkey, objnam, atttype, attnam, valptr);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmgnam		Get base name of an object
##===========================================================================
##		Tested 2001/03/22
##===========================================================================
int
perl_Cfmgnam(dbkey, objnam, sv_basnam)
int		dbkey
char	*objnam
SV		*sv_basnam

	PREINIT:
char	buff[SMALLBUF];

	CODE:
		cfmgnam(&status, dbkey, objnam, buff);
		if (status == HSUCC) {
			sv_setpv(sv_basnam, buff);
		} else {
			printf("Cfmgnam: Danger Will Robinson! (%d)\n", status);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_basnam


##===========================================================================
##		cfmgtali	Get the aliases of an object
##===========================================================================
##		Tested 2001/03/22
##===========================================================================
int
perl_Cfmgtali(dbkey, objnam, sv_alias, xinlen=0, xoutlen=0)
int		dbkey
char	*objnam
SV		*sv_alias
int		xinlen;
int		xoutlen;

	PREINIT:
int		worked = TRUE;
int		inlen;
int		outlen;
char	*buff;

	CODE:
		cfmlali(&status, dbkey, objnam, &inlen);
		if (status != HSUCC) {
			worked = FALSE;
		}

		if (worked) {
			New(0, buff, inlen+1, char);
			outlen = inlen;

			cfmgtali(&status, dbkey, objnam, buff, inlen, &outlen);
			if (status == HSUCC) {
				sv_setpv(sv_alias, buff);
			}
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_alias


##===========================================================================
##		cfmsali		Set the alias of an object
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmsali(dbkey, objnam, aliass)
int		dbkey
char	*objnam
char	*aliass

	PREINIT:
int		x;

	CODE:
		cfmsali(&status, dbkey, objnam, aliass);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmlsts		Get the lengths of a range of strings
##===========================================================================
##		Tested		2001/03/22
##===========================================================================
int
perl_Cfmlsts(dbkey, objnam, range, sv_lenary)
int		dbkey
char	*objnam
SV		*range
SV		*sv_lenary

	PREINIT:
int		i;
int		worked	=	TRUE;
SV		**svptr;
SV		*sv;
I32		ix;
int		rlen;
int		rng[3];
AV		*rngarray;
AV		*lenarray;
int		class, type, freq;
int		fyear, fprd, lyear, lprd;
int		*lenary;

	CODE:
##		----------------------------------------------------------------------
##		Check to see if we have been given anything valid.  If so, use it.
##		----------------------------------------------------------------------
		if (SvROK(sv_lenary) && (SvTYPE(SvRV(sv_lenary)) == SVt_PVAV)) {
			lenarray = (AV *)SvRV(sv_lenary);
			av_clear(lenarray);
				
##		----------------------------------------------------------------------
##		It isn't a refrence or an array.  For now, blow away the old thing 
##		and create a new reference.
##		----------------------------------------------------------------------
		} else {
			lenarray = newAV();
			SvREFCNT_dec(sv_lenary);
			sv_lenary = newRV_inc((SV *)lenarray);
		}

##		----------------------------------------------------------------------
##		First, let's see what type of data object we are reading.  This will
##		affect what we do with the DATA set and the MISSING TABLE stuff.
##		----------------------------------------------------------------------
		cfmosiz(&status, dbkey, objnam, &class, &type, &freq,
					&fyear, &fprd, &lyear, &lprd);

##		----------------------------------------------------------------------
##		Check to see if we have been given a valid RANGE.
##		----------------------------------------------------------------------
		if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
			rngarray = (AV *)SvRV(range);
		} else {
			status = HBRNG;
			worked = FALSE;
		}

		if (worked && av_len(rngarray) == 2) {
			for (ix=0; ix<3; ix++) {
				svptr = av_fetch(rngarray, ix, 0);
				rng[ix] = SvIV(*svptr);
			}
##			----------------------------------------------------------
##			This might be cheating but I believe it is correct...
##			[0]=freq, [1]=start, [2]=end so [2]-[1] should be nobs - 1.
##			----------------------------------------------------------
			rlen = rng[2] - rng[1] + 1;
		}

		lenary = NULL;

		if (worked) {
			New(0, lenary, rlen, int);
			cfmlsts(&status, dbkey, objnam, rng, lenary);
		}

		if (status == HSUCC) {
			for (i=0; i<rlen; i++) {
				sv = newSViv(lenary[i]);
				av_push(lenarray, sv);
			}
		} else {
			printf("Cfmlsts: Danger Will Robinson! (%d)\n", status);
		}

		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_lenary


##===========================================================================
##		cfmgsln		Get the STRINGLENGTH attribute of an object
##===========================================================================
##		Tested 		NOT TESTED
##===========================================================================
int
perl_Cfmgsln(dbkey, objnam, sv_length)
int		dbkey
char	*objnam
SV		*sv_length

	PREINIT:
int		length;

	CODE:
		sv_setiv(sv_length, -1);
		cfmgsln(&status, dbkey, objnam, &length);
		if (status == HSUCC) {
			sv_setiv(sv_length, length);
		} else {
			printf("Cfmgsln: Danger Will Robinson! (%d)\n", status);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_length


##===========================================================================
##		cfmssln		Set the STRINGLENGTH attribute of an object
##=========================================================================*/
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmssln(dbkey, objnam, length)
int		dbkey
char	*objnam
int		length

	CODE:
		cfmssln(&status, dbkey, objnam, length);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmgtaso	G e t   A S S O C I A T E  A t t r i b u t e
##=========================================================================*/
##		Tested	2001/03/22
##=========================================================================*/
int
perl_Cfmgtaso(dbkey, objnam, sv_assoc)
int		dbkey
char	*objnam
SV		*sv_assoc

	PREINIT:
int		inlen;
int		outlen;
char	tmp[2];
char	*buff;
int		cnt = 0;

	CODE:
		inlen = 1;
		cfmgtaso(&status, dbkey, objnam, tmp, inlen, &outlen);

		buff = NULL;
		if (status == HSUCC || status == HTRUNC) {
			inlen = outlen;
			New(0, buff, outlen+1, char);
			cfmgtaso(&status, dbkey, objnam, buff, inlen, &outlen);
		}

		if (status == HSUCC) {
			sv_setpv(sv_assoc, buff);
		} else {
			printf("Cfmgtaso: Danger Will Robinson! (%d)\n", status);
		}

		if (buff) {
			Safefree(buff);
		}

		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_assoc


##===========================================================================
##		cfmlaso		A S S O C I A T E  A t t r i b u t e   L e n g t h
##=========================================================================*/
##		Tested	2001/03/22
##=========================================================================*/
int
perl_Cfmlaso(dbkey, objnam, sv_asolen)
int		dbkey
char	*objnam
SV		*sv_asolen

	PREINIT:
int		asolen;

	CODE:
		sv_setiv(sv_asolen, -1);
		cfmlaso(&status, dbkey, objnam, &asolen);
		if (status == HSUCC) {
			sv_setiv(sv_asolen, asolen);
		} else {
			printf("Cfmlaso: Danger Will Robinson! (%d)\n", status);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_asolen


##===========================================================================
##		cfmsaso		S e t   A S S O C I A T E  A t t r i b u t e
##=========================================================================*/
##		Tested	2001/03/22
##=========================================================================*/
int
perl_Cfmsaso(dbkey, objnam, assoc)
int		dbkey
char	*objnam
char	*assoc

	CODE:
		cfmsaso(&status, dbkey, objnam, assoc);
		RETVAL = status;
	OUTPUT:
		RETVAL



##***************************************************************************
##***************************************************************************
##					H A N D L I N G   D A T E S
##***************************************************************************
##***************************************************************************


##===========================================================================
##		cfmfdiv		F r e q 1   D i v i s i b l e   B y   F r e q 2
##===========================================================================
##===========================================================================
int
perl_Cfmfdiv(freq1, freq2, sv_flag)
int		freq1
int		freq2
SV		*sv_flag

	PREINIT:
int		flag;

	CODE:
		cfmfdiv(&status, freq1, freq2, &flag);
		if (status == HSUCC) {
			sv_setiv(sv_flag, flag);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_flag


##===========================================================================
##		cfmtody		R E T R E I V E   T O D A Y ' S   D A T E
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmtody(freq, sv_date)
int		freq
SV		*sv_date

	PREINIT:
int		date;

	CODE:
		cfmtody(&status, freq, &date);
		if (status == HSUCC) {
			sv_setiv(sv_date, date);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_date


##===========================================================================
##		cfmpind		G e t   P e r i o d s   i n   a   D a y
##===========================================================================
##		Tested:	2001/04/18
##===========================================================================
int
perl_Cfmpind(freq, sv_count)
int		freq
SV		*sv_count

	PREINIT:
int		count;

	CODE:
		cfmpind(&status, freq, &count);
		if (status == HSUCC) {
			sv_setiv(sv_count, count);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_count


##===========================================================================
##		cfmpinm		G e t   P e r i o d s   i n   a   M o n t h
##===========================================================================
##		Tested:	2001/04/18
##===========================================================================
int
perl_Cfmpinm(freq, year, month, sv_count)
int		freq
int		year
int		month
SV		*sv_count

	PREINIT:
int		count;

	CODE:
		cfmpinm(&status, freq, year, month, &count);
		if (status == HSUCC) {
			sv_setiv(sv_count, count);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_count


##===========================================================================
##		cfmpiny		G e t   P e r i o d s   i n   a   Y e a r
##===========================================================================
##		Tested:	2001/04/18
##===========================================================================
int
perl_Cfmpiny(freq, year, sv_count)
int		freq
int		year
SV		*sv_count

	PREINIT:
int		count;

	CODE:
		cfmpiny(&status, freq, year, &count);
		if (status == HSUCC) {
			sv_setiv(sv_count, count);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_count


##===========================================================================
##		cfmwkdy		G e t   W e e k d a y   o f   a   D a t e
##===========================================================================
##		Tested:	2001/04/18
##===========================================================================
int
perl_Cfmwkdy(freq, date, sv_wkdy)
int freq
int date
SV		*sv_wkdy

	PREINIT:
int		wkdy;

	CODE:
		cfmwkdy(&status, freq, date, &wkdy);
		if (status == HSUCC) {
			sv_setiv(sv_wkdy, wkdy);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_wkdy


##===========================================================================
##		cfmbwdy		G e t   B i w e e k d a y   o f   a   D a t e
##===========================================================================
##		Tested:	2001/04/18
##===========================================================================
int
perl_Cfmbwdy(freq, date, sv_biwkdy)
int		freq
int		date
SV		*sv_biwkdy

	PREINIT:
int		biwkdy;

	CODE:
		cfmbwdy(&status, freq, date, &biwkdy);
		if (status == HSUCC) {
			sv_setiv(sv_biwkdy, biwkdy);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_biwkdy


##===========================================================================
##		cfmislp		I s   Y e a r   L e a p   Y e a r ?
##===========================================================================
##		Tested:	2001/04/18
##===========================================================================
int
perl_Cfmislp(year, sv_leap)
int		year
SV		*sv_leap

	PREINIT:
int		leap;

	CODE:
		cfmislp(&status, year, &leap);
		if (status == HSUCC) {
			sv_setiv(sv_leap, leap);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_leap


##===========================================================================
##		cfmchfr		C h a n g e   F r e q   o f   D a t e
##===========================================================================
int
perl_Cfmchfr(sfreq, sdate, select, tfreq, sv_tdate, relate)
int		sfreq
int		sdate
int		select
int		tfreq
SV		*sv_tdate
int		relate

	PREINIT:
int		tdate;

	CODE:
		cfmchfr(&status, sfreq, sdate, select, tfreq, &tdate, relate);
		if (status == HSUCC) {
			sv_setiv(sv_tdate, tdate);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_tdate


##===========================================================================
##		cfmpfrq
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmpfrq(sv_freq, base, nunits, year, month)
SV		*sv_freq
int		base
int		nunits
int		year
int		month

	PREINIT:
int		freq;

	CODE:
		cfmpfrq(&status, &freq, base, nunits, year, month);
		if (status == HSUCC) {
			sv_setiv(sv_freq, freq);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_freq


##===========================================================================
##		cfmufrq
##===========================================================================
##		Tested 2001/02/14
##===========================================================================
int
perl_Cfmufrq(freq, sv_base, sv_nunits, sv_year, sv_month)
int		freq
SV		*sv_base
SV		*sv_nunits
SV		*sv_year
SV		*sv_month

	PREINIT:
int		base;
int		nunits;
int		year;
int		month;

	CODE:
		cfmufrq(&status, freq, &base, &nunits, &year, &month);
		if (status == HSUCC) {
			sv_setiv(sv_base, base);
			sv_setiv(sv_nunits, nunits);
			sv_setiv(sv_year, year);
			sv_setiv(sv_month, month);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_base
		sv_nunits
		sv_year
		sv_month


##***************************************************************************
##***************************************************************************
##		H a n d l i n g   M i s s i n g   V a l u e s
##***************************************************************************
##***************************************************************************


##===========================================================================
##		Since we handle missing values as references to strings like "NA",
##		"NC" and "ND" there is really no reason to have these functions.
##		At the suggestion of a well positioned Fame employee, we simply
##		return the "This operation not allowed in current context" value
##		if you call one of these (HBCNTX).  That way, you get a "valid"
##		return code.
##
##		First, the "Set It" functions
##
##===========================================================================

##===========================================================================
##		cfmsnm
##===========================================================================

int
perl_Cfmsnm(t_nctran = FNUMNC, t_ndtran = FNUMND, t_natran = FNUMNA, table)
double		t_nctran
double		t_ndtran
double		t_natran
SV			*table

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmspm
##===========================================================================
int
perl_Cfmspm(nctran = FPRCNC, ndtran = FPRCND, natran = FPRCNA, table)
double		nctran
double		ndtran
double		natran
SV			*table

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmsbm
##===========================================================================
int
perl_Cfmsbm(t_nctran = FBOONC, t_ndtran = FBOOND, t_natran = FBOONA, table)
double		t_nctran;
double		t_ndtran;
double		t_natran;
SV			*table

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmsdm
##===========================================================================
int
perl_Cfmsdm(t_nctran = FDATNC, t_ndtran = FDATND, t_natran = FDATNA, table)
double		t_nctran;
double		t_ndtran;
double		t_natran;
SV			*table

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##===========================================================================
##		And then....
##			The "IS IT?" functions
##===========================================================================

##===========================================================================
##		cfmisnm
##===========================================================================
int
perl_Cfmisnm(t_value, sv_ismiss)
double	t_value
SV		*sv_ismiss

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##		sv_ismiss
##===========================================================================
##		cfmispm
##===========================================================================
int
perl_Cfmispm(t_value, sv_ismiss)
double	t_value
SV		*sv_ismiss

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmisbm
##===========================================================================
int
perl_Cfmisbm(t_value, sv_ismiss)
double	t_value
SV		*sv_ismiss

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmisdm
##===========================================================================
int
perl_Cfmisdm(t_value, sv_ismiss)
double	t_value
SV		*sv_ismiss

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmissm
##===========================================================================
int
perl_Cfmissm(t_value, sv_ismiss)
double	t_value
SV		*sv_ismiss

	CODE:
		RETVAL = HBCNTX;

	OUTPUT:
		RETVAL


##***************************************************************************
##***************************************************************************
##		W i l d c a r d i n g
##***************************************************************************
##***************************************************************************

##===========================================================================
##		cfminwc		I n i t   W i l d c a r d
##===========================================================================
##		Tested	2000/10/16
##===========================================================================
int
perl_Cfminwc(dbkey, wildname)
int dbkey
char *wildname

	CODE:
		cfminwc(&status, dbkey, wildname);
		RETVAL = status;
	OUTPUT:
		RETVAL

##===========================================================================
##		cfmnxwc		N e x t   W i l d c a r d   M a t c h
##===========================================================================
##		Object names can only be 64 characters long so the buffer is more
##		than enough.
##===========================================================================
##		Tested	2001/03/16
##===========================================================================
int
perl_Cfmnxwc(dbkey, sv_str, sv_class, sv_type, sv_freq)
int		dbkey
SV 		*sv_str
SV		*sv_class
SV		*sv_type
SV		*sv_freq

	PREINIT:
char	buffer[SMALLBUF];
static	int	xx = 0;
char	*thing;
int		len;
int		class;
int		type;
int		freq;

	CODE:
		cfmnxwc(&status, dbkey, buffer, &class, &type, &freq);
		if (status == HSUCC) {
			sv_setpv(sv_str, buffer);
			sv_setiv(sv_class, class);
			sv_setiv(sv_type, type);
			sv_setiv(sv_freq, freq);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_str
		sv_class
		sv_type
		sv_freq


##***************************************************************************
##***************************************************************************
##		R e a d i n g   D a t a
##***************************************************************************
##***************************************************************************

##===========================================================================
##		cfmrdfa		R e a d   A l l   D a t a   F r o m   O b j e c t
##===========================================================================
##	BROKE
##===========================================================================
int
perl_Cfmrdfa(dbkey, objnam, wntobs, syear, sprd, gotobs, data, tmiss, tbl)
int		dbkey
char	*objnam
int		wntobs
int		syear
int		sprd
int		gotobs
double	data		=	NO_INIT
int		tmiss
double	tbl

	CODE:
		status = HBCNTX;
##		cfmrdfa(&status, dbkey, objnam, wntobs, &syear, &sprd, &gotobs, 
##				(float *)(data->data), tmiss, (float *)tbl->tbl);
		RETVAL = status;
	OUTPUT:
		RETVAL
		syear
		sprd
		gotobs
		data


##===========================================================================
##		cfmgtnl		G e t   N a m e l i s t  ( E l e m e n t   o r   A l l )
##===========================================================================
##===========================================================================
int
perl_Cfmgtnl(dbkey, objnam, index, sv_str, xinlen=0, xoutlen=0)
int		dbkey
char	*objnam
int		index
SV		*sv_str
int		xinlen
int		xoutlen

	PREINIT:
int		inlen;
int		outlen;
int		worked	=	TRUE;
char	*buffer;

	CODE:
		cfmnlen(&status, dbkey, objnam, index, &inlen);
		worked = status == HSUCC;
		if (worked) {
			New(0, buffer, inlen+1, char);
			cfmgtnl(&status, dbkey, objnam, index, buffer, inlen, &outlen);
			worked = status == HSUCC;
			sv_setpv(sv_str, buffer);
			Safefree(buffer);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_str

##===========================================================================
##		cfmrrng		R e a d   R a n g e   o f   D a t a
##===========================================================================
##		Tested
##			2001/04/17
##		Missing values passed, but not missing table values.
##===========================================================================
int
perl_Cfmrrng(dbkey, objnam, range, data, miss, table)
int		dbkey
char	*objnam
SV		*range
SV		*data
int		miss
SV		*table

	PREINIT:
int		i;
int		worked	=	TRUE;
SV		**svptr;
SV		*sv;
SV		*sv2;
I32		ix;
int		len;
int		rlen	=	0;
int		rng[3];
AV		*datarray;
AV		*rngarray;
AV		*tblarray;
int		*iptr;
float	*fptr;
void	*vptr;
int		*mitbl	=	NULL;
float	*mftbl	=	NULL;
double	*mdtbl	=	NULL;
void	*tbl	=	NULL;
int		class;
int		type;
int		freq;
int		fyear;
int		fprd;
int		lyear;
int		lprd;
double	*dptr;
double	dtmp;
int		ii = 0;


	CODE:
##		----------------------------------------------------------------------
##		First, let's see what type of data object we are reading.  This will
##		affect what we do with the DATA set and the MISSING TABLE stuff.
##		----------------------------------------------------------------------
		cfmosiz(&status, dbkey, objnam, &class, &type, &freq,
					&fyear, &fprd, &lyear, &lprd);

		if (status != HSUCC) {
			worked = FALSE;
		}

##		----------------------------------------------------------------------
##		See if we were given a real variable in which to save data.  If so, 
##		clear it out.
##		----------------------------------------------------------------------
		if (worked) {
			if (SvROK(data)) {
				if (SvTYPE(SvRV(data)) == SVt_PVAV) {
					datarray = (AV *)SvRV(data);
					av_clear(datarray);
				}

##		----------------------------------------------------------------------
##		----------------------------------------------------------------------
			} else {
				datarray = newAV();
				SvREFCNT_dec(data);
				data = newRV_inc((SV *)datarray);
			}
		}

##		----------------------------------------------------------------------
##		Check to see if we have been given a valid RANGE.
##		----------------------------------------------------------------------
		if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {

			rngarray = (AV *)SvRV(range);

			if (av_len(rngarray) == 2) {
				for (ix=0; ix<3; ix++) {
					svptr = av_fetch(rngarray, ix, 0);
					rng[ix] = SvIV(*svptr);
				}
##			----------------------------------------------------------
##			This might be cheating but I believe it is correct...
##			[0]=freq, [1]=start, [2]=end so [2]-[1] should be nobs - 1.
##			----------------------------------------------------------
				rlen = rng[2] - rng[1] + 1;
			}

##		----------------------------------------------------------------------
##		If there is no frequency then this is a SCALAR and needs to be handled
##		as such.  FAME will ignore the 'range' object but we need a length.
##		----------------------------------------------------------------------
		} else if (freq == HUNDFX) {
			rlen = 1;

##		----------------------------------------------------------------------
##		Not much we can do here...
##		----------------------------------------------------------------------
		} else {
			status = HBRNG;
			worked = FALSE;
		}

##		----------------------------------------------------------------------
##		Next, depending on the type of data that we will be reading...
##		----------------------------------------------------------------------
		if (worked) {
			switch (type) {
			  case HNUMRC:
				New(0, fptr, rlen, float);
				vptr = (void *)fptr;
				break;
			  case HPRECN:
				New(0, dptr, rlen, double);
				vptr = (void *)dptr;
				break;
			  case HSTRNG:
			  case HNAMEL:
				worked = FALSE;
				status = -1;
				break;
			  case HBOOLN:
			  default:
				New(0, iptr, rlen, int);
				vptr = (void *)iptr;
				break;
			}
		}

##		----------------------------------------------------------------------
##		We now know that data type is one of the valid types.  'default'
##		now takes on the meaning "date frequency" type.
##		----------------------------------------------------------------------
		if (worked) {
			cfmrrng(&status, dbkey, objnam, rng, (float *)vptr, miss, tbl);
			if (status != HSUCC) {
				worked = FALSE;
			}
		}

##		----------------------------------------------------------------------
##		Copy the data into the array that is to be returned.
##		----------------------------------------------------------------------
		if (worked) {

##		----------------------------------------------------------------------
##		If there is no frequency, it is a scalar.  For now, however, it is
##		returned as the first element of an array (which is consistent with
##		the Fame C-HLI documentation).
##		----------------------------------------------------------------------

##		----------------------------------------------------------------------
##		F I X   T H I S
##		F I X   T H I S
##		Missing values need to be set as references to strings.
##		F I X   T H I S
##		F I X   T H I S
##      ----------------------------------------------------------------------

			if (freq == HUNDFX) {
				switch(type) {
				  case HNUMRC:
					if (fptr[0] == FNUMNA) {
						sv = newSVpv("NA", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (fptr[0] == FNUMNC) {
						sv = newSVpv("NC", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (fptr[0] == FNUMND) {
						sv = newSVpv("ND", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else {
##	fprintf(stderr, "\n\t'%s'%g'\n", objnam, fptr[0]);
						sv = newSVnv(fptr[0]);
						av_push(datarray, sv);
					}
					break;

				  case HBOOLN:
					if (iptr[0] == FBOONA) {
						sv = newSVpv("NA", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (iptr[0] == FBOONC) {
						sv = newSVpv("NC", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (iptr[0] == FBOOND) {
						sv = newSVpv("ND", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else {
##	fprintf(stderr, "\n\t'%d'\n", iptr[0]);
						sv = newSViv(iptr[0]);
						av_push(datarray, sv);
					}
					break;
				  case HPRECN:
					if (dptr[0] == FPRCNA) {
						sv = newSVpv("NA", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (dptr[0] == FPRCNC) {
						sv = newSVpv("NC", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (dptr[0] == FPRCND) {
						sv = newSVpv("ND", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else {
##	fprintf(stderr, "\n\t'%g'\n", dptr[0]);
						sv = newSVnv(dptr[0]);
						av_push(datarray, sv);
					}
					break;
				  default:
					if (iptr[0] == FDATNA) {
						sv = newSVpv("NA", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (iptr[0] == FDATNC) {
						sv = newSVpv("NC", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else if (iptr[0] == FDATND) {
						sv = newSVpv("ND", 0);
						sv2 = newRV_noinc(sv);
						av_push(datarray, sv2);
					} else {
##	fprintf("\n\t'%d'\n", iptr[0]);
						sv = newSViv(iptr[0]);
						av_push(datarray, sv);
					}
					break;
				}

##		----------------------------------------------------------------------
##			Otherwise this is an array so set all the values.
##		----------------------------------------------------------------------
			} else {
				for (i=0; i<rlen; i++) {
					switch(type) {
					  case HNUMRC:
						if (fptr[i] == FNUMNA) {
							sv = newSVpv("NA", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (fptr[i] == FNUMNC) {
							sv = newSVpv("NC", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (fptr[i] == FNUMND) {
							sv = newSVpv("ND", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else {
							sv = newSVnv(fptr[i]);
							av_push(datarray, sv);
						}
						break;

					  case HBOOLN:
						if (iptr[i] == FBOONA) {
							sv = newSVpv("NA", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (iptr[i] == FBOONC) {
							sv = newSVpv("NC", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (iptr[i] == FBOOND) {
							sv = newSVpv("ND", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else {
							sv = newSViv(iptr[i]);
							av_push(datarray, sv);
						}
						break;

					  case HPRECN:
						if (dptr[i] == FPRCNA) {
							sv = newSVpv("NA", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (dptr[i] == FPRCNC) {
							sv = newSVpv("NC", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (dptr[i] == FPRCND) {
							sv = newSVpv("ND", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else {
							sv = newSVnv(dptr[i]);
							av_push(datarray, sv);
						}
						break;

					  default:
						if (iptr[i] == FDATNA) {
							sv = newSVpv("NA", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (iptr[i] == FDATNC) {
							sv = newSVpv("NC", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else if (iptr[i] == FDATND) {
							sv = newSVpv("ND", 0);
							sv2 = newRV_noinc(sv);
							av_push(datarray, sv2);
						} else {
							sv = newSViv(iptr[i]);
							av_push(datarray, sv);
						}
						break;

					}
				}
			}
			data = newRV_inc((SV *)datarray);
		}

		RETVAL = status;

	OUTPUT:
		RETVAL
		data


##===========================================================================
##		cfmgtstr	G e t   A   S i n g l e   S t r i n g   V a l u e
##===========================================================================
##		Tested
##			2001/04/17
##===========================================================================
##		The last three variables are there for completeness.  They aren't
##		needed and, currently, aren't used.
##		Note that we completely ignore the ismiss, inlen and outlen values 
##			even if the caller provides them.  In fact, sv_out is not set
##			as a return value.
##===========================================================================
int
perl_Cfmgtstr(dbkey, objnam, range, sv_str, sv_ismiss=0, sv_inlen=0, sv_out=0)
int		dbkey
char	*objnam
SV		*range
SV		*sv_str
SV		*sv_ismiss
SV		*sv_inlen
SV		*sv_out

	PREINIT:
int		i;
int		worked	=	TRUE;
SV		**svptr;
SV		*sv;
SV		*sv2;
I32		ix;
int		rng[3];
AV		*rngarray;
char	mtbuff[3];
char	*buff;
char	*str;
int		ismiss;
int		inlen;
int		outlen;
int		fclass, ftype, freq, fyear, fprd, lyear, lprd;

	CODE:
		buff = 0;
##		----------------------------------------------------------------------
##		Let's find out what type of object we are checking.
##		----------------------------------------------------------------------
		cfmosiz(&status, dbkey, objnam, &fclass, &ftype, &freq,
					&fyear, &fprd, &lyear, &lprd);
		if (status != HSUCC) {
			worked = FALSE;
		}

##		----------------------------------------------------------------------
##		Check to see if we have been given a valid RANGE.
##		----------------------------------------------------------------------
		if (worked && fclass == HSERIE) {
			if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
				rngarray = (AV *)SvRV(range);
			} else {
				worked = FALSE;
			}

			if (worked && av_len(rngarray) == 2) {
				for (ix=0; ix<3; ix++) {
					svptr = av_fetch(rngarray, ix, 0);
					rng[ix] = SvIV(*svptr);
				}
##			----------------------------------------------------------
##			If there is no range object provided, fake one.  This
##			might be a scalar which ignores it.
##			----------------------------------------------------------
			} else {
				rng[0] = 0;
				rng[1] = 0;
				rng[2] = 0;
			}
		}

##		----------------------------------------------------------------------
##		Get the length of the item, then get the item.
##		----------------------------------------------------------------------
		if (worked) {
			cfmgtstr(&status, dbkey, objnam, rng, mtbuff, &ismiss, 2, &inlen);
			worked = (status == HSUCC || status == HTRUNC);
		}

		if (worked) {
			printf("inlen is '%d'\n", inlen);
			New(0, buff, inlen+1, char);
			cfmgtstr(&status, dbkey, objnam, rng, buff,
				&ismiss, inlen, &outlen);
			worked = status == HSUCC;
		}

##		----------------------------------------------------------------------
##		Now, if Missing Value, set it so, otherwise set the value.
##		----------------------------------------------------------------------
		if (worked) {
			if (ismiss == HNAVAL) {
				sv = newSVpv("NA", 0);
				sv2 = newRV_noinc(sv);
				sv_setsv(sv_str, sv2);
				SvROK_on(sv_str);
			} else if (ismiss == HNCVAL) {
				sv = newSVpv("NC", 0);
				sv2 = newRV_noinc(sv);
				sv_setsv(sv_str, sv2);
				SvROK_on(sv_str);
			} else if (ismiss == HNDVAL) {
				sv = newSVpv("ND", 0);
				sv2 = newRV_noinc(sv);
				sv_setsv(sv_str, sv2);
				SvROK_on(sv_str);
			} else {
				sv_setpv(sv_str, buff);
			}
		}
		if (buff) {
			Safefree(buff);
		}

		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_str


##===========================================================================
##		cfmgtsts	G e t   A   R a n g e   o f   S t r i n g   V a l u e s
##===========================================================================
##		Tested
##			2001/04/17
##		Since the "misaray" array is essentially redundant information, it
##		is not returned.  Simply check to see if the returned object is a
##		reference or not.
##===========================================================================
int
perl_Cfmgtsts(dbkey, objnam, range, data, xmiss=0, xin=0, xout=0)
int		dbkey
char	*objnam
SV		*range
SV		*data
SV		*xmiss
SV		*xin
SV		*xout

	PREINIT:
int		i;
int		worked	=	TRUE;
SV		**svptr;
SV		*sv;
SV		*sv2;
I32		ix;
int		rlen;
int		rng[3];
AV		*datarray;
AV		*rngarray;
int		class;
int		type;
int		freq;
int		fyear;
int		fprd;
int		lyear;
int		lprd;
char	**strdata;
int		*inlen;
int		*outlen;
int		*misarray;

	CODE:
##		----------------------------------------------------------------------
##		See if we were given a real variable.  If so, clear it out.
##		----------------------------------------------------------------------
		if (SvROK(data) && (SvTYPE(SvRV(data)) == SVt_PVAV)) {
			datarray = (AV *)SvRV(data);
			av_clear(datarray);

##		----------------------------------------------------------------------
##		----------------------------------------------------------------------
		} else {
			datarray = newAV();
			SvREFCNT_dec(data);
			data = newRV_inc((SV *)datarray);
		}

##		----------------------------------------------------------------------
##		First, let's see what type of data object we are reading.  We want
##		to make sure that it is proper.
##		----------------------------------------------------------------------
		cfmosiz(&status, dbkey, objnam, &class, &type, &freq,
					&fyear, &fprd, &lyear, &lprd);

##		----------------------------------------------------------------------
##		Check to see if we have been given a valid RANGE.
##		----------------------------------------------------------------------
		if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
			rngarray = (AV *)SvRV(range);
		} else {
			status = HBRNG;
			worked = FALSE;
		}

		if (worked && av_len(rngarray) == 2) {
			for (ix=0; ix<3; ix++) {
				svptr = av_fetch(rngarray, ix, 0);
				rng[ix] = SvIV(*svptr);
			}
##			----------------------------------------------------------
##			This might be cheating but I believe it is correct...
##			[0]=freq, [1]=start, [2]=end so [2]-[1] should be nobs - 1.
##			----------------------------------------------------------
			rlen = rng[2] - rng[1] + 1;
		}

##		----------------------------------------------------------------------
##		Next, depending on the type of data that we will be reading...
##		----------------------------------------------------------------------
		if (worked) {
			worked = type == HSTRNG;
		} else {
			printf("I need a string to use this function!\n");
		}

		if (worked) {
			New(0, inlen, rlen, int);
			New(0, outlen, rlen, int);
			New(0, misarray, rlen, int);
			New(0, strdata, rlen, char *);
			for (i=0; i<rlen; i++) {
				strdata[i] = (char *)New(0, strdata[i], 2, char);
				inlen[i] = 1;
			}

##		----------------------------------------------------------------------
##		Get the length of elements in fame right now and store in outlen.
##		----------------------------------------------------------------------
			cfmgtsts(&status, dbkey, objnam, rng, strdata,
				misarray, inlen, outlen);
			worked = status == HSUCC || status == HTRUNC;
		}

##		----------------------------------------------------------------------
##		Free any data stored in the data array and reallocate space to match
##		what FAME needs to store data.  Then, get the data.
##		----------------------------------------------------------------------
		if (worked) {
			for (i=0; i<rlen; i++) {
				Safefree(strdata[i]);
				strdata[i] = (char *)malloc(sizeof(char) * (outlen[i]+1));
			}
			cfmgtsts(&status, dbkey, objnam, rng, strdata,
				misarray, outlen, inlen);
		}

##		----------------------------------------------------------------------
##		Next, send the data back.
##		----------------------------------------------------------------------
		if (worked) {
			for (i=0; i<rlen; i++) {
				switch(misarray[i]) {
				  case HNMVAL:
					sv = newSVpv(strdata[i], 0);
					av_push(datarray, sv);
					break;
				  case HNAVAL:
					sv = newSVpv("NA", 0);
					sv2 = newRV_noinc(sv);
					av_push(datarray, sv2);
					break;
				  case HNCVAL:
					sv = newSVpv("NC", 0);
					sv2 = newRV_noinc(sv);
					av_push(datarray, sv2);
					break;
				  case HNDVAL:
					sv = newSVpv("ND", 0);
					sv2 = newRV_noinc(sv);
					av_push(datarray, sv2);
					break;
				  case HMGVAL:
					printf("I just plopped on a Magic Nullsv\n");
					av_push(datarray, &PL_sv_undef);
					break;
				  default:
					break;
				}
			}
		} else {
			printf("It didn't work.\n");
		}

##		----------------------------------------------------------------------
##		----------------------------------------------------------------------
		if (inlen)		{	Safefree(inlen);	}
		if (outlen)		{	Safefree(outlen);	}
		if (misarray)	{	Safefree(misarray);	}
		if (strdata)	{
			for (i=0; i<rlen; i++) {
				Safefree(strdata[i]);
			}
			Safefree(strdata);
		}

		RETVAL = status;

	OUTPUT:
		RETVAL
		data


##===========================================================================
##		cfmrdfm		R e a d   F o r m u l a   S o u r c e
##===========================================================================
##		The function 'cfmrdfm' does not currently work.  This is an
##		outstanding FAME bug (djo 12/7/1999 Release 8.032).
##===========================================================================
##	BROKE
##===========================================================================
int
perl_Cfmrdfm(dbkey, objname, source)
int		dbkey
char	*objname
char	*source		=	NO_INIT

	PREINIT:
char	**dsrc = (char **)source;
char	*localsrc = *dsrc;
int		srclen, famelen, i;
char	buffer[255];

	CODE:
		srclen = 60;	// Just an arbitrary not too long number.

		cfmrdfm(&status, dbkey, objname, buffer, srclen, &famelen);
		if (status == HSUCC) {
			source = newString(buffer);
			printf("Cfmrdfm: (%d) '%s', '%s'\n", famelen, objname, buffer);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		source

##***************************************************************************
##***************************************************************************
##		W r i t i n g   D a t a
##***************************************************************************
##***************************************************************************

##===========================================================================
##		cfmwrng
##===========================================================================
##		Tested	2001/03/16
##			Numeric, Boolean, Precision, Date
##===========================================================================
int
perl_Cfmwrng(dbkey, objnam, range, data, miss, table)
int		dbkey
char	*objnam
SV		*range
SV		*data
int		miss
SV		*table

	PREINIT:
int		worked	=	TRUE;
SV		**svptr;
SV		*sv;
I32		ix;
int		len;
int		rlen;
int		xlen;
#
AV		*rngarray;
int		rng[3];
#
AV		*datarray;
int		*iptr;
float	*fptr;
void	*vptr;
#
AV		*tblarray;
int		*mitbl	=	NULL;
float	*mftbl	=	NULL;
double	*mdtbl	=	NULL;
void	*tbl	=	NULL;
#
int		class;
int		type;
int		freq;
int		fyear;
int		fprd;
int		lyear;
int		lprd;
int		missing	=	0;
char	*tempstr;
double	*dptr;

	CODE:
		dptr = 0;
		fptr = 0;
		iptr = 0;
		vptr = 0;

##		----------------------------------------------------------------------
##		First, let's see what type of data object we are writing.  This will
##		affect what we do with the DATA set and the MISSING TABLE stuff.
##		----------------------------------------------------------------------
		cfmosiz(&status, dbkey, objnam, &class, &type, &freq,
					&fyear, &fprd, &lyear, &lprd);

##		----------------------------------------------------------------------
##		Check to see if we have been given a valid RANGE.
##		----------------------------------------------------------------------
		if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
			rngarray = (AV *)SvRV(range);
		} else {
			status = HBRNG;
			worked = FALSE;
		}

		if (worked && av_len(rngarray) == 2) {
			for (ix=0; ix<3; ix++) {
				svptr = av_fetch(rngarray, ix, 0);
				rng[ix] = SvIV(*svptr);
			}
##			----------------------------------------------------------
##			This might be cheating but I believe it is correct...
##			[0]=freq, [1]=start, [2]=end so [2]-[1] should be nobs - 1.
##			----------------------------------------------------------
			rlen = rng[2] - rng[1] + 1;
		}

##		----------------------------------------------------------------------
##		Check to see if we have been given a valid MISSING TABLE.
##		----------------------------------------------------------------------
		if (worked && miss == HTMIS) {
			if (SvROK(table) && (SvTYPE(SvRV(table)) == SVt_PVAV)) {
				tblarray = (AV *)SvRV(range);
			} else {
				status = HBMISS;
				worked = FALSE;
			}
		}

##		----------------------------------------------------------------------
##		Check to see if we have been given a valid DATA set.
##		----------------------------------------------------------------------
		if (worked && SvROK(data) && (SvTYPE(SvRV(data)) == SVt_PVAV)) {
			datarray = (AV *)SvRV(data);
		} else {
			status = HUNEXP;
			worked = FALSE;
		}

		len = av_len(datarray);
		if (worked) {
##			----------------------------------------------------------
##			First, we allocate memory based on type.
##			----------------------------------------------------------
			switch (type) {
			  case HNUMRC:
				New(0, fptr, rlen, float);
				break;
			  case HPRECN:
				New(0, dptr, rlen, double);
				break;
			  case HSTRNG:
			  case HNAMEL:
				worked = FALSE;
				status = -1;
				break;
			  case HBOOLN:
			  default:
				New(0, iptr, rlen, int);
				break;
			}
		}

##			----------------------------------------------------------
##			Next we get the value and determine if it is missing
##			or not
##			----------------------------------------------------------
		if (worked) {
			for (ix=0; ix<= len; ix++) {
				missing = 0;
				svptr = av_fetch(datarray, ix, 0);
				if (SvROK(*svptr) && (SvTYPE(SvRV(*svptr)) == SVt_PV)) {
					sv = SvRV(*svptr);
					tempstr = SvPV(sv, xlen);
					if (strncmp(tempstr, "NA", 2) == 0) {
						missing = 1;
					} else if (strncmp(tempstr, "NC", 2) == 0) {
						missing = 2;
					} else if (strncmp(tempstr, "ND", 2) == 0) {
						missing = 3;
					} else {
						missing = 4;
					}
				}


##			----------------------------------------------------------
##			Next, depending on type, we stuff it into the array.
##			----------------------------------------------------------
				switch (type) {
				  case HNUMRC:
					switch(missing) {
					  case 0:
						fptr[ix] = SvNV(*svptr);
						break;
					  case 1:
						fptr[ix] = FNUMNA;
						break;
					  case 2:
						fptr[ix] = FNUMNC;
						break;
					  case 3:
						fptr[ix] = FNUMND;
						break;
					  default:
						fptr[ix] = FNUMND;
						printf("Cfmwrng(num): What was that at %d?\n", ix);
						break;
					}
					break;
				  case HBOOLN:
					switch(missing) {
					  case 0:
						iptr[ix] = (SvTRUE(*svptr) ? HYES : HNO);
						break;
					  case 1:
						iptr[ix] = FBOONA;
						break;
					  case 2:
						iptr[ix] = FBOONC;
						break;
					  case 3:
						iptr[ix] = FBOOND;
						break;
					  default:
						iptr[ix] = FBOOND;
						printf("Cfmwrng(bool): What was that at %d?\n", ix);
						break;
					}
					break;
				  case HPRECN:
					switch(missing) {
					  case 0:
						dptr[ix] = SvNV(*svptr);
						break;
					  case 1:
						dptr[ix] = FPRCNA;
						break;
					  case 2:
						dptr[ix] = FPRCNC;
						break;
					  case 3:
						dptr[ix] = FPRCND;
						break;
					  default:
						dptr[ix] = FPRCND;
						printf("Cfmwrng(prec): What was that at %d?\n", ix);
						break;
					}
					break;
##			----------------------------------------------------------
##					Date Frequency
##			----------------------------------------------------------
				  default:
					switch(missing) {
					  case 0:
						iptr[ix] = SvIV(*svptr);
						break;
					  case 1:
						iptr[ix] = FDATNA;
						break;
					  case 2:
						iptr[ix] = FDATNC;
						break;
					  case 3:
						iptr[ix] = FDATND;
						break;
					  default:
						iptr[ix] = FDATND;
						printf("Cfmwrng(date): What was that at %d?\n", ix);
						break;
					}
					break;
				}
			}

##			----------------------------------------------------------
##			Now, flesh out the rest with NDs and write it.
##			----------------------------------------------------------
			switch(type) {
			  case HNUMRC:
				for (ix=len+1; ix<rlen; ix++) {
					fptr[ix] = FNUMND;
				}
				cfmwrng(&status, dbkey, objnam, rng, fptr, 
							miss, (float *)tbl);
				break;
			  case HBOOLN:
				for (ix=len+1; ix<rlen; ix++) {
					iptr[ix] = FBOOND;
				}
				cfmwrng(&status, dbkey, objnam, rng, (float *)iptr, 
							miss, (float *)tbl);
				break;
			  case HPRECN:
				for (ix=len+1; ix<rlen; ix++) {
					dptr[ix] = FPRCND;
				}
				cfmwrng(&status, dbkey, objnam, rng, (float *)dptr, 
							miss, (float *)tbl);
				break;
			  default:
				for (ix=len+1; ix<rlen; ix++) {
					iptr[ix] = FDATND;
				}
				cfmwrng(&status, dbkey, objnam, rng, (float *)iptr, 
							miss, (float *)tbl);
				break;
			}
##			----------------------------------------------------------
##			This might, of course, be valid if you want to write out
##			a bunch of missing values!
##			----------------------------------------------------------
		} else {
			printf("You didn't give me any data!\n");
			worked = FALSE;
		}

		switch (type) {
		  case HNUMRC:
			if (fptr) {
				Safefree(fptr);
			}
			break;
		  case HPRECN:
			if (dptr) {
				Safefree(dptr);
			}
			break;
		  case HBOOLN:
		  default:
			if (iptr) {
				Safefree(iptr);
			}
			break;
		}
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmwstr
##===========================================================================
##		This function will take either the "ismiss=HNxVAL" or a reference
##		to one of the missing strings (NA/NC/ND) to effect missing values.
##===========================================================================
##		2005/03/20 daveo: removed artificial limit of 255 chars on "sv_val"
##			as per bug reported by Tarik.  Oops.
##===========================================================================
int
perl_Cfmwstr(dbkey, objnam, range, sv_val, ismiss=0, length=0)
int		dbkey
char	*objnam
SV		*range
SV		*sv_val
int		ismiss
int		length

	PREINIT:
int		worked	=	TRUE;
I32		ix;
AV		*rngarray;
int		rng[3];
SV		**svptr;
SV		*mis_val;
int		fclass, ftype, freq, fyear, fprd, lyear, lprd;
char	*mis;
char	*val;
char	*pval;

	CODE:
##		----------------------------------------------------------------------
##		Let's find out if we have a real value or a missing value.
##		----------------------------------------------------------------------
		val = malloc(15);
		strcpy(val, "Missing Value");
		length = strlen(val);

		if (SvROK(sv_val)) {
			mis_val = SvRV(sv_val);
			if (SvPOK(mis_val)) {
				mis = SvPV(mis_val, length);
				if (strncmp(mis, "NA", 2) == 0) {
					strcpy(val, "NA");
					ismiss = HNAVAL;
				} else if (strncmp(mis, "NC", 2) == 0) {
					strcpy(val, "NC");
					ismiss = HNCVAL;
				} else if (strncmp(mis, "ND", 2) == 0) {
					strcpy(val, "ND");
					ismiss = HNDVAL;
				} else {
					worked = FALSE;
					status = HBMISS;
				}
			} else {
				worked = FALSE;
				status = HBMISS;
			}
		} else if (ismiss) {
##			Let it flow through...  They specified "missing" with 'ismiss'
		} else if (SvPOK(sv_val)) {
			pval = SvPV(sv_val, length);
			val = malloc(length+1);
			strncpy(val, pval, length);
			val[length] = '\0';
			ismiss = HNMVAL;
		} else {
			worked = FALSE;
			fprintf(stderr, "cfmwsts: Bad data type.  Tell daveo.\n");
		}

##		----------------------------------------------------------------------
##		Let's find out what type of object we are checking.
##		----------------------------------------------------------------------
		if (worked) {
			cfmosiz(&status, dbkey, objnam, &fclass, &ftype, &freq,
					&fyear, &fprd, &lyear, &lprd);
			if (status != HSUCC) {
				worked = FALSE;
			}
		}

##		----------------------------------------------------------------------
##		If this is a series, we need to check to see if we have been given 
##		a valid RANGE.  Otherwise, ignore the range arg.
##		----------------------------------------------------------------------
		if (worked && fclass == HSERIE) {
			if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
				rngarray = (AV *)SvRV(range);
			} else {
				worked = FALSE;
			}

			if (worked && av_len(rngarray) == 2) {
				for (ix=0; ix<3; ix++) {
					svptr = av_fetch(rngarray, ix, 0);
					rng[ix] = SvIV(*svptr);
				}
			}
		}

		if (worked) {
			cfmwstr(&status, dbkey, objnam, rng, val, ismiss, length);
		}

		free(val);
fprintf(stderr, "Freeing '%d' bytes.\n", length);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmwsts
##===========================================================================
##	UNDER CONSTRUCTION
##===========================================================================
int
perl_Cfmwsts(dbkey, objnam, range, data)
int		dbkey
char	*objnam
SV		*range
SV		*data

	PREINIT:
int		worked	=	TRUE;
int		rng[3];
AV		*rngarray;
char	**saray;
char	*sptr;
int		*lptr;
int		xlen;
char	*str;
I32		ix;
int		len;
int		rlen;
SV		**svptr;
SV		*sv;
AV		*datarray;
int		*iptr;
char	*tempstr;
int		missing;

	CODE:
##		----------------------------------------------------------------------
##		Check to see if we have been given a valid RANGE.
##		----------------------------------------------------------------------
		if (SvROK(range) && (SvTYPE(SvRV(range)) == SVt_PVAV)) {
			rngarray = (AV *)SvRV(range);
		} else {
			status = HBRNG;
			worked = FALSE;
		}

		if (worked && av_len(rngarray) == 2) {
			for (ix=0; ix<3; ix++) {
				svptr = av_fetch(rngarray, ix, 0);
				rng[ix] = SvIV(*svptr);
			}
##			----------------------------------------------------------
##			This might be cheating but I believe it is correct...
##			[0]=freq, [1]=start, [2]=end so [2]-[1] should be nobs - 1.
##			----------------------------------------------------------
			rlen = rng[2] - rng[1] + 1;
		}

##		----------------------------------------------------------------------
##		Next, we need to see if we have data and "dereference" it.
##		----------------------------------------------------------------------
		if (worked && SvROK(data) && (SvTYPE(SvRV(data)) == SVt_PVAV)) {
			datarray = (AV *)SvRV(data);
			len = av_len(datarray);
		} else {
			status = HUNEXP;
		}

##		----------------------------------------------------------------------
##		If we have data, let's see what we can do with it...
##		----------------------------------------------------------------------
		if (worked) {
			New(0, saray, rlen, char *);
			New(0, iptr, rlen, int);
			New(0, lptr, rlen, int);

			for (ix=0; ix<= len; ix++) {
				missing = 0;
				svptr = av_fetch(datarray, ix, 0);
				if (SvROK(*svptr) && (SvTYPE(SvRV(*svptr)) == SVt_PV)) {
 					sv = SvRV(*svptr);
 					tempstr = SvPV(sv, xlen);
 					if (strncmp(tempstr, "NA", 2) == 0) {
 						missing = 1;
 					} else if (strncmp(tempstr, "NC", 2) == 0) {
 						missing = 2;
 					} else if (strncmp(tempstr, "ND", 2) == 0) {
 						missing = 3;
 					} else {
 						missing = 4;
 					}
				}
				if (missing == 0) {
					str = SvPV(*svptr, xlen);
					saray[ix] = newString(str);
					iptr[ix] = HNMVAL;
					lptr[ix] = xlen;
				} else {
					New(0, saray[ix], HSMLEN+1, char);
					saray[ix][HSMLEN] = '\0';
					switch(missing) {
					  case 1:
						iptr[ix] = HNAVAL;
						lptr[ix] = 2;
						strncpy(saray[ix], FSTRNA, HSMLEN);
						break;
					  case 2:
						iptr[ix] = HNCVAL;
						lptr[ix] = 2;
						strncpy(saray[ix], FSTRNC, HSMLEN);
						break;
					  case 3:
						iptr[ix] = HNDVAL;
						lptr[ix] = 2;
						strncpy(saray[ix], FSTRND, HSMLEN);
						break;
					  default:
						strncpy(saray[ix], FSTRND, HSMLEN);
						iptr[ix] = HNDVAL;
						lptr[ix] = 2;
						printf("Cfmwsts: What was that at %d?\n", ix);
						break;
					}
				}
			}
			for (ix=len+1; ix<rlen; ix++) {
				New(0, saray[ix], HSMLEN+1, char);
				sptr = saray[ix];
				strncpy(sptr, (FSTRNA), (HSMLEN));
				iptr[ix] = HNDVAL;
				lptr[ix] = 2;
			}
			cfmwsts(&status, dbkey, objnam, rng, saray, iptr, lptr);

			for (ix=len+1; ix<rlen; ix++) {
				Safefree(saray[ix]);
			}
			Safefree(saray);
			Safefree(iptr);
			Safefree(lptr);
		}

		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmwtnl
##===========================================================================
int
perl_Cfmwtnl(dbkey, objnam, idx, val)
int		dbkey
char	*objnam
int		idx
char	*val

	CODE:
		cfmwtnl(&status, dbkey, objnam, idx, val);
		RETVAL = status;
	OUTPUT:
		RETVAL


##===========================================================================
##		cfmwrmt
##===========================================================================
##		Untested and not implemented
##===========================================================================
int
perl_Cfmwrmt(dbkey, objnam, objtyp, rng, data, miss, tbl)
int		dbkey
char	*objnam
int		objtyp
double	rng
double	data
int		miss
double	tbl

	CODE:
		status = HBCNTX;
#		cfmwrmt(&status, dbkey, objnam, objtyp, (int *)rng,
#				(float *)(data->data), miss, (float *)tbl->tbl);
		RETVAL = status;

	OUTPUT:
		RETVAL


##***************************************************************************
##***************************************************************************
##		C o n v e r t i n g   D a t e s
##***************************************************************************
##***************************************************************************

##===========================================================================
##		cfmtdat
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmtdat(freq, sv_date, hour, minute, second, ddate)
int		freq
SV		*sv_date
int		hour
int		minute
int		second
int		ddate

	PREINIT:
int		date;

	CODE:
		cfmtdat(&status, freq, &date, hour, minute, second, ddate);
		if (status == HSUCC) {
			sv_setiv(sv_date, date);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_date


##===========================================================================
##		cfmdatt
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmdatt(freq, date, sv_hour, sv_minute, sv_second, sv_ddate)
int		freq
int		date
SV		*sv_hour
SV		*sv_minute
SV		*sv_second
SV		*sv_ddate

	PREINIT:
int		hour;
int		minute;
int		second;
int		ddate;

	CODE:
		cfmdatt(&status, freq, date, &hour, &minute, &second, &ddate);
		if (status == HSUCC) {
			sv_setiv(sv_hour, hour);
			sv_setiv(sv_minute, minute);
			sv_setiv(sv_second, second);
			sv_setiv(sv_ddate, ddate);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_hour
		sv_minute
		sv_second
		sv_ddate


##===========================================================================
##		cfmddat
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmddat(freq, sv_date, year, month, day)
int		freq
SV		*sv_date
int		year
int		month
int		day

	PREINIT:
int		date;

	CODE:
		cfmddat(&status, freq, &date, year, month, day);
		if (status == HSUCC) {
			sv_setiv(sv_date, date);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_date


##===========================================================================
##		cfmdatd
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmdatd(freq, date, sv_year, sv_month, sv_day)
int		freq
int		date
SV		*sv_year
SV		*sv_month
SV		*sv_day	

	PREINIT:
int		year;
int		month;
int		day;

	CODE:
		cfmdatd(&status, freq, date, &year, &month, &day);
		if (status == HSUCC) {
			sv_setiv(sv_year, year);
			sv_setiv(sv_month, month);
			sv_setiv(sv_day, day);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_year
		sv_month
		sv_day


##===========================================================================
##		cfmpdat
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmpdat(freq, sv_date, year, period)
int		freq
SV		*sv_date
int		year
int		period

	PREINIT:
int		date;

	CODE:
		cfmpdat(&status, freq, &date, year, period);
		if (status == HSUCC) {
			sv_setiv(sv_date, date);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_date


##===========================================================================
##		cfmdatp
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmdatp(freq, date, sv_year, sv_period)
int		freq
int		date
SV		*sv_year
SV		*sv_period

	PREINIT:
int		year;
int		period;

	CODE:
		cfmdatp(&status, freq, date, &year, &period);
		if (status == HSUCC) {
			sv_setiv(sv_year, year);
			sv_setiv(sv_period, period);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_year
		sv_period


##===========================================================================
##		cfmfdat
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmfdat(freq, sv_date, year, period, fmonth=HDEC, flabel=HFYFST)
int		freq
SV		*sv_date
int		year
int		period
int		fmonth
int		flabel

	PREINIT:
int		date;

	CODE:
		cfmfdat(&status, freq, &date, year, period, fmonth=HDEC, flabel=HFYFST);
		if (status == HSUCC) {
			sv_setiv(sv_date, date);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_date


##===========================================================================
##		cfmdatf
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmdatf(freq, date, sv_year, sv_period, fmonth, flabel)
int		freq
int		date
SV		*sv_year
SV		*sv_period
int		fmonth
int		flabel

	PREINIT:
int		year;
int		period;

	CODE:
		cfmdatf(&status, freq, date, &year, &period, fmonth=HDEC,flabel=HFYFST);
		if (status == HSUCC) {
			sv_setiv(sv_year, year);
			sv_setiv(sv_period, period);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_year
		sv_period


##===========================================================================
##		cfmldat
##===========================================================================
##		Tested
##===========================================================================
int
perl_Cfmldat(freq, sv_date, datestr, month=HDEC, label=HFYFST, century=DEF_CENT)
int		freq
SV		*sv_date
char	*datestr
int		month
int		label
int		century

	PREINIT:
int		date;

	CODE:
		cfmldat(&status, freq, &date, datestr, month, label, century);
		sv_setiv(sv_date, date);
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_date


##===========================================================================
##		cfmdatl
##===========================================================================
int
perl_Cfmdatl(freq, date, sv_datestr, month=HDEC, label=HFYFST)
int		freq
int		date
SV		*sv_datestr
int		month
int		label

	PREINIT:
char	buf[SMALLBUF];

	CODE:
		cfmdatl(&status, freq, date, buf, month, label);
		if (status == HSUCC) {
			sv_setpv(sv_datestr, buf);
		}
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_datestr


##===========================================================================
##		cfmidat
##===========================================================================
int
perl_Cfmidat(freq, sv_date, datestr, image="<YEAR>/<MZ>/<DZ>", month=HDEC, label=HFYFST, century=DEF_CENT)
int		freq
SV		*sv_date
char	*datestr
char	*image
int		month
int		label
int		century

	PREINIT:
int		date;

	CODE:
		cfmidat(&status, freq, &date, datestr, image, month, label, century);
		sv_setiv(sv_date, date);
		RETVAL = status;
	OUTPUT:
		RETVAL
		sv_date


##===========================================================================
##		cfmdati
##===========================================================================
int
perl_Cfmdati(freq, date, sv_datestr, image="<YEAR>/<MZ>/<DZ>", month=HDEC, label=HFYFST)
int		freq
int		date
SV		*sv_datestr
char	*image
int		month
int		label

	PREINIT:
char	buf[SMALLBUF];

	CODE:
		cfmdati(&status, freq, date, buf, image, month, label);
		if (status == HSUCC) {
			sv_setpv(sv_datestr, buf);
		}
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_datestr


##***************************************************************************
##***************************************************************************
##		U s i n g   t h e   F A M E  / S e r v e r
##***************************************************************************
##***************************************************************************

##===========================================================================
##		cfmfame
##===========================================================================
int
perl_Cfmfame(command)
char	*command

	CODE:
		cfmfame(&status, command);
		RETVAL = status;
	OUTPUT:
		RETVAL

##===========================================================================
##		cfmopwk
##===========================================================================
int
perl_Cfmopwk(sv_dbkey)
SV		*sv_dbkey

	PREINIT:
int		dbkey;

	CODE:
		cfmopwk(&status, &dbkey);
		sv_setiv(sv_dbkey, dbkey);
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_dbkey

##===========================================================================
##		cfmsinp
##===========================================================================
int
perl_Cfmsinp(cmd) 
char	*cmd

	CODE:
char	**dcmd = (char **)cmd;
char	buffer[HMAXSCMD];

		cfmsinp(&status, buffer);
		Safefree(*dcmd);
		*dcmd = newString(buffer);
		RETVAL = status;

	OUTPUT:
		RETVAL

##***************************************************************************
##***************************************************************************
##		U s i n g   a n   A n a l y t i c a l  C h a n n e l
##***************************************************************************
##***************************************************************************

##===========================================================================
##		cfmoprc
##===========================================================================
int
perl_Cfmoprc(sv_dbkey, connkey)
SV		*sv_dbkey
int		connkey

	PREINIT:
int		dbkey;

	CODE:
		cfmoprc(&status, &dbkey, connkey);
		sv_setiv(sv_dbkey, dbkey);
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_dbkey


##===========================================================================
##		cfmopre
##===========================================================================
int
perl_Cfmopre(sv_dbkey, svname)
SV		*sv_dbkey
char	*svname

	PREINIT:
int		dbkey;

	CODE:
		cfmopre(&status, &dbkey, svname);
		sv_setiv(sv_dbkey, dbkey);
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_dbkey


##===========================================================================
##		cfmrmev
##===========================================================================
int
perl_Cfmrmev(dbkey, expr, optns, wdbkey, objnam)
int		dbkey
char	*expr
char	*optns
int		wdbkey
char	*objnam

	CODE:
		cfmrmev(&status, dbkey, expr, optns, wdbkey, objnam);
		RETVAL = status;

	OUTPUT:
		RETVAL


##===========================================================================
##		cfmferr
##===========================================================================
##
##===========================================================================
int
perl_Cfmferr(sv_errtxt)
SV		*sv_errtxt

	PREINIT:
int		i;
char	buf[BIGBUF+1];

	CODE:
		for (i=0; i<BIGBUF; i++) {
			buf[i] = ' ';
		}
		buf[BIGBUF] = '\0';
		cfmferr(&status, buf);
		for (i=BIGBUF-1; buf[i] == ' '; i--) {
			buf[i] = '\0';
		}
		sv_setpv(sv_errtxt, buf);
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_errtxt


##===========================================================================
##		cfmlerr
##===========================================================================
##
##===========================================================================
int
perl_Cfmlerr(sv_len)
SV		*sv_len

	PREINIT:
int		errlen;

	CODE:
		cfmlerr(&status, &errlen);
		sv_setiv(sv_len, errlen);
		RETVAL = status;

	OUTPUT:
		RETVAL
		sv_len