/*
 * Undocumented things I've learned about writing XSUB's:
 *
 *  1.  av_len(AV*) returns the 0-based index of the last element (i.e.
 *      the number of elements minus 1).
 *
 *  2.  My way to distinguish between a reference to a scalar value and a
 *      reference to an array value is to obtain the referenced value and
 *      then do `SvIOK(sv) || SvNOK(sv) || SvPOK(sv)'.
 *
 *  3.  av_push() doesn't copy the pointed-to values.
 *
 *  4.  Values returned via arguments must be immortal.
 */

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

#include <stdlib.h>	/* for malloc() */
#include <stdio.h>	/* for printing */
#include <string.h>	/* for memcpy() */
#include <assert.h>
#include "netcdf.h"

/*
 * Macro for setting a scalar value either directly or through a reference:
 */
#define SV_SET(func, var, val)	func(SvROK(var) ? SvRV(var) : var, val)


typedef enum IntType
{
    IT_UNKNOWN,
    IT_CHAR,
    IT_SHORT,
    IT_INT,
    IT_NCLONG,
    IT_LONG,
    IT_FLOAT,
    IT_DOUBLE
} IntType;


typedef struct Value
{
    IntType	type;
    union
    {
	char	c;
	short	s;
	int	i;
	nclong	n;
	long	l;
	float	f;
	double	d;
    }		datum;
} Value;


typedef struct Vector
{
    char	*data;
    long	nelt;
    IntType	type;
    int		initialized;
} Vector;


typedef struct Record
{
    void	**data;
    Vector	*vecs;
    int		nvar;
    int		initialized;
} Record;


static IntType
nctype_inttype(nctype)
    nc_type	nctype;
{
    IntType	vectype;

    switch (nctype)
    {
	case NC_BYTE:
	    return IT_CHAR;
	case NC_CHAR:
	    return IT_CHAR;
	case NC_SHORT:
	    return IT_SHORT;
	case NC_LONG:
	    return IT_NCLONG;
	case NC_FLOAT:
	    return IT_FLOAT;
	case NC_DOUBLE:
	    return IT_DOUBLE;
	default:
	    return IT_UNKNOWN;
    }
}


static size_t
inttype_len(type)
    IntType	type;
{
    switch (type)
    {
	case IT_CHAR:
	    return sizeof(char);
	case IT_SHORT:
	    return sizeof(short);
	case IT_INT:
	    return sizeof(int);
	case IT_NCLONG:
	    return sizeof(nclong);
	case IT_LONG:
	    return sizeof(long);
	case IT_FLOAT:
	    return sizeof(float);
	case IT_DOUBLE:
	    return sizeof(double);
	default:
	    return 0;
    }
}


/*
 * Initialize a value from a specification.
 */
static void
value_initspec(value, type)
    Value	*value;
    IntType	type;
{
    value->type = type;
}


/*
 * Initialize a value structure from a perl reference value.
 */
static void
value_initref(value, type, ref)
    Value	*value;
    IntType	type;
    SV *	ref;
{
    value->type = type;

    switch (type)
    {
	case IT_CHAR:
	    value->datum.c = SvIV(ref);
	    break;
	case IT_SHORT:
	    value->datum.s = SvIV(ref);
	    break;
	case IT_INT:
	    value->datum.i = SvIV(ref);
	    break;
	case IT_NCLONG:
	    value->datum.n = SvIV(ref);
	    break;
	case IT_LONG:
	    value->datum.l = SvIV(ref);
	    break;
	case IT_FLOAT:
	    value->datum.f = SvNV(ref);
	    break;
	case IT_DOUBLE:
	    value->datum.d = SvNV(ref);
	    break;
    }
}


/*
 * Print a value structure.
 */
static void
value_print(value, stream, prefix)
    Value	*value;
    FILE	*stream;
    char	*prefix;
{
    (void) fprintf(stream, "%sType: ", prefix);

    switch (value->type)
    {
	case IT_CHAR:
	    (void) fputs("IT_CHAR\n", stream);
	    (void) fprintf(stream, "%sValue: %d\n",
			   prefix, value->datum.c);
	    break;
	case IT_SHORT:
	    (void) fputs("IT_SHORT\n", stream);
	    (void) fprintf(stream, "%sValue: %d\n",
			   prefix, value->datum.s);
	    break;
	case IT_INT:
	    (void) fputs("IT_INT\n", stream);
	    (void) fprintf(stream, "%sValue: %d\n",
			   prefix, value->datum.i);
	    break;
	case IT_NCLONG:
	    (void) fputs("IT_NCLONG\n", stream);
	    (void) fprintf(stream, "%sValue: %ld\n",
			   prefix, (long)value->datum.n);
	    break;
	case IT_LONG:
	    (void) fputs("IT_LONG\n", stream);
	    (void) fprintf(stream, "%sValue: %ld\n",
			   prefix, value->datum.l);
	    break;
	case IT_FLOAT:
	    (void) fputs("IT_FLOAT\n", stream);
	    (void) fprintf(stream, "%sValue: %g\n",
			   prefix, value->datum.f);
	    break;
	case IT_DOUBLE:
	    (void) fputs("IT_DOUBLE\n", stream);
	    (void) fprintf(stream, "%sValue: %g\n",
			   prefix, value->datum.d);
	    break;
    }
}


/*
 * Initialize a perl scalar value from a value structure.
 */
static void
sv_initvalue(scalar, value)
    SV		*scalar;
    Value	*value;
{
    switch (value->type)
    {
	case IT_CHAR:
	    sv_setiv(scalar, (IV)value->datum.c);
	    break;
	case IT_SHORT:
	    sv_setiv(scalar, (IV)value->datum.s);
	    break;
	case IT_INT:
	    sv_setiv(scalar, (IV)value->datum.i);
	    break;
	case IT_NCLONG:
	    sv_setiv(scalar, (IV)value->datum.n);
	    break;
	case IT_LONG:
	    sv_setiv(scalar, (IV)value->datum.l);
	    break;
	case IT_FLOAT:
	    sv_setnv(scalar, (double)value->datum.f);
	    break;
	case IT_DOUBLE:
	    sv_setnv(scalar, (double)value->datum.d);
	    break;
    }
}


/*
 * Initialize a perl scalar value from an internal vector structure.
 *
 * Returns:
 *	1	Success
 *	0	Error
 */
static int
sv_initvec(sv, vec)
    SV		*sv;
    Vector	*vec;
{
    int		ok = 0;				/* error */

    if (vec->type != IT_CHAR && vec->nelt != 1)
	warn("Can't convert multi-element vector to scalar");
    else
    {
	switch (vec->type)
	{
	    case IT_CHAR:
		sv_setpvn(sv, (char*)vec->data, (int)vec->nelt);
		break;
	    case IT_SHORT:
		sv_setiv(sv, (IV)*(short*)vec->data);
		break;
	    case IT_INT:
		sv_setiv(sv, (IV)*(int*)vec->data);
		break;
	    case IT_NCLONG:
		sv_setiv(sv, (IV)*(nclong*)vec->data);
		break;
	    case IT_LONG:
		sv_setiv(sv, (IV)*(long*)vec->data);
		break;
	    case IT_FLOAT:
		sv_setnv(sv, (double)*(float*)vec->data);
		break;
	    case IT_DOUBLE:
		sv_setnv(sv, (double)*(double*)vec->data);
		break;
	}

	ok = 1;
    }

    return ok;
}


/*
 * Destroy a perl reference value.
 */
static void
ref_destroy(ref)
    SV	*ref;
{
    sv_2mortal(ref);
}


/*
 * Initialize a perl array value from a vector.
 */
static int
av_initvec(av, vec)
    AV		*av;
    Vector	*vec;
{
    av_clear(av);	/* delete all elements in the AV */

    switch (vec->type)
    {
	case IT_CHAR:
	{
	    char	*ptr = (char*)vec->data;
	    char	*end = ptr + vec->nelt;

	    for (; ptr < end; ++ptr)
		av_push(av, newSViv((IV)*ptr));
	    break;
	}
	case IT_SHORT:
	{
	    short	*ptr = (short*)vec->data;
	    short	*end = ptr + vec->nelt;

	    for (; ptr < end; ++ptr)
		av_push(av, newSViv((IV)*ptr));
	    break;
	}
	case IT_INT:
	{
	    int	*ptr = (int*)vec->data;
	    int	*end = ptr + vec->nelt;

	    for (; ptr < end; ++ptr)
		av_push(av, newSViv((IV)*ptr));
	    break;
	}
	case IT_NCLONG:
	{
	    nclong	*ptr = (nclong*)vec->data;
	    nclong	*end = ptr + vec->nelt;

	    for (; ptr < end; ++ptr)
		av_push(av, newSViv((IV)*ptr));
	    break;
	}
	case IT_LONG:
	{
	    long	*ptr = (long*)vec->data;
	    long	*end = ptr + vec->nelt;

	    for (; ptr < end; ++ptr)
		av_push(av, newSViv((IV)*ptr));
	    break;
	}
	case IT_FLOAT:
	{
	    float	*ptr = (float*)vec->data;
	    float	*end = ptr + vec->nelt;

	    for (; ptr < end; ++ptr)
		av_push(av, newSVnv((double)*ptr));
	    break;
	}
	case IT_DOUBLE:
	{
	    double	*ptr = (double*)vec->data;
	    double	*end = ptr + vec->nelt;

	    for (; ptr < end; ++ptr)
		av_push(av, newSVnv((double)*ptr));
	    break;
	}
    }

    return 1;
}


/*
 * Destroy a perl(1) array value.
 */
static void
av_destroy(av)
    AV		*av;
{
    av_undef(av);
}


/*
 * Destroy a perl scalar value.
 */
static void
sv_destroy(sv)
    SV		*sv;
{
    sv_2mortal(sv);
}


/*
 * Initialize a perl(1) reference from a vector structure.  The referenced
 * value shall exist.
 *
 * Returns:
 *	0	Error
 *	1	Success
 */
static int
ref_initvec(ref, vec)
    SV		*ref;			/* a perl(1) reference (in/out) */
    Vector	*vec;			/* vector of values (in) */
{
    int		ok = 0;			/* error */
    SV		*sv;

    sv = SvRV(ref);

    if (SvOK(sv) || SvIOK(sv) || SvNOK(sv) || SvPOK(sv))
    {
	/*
	 * The referenced value is scalar.
	 */
	if (sv_initvec(sv, vec))
	    ok = 1;
    }
    else
    {
	/*
	 * The referenced value must be an array.
	 */
	AV	*av = (AV*)sv;

	if (av_initvec(av, vec))
	    ok = 1;
    }

    return ok;
}


/*
 * Return a new perl(1) reference that has been initialized from a vector
 * structure.
 *
 * Returns:
 *	 NULL	Error
 *	!NULL	Success
 */
static SV*
ref_newvec(vec)
    Vector	*vec;			/* vector of values (in) */
{
    SV		*ref = NULL;

    if (vec->type == IT_CHAR)
    {
	/*
	 * Generate a perl string from the vector structure.
	 */
	SV	*sv;

	sv = newSVpv((char*)vec->data, (int)vec->nelt);

	if (sv == NULL)
	    warn("Couldn't allocate new perl string value");
	else
	{
	    ref = newRV(sv);
	    if (ref == NULL)
	    {
		sv_destroy(sv);
		warn("Couldn't allocate new perl reference to string value");
	    }
	}
    }
    else
    {
	/*
	 * Generate a perl array value from the vector structure.
	 */
	AV	*av = newAV();

	if (av == NULL)
	    warn("Couldn't allocate new perl array value");
	else
	{
	    int	ok = 0;

	    if (av_initvec(av, vec))
	    {
		ref = newRV((SV*)av);

		if (ref != NULL)
		    ok = 1;			/* success */
	    }

	    if (!ok)
		av_destroy(av);
	}					/* new AV obtained */
    }

    return ref;
}


/*
 * Initialize a perl(1) array value from a record structure.
 *
 * Returns:
 *	0	Error
 *	1	Success
 */
static int
av_initrec(av, rec)
    AV		*av;
    Record	*rec;
{
    int		ivar;
    int		ok = 0;				/* error */
    int		nelt = av_len(av) + 1;

    if (nelt && nelt != rec->nvar)
    {
	(void) fprintf(stderr, "av_initrec(): nvar=%d, nref=%d\n", 
		       rec->nvar, nelt);
	warn("Number of record variables doesn't match number of references");
    }
    else if (nelt == 0)
    {
	/*
	 * The array is empty.  Create references and add them.
	 */
	for (ivar = 0; ivar < rec->nvar; ++ivar)
	{
	    SV	*ref = ref_newvec(&rec->vecs[ivar]);

	    if (ref == NULL)
		break;

	    av_push(av, ref);
	}

	if (ivar >= rec->nvar)
	    ok = 1;
	else
	{
	    /* ivar is the index of the reference that wasn't initialized. */
	    while (ivar--)
		ref_destroy(av_pop(av));
	}
    }
    else
    {
	/*
	 * The array contains the correct number of references.  Put the
	 * data in the referenced variables.
	 */
	for (ivar = 0; ivar < rec->nvar; ++ivar)
	{
	    SV	**ref = av_fetch(av, (I32)ivar, (I32)0);

	    if (!SvROK(*ref))
	    {
		warn("Array value member is not a reference");
		break;
	    }
	    else
	    {
		SV	*sv = SvRV(*ref);

		if (SvIOK(sv) || SvNOK(sv) || SvPOK(sv))
		{
		    /*
		     * The perl reference refers to a scalar value.
		     */
		    if (!sv_initvec(sv, &rec->vecs[ivar]))
			break;
		}
		else
		{
		    /*
		     * The referenced variable is undefined or the 
		     * reference refers to an array value.
		     */
		    AV	*av = (AV*)sv;

		    if (!av_initvec(av, &rec->vecs[ivar]))
			break;
		}
	    }
	}

	if (ivar >= rec->nvar)
	    ok = 1;
    }

    return ok;
}


/*
 * Initialize a perl(1) reference variable from a record structure.
 *
 * Returns:
 *	0	Error
 *	1	Success
 */
static int
ref_initrec(ref, rec)
    SV		**ref;
    Record	*rec;
{
    int		ok = 0;				/* error */
    AV		*av = newAV();

    if (av == NULL)
	warn("Couldn't allocate new perl array value");
    else
    {
	int	ivar;

	for (ivar = 0; ivar < rec->nvar; ++ivar)
	{
	    SV	*eltref = ref_newvec(&rec->vecs[ivar]);

	    if (eltref == NULL)
		break;

	    av_push(av, eltref);
	}

	if (ivar < rec->nvar)
	{
	    /* ivar is the index of the reference that wasn't initialized. */
	    while (ivar--)
		ref_destroy(av_pop(av));
	}
	else
	{
	    SV	*sv = newRV((SV*)av);

	    if (sv == NULL)
		warn("Couldn't allocate new perl reference value");
	    else
	    {
		*ref = sv;
		ok = 1;
	    }
	}
    }

    return ok;
}


/*
 * Return total number of data elements for a perl value.
 *
 * Recursive function.
 */
static long
pv_nelt(pv, type)
    SV		*pv;
    IntType	type;
{
    long	ntotal;

    if (SvROK(pv))
    {
	/*
	 * The scalar variable is a perl reference.
	 */
	ntotal = pv_nelt(SvRV(pv), type);
    }
    else
    {
	/*
	 * The scalar variable is not a perl reference.
	 */
	if (SvIOK(pv) || SvNOK(pv))
	{
	    /*
	     * The scalar variable is a numeric value.
	     */
	    ntotal = 1;
	}
	else
	if (SvPOK(pv))
	{
	    /*
	     * The scalar value is a string.
	     */
	    ntotal = type == IT_CHAR
			? SvCUR(pv)
			: 1;
	}
	else
	{
	    /*
	     * The `scalar variable' must be an array value.
	     */
	    AV		*list;
	    int		nelt;
	    int		i;

	    list = (AV*)pv;
	    nelt = av_len(list) + 1;
	    ntotal = 0;

#   	    if 0
		(void) fprintf(stderr, "pv_nelt(): nelt=%d\n", nelt);
#   	    endif

	    for (i = 0; i < nelt; ++i)
	    {
		SV	**sv;

#   	        if NP_DIAG_REF_NELT
		    (void) fprintf(stderr, "pv_nelt(): handling element %d\n",
				   i);
#   	        endif

		sv = av_fetch(list, (I32)i, (I32)0);

		ntotal += pv_nelt(*sv, type);
	    }
	}
    }

    return ntotal;
}


/*
 * Extract the data portion of a perl(1) value into contiguous memory.
 *
 * Recursive function.
 *
 * Can't fail.
 */
static char*
pv_data(pv, type, data)
    SV		*pv;
    IntType	type;
    char	*data;			/* SHALL have sufficient room */
{
    if (SvROK(pv))
    {
	/*
	 * The perl value is a perl reference.
	 */
	data = pv_data(SvRV(pv), type, data);
    }
    else
    if (!SvIOK(pv) && !SvNOK(pv) && !SvPOK(pv))
    {
	/*
	 * The perl value must be an array value.
	 */
	AV	*list;
	int	n;
	int	i;

	list = (AV*)pv;
	n = av_len(list) + 1;

	for (i = 0; i < n; ++i)
	{
	    SV	**sv;

#   	    if NP_DIAG_REF_DATA
		(void) fprintf(stderr, "pv_data(): handling element %d\n", i);
#   	    endif

	    sv = av_fetch(list, (I32)i, (I32)0);

	    data = pv_data(*sv, type, data);
	}
    }
    else
    {
	/*
	 * The perl value is a scalar value.
	 */
	switch (type)
	{
	    case IT_CHAR:
	    {
		if (SvPOK(pv))
		{
		    (void) memcpy(
			(char*)data, SvPV_nolen(pv), (size_t)SvCUR(pv));
		    data += SvCUR(pv);
		}
		else
		{
		    *(char*)data = SvIV(pv);
		    data += sizeof(char);
		}
		break;
	    }
	    case IT_SHORT:
	    {
		*(short*)data = SvIV(pv);
		data += sizeof(short);
		break;
	    }
	    case IT_INT:
	    {
		*(int*)data = SvIV(pv);
		data += sizeof(int);
		break;
	    }
	    case IT_NCLONG:
	    {
		*(nclong*)data = SvIV(pv);
		data += sizeof(nclong);
		break;
	    }
	    case IT_LONG:
	    {
		*(long*)data = SvIV(pv);
		data += sizeof(long);
		break;
	    }
	    case IT_FLOAT:
	    {
		*(float*)data = SvNV(pv);
		data += sizeof(float);
		break;
	    }
	    case IT_DOUBLE:
	    {
		*(double*)data = SvNV(pv);
		data += sizeof(double);
		break;
	    }
	}
    }

    return data;
}


/*
 * Destroy a vector structure.
 */
static void
vec_destroy(vec)
    Vector	*vec;
{
    if (vec->data != NULL)
    {
	free((char*)vec->data);
	vec->data = NULL;
    }
    vec->type = 0;
    vec->nelt = 0;
    vec->initialized = 0;
}


/*
 * Initialize a vector structure from a perl(1) reference.
 */
static void
vec_initref(vec, type, ref)
    Vector	*vec;
    IntType	type;
    SV		*ref;
{
    size_t	nelt;
    char	*data;

#   if 0
	(void) fprintf(stderr, "vec_initref(): type=%d\n", (int)type);
#   endif

    nelt = pv_nelt(ref, type);
#   if 0
	(void) fprintf(stderr, "vec_initref(): nelt=%lu\n",
		       (unsigned long)nelt);
#   endif
    data = (char*)malloc(nelt * inttype_len(type));

    vec->initialized = 0;
    vec->nelt = 0;
    vec->data = 0;

    if (data == NULL)
    {
	warn("Couldn't allocate memory for vector data");
    }
    else
    {
	(void) pv_data(ref, type, data);

	vec->data = data;
	vec->type = type;
	vec->nelt = nelt;
	vec->initialized = 1;
    }
}


/*
 * Initialize a vector structure from a specification.
 */
static void
vec_initspec(vec, type, nelt)
    Vector	*vec;
    IntType	type;
    long	nelt;
{
    char	*data = malloc((size_t)(nelt * inttype_len(type)));

    if (data == NULL)
	warn("Couldn't allocate memory for vector structure");
    else
    {
	    vec->data = data;
	    vec->type = type;
	    vec->nelt = nelt;
	    vec->initialized = 1;
    }
}


/*
 * Initialize a record-variable vector-structure from a perl reference
 * and a netCDF dataset.  The pearl reference must match the netCDF record.
 */
static void
vec_initrecref(vec, ref, ncid, varid)
    Vector	*vec;
    SV		*ref;
    int		ncid;
    int		varid;
{
    nc_type	nctype;
    int		ndim;
    int		dimids[MAX_NC_DIMS];

#   if NP_DIAG_VEC_INITRECREF
	(void) fprintf(stderr, "vec_initrecref(): ncid=%d, varid=%d\n",
		       ncid, varid);
#   endif

    if (ncvarinq(ncid, varid, (char*)0, &nctype, &ndim, dimids, (int*)0)
	!= -1)
    {
	vec_initref(vec, nctype_inttype(nctype), ref);

	if (vec->initialized)
	{
	    int	ok = 0;

	    if (vec->nelt == 0)
	    {
		/* Empty record variable. */
		ok = 1;
	    }
	    else
	    {
		int	idim;
		long	nelt = 1;

		for (idim = 1; idim < ndim; ++idim)
		{
		    long	length;

		    if (ncdiminq(ncid, dimids[idim], (char*)0, &length) ==
			-1)
		    {
			break;
		    }

		    nelt *= length;
		}

#		if 0
		    (void) fprintf(stderr,
			"vec_initrecref(): vec->nelt=%d, nelt=%d\n",
			vec->nelt, nelt);
#		endif

		if (idim >= ndim)
		{
		    if (vec->nelt != nelt)
			warn("perl/netCDF record variable size mismatch");
		    else
			ok = 1;
		}
	    }

	    if (!ok)
		vec_destroy(vec);
	}					/* vector initialized */
    }						/* variable info obtained */
}


/*
 * Initialize a vector structure from a record variable.
 *
 * The values are read into the vector.
 */
static void
vec_initrec(vec, ncid, varid, recid)
    Vector	*vec;
    int		ncid;
    int		varid;
    long	recid;
{
    int		ndim;
    int		dimids[MAX_NC_DIMS];
    nc_type	nctype;

    vec->type = 0;
    vec->nelt = 0;
    vec->data = NULL;
    vec->initialized = 0;

    if (ncvarinq(ncid, varid, (char*)0, &nctype, &ndim, dimids, (int*)0) != -1)
    {
	int	idim;
	long	count[MAX_NC_DIMS];
	long	nelt = 1;

	/* Skip dimension 0, which must be the record dimension. */
	count[0] = 1;
	for (idim = 1; idim < ndim; ++idim)
	{
	    if (ncdiminq(ncid, dimids[idim], (char*)NULL, count+idim) == -1)
		break;
	    nelt *= count[idim];
	}

	if (idim >= ndim)
	{
	    vec_initspec(vec, nctype_inttype(nctype), nelt);
	    if (vec->initialized)
	    {
		static long	start[MAX_NC_DIMS];

		start[0] = recid;

		if (ncvarget(ncid, varid, start, count, vec->data) == -1)
		    vec_destroy(vec);
	    }
	}
    }
}


/*
 * Compute the integer product of the elements of a vector structure.
 */
static long
vec_prod(vec)
    Vector	*vec;
{
    char	*data = vec->data;
    char	*out = vec->data + vec->nelt * inttype_len(vec->type);
    long	prod = 1;

    switch (vec->type)
    {
	case IT_CHAR:
	{
	    char	*ptr = (char*)data;
	    char	*end = (char*)out;

	    while (ptr < end)
		prod *= *ptr++;
	    break;
	}
	case IT_SHORT:
	{
	    short	*ptr = (short*)data;
	    short	*end = (short*)out;

	    while (ptr < end)
		prod *= *ptr++;
	    break;
	}
	case IT_INT:
	{
	    int		*ptr = (int*)data;
	    int		*end = (int*)out;

	    while (ptr < end)
		prod *= *ptr++;
	    break;
	}
	case IT_NCLONG:
	{
	    nclong	*ptr = (nclong*)data;
	    nclong	*end = (nclong*)out;

	    while (ptr < end)
		prod *= *ptr++;
	    break;
	}
	case IT_LONG:
	{
	    long	*ptr = (long*)data;
	    long	*end = (long*)out;

	    while (ptr < end)
		prod *= *ptr++;
	    break;
	}
	case IT_FLOAT:
	{
	    float	*ptr = (float*)data;
	    float	*end = (float*)out;

	    while (ptr < end)
		prod *= *ptr++;
	    break;
	}
	case IT_DOUBLE:
	{
	    double	*ptr = (double*)data;
	    double	*end = (double*)out;

	    while (ptr < end)
		prod *= *ptr++;
	    break;
	}
    }

    return prod;
}


/*
 * Print a vector structure.
 */
static void
vec_print(vec, stream, prefix)
    Vector	*vec;
    FILE	*stream;
    char	*prefix;
{
    if (!vec->initialized)
	warn("vec_print(): Vector not initialized");
    else
    {
	(void) fprintf(stream, "%sVector type = %s\n",
		       prefix,
		       vec->type == IT_CHAR
			    ? "IT_CHAR"
			    : vec->type == IT_SHORT
				? "IT_SHORT"
				: vec->type == IT_INT
				    ? "IT_INT"
				    : vec->type == IT_NCLONG
					? "IT_NCLONG"
					: vec->type == IT_LONG
					    ? "IT_LONG"
					    : vec->type == IT_FLOAT
						? "IT_FLOAT"
						: vec->type == IT_DOUBLE
						    ? "IT_DOUBLE"
						    : "UNKNOWN");
	(void) fprintf(stream, "%sVector size = %ld\n", prefix, vec->nelt);
	(void) fprintf(stream, "%sValues = ", prefix);
	switch (vec->type)
	{
	    case IT_CHAR:
	    {
		char	*ptr = (char*)vec->data;
		char	*out = ptr + vec->nelt;

		for (; ptr < out; ++ptr)
		    (void) fprintf(stream, "%d ", *ptr);
		break;
	    }
	    case IT_SHORT:
	    {
		short	*ptr = (short*)vec->data;
		short	*out = ptr + vec->nelt;

		for (; ptr < out; ++ptr)
		    (void) fprintf(stream, "%d ", *ptr);
		break;
	    }
	    case IT_INT:
	    {
		int	*ptr = (int*)vec->data;
		int	*out = ptr + vec->nelt;

		for (; ptr < out; ++ptr)
		    (void) fprintf(stream, "%d ", *ptr);
		break;
	    }
	    case IT_NCLONG:
	    {
		nclong	*ptr = (nclong*)vec->data;
		nclong	*out = ptr + vec->nelt;

		for (; ptr < out; ++ptr)
		    (void) fprintf(stream, "%ld ", *ptr);
		break;
	    }
	    case IT_LONG:
	    {
		long	*ptr = (long*)vec->data;
		long	*out = ptr + vec->nelt;

		for (; ptr < out; ++ptr)
		    (void) fprintf(stream, "%ld ", *ptr);
		break;
	    }
	    case IT_FLOAT:
	    {
		float	*ptr = (float*)vec->data;
		float	*out = ptr + vec->nelt;

		for (; ptr < out; ++ptr)
		    (void) fprintf(stream, "%g ", *ptr);
		break;
	    }
	    case IT_DOUBLE:
	    {
		double	*ptr = (double*)vec->data;
		double	*out = ptr + vec->nelt;

		for (; ptr < out; ++ptr)
		    (void) fprintf(stream, "%g ", *ptr);
		break;
	    }
	}					/* type switch */
	(void) putc('\n', stream);
    }						/* vector was initialized */
}


/*
 * Initialize a record from a reference and a netCDF dataset.
 */
static void
rec_initref(rec, ref, ncid)
    Record	*rec;
    SV		*ref;
    int		ncid;
{
    AV		*list = (AV*)SvRV(ref);
    int		nvar = av_len(list) + 1;
    int		*varids   = (int*)   malloc((size_t)(nvar*sizeof(int*)));
    long	*varsizes = (long*)  malloc((size_t)(nvar*sizeof(long)));
    void	**data    = (void**) malloc((size_t)(nvar*sizeof(void*)));
    Vector	*vecs     = (Vector*)malloc((size_t)(nvar*sizeof(Vector)));

#   if NP_DIAG_REC_INITREF
	(void) fprintf(stderr, "rec_initref(): ncid=%d\n", ncid);
#   endif

    rec->data = NULL;
    rec->vecs = NULL;
    rec->nvar = 0;
    rec->initialized = 0;

    if (vecs == NULL || data == NULL || varids == NULL || varsizes == NULL)
	warn("Couldn't allocate memory for record variables");
    else
    {
	int	ncnvar;

	if (ncrecinq(ncid, &ncnvar, varids, varsizes) != -1)
	{
	    if (ncnvar != nvar)
		warn("perl/netCDF record mismatch");
	    else
	    {
		int	ivar;

		for (ivar = 0; ivar < nvar; ++ivar)
		{
		    SV	**sv;

#   		    if NP_DIAG_REC_INITREF
			(void) fprintf(stderr, 
				       "rec_initref(): handling variable %d\n",
				       ivar);
#   		    endif

		    sv = av_fetch(list, (I32)ivar, (I32)0);

		    if (!SvROK(*sv))
		    {
			warn("Invalid perl record structure");
			break;
		    }

		    vec_initrecref(&vecs[ivar], *sv, ncid, varids[ivar]);
		    if (!vecs[ivar].initialized)
			break;

#   		    if NP_DIAG_REC_INITREF
			(void) fputs("Record vector:\n", stderr);
			vec_print(&vecs[ivar], stderr, "    ");
#   		    endif

		    data[ivar] = vecs[ivar].nelt == 0
				    ? NULL
				    : (void*)vecs[ivar].data;
		}				/* variable loop */

		if (ivar < nvar)
		{
		    /*
		     * ivar is the index of the vector that wasn't initialized.
		     */
		    while (ivar--)
			vec_destroy(&vecs[ivar]);
		}
		else
		{
		    rec->data = data;
		    rec->vecs = vecs;
		    rec->nvar = nvar;
		    rec->initialized = 1;
		}
	    }					/* same number variables */
	}					/* record info obtained */
    }						/* memory allocated */

    if (varids != NULL)
	free((char*)varids);
    if (varsizes != NULL)
	free((char*)varsizes);
    if (!rec->initialized)
    {
	if (data != NULL)
	    free((char*)data);
	if (vecs != NULL)
	    free((char*)vecs);
    }
}


/*
 * Initialize a record structure from a netCDF dataset.
 */
void rec_initnc(rec, ncid, recid)
    Record	*rec;
    int		ncid;
    long	recid;
{
    int		nvar;

    rec->data = NULL;
    rec->vecs = NULL;
    rec->nvar = 0;
    rec->initialized = 0;

    if (ncrecinq(ncid, &nvar, (int*)NULL, (long*)NULL) != -1)
    {
	int	*varids   = (int*)   malloc((size_t)(nvar*sizeof(int)));
	long	*varsizes = (long*)  malloc((size_t)(nvar*sizeof(long)));
	void	**data    = (void**) malloc((size_t)(nvar*sizeof(void*)));
	Vector	*vecs     = (Vector*)malloc((size_t)(nvar*sizeof(Vector)));

	if (varids == NULL || data == NULL || 
	    varsizes == NULL || vecs == NULL)
	{
	    warn("Couldn't allocate memory for record variables");
	}
	else if (ncrecinq(ncid, &nvar, varids, varsizes) != -1)
	{
	    int	ivar;

	    for (ivar = 0; ivar < nvar; ++ivar)
	    {
		vec_initrec(&vecs[ivar], ncid, varids[ivar], recid);
		if (!vecs[ivar].initialized)
		    break;

		data[ivar] = (void*)vecs[ivar].data;
	    }

	    if (ivar < nvar)
	    {
		/* ivar is the index of the vector that wasn't initialized. */
		while (ivar--)
		    vec_destroy(&vecs[ivar]);
	    }
	    else
	    {
		rec->data = data;
		rec->vecs = vecs;
		rec->nvar = nvar;
		rec->initialized = 1;
	    }
	}

	if (varids != NULL)
	    free((char*)varids);
	if (varsizes != NULL)
	    free((char*)varsizes);
	if (!rec->initialized)
	{
	    if (data != NULL)
		free((char*)data);
	    if (vecs != NULL)
		free((char*)vecs);
	}
    }
}


/*
 * Destroy a record.
 */
static void
rec_destroy(rec)
    Record	*rec;
{
    if (rec->data != NULL)
    {
	free((char*)rec->data);
	rec->data = NULL;
    }

    if (rec->vecs != NULL)
    {
	int	ivar;

	for (ivar = 0; ivar < rec->nvar; ++ivar)
	    vec_destroy(&rec->vecs[ivar]);

	free((char*)rec->vecs);
	rec->vecs = NULL;
    }

    rec->nvar = 0;
    rec->initialized = 0;
}


/*
 * Print a record.
 */
static void
rec_print(rec, stream, prefix)
    Record	*rec;
    FILE	*stream;
    char	*prefix;
{
    if (!rec->initialized)
    {
	warn("rec_print(): Record not initialized");
    }
    else
    {
	int	ivar;

	(void) fprintf(stream, "%sNumber of variables = %d\n", 
		       prefix, rec->nvar);

	for (ivar = 0; ivar < rec->nvar; ++ivar)
	{
	    char	buf[128];

	    (void) fprintf(stream, "%sRecord variable %d:\n", prefix, ivar);

	    (void) strcat(strcpy(buf, prefix), "    ");

	    vec_print(&rec->vecs[ivar], stream, buf);

	    (void) fprintf(stream, "%sData pointers: %p ?= %p\n", 
			   buf, rec->data[ivar], rec->vecs[ivar].data);
	}
    }
}


static int
not_here(s)
char *s;
{
    warn("%s not implemented on this architecture", s);
    return -1;
}

static double
constant(name, arg)
char *name;
int arg;
{
#if 0
    (void)printf("constant(): name=\"%s\", arg=%d\n", name, arg);
#endif
    errno = 0;
    switch (*name) {
    case 'A':
	break;
    case 'B':
	if (strEQ(name, "BYTE"))
	    return NC_BYTE;
	break;
    case 'C':
	if (strEQ(name, "CHAR"))
	    return NC_CHAR;
	if (strEQ(name, "CLOBBER"))
	    return NC_CLOBBER;
	break;
    case 'D':
	if (strEQ(name, "DOUBLE"))
	    return NC_DOUBLE;
	break;
    case 'E':
	if (strEQ(name, "EBADDIM"))
	    return NC_EBADDIM;
	if (strEQ(name, "EBADID"))
	    return NC_EBADID;
	if (strEQ(name, "EBADTYPE"))
	    return NC_EBADTYPE;
	if (strEQ(name, "EEXIST"))
	    return NC_EEXIST;
	if (strEQ(name, "EGLOBAL"))
	    return NC_EGLOBAL;
	if (strEQ(name, "EINDEFINE"))
	    return NC_EINDEFINE;
	if (strEQ(name, "EINVAL"))
	    return NC_EINVAL;
	if (strEQ(name, "EINVALCOORDS"))
	    return NC_EINVALCOORDS;
	if (strEQ(name, "EMAXATTS"))
	    return NC_EMAXATTS;
	if (strEQ(name, "EMAXDIMS"))
	    return NC_EMAXDIMS;
	if (strEQ(name, "EMAXNAME"))
	    return NC_EMAXNAME;
	if (strEQ(name, "EMAXVARS"))
	    return NC_EMAXVARS;
	if (strEQ(name, "ENAMEINUSE"))
	    return NC_ENAMEINUSE;
	if (strEQ(name, "ENFILE"))
	    return NC_ENFILE;
	if (strEQ(name, "ENOTATT"))
	    return NC_ENOTATT;
	if (strEQ(name, "ENOTINDEFINE"))
	    return NC_ENOTINDEFINE;
	if (strEQ(name, "ENOTNC"))
	    return NC_ENOTNC;
	if (strEQ(name, "ENOTVAR"))
	    return NC_ENOTVAR;
	if (strEQ(name, "ENTOOL"))
	    return NC_ENTOOL;
	if (strEQ(name, "EPERM"))
	    return NC_EPERM;
	if (strEQ(name, "ESTS"))
	    return NC_ESTS;
	if (strEQ(name, "EUNLIMIT"))
	    return NC_EUNLIMIT;
	if (strEQ(name, "EUNLIMPOS"))
	    return NC_EUNLIMPOS;
	if (strEQ(name, "EXDR"))
	    return NC_EXDR;
	break;
    case 'F':
	if (strEQ(name, "FATAL"))
	    return NC_FATAL;
	if (strEQ(name, "FILL"))
	    return NC_FILL;
	if (strEQ(name, "FILL_BYTE"))
	    return FILL_BYTE;
	if (strEQ(name, "FILL_CHAR"))
	    return FILL_CHAR;
	if (strEQ(name, "FILL_DOUBLE"))
	    return FILL_DOUBLE;
	if (strEQ(name, "FILL_FLOAT"))
	    return FILL_FLOAT;
	if (strEQ(name, "FILL_LONG"))
	    return FILL_LONG;
	if (strEQ(name, "FILL_SHORT"))
	    return FILL_SHORT;
	if (strEQ(name, "FLOAT"))
	    return NC_FLOAT;
	break;
    case 'G':
	if (strEQ(name, "GLOBAL"))
	    return NC_GLOBAL;
	break;
    case 'H':
	break;
    case 'I':
	break;
    case 'J':
	break;
    case 'K':
	break;
    case 'L':
	if (strEQ(name, "LONG"))
	    return NC_LONG;
	break;
    case 'M':
	if (strEQ(name, "MAX_ATTRS"))
	    return MAX_NC_ATTRS;
	if (strEQ(name, "MAX_DIMS"))
	    return MAX_NC_DIMS;
	if (strEQ(name, "MAX_NAME"))
	    return MAX_NC_NAME;
	if (strEQ(name, "MAX_OPEN"))
	    return MAX_NC_OPEN;
	if (strEQ(name, "MAX_VARS"))
	    return MAX_NC_VARS;
	if (strEQ(name, "MAX_VAR_DIMS"))
	    return MAX_VAR_DIMS;
	break;
    case 'N':
	if (strEQ(name, "NOCLOBBER"))
	    return NC_NOCLOBBER;
	if (strEQ(name, "NOERR"))
	    return NC_NOERR;
	if (strEQ(name, "NOFILL"))
	    return NC_NOFILL;
	if (strEQ(name, "NOWRITE"))
	    return NC_NOWRITE;
	break;
    case 'O':
	break;
    case 'P':
	break;
    case 'Q':
	break;
    case 'R':
	break;
    case 'S':
	if (strEQ(name, "SHORT"))
	    return NC_SHORT;
	if (strEQ(name, "SYSERR"))
	    return NC_SYSERR;
	break;
    case 'T':
	break;
    case 'U':
	if (strEQ(name, "UNLIMITED"))
	    return NC_UNLIMITED;
	break;
    case 'V':
	if (strEQ(name, "VERBOSE"))
	    return NC_VERBOSE;
	break;
    case 'W':
	if (strEQ(name, "WRITE"))
	    return NC_WRITE;
	break;
    case 'X':
	if (strEQ(name, "XDR_D_INFINITY"))
#ifdef XDR_D_INFINITY
	    return XDR_D_INFINITY;
#else
	    goto not_there;
#endif
	if (strEQ(name, "XDR_F_INFINITY"))
#ifdef XDR_F_INFINITY
	    return XDR_F_INFINITY;
#else
	    goto not_there;
#endif
	break;
    case 'Y':
	break;
    case 'Z':
	break;
    case 'a':
	break;
    case 'b':
	break;
    case 'c':
	break;
    case 'd':
	break;
    case 'e':
	break;
    case 'f':
	break;
    case 'g':
	break;
    case 'h':
	break;
    case 'i':
	break;
    case 'j':
	break;
    case 'k':
	break;
    case 'l':
	break;
    case 'm':
	break;
    case 'n':
	break;
    case 'o':
	break;
    case 'p':
	break;
    case 'q':
	break;
    case 'r':
	break;
    case 's':
	break;
    case 't':
	break;
    case 'u':
	break;
    case 'v':
	break;
    case 'w':
	break;
    case 'x':
	break;
    case 'y':
	break;
    case 'z':
	break;
    case '_':
	break;
    }
    errno = EINVAL;
    return 0;

not_there:
    errno = ENOENT;
    return 0;
}


MODULE = NetCDF		PACKAGE = NetCDF	PREFIX=nc

double
constant(name,arg)
	char *		name
	int		arg


################################################################################
# netCDF control operations:
#

int
nccreate(path, cmode)
    char *	path
    int		cmode


int
ncopen(path, mode)
    char *	path
    int		mode
    CODE:
    {
	/*
	(void) fprintf(stderr, "ncopen(): path=\"%s\", mode=%d\n",
		       path, mode);
	*/

	RETVAL = ncopen(path, mode);
    }
    OUTPUT:
	RETVAL


int
ncredef(ncid)
    int		ncid


int
ncendef(ncid)
    int		ncid


int
ncclose(ncid)
    int		ncid


int
ncinquire(ncid, ndims, nvars, natts, recdim)
    int		ncid
    SV *	ndims
    SV *	nvars
    SV *	natts
    SV *	recdim
    CODE:
    {
	int	nd, nv, na, rd;

	RETVAL = -1;				/* error */

	if (ncinquire(ncid, &nd, &nv, &na, &rd) != -1)
	{
	    SV_SET(sv_setiv, ndims, (IV)nd);
	    SV_SET(sv_setiv, nvars, (IV)nv);
	    SV_SET(sv_setiv, natts, (IV)na);
	    SV_SET(sv_setiv, recdim, (IV)rd);

	    RETVAL = 0;				/* success */
	}
    }
    OUTPUT:
	RETVAL


int
ncsync(ncid)
    int		ncid


int
ncabort(ncid)
    int		ncid


int
ncsetfill(ncid, fillmode)
    int		ncid
    int		fillmode


################################################################################
# Dimension control operations:
#

int
ncdimdef(ncid, name, size)
    int		ncid
    char *	name
    long	size


int
ncdimid(ncid, name)
    int		ncid
    char *	name


int
ncdiminq(ncid, dimid, name, length)
    int		ncid
    int		dimid
    SV *	name
    SV *	length
    CODE:
    {
	char	buf[MAX_NC_NAME+1];
	long	len;

	RETVAL = -1;				/* error */
	if (ncdiminq(ncid, dimid, buf, &len) != -1)
	{
	    SV_SET(sv_setpv, name, buf);
	    SV_SET(sv_setiv, length, (IV)len);

	    RETVAL = 0;				/* success */
	}
    }
    OUTPUT:
	RETVAL


int
ncdimrename(ncid, dimid, name)
    int		ncid
    int		dimid
    char *	name



################################################################################
# Variable operations:
#

int
ncvardef(ncid, name, type, dimids)
    int		ncid
    char *	name
    int		type
    SV *	dimids
    CODE:
    {
	Vector	dimvec;

	vec_initref(&dimvec, IT_INT, dimids);

	if (!dimvec.initialized)
	    RETVAL = -1;
	else
	{
	    RETVAL = ncvardef(ncid, name, type, (int)dimvec.nelt,
			      (int*)dimvec.data);
	    vec_destroy(&dimvec);
	}
    }
    OUTPUT:
	RETVAL


int
ncvarid(ncid, name)
    int		ncid
    char *	name


int
ncvarinq(ncid, varid, name, datatype, ndims, dimids, natts)
    int		ncid
    int		varid
    SV *	name
    SV *	datatype
    SV *	ndims
    SV *	dimids
    SV *	natts
    CODE:
    {
	Vector	dids;				/* dimension IDs */

	RETVAL = -1;				/* error */

	vec_initspec(&dids, IT_INT, (long)MAX_NC_DIMS);
	if (dids.initialized)
	{
	    int		nd;
	    int		na;
	    char	nam[MAX_NC_NAME+1];
	    nc_type	type;

	    if (ncvarinq(ncid, varid, nam, &type, &nd, (int*)dids.data,
			 &na) != -1)
	    {
#if 0
		SV *	ref;

		if (ref_initvec(&ref, dids))
		{
		    SV_SET(sv_setpv, name, nam);
		    SV_SET(sv_setiv, datatype, type);
		    SV_SET(sv_setiv, ndims, nd);
		    SV_SET(sv_setsv, dimids, ref);
		    SV_SET(sv_setiv, natts, na);
		    RETVAL = 0;			/* success */
		}
#else
		if (av_initvec((AV*)SvRV(dimids), &dids))
		{
		    SV_SET(sv_setpv, name, nam);
		    SV_SET(sv_setiv, datatype, type);
		    SV_SET(sv_setiv, ndims, nd);
		    SV_SET(sv_setiv, natts, na);
		    RETVAL = 0;			/* success */
		}
#endif
	    }
	    vec_destroy(&dids);
	}
    }
    OUTPUT:
	RETVAL


int
ncvarput1(ncid, varid, coords, value)
    int		ncid
    int		varid
    SV *	coords
    SV *	value
    CODE:
    {
	Vector	where;

	RETVAL = -1;				/* error */

	vec_initref(&where, IT_LONG, coords);
	if (where.initialized)
	{
	    nc_type	nctype;

	    if (ncvarinq(ncid, varid, (char*)NULL, &nctype, (int*)NULL,
			 (int*)NULL, (int*)NULL) != -1)
	    {
		Value	val;

		value_initref(&val, nctype_inttype(nctype), value);

		RETVAL = ncvarput1(ncid, varid, (long*)where.data, 
				   (char*)&val.datum);
	    }

	    vec_destroy(&where);
	}
    }
    OUTPUT:
	RETVAL


int
ncvarget1(ncid, varid, coords, value)
    int		ncid
    int		varid
    SV *	coords
    SV *	value
    CODE:
    {
	Vector	where;

	RETVAL = -1;				/* error */

	vec_initref(&where, IT_LONG, coords);

	/*
	(void) fputs("ncvarget1(): co-ordinate vector:\n", stderr);
	vec_print(&where, stderr, "    ");
	*/

	if (where.initialized)
	{
	    nc_type	nctype;

	    if (ncvarinq(ncid, varid, (char*)NULL, &nctype, (int*)NULL,
			 (int*)NULL, (int*)NULL) != -1)
	    {
		Value	val;

		value_initspec(&val, nctype_inttype(nctype));

		if (ncvarget1(ncid, varid, (long*)where.data, &val.datum) != -1)
		{
		    /*
		    (void) fputs("ncvarget1(): value obtained:\n", stderr);
		    value_print(&val, stderr, "    ");
		    */
		    sv_initvalue(value, &val);
		    RETVAL = 0;
		}
	    }

	    vec_destroy(&where);
	}
    }
    OUTPUT:
	RETVAL


int
ncvarput(ncid, varid, start, count, values)
    int		ncid
    int		varid
    SV *	start
    SV *	count
    SV *	values
    CODE:
    {
	nc_type		nctype;

	RETVAL = -1;				/* error */

	if (ncvarinq(ncid, varid, (char*)0, &nctype, (int*)0, (int*)0, (int*)0)
	    != -1)
	{
	    Vector	start_vec;

	    vec_initref(&start_vec, IT_LONG, start);
	    if (start_vec.initialized)
	    {
		Vector	count_vec;

		vec_initref(&count_vec, IT_LONG, count);
		if (count_vec.initialized)
		{
		    Vector	value_vec;

		    vec_initref(&value_vec, nctype_inttype(nctype), values);
		    if (value_vec.initialized)
		    {
			RETVAL = ncvarput(ncid,
					  varid,
					  (long*)start_vec.data,
					  (long*)count_vec.data,
					  value_vec.data);
			vec_destroy(&value_vec);
		    }
		    vec_destroy(&count_vec);
		}
		vec_destroy(&start_vec);
	    }
	}
    }
    OUTPUT:
	RETVAL


int
ncvarget(ncid, varid, start, count, values)
    int		ncid
    int		varid
    SV *	start
    SV *	count
    SV *	values
    CODE:
    {
	Vector	start_vec;

	RETVAL = -1;				/* error */

	vec_initref(&start_vec, IT_LONG, start);
	if (start_vec.initialized)
	{
	    Vector	count_vec;

	    vec_initref(&count_vec, IT_LONG, count);
	    if (count_vec.initialized)
	    {
		nc_type	nctype;

		if (ncvarinq(ncid, varid, (char*)0, &nctype, (int*)0,
			     (int*)0, (int*)0) != -1)
		{
		    Vector	value_vec;

		    vec_initspec(&value_vec,
				 nctype_inttype(nctype),
				 vec_prod(&count_vec));
		    if (value_vec.initialized)
		    {
			if (ncvarget(ncid, varid, (long*)start_vec.data,
				     (long*)count_vec.data, value_vec.data)
			    != -1)
			{
			    if (av_initvec((AV*)SvRV(values), &value_vec))
				RETVAL = 0;	/* success */
			}
			vec_destroy(&value_vec);
		    }				/* value vector initialized */
		}				/* value type obtained */
		vec_destroy(&count_vec);
	    }					/* count vector set */
	    vec_destroy(&start_vec);
	}					/* start vector set */
    }
    OUTPUT:
	RETVAL


int
ncvarrename(ncid, varid, name)
    int		ncid
    int		varid
    char *	name


################################################################################
# Attribute operations:
#

int
ncattput(ncid, varid, name, type, values)
    int		ncid
    int		varid
    char *	name
    int		type
    SV *	values
    CODE:
    {
	/*
	(void) fprintf(stderr, 
		       "ncattput(): ncid=%d, varid=%d, name=\"%s\", type=%d\n",
		       ncid, varid, name, type);
	*/

	if (SvROK(values))
	{
	    /*
	     * Reference value: must be a vector attribute.
	     */
	    Vector	vec;

	    vec_initref(&vec, nctype_inttype(type), values); 

	    if (!vec.initialized)
		RETVAL = -1;
	    else
	    {
		/*
		(void) fprintf(stderr, 
			       "ncattput(): nelt=%d\n", (int)vec.nelt);
		*/

		RETVAL = ncattput(ncid, varid, name, type, (int)vec.nelt, 
				  vec.data);
		vec_destroy(&vec);
	    }
	}					/* vector attribute */
	else
	{
	    /*
	     * Non-reference value: must be a scalar attribute.
	     */
	    union
	    {
		char	c;
		short	s;
		nclong	l;
		float	f;
		double	d;
	    }	val;
	    char	*ptr = (char*)&val;
	    int		len = 1;

	    switch (type)
	    {
		case NC_CHAR:
		    ptr = SvPV_nolen(values);
		    len = strlen(ptr) + 1;
		    break;
		case NC_BYTE:
		    val.c = SvIV(values);
		    break;
		case NC_SHORT:
		    val.s = SvIV(values);
		    break;
		case NC_LONG:
		    val.l = SvIV(values);
		    break;
		case NC_FLOAT:
		    val.f = SvNV(values);
		    break;
		case NC_DOUBLE:
		    val.d = SvNV(values);
		    break;
	    }

	    RETVAL = ncattput(ncid, varid, name, type, len, ptr);
	}					/* scalar attribute */
    }
    OUTPUT:
	RETVAL


int
ncattinq(ncid, varid, name, datatype, length)
    int		ncid
    int		varid
    char *	name
    SV *	datatype
    SV *	length
    CODE:
    {
	int	len;
	nc_type	nctype;

	RETVAL = -1;				/* error */

	if (ncattinq(ncid, varid, name, &nctype, &len) != -1)
	{
	    SV_SET(sv_setiv, datatype, (IV)nctype);
	    SV_SET(sv_setiv, length, (IV)len);
	    RETVAL = 0;				/* success */
	}
    }
    OUTPUT:
	RETVAL


int
ncattget(ncid, varid, name, value)
    int		ncid
    int		varid
    char *	name
    SV *	value
    CODE:
    {
	int	len;
	nc_type	nctype;

	/*
	(void) fprintf(stderr,
		       "ncattget(): ncid=%d, varid=%d, name=\"%s\"\n",
		       ncid, varid, name);
	 */

	RETVAL = -1;				/* error */

	if (ncattinq(ncid, varid, name, &nctype, &len) != -1)
	{
	    Vector	vec;

	    vec_initspec(&vec, nctype_inttype(nctype), (long)len);
	    if (vec.initialized)
	    {
		if (ncattget(ncid, varid, name, vec.data) != -1)
		{
		    /*
		    (void) fputs("ncattget(): Returned vector:\n", stderr);
		    vec_print(&vec, stderr, "    ");
		     */

		    if (ref_initvec(value, &vec))
		    {
			/*
			(void) fputs("ncattget(): Returned reference:\n",
				     stderr);
			vec_print(&vec, stderr, "    ");
			 */
			RETVAL = 0;		/* success */
		    }
		}

		vec_destroy(&vec);
	    }
	}
    }
    OUTPUT:
	RETVAL


int
ncattcopy(incdf, invar, name, outcdf, outvar)
    int		incdf
    int		invar
    char *	name
    int		outcdf
    int		outvar


int
ncattname(ncid, varid, attnum, name)
    int		ncid
    int		varid
    int		attnum
    SV *	name
    CODE:
    {
	char	buf[MAX_NC_NAME+1];

	RETVAL = ncattname(ncid, varid, attnum, buf);
	if (RETVAL != -1)
	{
	    buf[MAX_NC_NAME] = 0;
	    SV_SET(sv_setpv, name, buf);
	}
    }
    OUTPUT:
	RETVAL


int
ncattrename(ncid, varid, name, newname)
    int		ncid
    int		varid
    char *	name
    char *	newname


int
ncattdel(ncid, varid, name)
    int		ncid
    int		varid
    char *	name


################################################################################
# Record I/O operations:
#

int
ncrecput(ncid, recid, data)
    int		ncid
    long	recid
    SV *	data
    CODE:
    {
	Record	rec;

	/*
	(void) fprintf(stderr, "XS_NetCDF::recput(): ncid=%d, recid=%ld\n",
		       ncid, recid);
	*/

	RETVAL = -1;				/* error */

	rec_initref(&rec, data, ncid);
	if (rec.initialized)
	{
	    /*
	    (void) fputs("ncrecput() record:\n", stderr);
	    rec_print(&rec, stderr, "   ");
	    (void) fprintf(stderr, "*(short*)rec.data[0] = %d\n",
			   *(short*)rec.data[0]);
	     */

	    RETVAL = ncrecput(ncid, recid, rec.data);

	    rec_destroy(&rec);
	}
    }
    OUTPUT:
	RETVAL


int
ncrecget(ncid, recid, data)
    int		ncid
    long	recid
    SV *	data
    CODE:
    {
	Record	rec;

	RETVAL = -1;				/* error */

	rec_initnc(&rec, ncid, recid);

	if (rec.initialized)
	{
	    if (av_initrec((AV*)SvRV(data), &rec))
		RETVAL = 0;			/* success */

	    rec_destroy(&rec);
	}
    }
    OUTPUT:
	RETVAL


int
ncrecinq(ncid, nrecvars, recvarids, recsizes)
    int		ncid
    SV *	nrecvars
    SV *	recvarids
    SV *	recsizes
    CODE:
    {
	int	nvar;

	/*
	(void) fprintf(stderr, "ncrecinq(): ncid=%d\n");
	*/

	RETVAL = -1;				/* error */

	if (ncrecinq(ncid, &nvar, (int*)NULL, (long*)NULL) != -1)
	{
	    long	count = nvar;
	    Vector	varids;

	    vec_initspec(&varids, IT_INT, (long)nvar);
	    if (varids.initialized)
	    {
		Vector	varlens;

		vec_initspec(&varlens, IT_LONG, (long)nvar);
		if (varlens.initialized)
		{
		    if (ncrecinq(ncid, (int*)NULL, (int*)varids.data,
				 (long*)varlens.data) != -1)
		    {
			if (av_initvec((AV*)SvRV(recvarids), &varids) &&
			    av_initvec((AV*)SvRV(recsizes), &varlens))
			{
			    /*
			    (void) fputs("ncrecinq(): Variable IDs:\n", stderr);
			    vec_print(&varids, stderr, "    ");
			    (void) fputs("ncrecinq(): Record sizes:\n", stderr);
			    vec_print(&varlens, stderr, "    ");
			    */

			    SV_SET(sv_setiv, nrecvars, (IV)nvar);
			    RETVAL = 0;		/* success */
			}
		    }

		    vec_destroy(&varlens);
		}

		vec_destroy(&varids);
	    }
	}
    }
    OUTPUT:
	RETVAL


################################################################################
# Miscellaneous operations:
#

int
nctypelen(datatype)
    int		datatype


int
ncopts(mode)
    int		mode
    CODE:
    {
	RETVAL = ncopts;
	ncopts = mode;
    }
    OUTPUT:
	RETVAL


int
ncerr()
    CODE:
	RETVAL = ncerr;
    OUTPUT:
	RETVAL


int
foo(outarg)
    SV *	outarg
    CODE:
    {
	if (!SvROK(outarg))
	{
	    (void) fputs("Setting scalar\n", stderr);
	    SV_SET(sv_setpv, outarg, "Scalar works!");
	}
	else
	{
#if 1
	    AV		*av = newAV();
	    SV		*ref = sv_2mortal(newRV((SV*)av));
	    /*
	     * Making the following 2 variables mortal causes no output
	     * values to be printed.
	     */
	    SV		*sv1 = newSVpv("one", 3);
	    SV		*sv2 = newSVpv("two", 3);

	    (void) fputs("Setting reference\n", stderr);

	    /*
	     * av_push() doesn't copy the pointed-to values.
	     */
	    av_push(av, sv1);
	    av_push(av, sv2);

	    /*
	     * Using either of the following causes $outarg to not be
	     * an array.
	     *    *outarg = *ref
	     *     outarg =  ref;
	     */

	    /* Using (SV*)av in the following causes a SEGV. */
	    SV_SET(sv_setsv, outarg, ref);
#else
	    char	*string = "Reference works!";
	    SV		*newval = sv_2mortal(newSVpv(string, strlen(string)));
	    SV		*ref = sv_2mortal(newRV(newval));

	    SV_SET(sv_setsv, outarg, ref);
#endif
	}
	/*
	 * It is not necessary to set ST(1) from outarg.
	 *
	 * SV_SET(sv_setsv, ST(1), outarg);
	 */
	RETVAL = 1;				/* success */
    }
    OUTPUT:
	RETVAL


void
foo2()
    PPCODE:
    {
	AV	*av = newAV();

	av_push(av, newSViv(1));
	av_push(av, newSViv(2));

	EXTEND(sp, 1);
	PUSHs(sv_2mortal(newRV((SV*)av)));
    }


void
foo3()
    PPCODE:
    {
	EXTEND(sp, 2);
	PUSHs(sv_2mortal(newSViv(3)));
	PUSHs(sv_2mortal(newSViv(4)));
    }


int
foo4(ref)
    SV *	ref
    CODE:
    {
	AV	*av = newAV();

	av_push(av, newSViv(5));
	av_push(av, newSViv(6));

	SV_SET(sv_setsv, ref, newRV((SV*)av));

	RETVAL = 1;
    }
    OUTPUT:
	RETVAL

int
foo5(ref)
    SV *	ref
    CODE:
    {
	int	vals[5];
	Vector	vec;

	vals[0] = 0;
	vals[1] = 1;
	vals[2] = 2;
	vals[3] = 3;
	vals[4] = 4;

	vec_initspec(&vec, IT_INT, 4);
	if (vec.initialized)
	{
	    (void) memcpy((void*)vec.data, vals, sizeof(int)*4);
	    if (av_initvec((AV*)SvRV(ref), &vec))
		RETVAL = 0;
	    vec_destroy(&vec);
	}
    }
    OUTPUT:
	RETVAL