view release on metacpan or  search on metacpan

testprog/testprog_longnames.pl  view on Meta::CPAN

fits_delete_key($fptr,'DATE',$status);

print "\nAfter deleting the keywords...\n";
for ($ii=$keynum; $ii<=$keynum+1;$ii++) {
	fits_read_record($fptr,$ii,$card,$status);
	print $card,"\n";
}

$status and print "ERROR deleting keywords\n";

############################
#  insert keywords         #
############################

$keynum += 4;
fits_insert_record($fptr,$keynum-3,"KY_IREC = 'This keyword inserted by fxirec'",$status);
fits_insert_key_str($fptr,'KY_IKYS',"insert_value_string", "ikys comment", $status);
fits_insert_key_lng($fptr,'KY_IKYJ',49,"ikyj comment", $status);
fits_insert_key_log($fptr,'KY_IKYL',1, "ikyl comment", $status);
fits_insert_key_flt($fptr,'KY_IKYE',12.3456, 4, "ikye comment", $status);
fits_insert_key_dbl($fptr,'KY_IKYD',12.345678901234567, 14, "ikyd comment", $status);
fits_insert_key_fixflt($fptr,'KY_IKYF',12.3456, 4, "ikyf comment", $status);
fits_insert_key_fixdbl($fptr,'KY_IKYG',12.345678901234567, 13, "ikyg comment", $status);

print "\nAfter inserting the keywords...\n";
for ($ii=$keynum-4; $ii<=$keynum+5;$ii++) {
	fits_read_record($fptr,$ii,$card,$status);
	print $card,"\n";
}

$status and print "ERROR inserting keywords\n";

############################
#  modify keywords         #
############################

fits_modify_record($fptr,$keynum-4,'COMMENT   This keyword was modified by fxmrec', $status);
fits_modify_card($fptr,'KY_IREC',"KY_MREC = 'This keyword was modified by fxmcrd'",$status);
fits_modify_name($fptr,'KY_IKYS','NEWIKYS',$status);
fits_modify_comment($fptr,'KY_IKYJ','This is a modified comment', $status);
fits_modify_key_lng($fptr,'KY_IKYJ',50,'&',$status);
fits_modify_key_log($fptr,'KY_IKYL',0,'&',$status);
fits_modify_key_str($fptr,'NEWIKYS','modified_string', '&', $status);
fits_modify_key_flt($fptr,'KY_IKYE',-12.3456, 4, '&', $status);
fits_modify_key_dbl($fptr,'KY_IKYD',-12.345678901234567, 14, 'modified comment', $status);
fits_modify_key_fixflt($fptr,'KY_IKYF',-12.3456, 4, '&', $status);
fits_modify_key_fixdbl($fptr,'KY_IKYG',-12.345678901234567, 13, '&', $status);

print "\nAfter modifying the keywords...\n";
for ($ii=$keynum-4; $ii<=$keynum+5;$ii++) {
	fits_read_record($fptr,$ii,$card,$status);
	print $card,"\n";
}

$status and print "ERROR modifying keywords\n";

############################
#  update keywords         #
############################

fits_update_card($fptr,'KY_MREC',"KY_UCRD = 'This keyword was updated by fxucrd'",$status);

fits_update_key_lng($fptr,'KY_IKYJ',51,'&',$status);
fits_update_key_log($fptr,'KY_IKYL',1,'&',$status);
fits_update_key_str($fptr,'NEWIKYS',"updated_string",'&',$status);
fits_update_key_flt($fptr,'KY_IKYE',-13.3456, 4,'&',$status);
fits_update_key_dbl($fptr,'KY_IKYD',-13.345678901234567, 14,'modified comment',$status);
fits_update_key_fixflt($fptr,'KY_IKYF',-13.3456, 4,'&',$status);
fits_update_key_fixdbl($fptr,'KY_IKYG',-13.345678901234567, 13,'&',$status);

print "\nAfter updating the keywords...\n";
for ($ii=$keynum-4; $ii<=$keynum+5;$ii++) {
	fits_read_record($fptr,$ii,$card,$status);
	print $card,"\n";
}

$status and print "ERROR modifying keywords\n";

fits_read_record($fptr,0,$card,$status);

print "\nKeywords found using wildcard search (should be 13)...\n";
$nfound = 0;
while (!fits_find_nextkey($fptr,$inclist,2,$exclist,2,$card,$status)) {
	$nfound++;
	print $card,"\n";
}
($nfound == 13) or print("\nERROR reading keywords using wildcards (ffgnxk)\n"), goto ERRSTATUS;

$status=0;

############################
#  copy index keyword      #
############################

fits_copy_key($fptr,$fptr,1,4,'KY_PKNE',$status);
fits_read_keys_str($fptr,'ky_pkne',2,4,$inekey,$nfound,$status);
printf "\nCopied keyword: ffgkne:  %f, %f, %f\n", @$inekey;

$status and print("\nERROR in ffgkne $nfound, $status\n"),goto ERRSTATUS;

######################################
#  modify header using template file #
######################################

fits_write_key_template($fptr,$template,$status) and
	print "\nERROR returned by ffpktp\n", goto ERRSTATUS;
print "Updated header using template file (ffpktp)\n";

############################
#  create binary table     #
############################

$tform = [ qw( 15A 1L 16X 1B 1I 1J 1E 1D 1C 1M ) ];
$ttype = [ qw( Avalue Lvalue Xvalue Bvalue Ivalue Jvalue Evalue Dvalue Cvalue Mvalue ) ];
$tunit = [ ( '', 'm**2', 'cm', 'erg/s', 'km/s', '', '', '', '', '') ];

$nrows = 21;
$tfields = 10;
$pcount = 0;

fits_insert_btbl($fptr,$nrows,$tfields,$ttype,$tform,$tunit,$binname,0,$status);
print "\nffibin status = $status\n";
print "HDU number = ${\(fits_get_hdu_num($fptr,$hdunum))}\n";

fits_get_hdrpos($fptr,$existkeys,$keynum,$status);