File Coverage

blib/lib/Astro/FITS/HdrTrans/ClassicCam.pm
Criterion Covered Total %
statement 21 199 10.5
branch 1 62 1.6
condition 2 15 13.3
subroutine 7 33 21.2
pod 27 27 100.0
total 58 336 17.2


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Astro::FITS::HdrTrans::ClassicCam - Magellan ClassicCam translations
5              
6             =head1 SYNOPSIS
7              
8             use Astro::FITS::HdrTrans::ClassicCam;
9              
10             %gen = Astro::FITS::HdrTrans::ClassicCam->translate_from_FITS( %hdr );
11              
12             =head1 DESCRIPTION
13              
14             This class provides a generic set of translations that are specific to
15             Magellan ClassicCam observations.
16              
17             =cut
18              
19             use 5.006;
20 10     10   177143 use warnings;
  10         30  
21 10     10   47 use strict;
  10         19  
  10         257  
22 10     10   39 use Carp;
  10         18  
  10         204  
23 10     10   39  
  10         25  
  10         619  
24             # Inherit from FITS.
25             use base qw/ Astro::FITS::HdrTrans::FITS /;
26 10     10   56  
  10         24  
  10         1344  
27             use vars qw/ $VERSION /;
28 10     10   55  
  10         18  
  10         15496  
29             $VERSION = "1.65";
30              
31             # For a constant mapping, there is no FITS header, just a generic
32             # header that is constant.
33             my %CONST_MAP = (
34             DETECTOR_READ_TYPE => "NDSTARE",
35             GAIN => 7.5,
36             INSTRUMENT => "ClassicCam",
37             NSCAN_POSITIONS => 1,
38             NUMBER_OF_EXPOSURES => 1,
39             OBSERVATION_MODE => 'imaging',
40             ROTATION => 0, # assume good alignment for now
41             );
42              
43             # NULL mappings used to override base-class implementations
44             my @NULL_MAP = qw/ /;
45              
46             # Unit mapping implies that the value propogates directly
47             # to the output with only a keyword name change.
48             my %UNIT_MAP = (
49             AIRMASS_END => "AIRMASS",
50             DEC_TELESCOPE_OFFSET => "DSECS",
51             EQUINOX => "EQUINOX",
52             EXPOSURE_TIME => "EXPTIME",
53             FILTER => "FILTER",
54             OBJECT => "OBJECT",
55             OBSERVATION_NUMBER => "IRPICNO",
56             RA_TELESCOPE_OFFSET => "ASECS",
57             SPEED_GAIN => "SPEED",
58             X_DIM => "NAXIS1",
59             Y_DIM => "NAXIS2"
60             );
61              
62              
63             # Create the translation methods.
64             __PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP, \@NULL_MAP );
65              
66             =head1 METHODS
67              
68             =over 4
69              
70             =item B<this_instrument>
71              
72             The name of the instrument required to match (case insensitively)
73             against the C<CHIP> keyword to allow this class to translate the
74             specified headers. Called by the default C<can_translate> method.
75              
76             $inst = $class->this_instrument();
77              
78             Returns "ClassicCam".
79              
80             =cut
81              
82             return qr/^ClassicCam/i;
83             }
84 0     0 1 0  
85             =item B<can_translate>
86              
87             Returns true if the supplied headers can be handled by this class.
88              
89             $cando = $class->can_translate( \%hdrs );
90              
91             For this class, in the absence of an C<INSTRUME> keyword, the method
92             will return true if the C<CHIP> header exists and matches 'C-CAM'.
93             It is not clear how robust this is, or over what range of epochs this
94             keyword was written.
95              
96             =cut
97              
98             my $self = shift;
99             my $headers = shift;
100              
101 20     20 1 49 if ( exists $headers->{CHIP} &&
102 20         51 defined $headers->{CHIP} &&
103             $headers->{CHIP} =~ /^C-CAM/i ) {
104 20 50 33     95 return 1;
      33        
105             } else {
106             return 0;
107 0         0 }
108             }
109 20         376  
110             =back
111              
112             =head1 COMPLEX CONVERSIONS
113              
114             These methods are more complicated than a simple mapping. We have to
115             provide both from- and to-FITS conversions. All these routines are
116             methods and the to_ routines all take a reference to a hash and return
117             the translated value (a many-to-one mapping). The from_ methods take a
118             reference to a generic hash and return a translated hash (sometimes
119             these are many-to-many).
120              
121             =over 4
122              
123             =item B<to_AIRMASS_START>
124              
125             Sets a default airmass at the start of the observation if the C<AIRMASS>
126             keyword is not defined.
127              
128             =cut
129              
130             my $self = shift;
131             my $FITS_headers = shift;
132             my $airmass = 1.0;
133             if ( defined( $FITS_headers->{AIRMASS} ) ) {
134 0     0 1   $airmass = $FITS_headers->{AIRMASS};
135 0           }
136 0           return $airmass;
137 0 0         }
138 0            
139             =item B<to_DEC_BASE>
140 0            
141             Converts the base declination from sexagesimal d:m:s to decimal
142             degrees using the C<DEC> keyword, defaulting to 0.0.
143              
144             =cut
145              
146             my $self = shift;
147             my $FITS_headers = shift;
148             my $dec = 0.0;
149             my $sexa = $FITS_headers->{"DEC"};
150             if ( defined( $sexa ) ) {
151 0     0 1   $dec = $self->dms_to_degrees( $sexa );
152 0           }
153 0           return $dec;
154 0           }
155 0 0          
156 0           =item B<to_DEC_SCALE>
157              
158 0           Sets the declination scale in arcseconds per pixel. It has a
159             fixed absolute value of 0.115 arcsec/pixel, but its sign depends on
160             the declination. The scale increases with pixel index, i.e. has north
161             to the top, for declinations south of -29 degrees. It is flipped
162             north of -29 degrees. The default scale assumes north is up.
163              
164             =cut
165              
166             my $self = shift;
167             my $FITS_headers = shift;
168             my $scale = 0.115;
169              
170             # Find the declination, converting from sexagesimal d:m:s.
171             my $sexa = $FITS_headers->{"DEC"};
172 0     0 1   if ( defined( $sexa ) ) {
173 0           my $dec = $self->dms_to_degrees( $sexa );
174 0           if ( $dec > -29 ) {
175             $scale *= -1;
176             }
177 0           }
178 0 0         return $scale;
179 0           }
180 0 0          
181 0           =item B<to_DR_RECIPE>
182              
183             Returns the data-reduction recipe name. The selection depends on the
184 0           value of the C<OBJECT> keyword. The default is "QUICK_LOOK". A dark
185             returns "REDUCE_DARK", a sky flat "SKY_FLAT_MASKED", a dome flat
186             "SKY_FLAT", and an object's recipe is "JITTER_SELF_FLAT".
187              
188             =cut
189              
190             my $self = shift;
191             my $FITS_headers = shift;
192             my $type = "OBJECT";
193             my $recipe = "QUICK_LOOK";
194             if ( defined $FITS_headers->{OBJECT} ) {
195             my $object = uc( $FITS_headers->{OBJECT} );
196             if ( $object eq "DARK" ) {
197 0     0 1   $recipe = "REDUCE_DARK";
198 0           } elsif ( $object =~ /SKY*FLAT/ ) {
199 0           $recipe = "SKY_FLAT_MASKED";
200 0           } elsif ( $object =~ /DOME*FLAT/ ) {
201 0 0         $recipe = "SKY_FLAT";
202 0           } else {
203 0 0         $recipe = "JITTER_SELF_FLAT";
    0          
    0          
204 0           }
205             }
206 0           return $recipe;
207             }
208 0            
209             =item B<to_NUMBER_OF_OFFSETS>
210 0            
211             Stores the number of offsets using the UKIRT convention, i.e. adding
212             one to the number of dither positions, and a default dither pattern of
213 0           5.
214              
215             =cut
216              
217             my $self = shift;
218             my $FITS_headers = shift;
219              
220             # Allow for the UKIRT convention of the final offset to 0,0, and a
221             # default dither pattern of 5.
222             my $noffsets = 6;
223              
224             # The number of group members appears to be given by keyword NOFFSETS.
225 0     0 1   if ( defined $FITS_headers->{NOFFSETS} ) {
226 0           $noffsets = $FITS_headers->{NOFFSETS};
227             }
228             return $noffsets;
229             }
230 0            
231             =item B<to_NUMBER_OF_READS>
232              
233 0 0         Stores the number of reads of the detector, with a default of 2, from
234 0           the sum of keywords C<REASDS_EP> and C<PRE_EP>.
235              
236 0           =cut
237              
238             my $self = shift;
239             my $FITS_headers = shift;
240             my $reads = 2;
241             if ( defined $FITS_headers->{READS_EP} && $FITS_headers->{PRE_EP} ) {
242             $reads = $FITS_headers->{READS_EP} + $FITS_headers->{PRE_EP};
243             }
244             return $reads;
245             }
246              
247 0     0 1   =item B<to_OBSERVATION_TYPE>
248 0            
249 0           Determines the observation type from the C<OBJECT> keyword provided it is
250 0 0 0       "DARK" for a dark frame, or "FLAT" for a flat-field frame. All other
251 0           values of C<OBJECT> return a value of "OBJECT", i.e. of a source.
252              
253 0           =cut
254              
255             my $self = shift;
256             my $FITS_headers = shift;
257             my $type = "OBJECT";
258             if ( defined $FITS_headers->{OBJECT} ) {
259             my $object = uc( $FITS_headers->{OBJECT} );
260             if ( $object eq "DARK" ) {
261             $type = $object;
262             } elsif ( $object =~ /FLAT/ ) {
263             $type = "FLAT";
264             }
265 0     0 1   }
266 0           return $type;
267 0           }
268 0 0          
269 0           =item B<to_RA_BASE>
270 0 0          
    0          
271 0           Converts the base right ascension from sexagesimal h:m:s to decimal degrees
272             using the C<RA> keyword, defaulting to 0.0.
273 0            
274             =cut
275              
276 0           my $self = shift;
277             my $FITS_headers = shift;
278             my $ra = 0.0;
279             my $sexa = $FITS_headers->{"RA"};
280             if ( defined( $sexa ) ) {
281             $ra = $self->hms_to_degrees( $sexa );
282             }
283             return $ra;
284             }
285              
286             =item B<to_RA_SCALE>
287 0     0 1    
288 0           Sets the right-ascension scale in arcseconds per pixel. It has a
289 0           fixed absolute value of 0.115 arcsec/pixel, but its sign depends on
290 0           the declination. The scale increases with pixel index, i.e. has east
291 0 0         to the right, for declinations south of -29 degrees. It is flipped
292 0           north of -29 degrees. The default scale assumes east is to the right.
293              
294 0           =cut
295              
296             my $self = shift;
297             my $FITS_headers = shift;
298             my $scale = 0.115;
299             my $sexa = $FITS_headers->{"DEC"};
300             if ( defined( $sexa ) ) {
301             my $dec = $self->dms_to_degrees( $sexa );
302             if ( $dec > -29 ) {
303             $scale *= -1;
304             }
305             }
306             return $scale;
307             }
308 0     0 1    
309 0           =item B<to_UTDATE>
310 0            
311 0           Returns the UT date as C<Time::Piece> object. It copes with non-standard
312 0 0         format in C<DATE-OBS>.
313 0            
314 0 0         =cut
315 0            
316             my $self = shift;
317             my $FITS_headers = shift;
318 0            
319             # Guessing the format is ddmmmyy, which is not supported by
320             # Time::DateParse, so parse it.
321             return $self->get_UT_date( $FITS_headers );
322             }
323              
324             =item B<to_UTEND>
325              
326             Returns the UT time of the end of the observation as a C<Time::Piece> object.
327              
328             =cut
329 0     0 1    
330 0           # UT header gives end of observation in HH:MM:SS format.
331             my $self = shift;
332             my $FITS_headers = shift;
333              
334 0           # Get the UTDATE in YYYYMMDD format.
335             my $ymd = $self->to_UTDATE( $FITS_headers );
336             my $iso = sprintf( "%04d-%02d-%02dT%s",
337             substr( $ymd, 0, 4 ),
338             substr( $ymd, 4, 2 ),
339             substr( $ymd, 6, 2 ),
340             $FITS_headers->{UT} );
341             return $self->_parse_iso_date( $iso );
342             }
343              
344             =item B<from_UTEND>
345 0     0 1    
346 0           Returns the UT time of the end of the observation in HH:MM:SS format
347             and stores it in the C<UTEND> keyword.
348              
349 0           =cut
350              
351             my $self = shift;
352             my $generic_headers = shift;
353             my $utend = $generic_headers->{"UTEND"};
354 0           if (defined $utend) {
355 0           return $utend->strftime("%T");
356             }
357             return;
358             }
359              
360             =item B<to_UTSTART>
361              
362             Returns an estimated UT time of the start of the observation as a
363             C<Time::Piece> object. The start time is derived from the end time,
364             less the C<EXPTIME> exposure time and some allowance for the read time.
365              
366 0     0 1   =cut
367 0            
368 0           my $self = shift;
369 0 0         my $FITS_headers = shift;
370 0            
371             my $utend = $self->to_UTEND( $FITS_headers );
372 0            
373             my $nreads = $self->to_NUMBER_OF_READS( $FITS_headers );
374             my $speed = $self->get_speed_sec( $FITS_headers );
375             if ( defined $FITS_headers->{EXPTIME} ) {
376             my $offset = -1 * ( $FITS_headers->{EXPTIME} + $speed * $nreads );
377             $utend = $self->_add_seconds( $utend, $offset );
378             }
379             return $utend;
380             }
381              
382             =item B<to_X_LOWER_BOUND>
383              
384 0     0 1   Returns the lower bound along the X-axis of the area of the detector
385 0           as a pixel index.
386              
387 0           =cut
388              
389 0           my $self = shift;
390 0           my $FITS_headers = shift;
391 0 0         my @bounds = $self->quad_bounds( $FITS_headers );
392 0           return $bounds[ 0 ];
393 0           }
394              
395 0           =item B<to_X_REFERENCE_PIXEL>
396              
397             Specifies the X-axis reference pixel near the frame centre.
398              
399             =cut
400              
401             my $self = shift;
402             my $FITS_headers = shift;
403             my @bounds = $self->quad_bounds( $FITS_headers );
404             return int( ( $bounds[ 0 ] + $bounds[ 2 ] ) / 2 ) + 1;
405             }
406 0     0 1    
407 0           =item B<to_X_UPPER_BOUND>
408 0            
409 0           Returns the upper bound along the X-axis of the area of the detector
410             as a pixel index.
411              
412             =cut
413              
414             my $self = shift;
415             my $FITS_headers = shift;
416             my @bounds = $self->quad_bounds( $FITS_headers );
417             return $bounds[ 2 ];
418             }
419 0     0 1    
420 0           =item B<to_Y_LOWER_BOUND>
421 0            
422 0           Returns the lower bound along the Y-axis of the area of the detector
423             as a pixel index.
424              
425             =cut
426              
427             my $self = shift;
428             my $FITS_headers = shift;
429              
430             # Find the pixel bounds of the quadrant or whole detector.
431             my @bounds = $self->quad_bounds( $FITS_headers );
432             return $bounds[ 1 ];
433 0     0 1   }
434 0            
435 0           =item B<to_Y_REFERENCE_PIXEL>
436 0            
437             Specifies the Y-axis reference pixel near the frame centre.
438              
439             =cut
440              
441             my $self = shift;
442             my $FITS_headers = shift;
443             my @bounds = $self->quad_bounds($FITS_headers);
444             return int( ( $bounds[ 1 ] + $bounds[ 3 ] ) / 2 ) + 1;
445             }
446              
447 0     0 1   =item B<to_Y_UPPER_BOUND>
448 0            
449             Returns the upper bound along the Y-axis of the area of the detector
450             as a pixel index.
451 0            
452 0           =cut
453              
454             my $self = shift;
455             my $FITS_headers = shift;
456              
457             # Find the pixel bounds of the quadrant or whole detector.
458             my @bounds = $self->quad_bounds( $FITS_headers );
459             return $bounds[ 3 ];
460             }
461              
462 0     0 1   =back
463 0            
464 0           =cut
465 0            
466             # Supplementary methods for the translations
467             # ------------------------------------------
468              
469             =head1 HELPER ROUTINES
470              
471             These are ClassicCam-specific helper routines.
472              
473             =over 4
474              
475             =item B<dms_to_degrees>
476 0     0 1    
477 0           Converts a sky angle specified in d:m:s format into decimal degrees.
478             The argument is the sexagesimal-format angle.
479              
480 0           =cut
481 0            
482             my $self = shift;
483             my $sexa = shift;
484             my $dms;
485             if ( defined( $sexa ) ) {
486             my @pos = split( /:/, $sexa );
487             $dms = $pos[ 0 ] + $pos[ 1 ] / 60.0 + $pos [ 2 ] / 3600.;
488             }
489             return $dms;
490             }
491              
492             =item B<get_speed_sec>
493              
494             Returns the detector speed in seconds. It uses the C<SPEED> to derive a
495             time in decimal seconds. The default is 0.743.
496              
497             =cut
498              
499             my $self = shift;
500             my $FITS_headers = shift;
501             my $speed = 0.743;
502             if ( exists $FITS_headers->{SPEED} ) {
503             my $s_speed = $FITS_headers->{SPEED};
504             $speed = 2.01 if ( $s_speed eq "2.0s" );
505 0     0 1   $speed = 1.005 if ( $s_speed eq "1.0s" );
506 0           $speed = 0.743 if ( $s_speed eq "743ms" );
507 0           $speed = 0.405 if ( $s_speed eq "405ms" );
508 0 0         }
509 0           return $speed;
510 0           }
511              
512 0           =item B<get_UT_date>
513              
514             Returns the UT date in YYYYMMDD format. It parses the non-standard
515             ddMmmyy C<DATE-OBS> keyword.
516              
517             =cut
518              
519             my $self = shift;
520             my $FITS_headers = shift;
521             my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
522             my $junk = $FITS_headers->{"DATE-OBS"};
523 0     0 1   my $day = substr( $junk, 0, 2 );
524 0           my $smonth = substr( $junk, 2, 3 );
525 0           my $mindex = 0;
526 0 0         while ( $mindex < 11 && uc( $smonth ) ne uc( $months[ $mindex ] ) ) {
527 0           $mindex++;
528 0 0         }
529 0 0         $mindex++;
530 0 0         my $month = "0" x ( 2 - length( $mindex ) ) . $mindex;
531 0 0         my $year = substr( $junk, 5, 2 );
532             if ( $year > 90 ) {
533 0           $year += 1900;
534             } else {
535             $year += 2000;
536             }
537             return join "", $year, $month, $day;
538             }
539              
540             =item B<get_UT_hours>
541              
542             Returns the UT time of the end of observation in decimal hours from
543             the C<UT> keyeword.
544 0     0 1    
545 0           =cut
546 0            
547 0           my $self = shift;
548 0           my $FITS_headers = shift;
549 0           if ( exists $FITS_headers->{UT} && $FITS_headers->{UT} =~ /:/ ) {
550 0           my ($hour, $minute, $second) = split( /:/, $FITS_headers->{UT} );
551 0   0       return $hour + ($minute / 60) + ($second / 3600);
552 0           } else {
553             return $FITS_headers->{UT};
554 0           }
555 0           }
556 0            
557 0 0         =item B<hms_to_degrees>
558 0            
559             Converts a sky angle specified in h:m:s format into decimal degrees.
560 0           It takes no account of latitude. The argument is the sexagesimal
561             format angle.
562 0            
563             =cut
564              
565             my $self = shift;
566             my $sexa = shift;
567             my $hms;
568             if ( defined( $sexa ) ) {
569             my @pos = split( /:/, $sexa );
570             $hms = 15.0 * ( $pos[ 0 ] + $pos[ 1 ] / 60.0 + $pos [ 2 ] / 3600. );
571             }
572             return $hms;
573 0     0 1   }
574 0            
575 0 0 0       =item B<quad_bounds>
576 0            
577 0           Returns the detector bounds in pixels of the region of the detector
578             used. The region will be one of the four quadrants or the full
579 0           detector. We guess for the moment that keword C<QUAD> values of
580             1, 2, 3, 4 correspond to lower-left, lower-right, upper-left,
581             upper-right quadrants respectively, and 5 is the whole
582             256x256-pixel array.
583              
584             =cut
585              
586             my $self = shift;
587             my $FITS_headers = shift;
588             my @bounds = ( 1, 1, 256, 256 );
589             my $quad = $FITS_headers->{"QUAD"};
590             if ( defined( $quad ) ) {
591             if ( $quad < 5 ) {
592 0     0 1   $bounds[ 0 ] += 128 * ( $quad + 1 ) % 2;
593 0           $bounds[ 2 ] -= 128 * $quad % 2;
594 0           if ( $quad > 2 ) {
595 0 0         $bounds[ 1 ] += 128;
596 0           } else {
597 0           $bounds[ 3 ]-= 128;
598             }
599 0           }
600             }
601             return @bounds;
602             }
603              
604             =back
605              
606             =head1 SEE ALSO
607              
608             C<Astro::FITS::HdrTrans>, C<Astro::FITS::HdrTrans::UKIRT>.
609              
610             =head1 AUTHOR
611              
612             Malcolm J. Currie E<lt>mjc@jach.hawaii.eduE<gt>
613             Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>.
614 0     0 1    
615 0           =head1 COPYRIGHT
616 0            
617 0           Copyright (C) 2008 Science and Technology Facilities Council.
618 0 0         Copyright (C) 1998-2007 Particle Physics and Astronomy Research Council.
619 0 0         All Rights Reserved.
620 0            
621 0           This program is free software; you can redistribute it and/or modify it under
622 0 0         the terms of the GNU General Public License as published by the Free Software
623 0           Foundation; either Version 2 of the License, or (at your option) any later
624             version.
625 0            
626             This program is distributed in the hope that it will be useful,but WITHOUT ANY
627             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
628             PARTICULAR PURPOSE. See the GNU General Public License for more details.
629 0            
630             You should have received a copy of the GNU General Public License along with
631             this program; if not, write to the Free Software Foundation, Inc., 59 Temple
632             Place, Suite 330, Boston, MA 02111-1307, USA.
633              
634             =cut
635              
636             1;