File Coverage

blib/lib/Astro/FITS/HdrTrans/GEMINI.pm
Criterion Covered Total %
statement 23 137 16.7
branch 0 42 0.0
condition 0 18 0.0
subroutine 8 24 33.3
pod 5 16 31.2
total 36 237 15.1


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Astro::FITS::HdrTrans::GEMINI - Base class for translation of Gemini instruments
5              
6             =head1 SYNOPSIS
7              
8             use Astro::FITS::HdrTrans::GEMINI;
9              
10             =head1 DESCRIPTION
11              
12             This class provides a generic set of translations that are common to
13             instrumentation from the Gemini Observatory. It should not be used
14             directly for translation of instrument FITS headers.
15              
16             =cut
17              
18             use 5.006;
19 12     12   5223972 use warnings;
  12         31  
20 12     12   73 use strict;
  12         32  
  12         300  
21 12     12   113 use Carp;
  12         27  
  12         225  
22 12     12   49  
  12         35  
  12         703  
23             # Inherit from the Base translation class and not HdrTrans itself
24             # (which is just a class-less wrapper).
25              
26             use base qw/ Astro::FITS::HdrTrans::FITS /;
27 12     12   91  
  12         24  
  12         2097  
28             use Scalar::Util qw/ looks_like_number /;
29 12     12   66 use Astro::FITS::HdrTrans::FITS;
  12         20  
  12         510  
30 12     12   66  
  12         25  
  12         62  
31             use vars qw/ $VERSION /;
32 12     12   61  
  12         27  
  12         11717  
33             $VERSION = "1.65";
34              
35             # in each class we have three sets of data.
36             # - constant mappings
37             # - unit mappings
38             # - complex mappings
39              
40             # for a constant mapping, there is no FITS header, just a generic
41             # header that is constant
42             my %CONST_MAP = (
43             );
44              
45             # unit mapping implies that the value propogates directly
46             # to the output with only a keyword name change
47              
48             my %UNIT_MAP = (
49             AIRMASS_END => "AMEND",
50             AIRMASS_START => "AMSTART",
51             DEC_BASE => "CRVAL2",
52             EXPOSURE_TIME => "EXPTIME",
53             EQUINOX => "EQUINOX",
54             INSTRUMENT => "INSTRUME",
55             NUMBER_OF_EXPOSURES => "NSUBEXP",
56             NUMBER_OF_EXPOSURES => "COADDS",
57             OBJECT => "OBJECT",
58             X_REFERENCE_PIXEL => "CRPIX1",
59             Y_REFERENCE_PIXEL => "CRPIX2"
60             );
61              
62             # Create the translation methods
63             __PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP );
64              
65             =head1 COMPLEX CONVERSIONS
66              
67             These methods are more complicated than a simple mapping. We have to
68             provide both from- and to-FITS conversions All these routines are
69             methods and the to_ routines all take a reference to a hash and return
70             the translated value (a many-to-one mapping) The from_ methods take a
71             reference to a generic hash and return a translated hash (sometimes
72             these are many-to-many)
73              
74             =over 4
75              
76             =cut
77              
78             # Note use list context as there are multiple CD matrices in
79             # the header. We want scalar context.
80             my $self = shift;
81             my $FITS_headers = shift;
82 0     0 0   my $cd11 = $FITS_headers->{"CD1_1"};
83 0           my $cd12 = $FITS_headers->{"CD1_2"};
84 0           my $cd21 = $FITS_headers->{"CD2_1"};
85 0           my $cd22 = $FITS_headers->{"CD2_2"};
86 0           my $sgn;
87 0           if ( ( $cd11 * $cd22 - $cd12 * $cd21 ) < 0 ) {
88 0           $sgn = -1;
89 0 0         } else {
90 0           $sgn = 1;
91             }
92 0           abs( sqrt( $cd11**2 + $cd21**2 ) );
93             }
94 0            
95             my $self = shift;
96             my $FITS_headers = shift;
97              
98 0     0 0   # It's simple when there's a header.
99 0           my $offset = $FITS_headers->{ "DECOFFSE" };
100              
101             # Otherwise for older data have to derive an offset from the source
102 0           # position and the frame position. This does assume that the
103             # reference pixel is unchanged in the group. The other headers
104             # are measured in degrees, but the offsets are in arceseconds.
105             if ( !defined( $offset ) ) {
106             my $decbase = $FITS_headers->{ "CRVAL2" } ;
107             my $dec = $FITS_headers->{ "DEC" };
108 0 0         if ( defined( $decbase ) && defined( $dec ) ) {
109 0           $offset = 3600.0 * ( $dec - $decbase );
110 0           } else {
111 0 0 0       $offset = 0.0;
112 0           }
113             }
114 0           return $offset;
115             }
116              
117 0           my $self = shift;
118             my $generic_headers = shift;
119             "DECOFFSE", $generic_headers->{ "DEC_TELESCOPE_OFFSET" };
120             }
121 0     0 0    
122 0           my $self = shift;
123 0           my $FITS_headers = shift;
124             my $filter = "";
125             my $filter1 = $FITS_headers->{ "FILTER1" };
126             my $filter2 = $FITS_headers->{ "FILTER2" };
127 0     0 0   my $filter3 = $FITS_headers->{ "FILTER3" };
128 0            
129 0           if ( $filter1 =~ "open" ) {
130 0           $filter = $filter2;
131 0           }
132 0            
133             if ( $filter2 =~ "open" ) {
134 0 0         $filter = $filter1;
135 0           }
136              
137             if ( ( $filter1 =~ "blank" ) ||
138 0 0         ( $filter2 =~ "blank" ) ||
139 0           ( $filter3 =~ "blank" ) ) {
140             $filter = "blank";
141             }
142 0 0 0       return $filter;
      0        
143             }
144              
145 0           my $self = shift;
146             my $FITS_headers = shift;
147 0           my $type = $FITS_headers->{ "OBSTYPE" };
148             if ( $type eq "SCI" || $type eq "OBJECT-OBS" ) {
149             $type = "OBJECT";
150             }
151 0     0 0   return $type;
152 0           }
153 0            
154 0 0 0       my $self = shift;
155 0           my $FITS_headers = shift;
156             my $ra = 0.0;
157 0           if ( exists ( $FITS_headers->{CRVAL1} ) ) {
158             $ra = $FITS_headers->{CRVAL1};
159             }
160             $ra = defined( $ra ) ? $ra: 0.0;
161 0     0 0   return $ra;
162 0           }
163 0            
164 0 0         my $self = shift;
165 0           my $FITS_headers = shift;
166             my $cd12 = $FITS_headers->{"CD1_2"};
167 0 0         my $cd22 = $FITS_headers->{"CD2_2"};
168 0           sqrt( $cd12**2 + $cd22**2 );
169             }
170              
171             my $self = shift;
172 0     0 0   my $FITS_headers = shift;
173 0            
174 0           # It's simple when there's a header.
175 0           my $offset = $FITS_headers->{ "RAOFFSET" };
176 0            
177             # Otherwise for older data have to derive an offset from the source
178             # position and the frame position. This does assume that the
179             # reference pixel is unchanged in the group. The other headers
180 0     0 0   # are measured in degrees, but the offsets are in arceseconds.
181 0           if ( !defined( $offset ) ) {
182             my $rabase = $FITS_headers->{ "CRVAL1" };
183             my $ra = $FITS_headers->{ "RA" };
184 0           my $dec = $FITS_headers->{ "DEC" };
185             if ( defined( $rabase ) && defined( $ra ) && defined( $dec ) ) {
186             $offset = 3600* ( $ra - $rabase ) * cosdeg( $dec );
187             } else {
188             $offset = 0.0;
189             }
190 0 0         }
191 0           return $offset;
192 0           }
193 0            
194 0 0 0       my $self = shift;
      0        
195 0           my $generic_headers = shift;
196             "RAOFFSE", $generic_headers->{ "RA_TELESCOPE_OFFSET" };
197 0           }
198              
199             my $self = shift;
200 0           my $FITS_headers = shift;
201             my $return;
202             if (exists $FITS_headers->{'DATE-OBS'}) {
203             my $iso;
204 0     0 0   if ( $FITS_headers->{'DATE-OBS'} =~ /T/ ) {
205 0           # standard format
206 0           $iso = $FITS_headers->{'DATE-OBS'};
207             } elsif ( exists $FITS_headers->{UTSTART} ) {
208             $iso = $FITS_headers->{'DATE-OBS'}. "T" . $FITS_headers->{UTSTART};
209             } elsif ( exists $FITS_headers->{UT} ) {
210 0     0 1   $iso = $FITS_headers->{'DATE-OBS'}. "T" . $FITS_headers->{UT};
211 0           }
212 0           $return = $self->_parse_iso_date( $iso ) if $iso;
213 0 0         }
214 0           return $return;
215 0 0         }
    0          
    0          
216              
217 0           my $self = shift;
218             my $FITS_headers = shift;
219 0           my $return;
220             if ( exists $FITS_headers->{'DATE-END'} ) {
221 0           $return = $self->_parse_iso_date( $FITS_headers->{'DATE-END'} );
222             } elsif (exists $FITS_headers->{'DATE-OBS'}) {
223 0 0         my $iso;
224             my $ut;
225 0           if ( $FITS_headers->{'DATE-OBS'} =~ /T/ ) {
226             $ut = $FITS_headers->{'DATE-OBS'};
227             $ut =~ s/T.*$//;
228             } else {
229 0     0 1   $ut = $FITS_headers->{'DATE-OBS'};
230 0           }
231 0           if (exists $FITS_headers->{UTEND}) {
232 0 0         $iso = $ut. "T" . $FITS_headers->{UTEND};
    0          
233 0           }
234             $return = $self->_parse_iso_date( $iso ) if $iso;
235 0           }
236             return $return;
237 0 0         }
238 0            
239 0            
240             my $self = shift;
241 0           my $FITS_headers = shift;
242             return $self->get_UT_date( $FITS_headers );
243 0 0         }
244 0            
245             my $self = shift;
246 0 0         my $generic_headers = shift;
247             my $utend = $generic_headers->{UTEND}->strptime( '%T' );
248 0           return ( "UTEND"=> $utend );
249             }
250              
251             my $self = shift;
252             my $generic_headers = shift;
253 0     0 1   my $utstart = $generic_headers->{UTSTART}->strptime('%T');
254 0           return ( "UTSTART"=> $utstart );
255 0           }
256              
257             my $self = shift;
258             my $generic_headers = shift;
259 0     0 1   my $ymd = $generic_headers->{UTDATE};
260 0           my $dobs = substr( $ymd, 0, 4 ) . "-" . substr( $ymd, 4, 2 ) ."-" . substr( $ymd, 6, 2 );
261 0           return ( "DATE-OBS"=>$dobs );
262 0           }
263              
264             # Supplementary methods for the translations
265             # ------------------------------------------
266 0     0 1    
267 0           # Returns the UT date in YYYYMMDD format.
268 0           my $self = shift;
269 0           my $FITS_headers = shift;
270              
271             # This is UT start and time.
272             my $dateobs = $FITS_headers->{"DATE-OBS"};
273 0     0 0    
274 0           # Extract out the data in yyyymmdd format.
275 0           return substr( $dateobs, 0, 4 ) . substr( $dateobs, 5, 2 ) . substr( $dateobs, 8, 2 );
276 0           }
277 0            
278             =back
279              
280             =head1 SEE ALSO
281              
282             C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::Base>.
283              
284             =head1 AUTHOR
285 0     0 0    
286 0           Paul Hirst <p.hirst@jach.hawaii.edu>
287             Malcolm J. Currie <mjc@star.rl.ac.uk>
288             Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
289 0            
290             =head1 COPYRIGHT
291              
292 0           Copyright (C) 2007-2008 Science and Technology Facilities Council.
293             Copyright (C) 2006-2007 Particle Physics and Astronomy Research Council.
294             All Rights Reserved.
295              
296             This program is free software; you can redistribute it and/or modify
297             it under the terms of the GNU General Public License as published by
298             the Free Software Foundation; either Version 2 of the License, or (at
299             your option) any later version.
300              
301             This program is distributed in the hope that it will be useful,but
302             WITHOUT ANY WARRANTY; without even the implied warranty of
303             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
304             General Public License for more details.
305              
306             You should have received a copy of the GNU General Public License
307             along with this program; if not, write to the Free Software
308             Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307,
309             USA.
310              
311             =cut
312              
313             1;