view release on metacpan or  search on metacpan

lib/Astro/FITS/Header.pm  view on Meta::CPAN

   tie %hash, "Astro::FITS::Header", $header

   $value = $hash{$keyword};
   $hash{$keyword} = $value;

   print "keyword $keyword is present" if exists $hash{$keyword};

   foreach my $key (keys %hash) {
      print "$key = $hash{$key}\n";
   }

=head2 Basic hash translation

Header value type is determined on-the-fly by parsing of the input values.
Anything that parses as a number or a logical is converted to that before
being put in a card (but see below).

Per-card comment fields can be accessed using the tied interface by specifying
a key name of "key_COMMENT". This works because in general "_COMMENT" is too
long to be confused with a normal key name.

  $comment = $hdr{CRPIX1_COMMENT};

will return the comment associated with CRPIX1 header item. The comment
can be modified in the same way:

  $hdr{CRPIX1_COMMENT} = "An axis";

You can also modify the comment by slash-delimiting it when setting the
associated keyword:

  $hdr{CRPIX1} = "34 / Set this field manually";

If you want an actual slash character in your string field you must escape
it with a backslash.  (If you're in double quotes you have to use a double
backslash):

  $hdr{SLASHSTR} = 'foo\/bar / field contains "foo/bar"';

Keywords are CaSE-inNSEnSiTIvE, unlike normal hash keywords.  All
keywords are translated to upper case internally, per the FITS standard.

Aside from the SIMPLE and END keywords, which are automagically placed at
the beginning and end of the header respectively, keywords are included
in the header in the order received.  This gives you a modicum of control
over card order, but if you actually care what order they're in, you
probably don't want the tied interface.

=head2 Comment cards

Comment cards are a special case because they have no normal value and
their comment field is treated as the hash value.  The keywords
"COMMENT" and "HISTORY" are magic and refer to comment cards; nearly all other
keywords create normal valued cards.  (see "SIMPLE and END cards", below).

=head2 Multi-card values

Multiline string values are broken up, one card per line in the
string.  Extra-long string values are handled gracefully: they get
split among multiple cards, with a backslash at the end of each card
image.  They're transparently reassembled when you access the data, so
that there is a strong analogy between multiline string values and multiple
cards.

In general, appending to hash entries that look like strings does what
you think it should.  In particular, comment cards have a newline
appended automatically on FETCH, so that

  $hash{HISTORY} .= "Added multi-line string support";

adds a new HISTORY comment card, while

  $hash{TELESCOP} .= " dome B";

only modifies an existing TELESCOP card.

You can make multi-line values by feeding in newline-delimited
strings, or by assigning from an array ref.  If you ask for a tag that
has a multiline value it's always expanded to a multiline string, even
if you fed in an array ref to start with.  That's by design: multiline
string expansion often acts as though you are getting just the first
value back out, because perl string-to-number conversion stops at the
first newline.  So:

  $hash{CDELT1} = [3,4,5];
  print $hash{CDELT1} + 99,"\n$hash{CDELT1}";

prints "102\n3\n4\n5", and then

  $hash{CDELT1}++;
  print $hash{CDELT1};

prints "4".

In short, most of the time you get what you want.  But you can always fall
back on the non-tied interface by calling methods like so:

  ((tied $hash)->method())

If you prefer to have multi-valued items automagically become array
refs, then you can get that behavior using the C<tiereturnsref> method:

  tie %keywords, "Astro::FITS::Header", $header, tiereturnsref => 1;

When tiereturnsref is true, multi-valued items will be returned via a
reference to an array (ties do not respect calling context). Note that
if this is configured you will have to test each return value to see
whether it is returning a real value or a reference to an array if you
are not sure whether there will be more than one card with a duplicate
name.

=head2 Type forcing

Because perl uses behind-the-scenes typing, there is an ambiguity
between strings and numeric and/or logical values: sometimes you want
to create a STRING card whose value could parse as a number or as a
logical value, and perl kindly parses it into a number for you.  To
force string evaluation, feed in a trivial array ref:

  $hash{NUMSTR} = 123;     # generates an INT card containing 123.
  $hash{NUMSTR} = "123";   # generates an INT card containing 123.

lib/Astro/FITS/Header.pm  view on Meta::CPAN

    # Join everything together with a newline
    # BUT we are careful here to prevent stringification of references
    # at least for the case where we only have one value. We also must
    # handle the case where we have no value to return (without turning
    # it into a null string since that ruins autovivification of sub headers)
    if (scalar(@values) <= 1) {
      @out = @values;
    } else {

      # Multi values so join [protecting warnings from undef]
      @out = ( join("\n", map { defined $_ ? $_ : '' } @values) );

      # This is a hangover from the STORE (where we add a \ continuation
      # character to multiline strings)
      $out[0] =~ s/\\\n//gs if (defined($out[0]));
    }
  }

  # COMMENT cards get a newline appended.
  # (Whether this should happen is controversial, but it supports
  # the "just append a string to get a new COMMENT card" behavior
  # described in the documentation).
  if ($t_ok && ($item->type eq 'COMMENT')) {
    @out = map { $_ . "\n" } @out;
  }

  # If we have a header we need to tie it to another hash
  my $ishdr = ($t_ok && $item->type eq 'HEADER');
  for my $hdr (@out) {
    if ((UNIVERSAL::isa($hdr, "Astro::FITS::Header")) || $ishdr) {
      my %header;
      tie %header, ref($hdr), $hdr;
      # Change in place
      $hdr = \%header;
    }
  }

  # Can only return a scalar
  # So return the first value if tiereturnsref is false.
  # (by this point, all the values should be joined together into the
  # first element anyway.)
  my $out;
  if ($self->tiereturnsref && scalar(@out) > 1) {
    $out = \@out;
  } else {
    $out = $out[0];
  }

  return $out;
}

# store key and value pair
#
# Multiple-line kludges (CED):
#
#    * Array refs get handled gracefully by being put in as multiple cards.
#
#    * Multiline strings get broken up and put in as multiple cards.
#
#    * Extra-long strings get broken up and put in as multiple cards, with
#      an extra backslash at the end so that they transparently get put back
#      together upon retrieval.
#

sub STORE {
  my ($self, $keyword, $value) = @_;
  my @values;

  # Recognize slash-delimited comments in value keywords.  This is done
  # cheesily via recursion -- would be more efficient, but less readable,
  # to propagate the comment through the code...

  # I think this is fundamentally flawed. If I store a string "foo/bar"
  # in a hash and then read it back I expect to get "foo/bar" not "foo".
  # I can not be expected to know that this hash happens to be tied to
  # a FITS header that is trying to spot FITS item formatting. - TJ

  # Make sure that we do not stringify reference arguments by mistake
  # when looking from slashes

  if (defined $value && !ref($value) && $keyword !~ m/(_COMMENT$)|(^(COMMENT|HISTORY)$)/ and
      $value =~ s:\s*(?<!\\)/\s*(.*):: # Identify any '/' not preceded by '\'
     ) {
    my $comment = $1;

    # Recurse to store the comment.  This is a direct (non-method) call to
    # keep this method monolithic.  --CED 27-Jun-2003
    STORE($self,$keyword."_COMMENT",$comment);

  }

  # unescape (unless we are blessed)
  if (defined $value && !ref($value)) {
    $value =~ s:\\\\:\\:g;
    $value =~ s:\\\/:\/:g;
  }

  # skip the shenanigans for the normal case
  # or if we have an Astro::FITS::Header
  if (!defined $value) {
    @values = ($value);

  } elsif (UNIVERSAL::isa($value, "Astro::FITS::Header")) {
    @values = ($value);

  } elsif (ref $value eq 'HASH') {
    # Convert a hash to a Astro::FITS::Header
    # If this is a tied hash already just get the object
    my $tied = tied %$value;
    if (defined $tied && UNIVERSAL::isa($tied, "Astro::FITS::Header")) {
      # Just take the object
      @values = ($tied);
    } else {
      # Convert it to a hash
      @values = ( Astro::FITS::Header->new( Hash => $value ) );
    }

  } elsif ((ref $value eq 'ARRAY') || (length $value > 70) || $value =~ m/\n/s ) {
    my @val;
    # @val gets intermediate breakdowns, @values gets line-by-line breakdowns.