Astro-WCS-LibWCS

 view release on metacpan or  search on metacpan

LibWCS.xs  view on Meta::CPAN

typedef struct Star   Star;
typedef struct TabTable   TabTable;
typedef struct Range Range;
typedef struct Keyword Keyword;
typedef struct Tokens Tokens;

/* declarations which are not in libwcs headers */
#include "wcsdecl.h"

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

static double
constant(char *name, int arg)
{
    errno = 0;
    switch (*name) {

LibWCS.xs  view on Meta::CPAN

	break;
    case 'N':
	break;
    case 'O':
	break;
    case 'P':
	if (strEQ(name, "PI"))
#ifdef PI
	    return PI;
#else
	    goto not_there;
#endif
	break;
    case 'Q':
	break;
    case 'R':
	break;
    case 'S':
	break;
    case 'T':
	if (strEQ(name, "TNX_CHEBYSHEV"))
#ifdef TNX_CHEBYSHEV
	    return TNX_CHEBYSHEV;
#else
	    goto not_there;
#endif
	if (strEQ(name, "TNX_LEGENDRE"))
#ifdef TNX_LEGENDRE
	    return TNX_LEGENDRE;
#else
	    goto not_there;
#endif
	if (strEQ(name, "TNX_POLYNOMIAL"))
#ifdef TNX_POLYNOMIAL
	    return TNX_POLYNOMIAL;
#else
	    goto not_there;
#endif
	if (strEQ(name, "TNX_XFULL"))
#ifdef TNX_XFULL
	    return TNX_XFULL;
#else
	    goto not_there;
#endif
	if (strEQ(name, "TNX_XHALF"))
#ifdef TNX_XHALF
	    return TNX_XHALF;
#else
	    goto not_there;
#endif
	if (strEQ(name, "TNX_XNONE"))
#ifdef TNX_XNONE
	    return TNX_XNONE;
#else
	    goto not_there;
#endif
	break;
    case 'U':
	break;
    case 'V':
	break;
    case 'W':
	if (strEQ(name, "WCS_AIR"))
#ifdef WCS_AIR
	    return WCS_AIR;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_AIT"))
#ifdef WCS_AIT
	    return WCS_AIT;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_ALTAZ"))
#ifdef WCS_ALTAZ
	    return WCS_ALTAZ;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_ARC"))
#ifdef WCS_ARC
	    return WCS_ARC;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_AZP"))
#ifdef WCS_AZP
	    return WCS_AZP;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_B1950"))
#ifdef WCS_B1950
	    return WCS_B1950;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_BON"))
#ifdef WCS_BON
	    return WCS_BON;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_CAR"))
#ifdef WCS_CAR
	    return WCS_CAR;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_CEA"))
#ifdef WCS_CEA
	    return WCS_CEA;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_COD"))
#ifdef WCS_COD
	    return WCS_COD;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_COE"))
#ifdef WCS_COE
	    return WCS_COE;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_COO"))
#ifdef WCS_COO
	    return WCS_COO;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_CPS"))
#ifdef WCS_CPS
	    return WCS_CPS;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_CSC"))
#ifdef WCS_CSC
	    return WCS_CSC;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_CYP"))
#ifdef WCS_CYP
	    return WCS_CYP;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_DSS"))
#ifdef WCS_DSS
	    return WCS_DSS;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_ECLIPTIC"))
#ifdef WCS_ECLIPTIC
	    return WCS_ECLIPTIC;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_GALACTIC"))
#ifdef WCS_GALACTIC
	    return WCS_GALACTIC;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_GLS"))
#ifdef WCS_GLS
	    return WCS_GLS;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_J2000"))
#ifdef WCS_J2000
	    return WCS_J2000;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_LIN"))
#ifdef WCS_LIN
	    return WCS_LIN;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_LINEAR"))
#ifdef WCS_LINEAR
	    return WCS_LINEAR;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_MER"))
#ifdef WCS_MER
	    return WCS_MER;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_MOL"))
#ifdef WCS_MOL
	    return WCS_MOL;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_NCP"))
#ifdef WCS_NCP
	    return WCS_NCP;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_NPOLE"))
#ifdef WCS_NPOLE
	    return WCS_NPOLE;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_PAR"))
#ifdef WCS_PAR
	    return WCS_PAR;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_PCO"))
#ifdef WCS_PCO
	    return WCS_PCO;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_PIX"))
#ifdef WCS_PIX
	    return WCS_PIX;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_PLANET"))
#ifdef WCS_PLANET
	    return WCS_PLANET;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_PLT"))
#ifdef WCS_PLT
	    return WCS_PLT;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_QSC"))
#ifdef WCS_QSC
	    return WCS_QSC;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_SIN"))
#ifdef WCS_SIN
	    return WCS_SIN;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_SPA"))
#ifdef WCS_SPA
	    return WCS_SPA;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_STG"))
#ifdef WCS_STG
	    return WCS_STG;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_TAN"))
#ifdef WCS_TAN
	    return WCS_TAN;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_TNX"))
#ifdef WCS_TNX
	    return WCS_TNX;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_TSC"))
#ifdef WCS_TSC
	    return WCS_TSC;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_ZEA"))
#ifdef WCS_ZEA
	    return WCS_ZEA;
#else
	    goto not_there;
#endif
	if (strEQ(name, "WCS_ZPN"))
#ifdef WCS_ZPN
	    return WCS_ZPN;
#else
	    goto not_there;
#endif
	break;
    case 'X':
	break;
    case 'Y':
	break;
    case 'Z':
	break;
    }
    errno = EINVAL;
    return 0;

not_there:
    errno = ENOENT;
    return 0;
}


MODULE = Astro::WCS::LibWCS		PACKAGE = Astro::WCS::LibWCS
PROTOTYPES: DISABLE

double
constant(name,arg)

t/dateutil.t  view on Meta::CPAN

my $jd = 2451239.75;
my $epoch = 1999.16506849315;
my $fd = '1999-03-02T06:00:00.000';
my $ts = 1551506400;
my ($iyr, $imon, $iday, $ihr, $imin, $sec) =
    (1999, 3, 2, 6, 0, 0);

#
# dt2jd()
#
print( dt2jd($date,$time) == $jd ? ok() : not_ok() );

#
# jd2dt()
#
my ($date_tmp,$time_tmp);
jd2dt($jd,$date_tmp,$time_tmp);
print( ($date_tmp == $date && $time_tmp == $time) ? ok() : not_ok() );

#
# jd2ep()
#
print( equal(jd2ep($jd),$epoch,1e-12) ? ok() : not_ok() );

#
# ep2fd()
#
print( ep2fd($epoch) eq $fd ? ok() : not_ok() );

#
# ep2ts()
#
print( equal(ep2ts($epoch),$ts,1e-2) ? ok() : not_ok() );

#
# ep2jd()
#
print( equal(ep2jd($epoch),$jd,1e-5) ? ok() : not_ok() );

#
# jd2fd()
#
print( jd2fd($jd) eq $fd ? ok() : not_ok() );

#
# jd2ts()
#
print( equal(jd2ts($jd),$ts,1e-3) ? ok() : not_ok() );

#
# ts2jd()
#
print( equal(ts2jd($ts),$jd,1e-2) ? ok() : not_ok() );

#
# dt2ep()
#
print( equal(dt2ep($date,$time),$epoch,1e-12) ? ok() : not_ok() );

#
# ep2dt()
#
$date_tmp = $time_tmp = 0;
ep2dt($epoch,$date_tmp,$time_tmp);
print( $date_tmp == $date && equal($time_tmp,$time,1e-9) ? ok() : not_ok() );

#
# fd2jd()
#
print( fd2jd($fd) == $jd ? ok() : not_ok() );

#
# dt2fd
#
print ( dt2fd($date,$time) eq $fd ? ok() : not_ok() );

#
# dt2i
#

sub ok {
    return "ok\n";
}

sub not_ok {
    return "not ok\n";
}

sub equal {
    my ($n1, $n2, $range) = @_;

    return 1 if (abs($n1-$n2) < $range);

    return 0;
}

util.c  view on Meta::CPAN

	SvGROW(arg, data_length);
	memcpy(SvPV(arg,PL_na), var, data_length);

	return;
}

/*
 * Takes a pointer to a single value of any given type, puts
 * that value into the passed Perl scalar
 *
 * Note that type TSTRING does _not_ imply a (char **) was passed,
 * but rather a (char *).
 */
void unpackScalar(SV * arg, void * var, int datatype) {
	SV* tmp_sv[2];

	if (var == NULL) {
		sv_setpvn(arg,"",0);
		return;
	}
	switch (datatype) {