#!perl

# Test that sub-headers work correctly
# Needs a better suite of tests.
use strict;
use Test::More tests => 28;

require_ok( "Astro::FITS::Header" );
require_ok( "Astro::FITS::Header::Item");


# Force numify to return the actual object reference.
# This allows us to verify that a header stored through
# a tie does not get reblessed or stringified.
package Astro::FITS::Header;
use overload '0+' => 'fudge', fallback => 1;
sub fudge { return $_[0] }
package main;

# build a test card
my $int_card = new Astro::FITS::Header::Item(
                               Keyword => 'LIFE',
                               Value   => 42,
                               Comment => 'Life the Universe and everything',
                               Type    => 'INT' );

# build another
my $string_card = new Astro::FITS::Header::Item(
                               Keyword => 'STUFF',
                               Value   => 'Blah Blah Blah',
                               Comment => 'So long and thanks for all the fish',
			       Type    => 'STRING' );

# and another
my $another_card = new Astro::FITS::Header::Item(
                               Keyword => 'VALUE',
                               Value   => 34.5678,
                               Comment => 'A floating point number',
                               Type    => 'FLOAT' );

# and another for the array
my $x = "AA";
my @h1 = map { $x++; new Astro::FITS::Header::Item( 
						   Keyword => "H1$x",
						   Value   => $x,
						   Comment => "$x th header",
						   Type    => "STRING",
						  )} (0..5);
my @h2 = map { $x++; new Astro::FITS::Header::Item( 
						   Keyword => "H2$x",
						   Value   => $x,
						   Comment => "$x th header",
						   Type    => "STRING",
						  )} (0..5);


# Form a header
my $hdr = new Astro::FITS::Header( Cards => [ $int_card, $string_card ]);

# and another header
my $subhdr = new Astro::FITS::Header( Cards => [ $another_card ]);
print "# Subhdr: $subhdr\n";

# now create an item pointing to that subhdr
my $subitem = new Astro::FITS::Header::Item(
					    Keyword => 'EXTEND',
					    Value => $subhdr,
					   );

# Add the item
$hdr->insert(0,$subitem);

# Now use the alternate array based interface
my $h1 = new Astro::FITS::Header( Cards => \@h1);
my $h2 = new Astro::FITS::Header( Cards => \@h2);
$hdr->subhdrs( $h1, $h2);

my @ret = $hdr->subhdrs;
is( scalar(@ret), 2, "Count number of subheaders");

#tie
my %header;
tie %header, ref($hdr), $hdr;

# Add another item
$header{EXTEND2} = $subhdr;
is($header{EXTEND2}{VALUE},34.5678 );

# test that we have the correct type
# This should be a hash
is( ref($header{EXTEND}), "HASH");

# And this should be an Astro::FITS::Header
isa_ok( $hdr->value("EXTEND"), "Astro::FITS::Header");

# Now store a hash
$header{NEWHASH} = { A => 2, B => 3};
is( $header{NEWHASH}->{A}, 2);
is( $header{NEWHASH}->{B}, 3);

# Now store a tied hash
my %sub;
tie %sub, ref($subhdr), $subhdr;
$header{NEWTIE} = \%sub;
my $newtie = $header{NEWTIE};
my $tieobj = tied %$newtie;

# Check class
isa_ok( $tieobj, "Astro::FITS::Header");

# Make sure we have a long numification
my $tienum = 0 + $tieobj;
my $hdrnum = 0 + $subhdr;
ok( $tienum > 0);
ok( $hdrnum > 0);

# Compare memory addresses
is( $tienum, $hdrnum, "cf memory addresses" );

printf "# The tied object is: %s\n",0+$tienum;
printf "# The original object is:: %s\n",$hdrnum;

# test values
is($header{NEWTIE}->{VALUE}, $another_card->value);

# Test autovivification
# Note that $hdr{BLAH}->{YYY} = 5 does not work
my $void = $header{BLAH}->{XXX};
printf "# VOID is %s\n", defined $void ? $void : '(undef)';
is(ref($header{BLAH}), 'HASH');
$header{BLAH}->{XXX} = 5;
is($header{BLAH}->{XXX}, 5);

# Test tied array subheader
ok(exists $header{SUBHEADERS}, "Does the subheader exist?");
my $subh = $header{SUBHEADERS};
is( ref($subh), "ARRAY", "Do we have a tie?");
is(@$subh, 2, "Got correct number of array subheaders");
is($subh->[1]->{H2AM}, "AM", "array to tied hash");

# make sure we get SUBHEADERS as a valid key
my $got;
for my $k (keys %header) {
  $got = 1 if $k eq 'SUBHEADERS';
}
ok( $got, "SUBHEADERS appeared in foreach");

my $p = pop( @$subh );
is($p->{H2AM}, "AM", "pop?");

# push it back on the front
unshift( @$subh, $p);
is($subh->[0]->{H2AM}, "AM", "unshift?");

# shift it off
my $s = shift( @$subh );
is($s->{H2AM}, "AM", "shift?");

# and push it on the end
push(@$subh, $s);
is($subh->[1]->{H2AM}, "AM", "push?");

# Now remove the subhdrs using the tie
@$subh = ();

# store the subheader from the earlier item
$subh->[2] = $header{BLAH};
is($subh->[2]->{XXX}, 5);

# Store a hash
$subh->[3] = { AAA => "22"};
is($subh->[3]->{AAA}, 22);

# Clear using the objecy
@{ $hdr->subhdrs } = ();

ok(!exists $header{SUBHEADERS}, "Subheader should not exist");

# make sure we do not get SUBHEADERS as a valid key
$got = 0;
for my $k (keys %header) {
  $got = 1 if $k eq 'SUBHEADERS';
}
ok( !$got, "SUBHEADERS should not appear in foreach");