Astro-FITS-Header
view release on metacpan or search on metacpan
lib/Astro/FITS/Header/Item.pm view on Meta::CPAN
# force to 80 characters
if ($clen < 80) {
$card = $card . (" "x(80-$clen));
} elsif ($clen > 80) {
$card = substr($card, 0, 80);
}
}
# can assign undef to clear
$self->{Card} = $card;
}
# We are returning a value. Create if not present
# Since we are being called by stringify to set the object
# we need to make sure we don't get into an endless loop
# trying to create the string but not having the correct info
# Especially important since stringify calls card().
$self->{Card} = $self->_stringify unless defined $self->{Card};
return $self->{Card};
}
=back
=head2 General Methods
=over 4
=item B<configure>
Configures the object from multiple pieces of information.
$item->configure( %options );
Takes a hash as argument with the following keywords:
=over 8
=item B<Card>
If supplied, the value is assumed to be a standard 80 character
FITS header card. This is sent to the C<parse_card> method directly.
Takes priority over any other key.
If it is an C<Astro::FITS::Header::Item> it will be copied rather
than parsed.
=item B<Keyword>
Used to specify the keyword associated with this object.
=item B<Value>
Used to specify the value associated with this FITS item.
=item B<Comment>
Used to specify the comment associated with this FITS item.
=item B<Type>
Used to specify the variable type. See the C<type> method
for more details. A type will be guessed if one is not supplied.
The guess may well be wrong.
=back
Does nothing if these keys are not supplied.
=cut
sub configure {
my $self = shift;
my %hash = @_;
if (exists $hash{'Card'}) {
if (ref($hash{Card}) && $hash{Card}->isa("Astro::FITS::Header::Item")) {
# low level populate - can not use copy since we already have a copy
for my $k (keys %{$hash{Card}}) {
$self->{$k} = $hash{Card}->{$k};
}
} else {
$self->parse_card( $hash{'Card'});
}
} else {
# Loop over the allowed keys storing the values
# in the object if they exist
for my $key (qw/Keyword Type Comment Value/) {
my $method = lc($key);
$self->$method( $hash{$key}) if exists $hash{$key};
}
# only set type if we have not been given a type
if (!$self->type) {
if (!$self->keyword && !$self->value) {
# completely blank
$self->type("BLANK");
} elsif (!$self->keyword || $self->keyword =~ /^(COMMENT|HISTORY)$/) {
# COMMENT, HISTORY, and blank cards are special
$self->type('COMMENT')
} else {
my $type = $self->guess_type( $self->value );
$self->type( $type ) if defined $type;
}
}
# End cards are special, need only do a Keyword => 'END' to configure
$self->type('END') if $self->keyword() eq 'END';
}
}
=item B<freeze>
Method to return a blessed reference to the object so that we can store
ths object on disk using Data::Dumper module.
=cut
sub freeze {
my $self = shift;
return bless $self, 'Astro::FITS::Header::Item';
}
=item B<parse_card>
Parse a FITS card image and store the keyword, value and comment
into the object.
($key, $val, $com) = $item->parse_card( $card );
Returns an empty list on error.
=cut
# Fits standard specifies
# Characters 1:8 KEYWORD (trailing spaces) Comment cards: COMMENT,
# HISTORY, blank, and HIERARCH are special.
# 9:10 "= " for a valid value (unless comment keyword)
# 11:80 The Value "/" used to indicate a comment
# HIERARCH keywords
# This is a comment but used to store values in an extended,
# hierarchical name space. The keyword is the string before
# the equals sign and ignoring trailing spaces. The value
# follows the first equals sign. The comment is delimited by a
# solidus following a string or a single value. The HIERARCH
# keyword may follow a blank keyword in columns 1:8..
#
# The value can contain:
# STRINGS:
# ' starting at position 12
# A single quote represented as ''
# Closing quote must be at position 20 or greater (max 80)
# Trailing blanks are removed. Leading spaces in the quotes
# are significant
# LOGICAL
# T or F in column 30. Translated to 1 or 0
# Numbers
# D is an allowed exponent as well as E
sub parse_card {
my $self = shift;
lib/Astro/FITS/Header/Item.pm view on Meta::CPAN
Internal routine to generate a FITS header card using the contents of
the object. This rouinte should not be called directly. Use the
C<card> method to retrieve the contents.
$card = $item->_stringify;
The object state is not updated by this routine.
This routine is only called if the card cache has been cleared.
If this item points to a sub-header the stringification returns
a comment indicating that we have a sub header. In the future
this behaviour may change (either to return nothing, or
to return the stringified header itself).
=cut
sub _stringify {
my $self = shift;
# Get the components
my $keyword = $self->keyword;
my $value = $self->value;
my $comment = $self->comment;
my $type = $self->type;
# Special case for HEADER type
if (defined $type && $type eq 'HEADER') {
$type = "COMMENT";
$comment = "Contains a subsidiary header";
}
# Sort out the keyword. This always uses up the first 8 characters
my $card = sprintf("%-8s", $keyword);
# End card and Comments first
if (defined $type && $type eq 'END' ) {
$card = sprintf("%-10s%-70s", $card, "");
} elsif (defined $type && $type eq 'BLANK') {
$card = " " x 80;
} elsif (defined $type && $type eq 'COMMENT') {
# Comments are from character 9 - 80
$card = sprintf("%-8s%-72s", $card, (defined $comment ? $comment : ''));
} elsif (!defined $type && !defined $value && !defined $comment) {
# This is a blank line
$card = " " x 80;
} else {
# A real keyword/value so add the "= "
$card .= "= ";
# Try to sort out the type if we havent got one
# We can not find LOGICAL this way since we can't
# tell the difference between 'F' and F
# an undefined value is typeless
unless (defined $type) {
$type = $self->guess_type( $value );
}
# Numbers behave identically whether they are float or int
# Logical is a number formatted as a "T" or "F"
if ($type eq 'INT' or $type eq 'FLOAT' or $type eq 'LOGICAL' or
$type eq 'UNDEF') {
# Change the value for logical
if ($type eq 'LOGICAL') {
$value = ( ($value && ($value ne 'F')) ? 'T' : 'F' );
}
# An undefined value should simply propogate as an empty
$value = '' unless defined $value;
# A number can only be up to 67 characters long but
# Should we raise an error if it is longer? We should
# not truncate
$value = substr($value,0,67);
$value = (' 'x(20-length($value))).$value;
# Translate lower case e to upper
# Probably should test length of exponent to decide
# whether we should be using D instead of E
# [depends whether the argument is stringified or not]
$value =~ tr /ed/ED/;
} elsif ($type eq 'STRING') {
# Check that a value is there
# There is a distinction between '''' and nothing ''
if (defined $value) {
# Escape single quotes
$value =~ s/'/''/g; #';
# chop to 65 characters
$value = substr($value,0, 65);
# if the string has less than 8 characters pad it to put the
# closing quote at CHAR 20
if (length($value) < 8 ) {
$value = $value.(' 'x(8-length($value))) unless length($value) == 0;
}
$value = "'$value'";
} else {
$value = ''; # undef is an empty FITS string
}
# Pad goes reverse way to a number
$value = $value.(' 'x(20-length($value)));
} else {
carp("Type '$type' is not a recognized type. Header creation may be incorrect");
}
# Add the comment
if (defined $comment && length($comment) > 0) {
$card .= $value . ' / ' . $comment;
} else {
$card .= $value;
}
# Fix at 80 characters
$card = substr($card,0,80);
$card .= ' 'x(80-length($card));
}
# Return the result
return $card;
}
=item B<guess_type>
This class method can be used to guess the data type of a supplied value.
It is private but can be used by other classes in the Astro::FITS::Header
hierarchy.
$type = Astro::FITS::Header::Item->guess_type( $value );
Can not distinguish a string F from a LOGICAL F so will always guess
"string". Returns "string" if a type could not be determined.
=cut
sub guess_type {
my $self = shift;
my $value = shift;
my $type;
if (!defined $value) {
$type = "UNDEF";
} elsif ($value =~ /^\d+$/) {
$type = "INT";
} elsif ($value =~ /^(-?)(\d*)(\.?)(\d*)([EeDd][-\+]?\d+)?$/) {
$type = "FLOAT";
} else {
$type = "STRING";
}
return $type;
}
=end __private
=back
=head1 SEE ALSO
C<Astro::FITS::Header>
=head1 COPYRIGHT
Copyright (C) 2008-2009 Science and Technology Facilities Council.
Copyright (C) 2001-2007 Particle Physics and Astronomy Research Council.
All Rights Reserved.
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 3 of the License, or (at your option) any later
version.
This program is distributed in the hope that it will be useful,but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place,Suite 330, Boston, MA 02111-1307, USA
=head1 AUTHORS
Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>,
Alasdair Allan E<lt>aa@astro.ex.ac.ukE<gt>
=cut
1;
( run in 3.381 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )