r69963 - in /trunk/libastro-fits-cfitsio-perl: CFITSIO.pm CFITSIO.xs ChangeLog MANIFEST META.yml NOTES README announce debian/changelog testprog/testprog.pl testprog/testprog_OO.pl testprog/testprog_longnames.pl testprog/testprog_pdl.pl util.c
chrisb at users.alioth.debian.org
chrisb at users.alioth.debian.org
Sun Feb 27 18:18:37 UTC 2011
Author: chrisb
Date: Sun Feb 27 18:18:27 2011
New Revision: 69963
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=69963
Log:
New upstream release
Removed:
trunk/libastro-fits-cfitsio-perl/announce
Modified:
trunk/libastro-fits-cfitsio-perl/CFITSIO.pm
trunk/libastro-fits-cfitsio-perl/CFITSIO.xs
trunk/libastro-fits-cfitsio-perl/ChangeLog
trunk/libastro-fits-cfitsio-perl/MANIFEST
trunk/libastro-fits-cfitsio-perl/META.yml
trunk/libastro-fits-cfitsio-perl/NOTES
trunk/libastro-fits-cfitsio-perl/README
trunk/libastro-fits-cfitsio-perl/debian/changelog
trunk/libastro-fits-cfitsio-perl/testprog/testprog.pl
trunk/libastro-fits-cfitsio-perl/testprog/testprog_OO.pl
trunk/libastro-fits-cfitsio-perl/testprog/testprog_longnames.pl
trunk/libastro-fits-cfitsio-perl/testprog/testprog_pdl.pl
trunk/libastro-fits-cfitsio-perl/util.c
Modified: trunk/libastro-fits-cfitsio-perl/CFITSIO.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/CFITSIO.pm?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/CFITSIO.pm (original)
+++ trunk/libastro-fits-cfitsio-perl/CFITSIO.pm Sun Feb 27 18:18:27 2011
@@ -1,5 +1,5 @@
package Astro::FITS::CFITSIO;
-$VERSION = '1.05';
+$VERSION = '1.06';
use strict;
use Carp;
@@ -18,7 +18,6 @@
fits_set_noise_bits
fits_get_tile_dim
fits_set_tile_dim
- fits_hdr2str
fits_translate_keyword
fits_translate_keywords
fits_copy_cell2image
@@ -127,6 +126,7 @@
ffphprll => 'fits_write_grphdrll',
ffphtb => 'fits_write_atblhdr',
ffphbn => 'fits_write_btblhdr',
+ ffphext => 'fits_write_exthdr',
ffpktp => 'fits_write_key_template',
ffghsp => 'fits_get_hdrspace',
ffghps => 'fits_get_hdrpos',
@@ -148,6 +148,8 @@
ffgkym => 'fits_read_key_dblcmp',
ffgkyt => 'fits_read_key_triple',
ffgkls => 'fits_read_key_longstr',
+ ffhdr2str => 'fits_hdr2str',
+ ffcnvthdr2str => 'fits_convert_hdr2str',
ffgtdm => 'fits_read_tdim',
ffgtdmll => 'fits_read_tdimll',
ffdtdm => 'fits_decode_tdim',
@@ -222,6 +224,7 @@
ffgipr => 'fits_get_img_param',
ffgiprll => 'fits_get_img_paramll',
ffgidt => 'fits_get_img_type',
+ ffinttyp => 'fits_get_inttype',
ffgiet => 'fits_get_img_equivtype',
ffgidm => 'fits_get_img_dim',
ffgisz => 'fits_get_img_size',
@@ -245,6 +248,7 @@
ffcopy => 'fits_copy_hdu',
ffcphd => 'fits_copy_header',
ffcpdt => 'fits_copy_data',
+ ffwrhdu => 'fits_write_hdu',
ffrdef => 'fits_set_hdustruc',
ffhdef => 'fits_set_hdrsize',
ffpthp => 'fits_write_theap',
@@ -519,6 +523,7 @@
fficls => 'fits_insert_cols',
ffdcol => 'fits_delete_col',
ffcpcl => 'fits_copy_col',
+ ffcprw => 'fits_copy_rows',
ffmvec => 'fits_modify_vector_len',
ffgics => 'fits_read_img_coord',
ffgtcs => 'fits_read_tbl_coord',
@@ -606,6 +611,8 @@
BYTE_IMG
CASEINSEN
CASESEN
+ CFITSIO_MAJOR
+ CFITSIO_MINOR
COL_NOT_FOUND
COL_NOT_UNIQUE
COL_TOO_WIDE
Modified: trunk/libastro-fits-cfitsio-perl/CFITSIO.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/CFITSIO.xs?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/CFITSIO.xs (original)
+++ trunk/libastro-fits-cfitsio-perl/CFITSIO.xs Sun Feb 27 18:18:27 2011
@@ -331,6 +331,18 @@
#else
goto not_there;
#endif
+ if (strEQ(name, "CFITSIO_MAJOR"))
+#ifdef CFITSIO_MAJOR
+ return CFITSIO_MAJOR;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "CFITSIO_MINOR"))
+#ifdef CFITSIO_MINOR
+ return CFITSIO_MINOR;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "COL_NOT_FOUND"))
#ifdef COL_NOT_FOUND
return COL_NOT_FOUND;
@@ -1598,6 +1610,19 @@
status
int
+ffcprw(infptr,outfptr,firstrow,nrows,status)
+ fitsfile * infptr
+ fitsfile * outfptr
+ LONGLONG firstrow
+ LONGLONG nrows
+ int &status
+ ALIAS:
+ Astro::FITS::CFITSIO::fits_copy_rows = 1
+ fitsfilePtr::copy_rows = 2
+ OUTPUT:
+ status
+
+int
ffcpdt(infptr,outfptr,status)
fitsfile * infptr
fitsfile * outfptr
@@ -1605,6 +1630,17 @@
ALIAS:
Astro::FITS::CFITSIO::fits_copy_data = 1
fitsfilePtr::copy_data = 2
+ OUTPUT:
+ status
+
+int
+ffwrhdu(infptr, stream, status)
+ fitsfile * infptr
+ FILE * stream
+ int &status
+ ALIAS:
+ Astro::FITS::CFITSIO::fits_write_hdu = 1
+ fitsfilePtr::write_hdu = 2
OUTPUT:
status
@@ -2586,6 +2622,19 @@
status
int
+ffinttyp(value,inttype,neg,status)
+ char * value
+ int &inttype = NO_INIT
+ int &neg = NO_INIT
+ int &status
+ ALIAS:
+ Astro::FITS::CFITSIO::fits_get_inttype = 1
+ OUTPUT:
+ inttype
+ neg
+ status
+
+int
ffgiet(fptr,bitpix,status)
fitsfile * fptr
int &bitpix = NO_INIT
@@ -2811,14 +2860,34 @@
RETVAL
int
-fits_hdr2str(fptr, nocomments, header, nkeys, status)
+ffhdr2str(fptr, nocomments, header, nkeys, status)
FitsFile *fptr
int nocomments
char *header = NO_INIT
int nkeys = NO_INIT
int status
ALIAS:
- fitsfilePtr::hdr2str = 1
+ Astro::FITS::CFITSIO::fits_hdr2str = 1
+ fitsfilePtr::hdr2str = 2
+ CODE:
+ RETVAL=fits_hdr2str(fptr->fptr,nocomments,NULL,0,&header,&nkeys,&status);
+ if (ST(2)!=&PL_sv_undef) unpackScalar(ST(2), header, TSTRING);
+ if (ST(3)!=&PL_sv_undef) unpackScalar(ST(3), &nkeys, TINT);
+ free(header);
+ OUTPUT:
+ status
+ RETVAL
+
+int
+ffcnvthdr2str(fptr, nocomments, header, nkeys, status)
+ FitsFile *fptr
+ int nocomments
+ char *header = NO_INIT
+ int nkeys = NO_INIT
+ int status
+ ALIAS:
+ Astro::FITS::CFITSIO::fits_convert_hdr2str = 1
+ fitsfilePtr::convert_hdr2str = 2
CODE:
RETVAL=fits_hdr2str(fptr->fptr,nocomments,NULL,0,&header,&nkeys,&status);
if (ST(2)!=&PL_sv_undef) unpackScalar(ST(2), header, TSTRING);
@@ -9373,14 +9442,15 @@
fitsfile * fptr
int datatype
char * keyname
- SV * value
+ void * value = NO_INIT
char * comm
int status
ALIAS:
Astro::FITS::CFITSIO::fits_update_key = 1
fitsfilePtr::update_key = 2
CODE:
- RETVAL=ffuky(fptr,datatype,keyname,pack1D(value,datatype),comm,&status);
+ value = pack1D(ST(3),(datatype == TLOGICAL) ? TINT : datatype);
+ RETVAL=ffuky(fptr,datatype,keyname,value,comm,&status);
OUTPUT:
status
RETVAL
@@ -10008,6 +10078,22 @@
ALIAS:
Astro::FITS::CFITSIO::fits_write_btblhdr = 1
fitsfilePtr::write_btblhdr = 2
+ OUTPUT:
+ status
+
+int
+ffphext(fptr, xtension, bitpix, naxis, naxes, pcount, gcount, status)
+ fitsfile * fptr
+ char * xtension
+ int bitpix
+ int naxis
+ long * naxes
+ LONGLONG pcount
+ LONGLONG gcount
+ int &status
+ ALIAS:
+ Astro::FITS::CFITSIO::fits_write_exthdr = 1
+ fitsfilePtr::write_exthdr = 2
OUTPUT:
status
Modified: trunk/libastro-fits-cfitsio-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/ChangeLog?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/ChangeLog (original)
+++ trunk/libastro-fits-cfitsio-perl/ChangeLog Sun Feb 27 18:18:27 2011
@@ -1,3 +1,35 @@
+2011-01-26 Pete Ratzlaff <rpete at legs.cfa.harvard.edu>
+
+2011-01-26 Pete Ratzlaff <pratzlaff at cfa.harvard.edu>
+
+ * CFITSIO.pm: $VERSION = '1.06';
+
+ * CFITSIO.xs: update to cfitsio 3.26, added routines
+ fits_copy_rows, fits_get_inttype, fits_convert_hdr2str, added
+ short name ffhdr2str => 'fits_hdr2str', added constants
+ CFITSIO_MAJOR and CFITSIO_MINOR
+
+2010-07-28 Pete Ratzlaff <pratzlaff at cfa.harvard.edu>
+
+ * util.c (column_width): fixed incorrect determination of ASCII
+ string widths for values in binary tables columns
+
+2009-08-21 Pete Ratzlaff <pratzlaff at cfa.harvard.edu>
+
+ * CFITSIO.xs: fixed bug in fits_update_key when called with
+ datatype TLOGICAL, whereby the input value was not converted to
+ int properly.
+
+2008-08-26 Pete Ratzlaff <pratzlaff at cfa.harvard.edu>
+
+ * testprog/testprog_pdl.pl: get testprog_pdl.pl work properly on
+ 64-bit archs
+
+2007-02-14 Pete Ratzlaff <pratzlaff at cfa.harvard.edu>
+
+ * CFITSIO.xs: added fits_write_hdu/ffwrhdu,
+ fits_write_exthdr/ffphext
+
2006-06-27 Pete Ratzlaff <pratzlaff at cfa.harvard.edu>
* CFITSIO.pm: $VERSION = '1.0.5';
Modified: trunk/libastro-fits-cfitsio-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/MANIFEST?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/MANIFEST (original)
+++ trunk/libastro-fits-cfitsio-perl/MANIFEST Sun Feb 27 18:18:27 2011
@@ -7,7 +7,6 @@
Makefile.PL
NOTES
README
-announce
test.pl
typemap
util.c
Modified: trunk/libastro-fits-cfitsio-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/META.yml?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/META.yml (original)
+++ trunk/libastro-fits-cfitsio-perl/META.yml Sun Feb 27 18:18:27 2011
@@ -1,10 +1,20 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Astro-FITS-CFITSIO
-version: 1.05
-version_from: CFITSIO.pm
-installdirs: site
-requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+--- #YAML:1.0
+name: Astro-FITS-CFITSIO
+version: 1.06
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libastro-fits-cfitsio-perl/NOTES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/NOTES?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/NOTES (original)
+++ trunk/libastro-fits-cfitsio-perl/NOTES Sun Feb 27 18:18:27 2011
@@ -3,6 +3,8 @@
* fits_open_memfile
* fits_split_names
* fits_read_wcstab
+ * fits_write_ext
+ * fits_read_ext
Other:
* fits_hdr2str - exclude, nexc parameters unimplemented, they are
Modified: trunk/libastro-fits-cfitsio-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/README?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/README (original)
+++ trunk/libastro-fits-cfitsio-perl/README Sun Feb 27 18:18:27 2011
@@ -13,7 +13,7 @@
What version of cfitsio does this module require?
----------------------------------------------
- Astro::FITS::CFITSIO version 1.05 requires at least cfitsio v3.006
+ Astro::FITS::CFITSIO version 1.06 requires at least cfitsio version 3.26
Installation
------------
@@ -21,7 +21,7 @@
distribution directory. Essentially, it just tells you to set the
CFITSIO environment variable, and then do
- $ perl Makefile.PL OPTIMIZE=-O
+ $ perl Makefile.PL OPTIMIZE=-O0
$ make
$ make test
$ make install
Modified: trunk/libastro-fits-cfitsio-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/debian/changelog?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/debian/changelog (original)
+++ trunk/libastro-fits-cfitsio-perl/debian/changelog Sun Feb 27 18:18:27 2011
@@ -1,4 +1,4 @@
-libastro-fits-cfitsio-perl (1.05-3) UNRELEASED; urgency=low
+libastro-fits-cfitsio-perl (1.06-1) UNRELEASED; urgency=low
[ Joachim Breitner ]
* Removed myself from uploaders.
@@ -19,7 +19,10 @@
perl (>= 5.6.0-{12,16}) with an unversioned dependency on perl (as
permitted by Debian Policy 3.8.3).
- -- Ryan Niebur <ryanryan52 at gmail.com> Wed, 08 Apr 2009 19:00:10 -0700
+ [ Chris Butler ]
+ * New upstream release
+
+ -- Chris Butler <chrisb at debian.org> Sun, 27 Feb 2011 18:03:02 +0000
libastro-fits-cfitsio-perl (1.05-2) unstable; urgency=low
Modified: trunk/libastro-fits-cfitsio-perl/testprog/testprog.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/testprog/testprog.pl?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/testprog/testprog.pl (original)
+++ trunk/libastro-fits-cfitsio-perl/testprog/testprog.pl Sun Feb 27 18:18:27 2011
@@ -74,7 +74,6 @@
print "ffinit create new file status = $status\n";
$status and goto ERRSTATUS;
-$filemode;
ffflnm($fptr,$filename,$status);
ffflmd($fptr,$filemode,$status);
print "Name of file = $filename, I/O mode = $filemode\n";
Modified: trunk/libastro-fits-cfitsio-perl/testprog/testprog_OO.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/testprog/testprog_OO.pl?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/testprog/testprog_OO.pl (original)
+++ trunk/libastro-fits-cfitsio-perl/testprog/testprog_OO.pl Sun Feb 27 18:18:27 2011
@@ -74,7 +74,6 @@
print "ffinit create new file status = $status\n";
$status and goto ERRSTATUS;
-$filemode;
$fptr->file_name($filename,$status);
$fptr->file_mode($filemode,$status);
print "Name of file = $filename, I/O mode = $filemode\n";
@@ -281,7 +280,6 @@
$status and print("ERROR: ffgpv_ status = $status\n"), goto ERRSTATUS;
$anynull or print "ERROR: ffgpv_ did not detect null values\n";
-$ii;
for ($ii=3;$ii<$npixels;$ii+=4) {
$boutarray->[$ii] = 99;
$ioutarray->[$ii] = 99;
@@ -316,7 +314,6 @@
@{$dinarray} = map(0.0,(0..$npixels-1));
$anynull = 0;
-$larray;
$fptr->read_imgnull_byt(1,1,10,$binarray,$larray,$anynull,$status);
$fptr->read_imgnull_byt(1,11,10,$tmp1,$tmp2,$anynull,$status);
@{$binarray}[10..$npixels-1] = @{$tmp1};
Modified: trunk/libastro-fits-cfitsio-perl/testprog/testprog_longnames.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/testprog/testprog_longnames.pl?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/testprog/testprog_longnames.pl (original)
+++ trunk/libastro-fits-cfitsio-perl/testprog/testprog_longnames.pl Sun Feb 27 18:18:27 2011
@@ -74,7 +74,6 @@
print "ffinit create new file status = $status\n";
$status and goto ERRSTATUS;
-$filemode;
fits_file_name($fptr,$filename,$status);
fits_file_mode($fptr,$filemode,$status);
print "Name of file = $filename, I/O mode = $filemode\n";
@@ -282,7 +281,6 @@
$status and print("ERROR: ffgpv_ status = $status\n"), goto ERRSTATUS;
$anynull or print "ERROR: ffgpv_ did not detect null values\n";
-$ii;
for ($ii=3;$ii<$npixels;$ii+=4) {
$boutarray->[$ii] = 99;
$ioutarray->[$ii] = 99;
@@ -317,7 +315,6 @@
@{$dinarray} = map(0.0,(0..$npixels-1));
$anynull = 0;
-$larray;
fits_read_imgnull_byt($fptr,1,1,10,$binarray,$larray,$anynull,$status);
fits_read_imgnull_byt($fptr,1,11,10,$tmp1,$tmp2,$anynull,$status);
@{$binarray}[10..$npixels-1] = @{$tmp1};
Modified: trunk/libastro-fits-cfitsio-perl/testprog/testprog_pdl.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/testprog/testprog_pdl.pl?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/testprog/testprog_pdl.pl (original)
+++ trunk/libastro-fits-cfitsio-perl/testprog/testprog_pdl.pl Sun Feb 27 18:18:27 2011
@@ -4,8 +4,21 @@
use blib;
use Astro::FITS::CFITSIO qw( :longnames :constants );
use PDL;
+use PDL::Core qw( howbig ); # for building the type translation table
Astro::FITS::CFITSIO::PerlyUnpacking(0);
+
+my %types = type_table();
+
+# bug in PDL (error with pdl(longlong, [1,2,3]) even though all other
+# types are fine with this sytax) forces us to use a workaround
+# whereby we first copy the hash elements to scalar and then use those
+# scalars as methods
+
+my $tbyte = $types{TBYTE()};
+my $tshort = $types{TSHORT()};
+my $tint = $types{TINT()};
+my $tlong = $types{TLONG()};
my $oskey='value_string';
my $olkey=1;
@@ -21,13 +34,13 @@
my $onskey = [ 'first string', 'second string', ' ' ];
my $inclist = [ 'key*', 'newikys' ];
my $exclist = [ 'key_pr*', 'key_pkls' ];
-my $onlkey = long [1,0,1]; # fits_write_key_log expects (int), though...
-my $onjkey = long [11,12,13];
+my $onlkey = pdl([1,0,1])->$tint; # fits_write_key_log expects int
+my $onjkey = pdl([11,12,13])->$tlong;
my $onfkey = float [12.121212, 13.131313, 14.141414];
my $onekey = float [13.131313, 14.141414, 15.151515];
my $ongkey = double [14.1414141414141414, 15.1515151515151515,16.1616161616161616];
my $ondkey = double [15.1515151515151515, 16.1616161616161616,17.1717171717171717];
-my $tbcol = long [1,17,28,43,56];
+my $tbcol = pdl([1,17,28,43,56])->$tlong;
my $binname = "Test-BINTABLE";
my $template = "testprog.tpt";
my $tblname = "Test-ASCII";
@@ -77,7 +90,6 @@
print "ffinit create new file status = $status\n";
$status and goto ERRSTATUS;
-$filemode;
$fptr->file_name($filename,$status);
$fptr->file_mode($filemode,$status);
print "Name of file = $filename, I/O mode = $filemode\n";
@@ -226,12 +238,12 @@
$fptr->write_key_lng('BLANK',-99,'value to use for undefined pixels',$status)
and print "BLANK keyword status = $status\n";
-$boutarray = byte [1..$npixels+1];
-$ioutarray = short [1..$npixels+1];
-$koutarray = long [1..$npixels+1];
-$joutarray = long [1..$npixels+1];
-$eoutarray = float [1..$npixels+1];
-$doutarray = double [1..$npixels+1];
+$boutarray = sequence($types{TBYTE()}, $npixels+1)+1;
+$ioutarray = sequence($types{TSHORT()}, $npixels+1)+1;
+$koutarray = sequence($types{TINT()}, $npixels+1)+1;
+$joutarray = sequence($types{TLONG()}, $npixels+1)+1;
+$eoutarray = sequence(float, $npixels+1)+1;
+$doutarray = sequence(double, $npixels+1)+1;
$fptr->write_img_byt(1,1,2,$boutarray->slice('0:1')->get_dataref,$status);
$fptr->write_img_sht(1,5,2,$ioutarray->slice('4:5')->get_dataref,$status);
@@ -257,27 +269,27 @@
print "The 1st, and every 4th pixel should be undefined:\n";
$anynull = 0;
-$binarray = zeroes($npixels)->byte;
+$binarray = zeroes($types{TBYTE()}, $npixels);
$fptr->read_img_byt(1,1,$npixels,99,${$binarray->get_dataref},$anynull,$status);
map printf(" %2d",$binarray->at($_)),(0..$npixels-1);
print " $anynull (ffgpvb)\n";
-$iinarray = zeroes($npixels)->short;
+$iinarray = zeroes($types{TSHORT()}, $npixels);
$fptr->read_img_sht(1,1,$npixels,99,${$iinarray->get_dataref},$anynull,$status);
map printf(" %2d",$iinarray->at($_)),(0..$npixels-1);
print " $anynull (ffgpvi)\n";
-$jinarray = zeroes($npixels)->long;
+$jinarray = zeroes($types{TLONG()}, $npixels);
$fptr->read_img_lng(1,1,$npixels,99,${$jinarray->get_dataref},$anynull,$status);
map printf(" %2d",$jinarray->at($_)),(0..$npixels-1);
print " $anynull (ffgpvj)\n";
-$einarray = zeroes($npixels)->float;
+$einarray = zeroes(float, $npixels);
$fptr->read_img_flt(1,1,$npixels,99,${$einarray->get_dataref},$anynull,$status);
map printf(" %2.0f",$einarray->at($_)),(0..$npixels-1);
print " $anynull (ffgpve)\n";
-$dinarray = zeroes($npixels)->double;
+$dinarray = zeroes(double, $npixels);
$fptr->read_img_dbl(1,1,$npixels,99,${$dinarray->get_dataref},$anynull,$status);
map printf(" %2.0d",$dinarray->at($_)),(0..$npixels-1);
print " $anynull (ffgpvd)\n";
@@ -285,7 +297,6 @@
$status and print("ERROR: ffgpv_ status = $status\n"), goto ERRSTATUS;
$anynull or print "ERROR: ffgpv_ did not detect null values\n";
-$ii;
for ($ii=3;$ii<$npixels;$ii+=4) {
$boutarray->set($ii,99);
$ioutarray->set($ii,99);
@@ -313,12 +324,12 @@
print "dout != din = ${\($doutarray->at($ii))} ${\($dinarray->at($ii))}\n";
}
-$binarray = zeroes($npixels)->byte;
+$binarray = zeroes($types{TBYTE()}, $npixels);
$larray = $binarray->copy;
-$iinarray = zeroes($npixels)->short;
-$jinarray = zeroes($npixels)->long;
-$einarray = zeroes($npixels)->float;
-$dinarray = zeroes($npixels)->double;
+$iinarray = zeroes($types{TSHORT()}, $npixels);
+$jinarray = zeroes($types{TLONG()}, $npixels);
+$einarray = zeroes(float, $npixels);
+$dinarray = zeroes(double, $npixels);
$anynull = 0;
@@ -1056,7 +1067,7 @@
printf "%8s %8s %8s \n", $ttype->[$ii], $tform->[$ii], $tunit->[$ii];
}
-$larray = zeroes(40)->byte;
+$larray = zeroes($types{TBYTE()}, 40);
print "\nData values read from binary table:\n";
printf " Bit column (X) data values: \n\n";
@@ -1068,15 +1079,15 @@
print " ";
}
-$larray = zeroes($nrows)->byte;
-$xinarray = zeroes($nrows)->byte;
-$binarray = zeroes($nrows)->byte;
-$iinarray = zeroes($nrows)->short;
-$kinarray = zeroes($nrows)->long;
-$einarray = zeroes($nrows)->float;
-$dinarray = zeroes($nrows)->double;
-$cinarray = zeroes($nrows*2)->float;
-$minarray = zeroes($nrows*2)->double;
+$larray = zeroes($types{TBYTE()}, $nrows);
+$xinarray = zeroes($types{TBYTE()}, $nrows);
+$binarray = zeroes($types{TBYTE()}, $nrows);
+$iinarray = zeroes($types{TSHORT()}, $nrows);
+$kinarray = zeroes($types{TINT()}, $nrows);
+$einarray = zeroes(float, $nrows);
+$dinarray = zeroes(double, $nrows);
+$cinarray = zeroes(float, $nrows*2);
+$minarray = zeroes(double, $nrows*2);
print "\n\n";
@@ -1107,12 +1118,12 @@
}
@tmp = (0..$nrows-1);
-$larray = byte \@tmp;
+$larray = pdl(\@tmp)->$tbyte;
$larray2 = $larray->copy;
-$xinarray = byte \@tmp;
-$binarray = byte \@tmp;
-$iinarray = short \@tmp;
-$kinarray = long \@tmp;
+$xinarray = pdl(\@tmp)->$tbyte;
+$binarray = pdl(\@tmp)->$tbyte;
+$iinarray = pdl(\@tmp)->$tshort;
+$kinarray = pdl(\@tmp)->$tint;
$einarray = float \@tmp;
$dinarray = double \@tmp;
@tmp = (0..2*$nrows-1);
@@ -1314,7 +1325,7 @@
# write data to columns #
############################
-$joutarray = long [0,1000,10000,32768,65535];
+$joutarray = pdl([0,1000,10000,32768,65535])->$tlong;
for ($ii=4;$ii<7;$ii++) {
$fptr->write_col_lng($ii,1,1,5,$joutarray->get_dataref,$status);
@@ -1354,7 +1365,7 @@
print "\nCreate image extension: ffiimg status = $status\n";
print "HDU number = ${\($fptr->get_hdu_num($hdunum))}\n";
-$imgarray = zeroes(19,30)->short;
+$imgarray = zeroes($types{TSHORT()}, 19,30);
for ($jj=0;$jj<30;$jj++) {
for ($ii=0;$ii<19;$ii++) {
$imgarray->set($ii,$jj, ($ii<15) ? ($jj * 10) + $ii : 0 );;
@@ -1364,7 +1375,7 @@
$fptr->write_2d_sht(1,19,$naxes->[0],$naxes->[1],$imgarray->get_dataref,$status);
print "\nWrote whole 2D array: ffp2di status = $status\n";
-$imgarray = zeroes(19,30)->short;
+$imgarray = zeroes($types{TSHORT()}, 19,30);
$fptr->read_2d_sht(1,0,19,$naxes->[0],$naxes->[1],${$imgarray->get_dataref},$anynull,$status);
print "\nRead whole 2D array: ffg2di status = $status\n";
@@ -1376,7 +1387,7 @@
print "\n";
}
-$imgarray2 = zeroes(10,20)->short;
+$imgarray2 = zeroes($types{TSHORT()}, 10,20);
for ($jj=0;$jj<20;$jj++) {
for ($ii=0;$ii<10;$ii++) {
$imgarray2->set($ii,$jj, ($jj * -10) - $ii);
@@ -1388,7 +1399,7 @@
$fptr->write_subset_sht(1,$naxis,$naxes,$fpixels,$lpixels,$imgarray2->get_dataref,$status);
print "\nWrote subset 2D array: ffpssi status = $status\n";
-$imgarray = zeroes(19,30)->short;
+$imgarray = zeroes($types{TSHORT()}, 19,30);
$fptr->read_2d_sht(1,0,19,$naxes->[0],$naxes->[1],${$imgarray->get_dataref},$anynull,$status);
print "\nRead whole 2D array: ffg2di status = $status\n";
@@ -1404,7 +1415,7 @@
$lpixels = [10,8];
$inc = [2,3];
-$imgarray = zeroes(19,30)->short;
+$imgarray = zeroes($types{TSHORT()}, 19,30);
$fptr->read_subset_sht(1,$naxis,$naxes,$fpixels,$lpixels,$inc,0,${$imgarray->get_dataref},$anynull,$status);
print "\nRead subset of 2D array: ffgsvi status = $status\n";
@@ -1486,13 +1497,13 @@
$iskey = 'abcdefghijklmnopqrst';
-$boutarray = byte [1..21];
-$ioutarray = short [1..21];
-$joutarray = long [1..21];
+$boutarray = pdl([1..21])->$tbyte;
+$ioutarray = pdl([1..21])->$tshort;
+$joutarray = pdl([1..21])->$tlong;
$eoutarray = float [1..21];
$doutarray = double [1..21];
-$larray = byte [0,1,0,0,1,1,0,0,0,1,1,1,0,0,0,0,1,1,1,1];
+$larray = pdl([0,1,0,0,1,1,0,0,0,1,1,1,0,0,0,0,1,1,1,1])->$tbyte;
$inskey=[''];
$fptr->write_col_str(1,1,1,1,$inskey,$status);
@@ -1513,7 +1524,7 @@
$fptr->write_col_null(2,$ii,$ii-1,1,$status);
$fptr->write_col_bit(3,$ii,1,$ii,$larray->get_dataref,$status);
-
+
$fptr->write_col_byt(4,$ii,1,$ii,$boutarray->get_dataref,$status);
$fptr->write_col_null(4,$ii,$ii-1,1,$status);
@@ -1550,12 +1561,12 @@
print "HDU number = ${\($fptr->get_hdu_num($hdunum))}\n";
for ($ii=1;$ii<=20;$ii++) {
- $larray = zeroes($ii)->byte;
- $boutarray = zeroes($ii)->byte;
- $ioutarray = zeroes($ii)->short;
- $joutarray = zeroes($ii)->long;
- $eoutarray = zeroes($ii)->float;
- $doutarray = zeroes($ii)->double;
+ $larray = zeroes($types{TBYTE()}, $ii);
+ $boutarray = zeroes($types{TBYTE()}, $ii);
+ $ioutarray = zeroes($types{TSHORT()}, $ii);
+ $joutarray = zeroes($types{TLONG()}, $ii);
+ $eoutarray = zeroes(float, $ii);
+ $doutarray = zeroes(double, $ii);
$fptr->read_col_str(1,$ii,1,1,$iskey,$inskey,$anynull,$status);
print "A $inskey->[0] $status\nL";
@@ -1621,10 +1632,10 @@
print "\nffcrim status = $status\n";
@tmp = map(($_*2),(0..$npixels-1));
-$boutarray = byte \@tmp;
-$ioutarray = short \@tmp;
-$koutarray = long \@tmp;
-$joutarray = long \@tmp;
+$boutarray = pdl(\@tmp)->$tbyte;
+$ioutarray = pdl(\@tmp)->$tshort;
+$koutarray = pdl(\@tmp)->$tint;
+$joutarray = pdl(\@tmp)->$tlong;
$eoutarray = float \@tmp;
$doutarray = double \@tmp;
@@ -1730,10 +1741,10 @@
$fptr->write_col(TSTRING,1,1,1,3,$onskey,$status);
@tmp = map(($_*3),(0..$npixels-1));
-$boutarray = byte \@tmp;
-$ioutarray = short \@tmp;
-$koutarray = long \@tmp;
-$joutarray = long \@tmp;
+$boutarray = pdl(\@tmp)->$tbyte;
+$ioutarray = pdl(\@tmp)->$tshort;
+$koutarray = pdl(\@tmp)->$tint;
+$joutarray = pdl(\@tmp)->$tlong;
$eoutarray = float \@tmp;
$doutarray = double \@tmp;
@@ -1888,3 +1899,29 @@
print "\nStatus = $status: $errmsg\n";
}
+
+sub type_table {
+
+ my %table;
+
+ my (@pdl_types, @cfitsio_types);
+
+ # unsigned type routines are not tested in this program, so we only
+ # need to handle the signed types
+
+ @pdl_types = (byte, short, long, longlong);
+ @cfitsio_types = ( TBYTE, TSHORT, TINT, TLONG, TLONGLONG );
+
+ CFITSIO_TYPES:
+ for my $cfitsio_type ( @cfitsio_types ) {
+ for my $ptype (@pdl_types) {
+ howbig($ptype) == Astro::FITS::CFITSIO::sizeof_datatype($cfitsio_type)
+ and $table{$cfitsio_type} = $ptype, next CFITSIO_TYPES;
+ }
+
+ die "could not find a matching PDL type for cfitsio type $cfitsio_type";
+ }
+
+ return %table;
+
+}
Modified: trunk/libastro-fits-cfitsio-perl/util.c
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libastro-fits-cfitsio-perl/util.c?rev=69963&op=diff
==============================================================================
--- trunk/libastro-fits-cfitsio-perl/util.c (original)
+++ trunk/libastro-fits-cfitsio-perl/util.c Sun Feb 27 18:18:27 2011
@@ -19,7 +19,7 @@
* Get the width of a string column in an ASCII or binary table
*/
long column_width(fitsfile * fptr, int colnum) {
- int hdutype, status=0, tfields;
+ int hdutype, status=0, tfields, dispwidth;
long repeat, size;
long start_col,end_col; /* starting and ending positions for ASCII tables */
long rowlen, nrows, *tbcol;
@@ -58,23 +58,12 @@
size = end_col - start_col;
break;
- /* Get the typechar parameter, which should be of form 'An', where
- * n is an the width of the field
- */
case BINARY_TBL:
- fits_get_bcolparms(
- fptr,colnum,NULL,NULL,typechar,&repeat,NULL,NULL,
- NULL,NULL,&status
- );
+ fits_get_col_display_width(fptr, colnum, &dispwidth, &status);
check_status(status);
- if (typechar[0] != 'A') { /* perhaps variable size? */
- fits_read_key_lng(fptr,"NAXIS2",&rowlen,NULL,&status);
- check_status(status);
- size = rowlen+1;
- }
- else
- size = repeat;
- break;
+ size = dispwidth;
+ break;
+
default:
croak("column_width() - unrecognized HDU type (%d)",hdutype);
}
More information about the Pkg-perl-cvs-commits
mailing list