[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Perl NetCDF module
- Subject: Re: Perl NetCDF module
- Date: Mon, 22 Jul 2002 16:19:26 -0600
Hi Mark,
>Date: Mon, 22 Jul 2002 15:48:41 -0600 (MDT)
>From: Mark Bradford <address@hidden>
>Organization: UCAR/Unidata
>To: "Steven R. Emmerson" <address@hidden>
>Subject: Perl NetCDF module
>Keywords: 200207222149.g6MLn3912771
The above message contained the following:
> Steve,
>
> I'm trying to resuscitate my Perl-NetCDF module and PDL::NetCDF, having
> upgraded to Perl 5.6.1. I'm seeing the results in the attached file when I
> try to install it -- any clues? Thanks!
>
> --
> Mark Bradford, Systems Administrator <> address@hidden
> UCAR Joint Office for Science Support <> (303) 497-8169
...
> Script started on Mon Jul 22 15:44:34 2002
> sysadmin@thunder[~/src/netcdf/netcdf-perl-1.2/src]> ./configure
> loading cache ./config.cache
> checking for catman... (cached) catman
> checking for perl utility... /bin/perl
> checking for perl manual page directory... /usr/local/man
> checking for neqn... (cached) neqn
> checking for tbl... (cached) tbl
> checking for cc... (cached) cc
> checking type of operating system... sunos5
> checking for tar flags... -chof
> checking for netCDF header-file... -I/opt/include
> checking for netCDF library... -L/opt/lib -R/opt/lib -lnetcdf
> checking for package version... 1.2
> creating ./config.status
> creating Makefile
> creating perl/Makefile.PL
> creating port/master.mk
> creating port/Makefile
> expanding `include's in file `Makefile'
> expanding `include's in file `perl/Makefile.PL'
> expanding `include's in file `port/master.mk'
> expanding `include's in file `port/Makefile'
> sysadmin@thunder[~/src/netcdf/netcdf-perl-1.2/src]> make
> cd perl && /bin/perl Makefile.PL
> Checking if your kit is complete...
> Looks good
> Writing Makefile for NetCDF
>
> making `dynamic' in directory
> /home/sysadmin/src/netcdf/netcdf-perl-1.2/src/perl
>
> /bin/perl -I/opt/perl/lib/5.6.1/sun4-solaris -I/opt/perl/lib/5.6.1
> /opt/perl/lib/5.6.1/ExtUtils/xsubpp -typemap
> /opt/perl/lib/5.6.1/ExtUtils/typemap NetCDF.xs > NetCDF.xsc && mv NetCDF.xsc
> NetCDF.c
> Please specify prototyping behavior for NetCDF.xs (see perlxs manual)
> cc -c -I/opt/include -I/usr/local/include -D_LARGEFILE_SOURCE
> -D_FILE_OFFSET_BITS=64 -O -DVERSION=\"1.2\" -DXS_VERSION=\"1.2\" -KPIC
> -I/opt/perl/lib/5.6.1/sun4-solaris/CORE NetCDF.c
> "NetCDF.xs", line 823: undefined symbol: na
> "NetCDF.xs", line 823: warning: argument #2 is incompatible with prototype:
> prototype: pointer to uint :
> "/opt/perl/lib/5.6.1/sun4-solaris/CORE/proto.h", line 709
> argument : pointer to int
> "NetCDF.xs", line 2251: undefined symbol: na
> "NetCDF.xs", line 2251: warning: argument #2 is incompatible with prototype:
> prototype: pointer to uint :
> "/opt/perl/lib/5.6.1/sun4-solaris/CORE/proto.h", line 709
> argument : pointer to int
> cc: acomp failed for NetCDF.c
> *** Error code 2
> make: Fatal error: Command failed for target `NetCDF.o'
> Current working directory /home/sysadmin/src/netcdf/netcdf-perl-1.2/src/perl
> *** Error code 1
> make: Fatal error: Command failed for target `perl/dynamic'
> Current working directory /home/sysadmin/src/netcdf/netcdf-perl-1.2/src
> *** Error code 1
> make: Fatal error: Command failed for target `decision'
> Current working directory /home/sysadmin/src/netcdf/netcdf-perl-1.2/src
> *** Error code 1
> make: Fatal error: Command failed for target `all'
> script done on Mon Jul 22 15:45:06 2002
Interesting problem. It's been so long since I wrote this package that
I've forgotten most of the Perl module API. :-(
Try replacing your file "perl/NetCDF.xs" with the attachment. Please let
know if it works.
Regards,
Steve Emmerson <http://www.unidata.ucar.edu>
/*
* 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.
*/
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