view release on metacpan or  search on metacpan

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

  # value comparison will depend on type
  # we know the types are the same
  my $val1 = $self->value;
  my $val2 = $ref->value;
  my $type = $self->type;

  return 0 if ((defined $val1 && !defined $val2) ||
	       (defined $val2 && !defined $val1));
  return 1 if (!defined $val1 && !defined $val2);

  if ($type eq 'FLOAT' || $type eq 'INT') {
    return ( $val1 == $val2 );
  } elsif ($type eq 'STRING') {
    return ( $val1 eq $val2 );
  } elsif ($type eq 'LOGICAL') {
    if (($val1 && $val2) || (!$val1 && !$val2)) {
      return 1;
    } else {
      return 0;
    }
  } elsif ($type eq 'COMMENT') {
    # if we get to here we have a defined value so we should
    # check it even if COMMENT is meant to use COMMENT
    return ($val1 eq $val2);

  } elsif ($type eq 'HEADER') {
    my @items1 = $val1->allitems;
    my @items2 = $val2->allitems;

    # count the items
    return 0 if @items1 != @items2;

    for my $i (0..$#items1) {
      return 0 if ! $items1[$i]->equals( $items2[$i] );
    }
    return 1;

  } elsif ($type eq 'UNDEF') {
    # both are undef...
    return 1;
  } else {
    croak "Unable to compare items of type '$type'\n";
  }

  # somehow we got to the end
  return 0;
}


=begin __private

=item B<_stringify>

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') {