| 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; |