File Coverage

blib/lib/Astro/FITS/HdrTrans/CGS4Old.pm
Criterion Covered Total %
statement 77 89 86.5
branch 17 40 42.5
condition 34 70 48.5
subroutine 15 15 100.0
pod 9 9 100.0
total 152 223 68.1


line stmt bran cond sub pod time code
1             package Astro::FITS::HdrTrans::CGS4Old;
2              
3             =head1 NAME
4              
5             Astro::FITS::HdrTrans::CGS4 - UKIRT CGS4 translations for "old" style
6             CGS4 headers.
7              
8             =head1 SYNOPSIS
9              
10             use Astro::FITS::HdrTrans::CGS4Old;
11              
12             %gen = Astro::FITS::HdrTrans::CGS4Old->translate_from_FITS( %hdr );
13              
14             =head1 DESCRIPTION
15              
16             This class provides a generic set of translations that are specific
17             to the CGS4 spectrometer of the United Kingdom Infrared Telescope.
18              
19             =cut
20              
21 10     10   38012033 use 5.006;
  10         43  
22 10     10   57 use warnings;
  10         26  
  10         382  
23 10     10   58 use strict;
  10         30  
  10         277  
24 10     10   79 use Carp;
  10         30  
  10         889  
25              
26             # Inherit from UKIRT "Old"
27 10     10   76 use base qw/ Astro::FITS::HdrTrans::UKIRTOld /;
  10         20  
  10         1791  
28              
29 10     10   68 use vars qw/ $VERSION /;
  10         22  
  10         10408  
30              
31             $VERSION = "1.64";
32              
33             # for a constant mapping, there is no FITS header, just a generic
34             # header that is constant
35             my %CONST_MAP = (
36              
37             );
38              
39             # unit mapping implies that the value propogates directly
40             # to the output with only a keyword name change
41              
42             my %UNIT_MAP = (
43             # CGS4 Specific
44             GRATING_DISPERSION => "GDISP",
45             GRATING_NAME => "GRATING",
46             GRATING_ORDER => "GORDER",
47             GRATING_WAVELENGTH => "GLAMBDA",
48             SLIT_ANGLE => "SANGLE",
49             SLIT_NAME => "SLIT",
50             SLIT_WIDTH => "SWIDTH",
51             # MICHELLE compatible
52             NSCAN_POSITIONS => "DETNINCR",
53             SCAN_INCREMENT => "DETINCR",
54             # MICHELLE + UIST + WFCAM
55             CONFIGURATION_INDEX => 'CNFINDEX',
56             );
57              
58              
59             # Create the translation methods
60             __PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP );
61              
62             # Im
63              
64             =head1 METHODS
65              
66             =over 4
67              
68             =item B<can_translate>
69              
70             Returns true if the supplied headers can be handled by this class.
71              
72             $cando = $class->can_translate( \%hdrs );
73              
74             This method returns true if the INSTRUME header exists and is equal to
75             'CGS4', and if the IDATE header exists, matches the regular
76             expression '\d{8}', and is less than 20081115.
77              
78             It also handles the reverse (to FITS) case where the INSTRUMENT header
79             replaces INSTRUME, and UTDATE replaces IDATE in the above tests.
80              
81             =cut
82              
83             sub can_translate {
84 22     22 1 69 my $self = shift;
85 22         56 my $headers = shift;
86              
87 22 100 66     156 if ( exists $headers->{IDATE} &&
      66        
      33        
      33        
      33        
      33        
      66        
88             defined $headers->{IDATE} &&
89             $headers->{IDATE} =~ /\d{8}/ &&
90             $headers->{IDATE} < 20081115 &&
91             exists $headers->{INSTRUME} &&
92             defined $headers->{INSTRUME} &&
93             ! exists $headers->{RAJ2000} &&
94             uc( $headers->{INSTRUME} ) eq 'CGS4' ) {
95 2         807 return 1;
96             }
97              
98             # Need to handle the reverse case as well. This module can translate
99             # CGS4 headers older than 20081115. Note that the translations mean
100             # different header names are tested.
101 20 50 66     1174 if ( exists $headers->{UTDATE} &&
      100        
      100        
      100        
      66        
      66        
102             defined $headers->{UTDATE} &&
103             $headers->{UTDATE} =~ /\d{8}/ &&
104             $headers->{UTDATE} < 20081115 &&
105             exists $headers->{INSTRUMENT} &&
106             defined $headers->{INSTRUMENT} &&
107             uc( $headers->{INSTRUMENT} ) eq 'CGS4' ) {
108 2         13 return 1;
109             }
110              
111 18         3054 return 0;
112             }
113              
114             =back
115              
116             =head1 COMPLEX CONVERSIONS
117              
118             These methods are more complicated than a simple mapping. We have to
119             provide both from- and to-FITS conversions All these routines are
120             methods and the to_ routines all take a reference to a hash and return
121             the translated value (a many-to-one mapping) The from_ methods take a
122             reference to a generic hash and return a translated hash (sometimes
123             these are many-to-many)
124              
125             =over 4
126              
127             =item B<to_POLARIMETRY>
128              
129             Checks the C<FILTER> FITS header keyword for the existance of
130             'prism'. If 'prism' is found, then the C<POLARIMETRY> generic
131             header is set to 1, otherwise 0.
132              
133             =cut
134              
135             sub to_POLARIMETRY {
136 2     2 1 6 my $self = shift;
137 2         6 my $FITS_headers = shift;
138 2         4 my $return;
139 2 50       8 if (exists($FITS_headers->{FILTER})) {
140 2 50       68 $return = ( $FITS_headers->{FILTER} =~ /prism/i ? 1 : 0);
141             }
142 2         136 return $return;
143             }
144              
145             =item B<to_DEC_TELESCOPE_OFFSET>
146              
147             The header keyword for the Dec telescope offset changed from DECOFF to
148             TDECOFF on 20050315, so switch on this date to use the proper header.
149              
150             =cut
151              
152             sub to_DEC_TELESCOPE_OFFSET {
153 2     2 1 6 my $self = shift;
154 2         5 my $FITS_headers = shift;
155 2         4 my $return;
156 2 50 33     8 if ( exists( $FITS_headers->{IDATE} ) && defined( $FITS_headers->{IDATE} ) ) {
157 2 50       188 if ( $FITS_headers->{IDATE} < 20050315 ) {
158 2         134 $return = $FITS_headers->{DECOFF};
159             } else {
160 0         0 $return = $FITS_headers->{TDECOFF};
161             }
162             }
163 2         130 return $return;
164             }
165              
166             =item B<from_DEC_TELESCOPE_OFFSET>
167              
168             The header keyword for the Dec telescope offset changed from DECOFF to
169             TDECOFF on 20050315, so return the proper keyword depending on observation
170             date.
171              
172             =cut
173              
174             sub from_DEC_TELESCOPE_OFFSET {
175 2     2 1 6 my $self = shift;
176 2         5 my $generic_headers = shift;
177 2         13 my %return;
178 2 50 33     30 if ( exists( $generic_headers->{UTDATE} ) &&
179             defined( $generic_headers->{UTDATE} ) ) {
180 2         7 my $ut = $generic_headers->{UTDATE};
181 2 50 33     14 if ( exists( $generic_headers->{DEC_TELESCOPE_OFFSET} ) &&
182             defined( $generic_headers->{DEC_TELESCOPE_OFFSET} ) ) {
183 2 50       8 if ( $ut < 20050315 ) {
184 2         7 $return{'DECOFF'} = $generic_headers->{DEC_TELESCOPE_OFFSET};
185             } else {
186 0         0 $return{'TDECOFF'} = $generic_headers->{DEC_TELESCOPE_OFFSET};
187             }
188             }
189             } else {
190 0 0 0     0 if ( exists( $generic_headers->{DEC_TELESCOPE_OFFSET} ) &&
191             defined( $generic_headers->{DEC_TELESCOPE_OFFSET} ) ) {
192 0         0 $return{'TDECOFF'} = $generic_headers->{DEC_TELESCOPE_OFFSET};
193             }
194             }
195 2         31 return %return;
196             }
197              
198             =item B<to_RA_TELESCOPE_OFFSET>
199              
200             The header keyword for the RA telescope offset changed from RAOFF to
201             TRAOFF on 20050315, so switch on this date to use the proper header.
202              
203             =cut
204              
205             sub to_RA_TELESCOPE_OFFSET {
206 2     2 1 6 my $self = shift;
207 2         5 my $FITS_headers = shift;
208 2         5 my $return;
209 2 50 33     8 if ( exists( $FITS_headers->{IDATE} ) && defined( $FITS_headers->{IDATE} ) ) {
210 2 50       203 if ( $FITS_headers->{IDATE} < 20050315 ) {
211 2         131 $return = $FITS_headers->{RAOFF};
212             } else {
213 0         0 $return = $FITS_headers->{TRAOFF};
214             }
215             }
216 2         134 return $return;
217             }
218              
219             =item B<from_RA_TELESCOPE_OFFSET>
220              
221             The header keyword for the RA telescope offset changed from RAOFF to
222             TRAOFF on 20050315, so return the proper keyword depending on observation
223             date.
224              
225             =cut
226              
227             sub from_RA_TELESCOPE_OFFSET {
228 2     2 1 6 my $self = shift;
229 2         4 my $generic_headers = shift;
230 2         5 my %return;
231 2 50 33     14 if ( exists( $generic_headers->{UTDATE} ) &&
232             defined( $generic_headers->{UTDATE} ) ) {
233 2         7 my $ut = $generic_headers->{UTDATE};
234 2 50 33     31 if ( exists( $generic_headers->{RA_TELESCOPE_OFFSET} ) &&
235             defined( $generic_headers->{RA_TELESCOPE_OFFSET} ) ) {
236 2 50       10 if ( $ut < 20050315 ) {
237 2         14 $return{'RAOFF'} = $generic_headers->{RA_TELESCOPE_OFFSET};
238             } else {
239 0         0 $return{'TRAOFF'} = $generic_headers->{RA_TELESCOPE_OFFSET};
240             }
241             }
242             } else {
243 0 0 0     0 if ( exists( $generic_headers->{RA_TELESCOPE_OFFSET} ) &&
244             defined( $generic_headers->{RA_TELESCOPE_OFFSET} ) ) {
245 0         0 $return{'TRAOFF'} = $generic_headers->{RA_TELESCOPE_OFFSET};
246             }
247             }
248 2         33 return %return;
249             }
250              
251             =item B<to_DETECTOR_READ_TYPE>
252              
253             Should be the "MODE" header but if this is missing we can look
254             at INTTYPE instead.
255              
256             =cut
257              
258             sub to_DETECTOR_READ_TYPE {
259 2     2 1 6 my $self = shift;
260 2         4 my $FITS_headers = shift;
261              
262 2         13 my %mode = (
263             CHOP => 'CHOP',
264             'STARE+NDR' => 'ND_STARE',
265             STARE => 'STARE',
266             );
267              
268 2 50       7 if (exists $FITS_headers->{'MODE'}) {
    0          
269 2         58 return $FITS_headers->{'MODE'};
270             }
271             elsif (exists $FITS_headers->{'INTTYPE'}) {
272 0         0 my $inttype = $FITS_headers->{'INTTYPE'};
273 0 0       0 if (exists $mode{$inttype}) {
274 0         0 return $mode{$inttype};
275             }
276             }
277              
278 0         0 return undef;
279             }
280              
281             =item B<to_SAMPLING>
282              
283             Converts FITS header values in C<DETINCR> and C<DETNINCR> to a single
284             descriptive string.
285              
286             =cut
287              
288             sub to_SAMPLING {
289 2     2 1 5 my $self = shift;
290 2         5 my $FITS_headers = shift;
291 2         5 my $return;
292 2 50 33     8 if (exists($FITS_headers->{DETINCR}) && exists($FITS_headers->{DETNINCR})) {
293 2   50     108 my $detincr = $FITS_headers->{DETINCR} || 1;
294 2   50     135 my $detnincr = $FITS_headers->{DETNINCR} || 1;
295 2         146 $return = int ( 1 / $detincr ) . 'x' . int ( $detincr * $detnincr );
296             }
297 2         8 return $return;
298             }
299              
300             =item B<from_TELESCOPE>
301              
302             Returns 'UKIRT, Mauna Kea, HI' for the C<TELESCOP> FITS header.
303              
304             =cut
305              
306             sub from_TELESCOPE {
307 2     2 1 9 my %return = ( "TELESCOP", "UKIRT, Mauna Kea, HI" );
308 2         29 return %return;
309             }
310              
311             =back
312              
313             =head1 SEE ALSO
314              
315             C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::UKIRT>.
316              
317             =head1 AUTHOR
318              
319             Brad Cavanagh E<lt>b.cavanagh@jach.hawaii.eduE<gt>,
320             Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>.
321              
322             =head1 COPYRIGHT
323              
324             Copyright (C) 2003-2005 Particle Physics and Astronomy Research Council.
325             All Rights Reserved.
326              
327             This program is free software; you can redistribute it and/or modify it under
328             the terms of the GNU General Public License as published by the Free Software
329             Foundation; either version 2 of the License, or (at your option) any later
330             version.
331              
332             This program is distributed in the hope that it will be useful,but WITHOUT ANY
333             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
334             PARTICULAR PURPOSE. See the GNU General Public License for more details.
335              
336             You should have received a copy of the GNU General Public License along with
337             this program; if not, write to the Free Software Foundation, Inc., 59 Temple
338             Place,Suite 330, Boston, MA 02111-1307, USA
339              
340             =cut
341              
342             1;