#!perl
# Astro::FITS::Header test harness
# strict
use
strict;
#load test
# load modules
use
Astro::FITS::Header;
# T E S T H A R N E S S --------------------------------------------------
# test the test system
ok(1);
# read header from DATA block
my
@raw
= <DATA>;
chomp
(
@raw
);
# build header array
my
$header
= new Astro::FITS::Header(
Cards
=> \
@raw
);
# tie
my
%keywords
;
tie
%keywords
,
"Astro::FITS::Header"
,
$header
;
# fetch
my
$value
=
$keywords
{
"TELESCOP"
};
is(
"$value"
,
"UKIRT, Mauna Kea, HI"
);
# store
$keywords
{
"TELESCOP"
} =
"JCMT, Mauna Kea, HI"
;
my
@values
=
$header
->value(
"TELESCOP"
);
is(
"$values[0]"
,
"JCMT, Mauna Kea, HI"
);
# Get the comment, set a new one and retrieve it
is(
$keywords
{
"TELESCOP_COMMENT"
},
"Telescope name"
);
my
$new
=
"Not a telescope"
;
$keywords
{TELESCOP_COMMENT} =
$new
;
is(
$keywords
{TELESCOP_COMMENT},
$new
);
# store
$keywords
{
"LIFE"
} = 42;
my
@end
=
$header
->
index
(
'END'
);
my
@test
=
$header
->
index
(
'LIFE'
);
is(
$end
[0],125);
is(
$test
[0],124);
##########
# "Missing" header values
#
ok(
exists
(
$keywords
{
"MSBID"
} ) );
$value
=
$keywords
{
"MSBID"
};
is(
$value
,
undef
);
$value
=
$keywords
{
"MSBID_COMMENT"
};
is(
"$value"
,
"Unique identifier"
);
ok( !
exists
(
$keywords
{
"CSOTAU"
} ) );
$value
=
$keywords
{
"CSOTAU"
};
is(
$value
,
undef
);
$value
=
$keywords
{
"CSOTAU_COMMENT"
};
is(
"$value"
,
" / Tau at 225 GHz from CSO\n"
);
##########
# Multiline comments
#
my
$s
=
"Comment line 1\nComment line 2\nComment line 3"
;
# Store multiline comment
$keywords
{
"COMMENT"
} =
$s
;
# It doesn't make any values
@values
=
$header
->value(
"COMMENT"
);
is(
$values
[0],
undef
);
is(
$values
[1],
undef
);
is(
$values
[2],
undef
);
# The comments come out correctly in the comment method
my
@comments
=
$header
->comment(
"COMMENT"
);
my
@s
=
split
(
"\n"
,
$s
);
chomp
@s
;
is(
$comments
[0],
$s
[0] );
is(
$comments
[1],
$s
[1] );
is(
$comments
[2],
$s
[2] );
# The comments come out correctly in the tied method
is(
$s
.
"\n"
,
$keywords
{
"COMMENT"
} );
##########
# Multiline values
$s
=
"0\n1\n2"
;
my
$sr
= [0,1,2];
# Assigning with array ref yields correct string
$keywords
{
"TESTVAL"
} =
$sr
;
is(
$keywords
{
"TESTVAL"
},
$s
);
# ... and also gives the correct values
my
(
@vals
) =
$header
->value(
"TESTVAL"
);
is(
$vals
[0], 0);
is(
$vals
[1], 1);
is(
$vals
[2], 2);
# ... and also acts correctly in arithmetic expressions
{
no
warnings;
is(
$keywords
{
"TESTVAL"
} + 1, 1 );
}
# ... and also truncates OK
$keywords
{
"TESTVAL"
}++;
is(
$keywords
{
"TESTVAL"
}, 1);
##############################
# delete
delete
$keywords
{
"LIFE"
};
my
@item
=
$header
->itembyname(
"LIFE"
);
unless
(
defined
(
$item
[0])) { ok(1) }
else
{ ok(0) };
# exists
ok(
exists
$keywords
{
"SIMPLE"
});
ok(!
exists
$keywords
{
"ARGH"
});
ok(!
exists
$keywords
{
"LIFE"
});
# firstkey, nextkey
my
$line
= 0;
my
$key
;
foreach
$key
(
keys
%keywords
) {
my
@values
=
$header
->value(
$key
);
is(
$header
->keyword(
$line
),
$key
);
if
(
$key
ne
'COMMENT'
) {
# Skip [multiline] comments...
# END card is a special case -- should return ' '
if
(
$key
eq
'END'
) {
is(
' '
,
$keywords
{
$key
});
}
else
{
is(
$values
[0],
$keywords
{
$key
});
}
}
do
{
$line
+= 1;
}
until
((
$header
->keyword(
$line
)||
''
) ne
'COMMENT'
||
$key
ne
'COMMENT'
);
}
# Test array ref return
my
$hdr
=
tied
%keywords
;
# First get the string
my
$str
=
$keywords
{COMMENT};
ok(not
ref
$str
);
# Then the array
$hdr
->tiereturnsref(1);
my
$strref
=
$keywords
{COMMENT};
is(
ref
(
$strref
),
"ARRAY"
);
my
@strings
=
@$strref
;
is(
scalar
(
@strings
), 3);
# There are 4 comments
is(
join
(
''
,
@strings
),
$str
);
$hdr
->tiereturnsref(0);
# Test that we can copy in a new hash
# This test will fail in v2.4 of Astro::FITS::Header
my
$href
= \
%keywords
;
%{
$href
} = (
TELESCOP
=>
'GEMINI'
,
instrume
=>
'MICHELLE'
);
is(
$href
->{TELESCOP},
'GEMINI'
);
is(
$href
->{INSTRUME},
'MICHELLE'
);
# Test that SIMPLE and END get put at the beginning and end, respectively
is(
$href
->{SIMPLE},
undef
);
is(
$href
->{END},
undef
);
$keywords
{SIMPLE} = 0;
$keywords
{END} =
"Drop this string on the floor"
;
my
@keys
=
keys
%keywords
;
is(
$keys
[0],
'SIMPLE'
);
is(
$keys
[3],
'END'
);
is(
$keywords
{SIMPLE},0);
is(
$keywords
{END},
' '
);
#clear
undef
%keywords
;
is(
$header
->keyword(0),
undef
);
# Test the override
my
%keywords2
;
my
$header2
= new Astro::FITS::Header(
Cards
=> \
@raw
);
tie
%keywords2
,
"Astro::FITS::Header"
,
$header2
,
tiereturnsref
=> 1;
my
$value2
=
$keywords2
{COMMENT};
is(
ref
$value2
,
"ARRAY"
);
# Test comment parsing in keyword setting
$href
->{NUM} =
"3 / test"
;
is(
$href
->{NUM},3,
"Test value from auto-parse"
);
is(
$href
->{NUM_COMMENT},
'test'
,
"Test comment from auto-parse"
);
$href
->{SLASHSTR} =
"foo\\/bar / value is 'foo/bar'"
;
is(
$href
->{SLASHSTR},
'foo/bar'
,
"Test value from complex auto-parse"
);
is(
$href
->{SLASHSTR_COMMENT},
'value is \'foo/bar\''
,
"Test comment from complex auto-parse"
);
# test HISTORY handling
$keywords
{HISTORY} =
"foo"
;
$keywords
{HISTORY} .=
"bar"
;
ok(
$keywords
{HISTORY} eq
<<FOO
foo
bar
FOO
);
# Test handling of subheaders.
my
(
$header3
,
@diff3
) = Astro::FITS::Header->new(
Cards
=> [
'KEY1 = 1 / Example header '
,
'KEY2 = 2 / Example header '
,
])->merge_primary(Astro::FITS::Header->new(
Cards
=> [
'KEY1 = 1 / Example header '
,
'KEY2 = 3 / Example header '
,
]));
$header3
->subhdrs(
@diff3
);
tie
my
%keywords3
,
'Astro::FITS::Header'
,
$header3
,
tiereturnsref
=> 1;
is_deeply(\
%keywords3
, {
'KEY1'
=>
'1'
,
'SUBHEADERS'
=> [{
'KEY2'
=>
'2'
}, {
'KEY2'
=>
'3'
}],
},
'Tied hash with subheaders'
);
%keywords3
= ();
is_deeply(\
%keywords3
, {},
'Cleared tied hash is empty'
);
$keywords3
{
'KEY3'
} = 4;
is_deeply(\
%keywords3
, {
'KEY3'
=> 4,
},
'Cleared tied hash with new key'
);
# principal of least surprise.... you should get back what you put in!
#$href->{REVERSE} = "foo / bar";
#is($href->{REVERSE}, "foo / bar");
exit
;
__DATA__
SIMPLE = T / file does conform to FITS standard
BITPIX = -32 / number of bits per data pixel
NAXIS = 3 / number of data axes
NAXIS1 = 25 / length of data axis 1
NAXIS2 = 36 / length of data axis 2
NAXIS3 = 252 / length of data axis 3
EXTEND = T / FITS dataset may contain extensions
COMMENT FITS (Flexible Image Transport System) format defined in Astronomy and
COMMENT Astrophysics Supplement Series v44/p363, v44/p371, v73/p359, v73/p365.
COMMENT Contact the NASA Science Office of Standards and Technology for the
COMMENT FITS Definition document #100 and other FITS information.
CRVAL1 = -0.07249999791383749 / Axis 1 reference value
CRPIX1 = 12.5 / Axis 1 pixel value
CTYPE1 = 'a1 ' / LINEAR
CRVAL2 = -0.07249999791383743 / Axis 2 reference value
CRPIX2 = 18.0 / Axis 2 pixel value
CTYPE2 = 'a2 ' / LINEAR
CRVAL3 = 1.27557086671004E-6 / Axis 3 reference value
CRPIX3 = 126.0 / Axis 3 pixel value
CTYPE3 = 'a3 ' / LAMBDA
OBJECT = 'galaxy ' / Title of the dataset
DATE = '2000-12-13T22:44:53' / file creation date (YYYY-MM-DDThh:mm:ss UTC)
ORIGIN = 'NOAO-IRAF FITS Image Kernel July 1999' / FITS file originator
BSCALE = 1.0 / True_value = BSCALE * FITS_value + BZERO
BZERO = 0.0 / True_value = BSCALE * FITS_value + BZERO
HDUCLAS1= 'NDF ' / Starlink NDF (hierarchical n-dim format)
HDUCLAS2= 'DATA ' / Array component subclass
IRAF-TLM= '23:07:26 (27/02/2000)' / Time of last modification
TELESCOP= 'UKIRT, Mauna Kea, HI' / Telescope name
INSTRUME= 'CGS4 ' / Instrument
OBSERVER= 'SMIRF ' / Observer name(s)
OBSREF = '? ' / Observer reference
DETECTOR= 'fpa046 ' / Detector array used
OBSTYPE = 'OBJECT ' / Type of observation
INTTYPE = 'STARE+NDR' / Type of integration
MODE = 'ND_STARE' / Observing mode
GRPNUM = 0 / Number of observation group
RUN = 54 / Number of run
EXPOSED = 180 / Total exposure time for integration
OBJCLASS= 0 / Class of observed object
CD1_1 = 0.144999980926513672 / Axis rotation and scaling matrix
CD1_2 = 0.0 / Axis rotation and scaling matrix
CD1_3 = 0.0 / Axis rotation and scaling matrix
CD2_1 = 0.0 / Axis rotation and scaling matrix
CD2_2 = 0.144999980926513672 / Axis rotation and scaling matrix
CD2_3 = 0.0 / Axis rotation and scaling matrix
CD3_1 = 0.0 / Axis rotation and scaling matrix
CD3_2 = 0.0 / Axis rotation and scaling matrix
CD3_3 = 2.07933226192836E-10 / Axis rotation and scaling matrix
MEANRA = 10.34629999999999939 / Object RA at equinox (hrs)
MEANDEC = 20.1186000000000007 / Object Dec at equinox (deg)
RABASE = 10.34629999999999939 / Offset zero-point RA at equinox (hrs)
DECBASE = 20.1186000000000007 / Offset zero-point Dec at equinox (deg)
RAOFF = 0 / Offset RA at equinox (arcsec)
DECOFF = 0 / Offset Dec at equinox (arcsec)
DROWS = 178 / No of det. in readout row
DCOLUMNS= 256 / No of det. in readout column
DEPERDN = 6 / Electrons per data number
CLOCK0 = -6.20000000000000018 / ALICE CLOCK0 voltage
CLOCK1 = -3 / ALICE CLOCK1 voltage
CLOCK2 = -7.5 / ALICE CLOCK2 voltage
CLOCK3 = -2.79999999999999982 / ALICE CLOCK3 voltage
CLOCK4 = -6 / ALICE CLOCK4 voltage
CLOCK5 = -2 / ALICE CLOCK5 voltage
CLOCK6 = -7.5 / ALICE CLOCK6 voltage
VSLEW = 4 / ALICE VSLEW voltage
VDET = -3.02000000000000002 / ALICE VDET voltage
DET_BIAS= 0.57999999999999996 / ALICE DET_BIAS voltage
VDDUC = -3.60000000000000009 / ALICE VDDUC voltage
VDETGATE= -4.5 / ALICE VDETGATE voltage
VGG_A = -1.60000000000000009 / ALICE VGG_ACTIVE voltage
VGG_INA = -1.30000000000000004 / ALICE VGG_INACTIVE voltage
VDDOUT = -1 / ALICE VDDOUT voltage
V3 = -2.79999999999999982 / ALICE V3 voltage
VLCLR = -3 / ALICE VLCLR voltage
VLD_A = 4 / ALICE VLOAD_ACTIVE voltage
VLD_INA = 4 / ALICE VLOAD_INACTIVE voltage
WFREQ = 1 / ALICE waveform state freq. (MHz)
RESET_DL= 0.200000000000000011 / NDR reset delay (seconds)
CHOP_DEL= 0.029999998999999999 / Chop delay (seconds)
READ_INT= 5 / NDR read interval (seconds)
NEXP_PH = 0 / Exposures in each chop phase
DEXPTIME= 180 / Exposure time (seconds)
RDOUT_X1= 1 / Start column of array readout
RDOUT_X2= 256 / End column of array readout
RDOUT_Y1= 45 / Start row of array readout
RDOUT_Y2= 222 / End row of array readout
CHOPDIFF= T / Main-offset beam value stored
IF_SHARP= F / Shift & add disabled
LINEAR = F / Linearisation disabled
FILTER = 'B1 ' / Combined filter name
FILTERS = 'B1 ' / Combined filter name
DETINCR = 1 / Increment (pixels) betw scan positions
DETNINCR= 2 / Number of scan positions in scan
WPLANGLE= 0 / IRPOL waveplate angle
SANGLE = -2.19303900000000018 / Angle of slit
SLIT = '0ew ' / Name of slit
SLENGTH = 18 / Length of slit
SWIDTH = 4 / Width of slit
DENCBASE= 800 / Zeropoint (steps) of detector translation
DFOCUS = 1.819309999999999983 / Detector focus position
GRATING = '150_lpmm' / Name of grating
GLAMBDA = 1.274947000000000052 / Grating wavelength
GANGLE = 17.09262000000000015 / Grating wavelength
GORDER = 3 / Grating order
GDISP = 0.00020796522 / Grating dispersion
CNFINDEX= 75488 / Index increments when h/w config changes
CVF = 'open ' / Name of CVF
CLAMBDA = 0 / CVF wavelength
IRTANGLE= 6.396519999999999762 / Image rotator angle
LAMP = 'off ' / Name of calibration lamp
BBTEMP = 0 / Black body temperature
CALAPER = 0 / Aperture of tungsten-halogen lamp (%)
THLEVEL = 0 / Level of tungsten-halogen lamp
IDATE = 19980217 / Date as integer
OBSNUM = 54 / Number of observation
NEXP = 1 / Exposures in integration
AMSTART = 1.334643999999999942 / Airmass at start of obs
AMEND = 1.320149999999999935 / Airmass at end of obs
RUTSTART= 8.000171999999999173 / Start time of obs (hrs)
RUTEND = 8.101883000000000834 / End time of obs (hrs)
NBADPIX = 32
MSBID = / Unique identifier
CSOTAU / Tau at 225 GHz from CSO
END