File Coverage

blib/lib/Astro/FITS/HdrTrans/JCMT_GSD_DB.pm
Criterion Covered Total %
statement 99 136 72.7
branch 20 66 30.3
condition 19 93 20.4
subroutine 17 17 100.0
pod 9 9 100.0
total 164 321 51.0


line stmt bran cond sub pod time code
1             package Astro::FITS::HdrTrans::JCMT_GSD_DB;
2              
3             =head1 NAME
4              
5             Astro::FITS::HdrTrans::JCMT_GSD_DB - JCMT GSD Database header translations
6              
7             =head1 DESCRIPTION
8              
9             Converts information contained in JCMT heterodyne database headers
10             to and from generic headers. See Astro::FITS::HdrTrans for a list of
11             generic headers.
12              
13             =cut
14              
15 10     10   23485560 use 5.006;
  10         68  
16 10     10   70 use warnings;
  10         35  
  10         937  
17 10     10   75 use strict;
  10         22  
  10         274  
18 10     10   65 use Carp;
  10         25  
  10         1137  
19              
20 10     10   699 use Time::Piece;
  10         16511  
  10         165  
21              
22             # Inherit from Base
23 10     10   3247 use base qw/ Astro::FITS::HdrTrans::Base /;
  10         31  
  10         23317  
24              
25             our $VERSION = "1.66";
26              
27             # for a constant mapping, there is no FITS header, just a generic
28             # header that is constant
29             my %CONST_MAP = (
30             INST_DHS => 'HET_GSD',
31             COORDINATE_UNITS => 'decimal',
32             EQUINOX => 'current',
33             TELESCOPE => 'JCMT',
34             );
35              
36             # NULL mappings used to override base class implementations
37             my @NULL_MAP = ();
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             AMBIENT_TEMPERATURE => "TAMB",
44             APERTURE => "APERTURE",
45             AZIMUTH_START => "AZ",
46             BACKEND => "BACKEND",
47             BACKEND_SECTIONS => "NORSECT",
48             CHOP_FREQUENCY => "CHOPFREQ",
49             CHOP_THROW => "CHOPTHRW",
50             COORDINATE_SYSTEM => "COORDCD",
51             # COORDINATE_TYPE => "C4LSC",
52             CYCLE_LENGTH => "CYCLLEN",
53             # DEC_BASE => "",
54             ELEVATION_START => "EL",
55             FILENAME => "GSDFILE",
56             FILTER => "FILTER",
57             FREQUENCY_RESOLUTION => "FREQRES",
58             FRONTEND => "FRONTEND",
59             HUMIDITY => "HUMIDITY",
60             NUMBER_OF_CYCLES => "NOCYCLES",
61             NUMBER_OF_SUBSCANS => "NOSCANS",
62             OBJECT => "OBJECT",
63             OBSERVATION_MODE => "OBSMODE",
64             OBSERVATION_NUMBER => "SCAN",
65             PROJECT => "PROJID",
66             # RA_BASE => "C4RADATE",
67             RECEIVER_TEMPERATURE => "TRX",
68             ROTATION => "YPOSANG",
69             REST_FREQUENCY => "RESTFRQ1",
70             SEEING => "PHA",
71             SWITCH_MODE => "SWMODE",
72             SYSTEM_TEMPERATURE => "STSYS",
73             TAU => "TAU",
74             USER_AZ_CORRECTION => "UXPNT",
75             USER_EL_CORRECTION => "UYPNT",
76             VELOCITY => "VELOCITY",
77             VELOCITY_REFERENCE_FRAME => "VREF",
78             VELOCITY_TYPE => "VDEF",
79             X_BASE => "XREF",
80             Y_BASE => "YREF",
81             X_DIM => "NOXPTS",
82             Y_DIM => "NOYPTS",
83             X_REQUESTED => "XSOURCE",
84             Y_REQUESTED => "YSOURCE",
85             X_SCALE => "DELTAX",
86             Y_SCALE => "DELTAY",
87             );
88              
89             # Create the translation methods
90             __PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP, \@NULL_MAP );
91              
92             =head1 METHODS
93              
94             =over 4
95              
96             =item B<can_translate>
97              
98             Returns true if the supplied headers can be handled by this class.
99              
100             $cando = $class->can_translate( \%hdrs );
101              
102             For this class, the method will return true if the "GSDFILE" header
103             exists and the "SCA#" header exist.
104              
105             =cut
106              
107             sub can_translate {
108 20     20 1 52 my $self = shift;
109 20         56 my $headers = shift;
110              
111 20 50 66     153 if (exists $headers->{GSDFILE} && exists $headers->{"SCA#"}) {
112 1         3 return 1;
113             }
114 19         490 return 0;
115             }
116              
117             =back
118              
119             =head1 COMPLEX CONVERSIONS
120              
121             These methods are more complicated than a simple mapping. We have to
122             provide both from- and to-FITS conversions All these routines are
123             methods and the to_ routines all take a reference to a hash and return
124             the translated value (a many-to-one mapping) The from_ methods take a
125             reference to a generic hash and return a translated hash (sometimes
126             these are many-to-many)
127              
128             =over 4
129              
130             =item B<to_INSTRUMENT>
131              
132             Sets the C<INSTRUMENT> generic header. For RxA3i, sets the value
133             to RXA3. For RxB, sets the value to RXB3.
134              
135             =cut
136              
137             sub to_INSTRUMENT {
138 1     1 1 2 my $self = shift;
139 1         3 my $FITS_headers = shift;
140 1         2 my $return;
141              
142 1 50       3 if ( exists( $FITS_headers->{'FRONTEND'} ) ) {
143 1         9 $return = $FITS_headers->{'FRONTEND'};
144 1 50       7 if ( $return =~ /^rxa3/i ) {
    50          
145 0         0 $return = "RXA3";
146             } elsif ( $return =~ /^rxb/i ) {
147 1         3 $return = "RXB3";
148             }
149             }
150 1         4 return $return;
151             }
152              
153             =item B<to_OBSERVATION_ID>
154              
155             Calculate a unique Observation ID.
156              
157             =cut
158              
159             # Note this routine is generic for JCMT heterodyne instrumentation.
160             # Would be completely generic if BACKEND was not used in preference to instrument.
161              
162             sub to_OBSERVATION_ID {
163 1     1 1 2 my $self = shift;
164 1         3 my $FITS_headers = shift;
165 1         26 my $backend = lc( $self->to_BACKEND( $FITS_headers ) );
166 1         30 my $obsnum = $self->to_OBSERVATION_NUMBER( $FITS_headers );
167 1         5 my $dateobs = $self->to_UTSTART( $FITS_headers );
168 1         6 my $datetime = $dateobs->datetime;
169 1         86 $datetime =~ s/-//g;
170 1         4 $datetime =~ s/://g;
171              
172 1         4 my $obsid = join('_', $backend, $obsnum, $datetime);
173 1         8 return $obsid;
174             }
175              
176             =item B<to_UTDATE>
177              
178             Translates the C<DATE_OBS> or C<LONGDATEOBS> header into a
179             YYYYMMDD integer.
180              
181             =cut
182              
183             sub to_UTDATE {
184 1     1 1 3 my $self = shift;
185 1         2 my $FITS_headers = shift;
186 1         3 my $date = _mysql_convert_date( _date_header( $FITS_headers ), 1);
187 1         6 return $date->strftime('%Y%m%d');
188             }
189              
190             =item B<to_UTSTART>
191              
192             Translates the DB date header into a C<Time::Piece> object.
193              
194             =cut
195              
196             sub to_UTSTART {
197 2     2 1 6 my $self = shift;
198 2         3 my $FITS_headers = shift;
199 2         6 return _mysql_convert_date( _date_header( $FITS_headers ));
200             }
201              
202             =item B<to_UTEND>
203              
204             Translates the database date header into a C<Time::Piece> object and adds
205             on the exposure time.
206              
207             =cut
208              
209             sub to_UTEND {
210 1     1 1 3 my $self = shift;
211 1         2 my $FITS_headers = shift;
212              
213 1         2 my $return = _mysql_convert_date( _date_header( $FITS_headers ) );
214 1 50       4 return undef unless defined $return;
215 1         5 my $expt = $self->to_EXPOSURE_TIME( $FITS_headers );
216              
217 1         5 $return += $expt;
218 1         95 return $return;
219             }
220              
221             =item B<to_BANDWIDTH_MODE>
222              
223             Uses the NORSECT (number of backend sections), NOFCHAN (number of
224             frontend output channels) and NOBCHAN (number of channels) to form a
225             string that is of the format 250MHzx2048. To obtain this, the
226             bandwidth (250MHz in this example) is calculated as 125MHz * NORSECT /
227             NOFCHAN. The number of channels is taken directly and not manipulated
228             in any way.
229              
230             If appropriate, the bandwidth may be given in GHz.
231              
232             =cut
233              
234             sub to_BANDWIDTH_MODE {
235 1     1 1 3 my $self = shift;
236 1         2 my $FITS_headers = shift;
237              
238 1         3 my $return;
239              
240 1 50 33     34 if ( exists( $FITS_headers->{'NORSECT'} ) && defined( $FITS_headers->{'NORSECT'} ) &&
      33        
      33        
      33        
      33        
241             exists( $FITS_headers->{'NOFCHAN'} ) && defined( $FITS_headers->{'NOFCHAN'} ) &&
242             exists( $FITS_headers->{'NOBCHAN'} ) && defined( $FITS_headers->{'NOBCHAN'} ) ) {
243              
244 1         4 my $bandwidth = 125 * $FITS_headers->{'NORSECT'} / $FITS_headers->{'NOFCHAN'};
245              
246 1 50       5 if ( $bandwidth >= 1000 ) {
247 0         0 $bandwidth /= 1000;
248 0         0 $return = sprintf( "%dGHzx%d", $bandwidth, $FITS_headers->{'NOBCHAN'} );
249             } else {
250 1         12 $return = sprintf( "%dMHzx%d", $bandwidth, $FITS_headers->{'NOBCHAN'} );
251             }
252             }
253              
254 1         3 return $return;
255              
256             }
257              
258              
259             =item B<to_EXPOSURE_TIME>
260              
261             =cut
262              
263             sub to_EXPOSURE_TIME {
264 2     2 1 3 my $self = shift;
265 2         5 my $FITS_headers = shift;
266 2         3 my $expt = 0;
267              
268 2 50 33     12 if ( exists( $FITS_headers->{'OBSMODE'} ) && defined( $FITS_headers->{'OBSMODE'} ) ) {
269              
270 2         5 my $obsmode = uc( $FITS_headers->{'OBSMODE'} );
271              
272 2 50 33     12 if ( $obsmode eq 'RASTER' ) {
    50          
273              
274 0 0 0     0 if ( exists( $FITS_headers->{'NSCAN'} ) && defined( $FITS_headers->{'NSCAN'} ) &&
      0        
      0        
      0        
      0        
275             exists( $FITS_headers->{'CYCLLEN'} ) && defined( $FITS_headers->{'CYCLLEN'} ) &&
276             exists( $FITS_headers->{'NOCYCPTS'} ) && defined( $FITS_headers->{'NOCYCPTS'} ) ) {
277              
278 0         0 my $nscan = $FITS_headers->{'NSCAN'};
279 0         0 my $cycllen = $FITS_headers->{'CYCLLEN'};
280 0         0 my $nocycpts = $FITS_headers->{'NOCYCPTS'};
281              
282             # raster.
283 0         0 $expt = 15 + $nscan * $cycllen * ( 1 + 1 / sqrt( $nocycpts ) ) * 1.4;
284             }
285             } elsif ( $obsmode eq 'PATTERN' or $obsmode eq 'GRID' ) {
286              
287 0         0 my $swmode = '';
288              
289 0 0 0     0 if ( exists( $FITS_headers->{'SWMODE'} ) && defined( $FITS_headers->{'SWMODE'} ) ) {
290 0         0 $swmode = $FITS_headers->{'SWMODE'};
291             } else {
292 0         0 $swmode = 'BEAMSWITCH';
293             }
294              
295 0 0 0     0 if ( exists( $FITS_headers->{'NSCAN'} ) && defined( $FITS_headers->{'NSCAN'} ) &&
      0        
      0        
      0        
      0        
296             exists( $FITS_headers->{'NCYCLE'} ) && defined( $FITS_headers->{'NCYCLE'} ) &&
297             exists( $FITS_headers->{'CYCLLEN'} ) && defined( $FITS_headers->{'CYCLLEN'} ) ) {
298              
299 0         0 my $nscan = $FITS_headers->{'NSCAN'};
300 0         0 my $ncycle = $FITS_headers->{'NCYCLE'};
301 0         0 my $cycllen = $FITS_headers->{'CYCLLEN'};
302              
303 0 0       0 if ( $swmode eq 'POSITION_SWITCH' ) {
    0          
    0          
304              
305             # position switch pattern/grid.
306 0         0 $expt = 6 + $nscan * $ncycle * $cycllen * 1.35;
307              
308             } elsif ( $swmode eq 'BEAMSWITCH' ) {
309              
310             # beam switch pattern/grid.
311 0         0 $expt = 6 + $nscan * $ncycle * $cycllen * 1.35;
312              
313             } elsif ( $swmode eq 'CHOPPING' ) {
314 0 0 0     0 if ( exists( $FITS_headers->{'FRONTEND'} ) && defined( $FITS_headers->{'FRONTEND'} ) ) {
315 0         0 my $frontend = uc( $FITS_headers->{'FRONTEND'} );
316 0 0       0 if ( $frontend eq 'RXA3I' ) {
    0          
317              
318             # fast frequency switch pattern/grid, receiver A.
319 0         0 $expt = 15 + $nscan * $ncycle * $cycllen * 1.20;
320              
321             } elsif ( $frontend eq 'RXB' ) {
322              
323             # slow frequency switch pattern/grid, receiver B.
324 0         0 $expt = 18 + $nscan * $ncycle * $cycllen * 1.60;
325              
326             }
327             }
328             }
329             }
330             } else {
331              
332 2         3 my $swmode;
333 2 50 33     10 if ( exists( $FITS_headers->{'SWMODE'} ) && defined( $FITS_headers->{'SWMODE'} ) ) {
334 2         4 $swmode = uc( $FITS_headers->{'SWMODE'} );
335             } else {
336 0         0 $swmode = 'BEAMSWITCH';
337             }
338              
339 2 50 33     49 if ( exists( $FITS_headers->{'NSCAN'} ) && defined( $FITS_headers->{'NSCAN'} ) &&
      33        
      33        
      33        
      33        
340             exists( $FITS_headers->{'NCYCLE'} ) && defined( $FITS_headers->{'NCYCLE'} ) &&
341             exists( $FITS_headers->{'CYCLLEN'} ) && defined( $FITS_headers->{'CYCLLEN'} ) ) {
342              
343 2         4 my $nscan = $FITS_headers->{'NSCAN'};
344 2         4 my $ncycle = $FITS_headers->{'NCYCLE'};
345 2         4 my $cycllen = $FITS_headers->{'CYCLLEN'};
346              
347 2 50       7 if ( $swmode eq 'POSITION_SWITCH' ) {
    50          
    0          
348              
349             # position switch sample.
350 0         0 $expt = 4.8 + $nscan * $ncycle * $cycllen * 1.10;
351              
352             } elsif ( $swmode eq 'BEAMSWITCH' ) {
353              
354             # beam switch sample.
355 2         8 $expt = 4.8 + $nscan * $ncycle * $cycllen * 1.25;
356              
357             } elsif ( $swmode eq 'CHOPPING' ) {
358 0 0 0     0 if ( exists( $FITS_headers->{'FRONTEND'} ) && defined( $FITS_headers->{'FRONTEND'} ) ) {
359 0         0 my $frontend = uc( $FITS_headers->{'FRONTEND'} );
360 0 0       0 if ( $frontend eq 'RXA3I' ) {
    0          
361              
362             # fast frequency switch sample, receiver A.
363 0         0 $expt = 3 + $nscan * $ncycle * $cycllen * 1.10;
364              
365             } elsif ( $frontend eq 'RXB' ) {
366              
367             # slow frequency switch sample, receiver B.
368 0         0 $expt = 3 + $nscan * $ncycle * $cycllen * 1.40;
369             }
370             }
371             }
372             }
373             }
374             }
375              
376 2         5 return $expt;
377             }
378              
379             =item B<to_SYSTEM_VELOCITY>
380              
381             Translate the C<VREF> and C<C12VDEF> headers into one combined header.
382              
383             =cut
384              
385             sub to_SYSTEM_VELOCITY {
386 1     1 1 2 my $self = shift;
387 1         3 my $FITS_headers = shift;
388 1         2 my $return;
389 1 50 33     12 if ( exists( $FITS_headers->{'VREF'} ) && defined( $FITS_headers->{'VREF'} ) &&
      33        
      33        
390             exists( $FITS_headers->{'VDEF'} ) && defined( $FITS_headers->{'VDEF'} ) ) {
391 1         6 $return = uc( substr( $FITS_headers->{'VDEF'}, 0, 3 ) . substr( $FITS_headers->{'VREF'}, 0, 3 ) );
392             }
393 1         3 return $return;
394             }
395              
396             =back
397              
398             =begin __PRIVATE
399              
400             =over 4
401              
402             =item B<_date_header>
403              
404             Works out which header corresponds to the date field in MySQL format and returns the value.
405              
406             $value = _date_header( $FITS_headers );
407              
408             Returns undef if none found.
409              
410             =cut
411              
412             sub _date_header {
413 4     4   8 my $FITS_headers = shift;
414             # For compatability with Sybase database, also accept LONGDATEOBS LONGDATE
415 4         9 for my $key (qw/ DATE_OBS LONGDATEOBS LONGDATE / ) {
416 4 50 33     29 if (exists $FITS_headers->{$key} && defined $FITS_headers->{$key}) {
417 4         16 return $FITS_headers->{$key};
418             }
419             }
420 0         0 return;
421             }
422              
423             =item B<_mysql_convert_date>
424              
425             Converts a MySQL date to Time::Piece object.
426              
427             $date = _mysql_convert_date( $string );
428              
429             Optional flag can be set to true to drop Hours, minutes and seconds from parse.
430              
431             $utday = _mysql_convert_date( $string, 1);
432              
433             Returns undef if no string is supplied.
434              
435             =cut
436              
437             sub _mysql_convert_date {
438 4     4   6 my $date = shift;
439 4         8 my $drophms = shift;
440 4 50       11 return undef unless $date;
441              
442             # The UT header is in MySQL format, which is something like
443             # "2002-03-15 07:04:35".
444             #
445             # Also support the Sybase format, which is something like
446             # "Mar 15 2002 7:04:35:234AM ". We first need to remove the number
447             # of milliseconds, then the whitespace at the end, then use the
448             # "%b%t%d%t%Y%t%I:%M:%S%p" format.
449              
450             # General cleanup
451 4         33 $date =~ s/\s*$//;
452              
453 4         6 my $return;
454              
455 4 50       24 if ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/) {
456 4 100       10 if ($drophms) {
457 1         9 $date =~ s/\s*\d\d?:\d\d:\d\d$//;
458 1         6 $return = Time::Piece->strptime( $date,
459             "%Y-%m-%d" );
460             } else {
461 3         20 $return = Time::Piece->strptime( $date,
462             "%Y-%m-%d %T" );
463             }
464             } else {
465 0         0 $date =~ s/:\d\d\d//;
466              
467 0 0       0 if ($drophms) {
468 0         0 $date =~ s/\s*\d\d?:\d\d:\d\d[A|P]M$//;
469 0         0 $return = Time::Piece->strptime( $date,
470             "%b %e %Y" );
471             } else {
472 0         0 $return = Time::Piece->strptime( $date,
473             "%b %e %Y %l:%M:%S%p" );
474             }
475             }
476 4         204 return $return;
477             }
478              
479             =back
480              
481             =end __PRIVATE
482              
483             =head1 AUTHOR
484              
485             Brad Cavanagh E<lt>b.cavanagh@jach.hawaii.eduE<gt>,
486             Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
487              
488             =head1 COPYRIGHT
489              
490             Copyright (C) 2008 Science and Technology Facilities Council.
491             Copyright (C) 2003-2007 Particle Physics and Astronomy Research Council.
492             All Rights Reserved.
493              
494             This program is free software; you can redistribute it and/or modify it under
495             the terms of the GNU General Public License as published by the Free Software
496             Foundation; either version 2 of the License, or (at your option) any later
497             version.
498              
499             This program is distributed in the hope that it will be useful,but WITHOUT ANY
500             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
501             PARTICULAR PURPOSE. See the GNU General Public License for more details.
502              
503             You should have received a copy of the GNU General Public License along with
504             this program; if not, write to the Free Software Foundation, Inc., 59 Temple
505             Place,Suite 330, Boston, MA 02111-1307, USA
506              
507             =cut
508              
509             1;