#! /usr/bin/perl
#read_fits_read_headers("/data/erw/kmos/DETDATA_2012.06.04/KMOS_SPEC_CAL156_0026.fits");
return 1;

sub read_fits_read_headers {
	my $file    = shift(@_);
	my @headers;
	my %header;
	my $record;
	my $offset;
	
	if ( !open( FITSFILE, "<$file" ) ) {
		printError("Cannot open FITS file $file");
		return @headers;
	}

  READ_FILE: while (1) {
		%header = read_fits_read_header(FITSFILE);
		push @headers, {%header};
		$offset = read_fits_get_data_block_size(\%header);
		read FITSFILE, $record, $offset;
		READ_EXTENSIONS: while (1) {
			last READ_FILE if eof(FITSFILE);
#			read FITSFILE, $record, 2880;
#			next READ_EXTENSIONS if $record!~/^XTENSION/;
#			seek FITSFILE, -2880, 1;
			%header = read_fits_read_header(FITSFILE);
			push @headers, {%header};
			$offset = read_fits_get_data_block_size(\%header);
#			read FITSFILE, $record, $offset;
			seek FITSFILE, $offset, 1;
		}
	}
	return @headers;
}

sub read_fits_get_data_block_size {
	my (%header, $size, $cnt);
	%header = %{$_[0]};
	$size = read_fits_get_data_size(\%header);
	$cnt = int($size/2880);
	$cnt ++ if ($size != ($cnt*2880));
	return $cnt * 2880;
}

sub read_fits_get_data_size {
	my ($size, %header, $naxis, $itemSize);	
#	%header = shift (@_);
	%header = %{$_[0]};
	$naxis = $header{"NAXIS"};
	$itemSize = abs($header{"BITPIX"}) / 8;
	NAXIS_SWITCH: {
		if ($naxis == 0) {
			$size = 0;
			last NAXIS_SWITCH;
		}
		if ($naxis == 1) {
			$size = $itemSize * $header{"NAXIS1"};
			last NAXIS_SWITCH;
		}
		if ($naxis == 2) {
			$size = $itemSize * $header{"NAXIS1"} * $header{"NAXIS2"};
			last NAXIS_SWITCH;
		}
		if ($naxis == 3) {
			$size = $itemSize * $header{"NAXIS1"} * $header{"NAXIS2"} * $header{"NAXIS3"};
			last NAXIS_SWITCH;
		}
		if ($naxis == 4) {
			$size = $itemSize * $header{"NAXIS1"} * $header{"NAXIS2"} * $header{"NAXIS3"} * $header{"NAXIS4"};
			last NAXIS_SWITCH;
		}
		$size = 0;
	}
	return $size;
}


sub read_fits_read_header {
	my $fh = shift(@_);
	my %header;
	my ($key, $value, $comment);

  READ_RECORD: while (1) {
  		last if eof($fh);
		read $fh, $record, 2880;

	  READHEADER: for ($i=0; $i<2880; $i += 80) {
			$card = substr($record,$i,80);
			$_ = $card;
			next
			  if /^(COMMENT|HISTORY|        )/
			  ;                     #skip COMMENT, HISTORY and BLANK records
			last READ_RECORD if /^END/;    # quit with END record

		  SWITCH: {

				# string value enclosed with single quotes
				if (m|(.*?)= \s*\'(.*?)\'\s*? \/(.*)|) {
					$key     = $1;
					$value   = $2;
					$comment = $3;
					last SWITCH;
				}

				# complex number enclosed with parentheses
				if (m|(.*?)= \s*\((.*)\)\s* /(.*)|) {
					$key     = $1;
					$value   = $2;
					$comment = $3;
					last SWITCH;
				}

				# single value
				if (m|(.*?)= \s*(\S*)\s* /(.*)|) {
					$key     = $1;
					$value   = $2;
					$comment = $3;
					last SWITCH;
				}

				# string value without comment
				if (m|(.*?)= \s*\'(.*?)\'\s*?|) {
					$key     = $1;
					$value   = $2;
					$comment = "";
					last SWITCH;
				}

				# complex numbers without comment
				if (m|(.*?)= \s*\((.*)\)\s*|) {
					$key     = $1;
					$value   = $2;
					$comment = "";
					last SWITCH;
				}

				# single value without comment
				if (m|(.*?)= \s*(\S*)\s*|) {
					$key     = $1;
					$value   = $2;
					$comment = "";
					last SWITCH;
				}

				# no value, only keyword
				$key = $1 if /^(........)/;
				$value = undef;
			}
			$key =~
			  s/^\s*(.*?)\s*$/$1/;    # strip leading and trailing white space
			$value =~ s/^\s*(.*?)\s*$/$1/ if defined $value;
			$header{$key} = $value;

			#print "$card\t\t\t$key = _${value}_\n";
		}
	}
	return %header;
}


sub read_fits_read_primary_header {
	my $file   = shift(@_);
	my %header = ();
	if ( !open( FITSFILE, "<$file" ) ) {
		printError("Cannot open FITS file $file");
		return %header;
	}

  READHEADER: while (1) {
		read FITSFILE, $card, 80;
		$_ = $card;
		next
		  if /^(COMMENT|HISTORY|        )/
		  ;    #skip COMMENT, HISTORY and BLANK records
		last READHEADER if /^END/;    # quit with END record

	  SWITCH: {

			# string value enclosed with single quotes
			if (m|(.*?)= \s*\'(.*?)\'\s*? \/(.*)|) {
				$key     = $1;
				$value   = $2;
				$comment = $3;
				last SWITCH;
			}

			# complex number enclosed with parentheses
			if (m|(.*?)= \s*\((.*)\)\s* /(.*)|) {
				$key     = $1;
				$value   = $2;
				$comment = $3;
				last SWITCH;
			}

			# single value
			if (m|(.*?)= \s*(\S*)\s* /(.*)|) {
				$key     = $1;
				$value   = $2;
				$comment = $3;
				last SWITCH;
			}

			# string value without comment
			if (m|(.*?)= \s*\'(.*?)\'\s*?|) {
				$key     = $1;
				$value   = $2;
				$comment = "";
				last SWITCH;
			}

			# complex numbers without comment
			if (m|(.*?)= \s*\((.*)\)\s*|) {
				$key     = $1;
				$value   = $2;
				$comment = "";
				last SWITCH;
			}

			# single value without comment
			if (m|(.*?)= \s*(\S*)\s*|) {
				$key     = $1;
				$value   = $2;
				$comment = "";
				last SWITCH;
			}

			# no value, only keyword
			$key = $1 if /^(........)/;
			$value = undef;
		}
		$key   =~ s/^\s*(.*?)\s*$/$1/;  # strip leading and trailing white space
		$value =~ s/^\s*(.*?)\s*$/$1/;
		$header{$key} = $value;

		#print "$card\t\t\t$key = _${value}_\n";
	}
	return %header;
}
