1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <error.h>
include <imhdr.h>
include "fxf.h"
# FXF_DELETE -- Delete a FITS file. NOTE: it is not possible to delete an
# individual extension at this time.
procedure fxf_delete (kernel, root, extn, status)
int kernel #I IKI kernel
char root[ARB] #I root filename
char extn[ARB] #I header file extension
int status #O status value
int cindx
pointer sp, fname, im, tmp
pointer immapz()
bool streq()
errchk syserrs
include "fxfcache.com"
begin
call smark (sp)
call salloc (fname, SZ_PATHNAME, TY_CHAR)
call salloc (tmp, SZ_PATHNAME, TY_CHAR)
call fxf_init()
status = OK
# Get the file extension if not given.
if (extn[1] == EOS) {
call fxf_access (kernel, root, extn, READ_ONLY, status)
if (status == NO) {
call sfree (sp)
status = ERR
return
}
}
call iki_mkfname (root, extn, Memc[fname], SZ_PATHNAME)
call strcpy (Memc[fname], Memc[tmp], SZ_PATHNAME)
call strcat ("[0]", Memc[tmp], SZ_PATHNAME)
iferr (im = immapz (Memc[tmp], READ_ONLY, 0))
call syserrs (SYS_FXFDELMEF, Memc[fname])
else
call imunmap (im)
iferr (call delete (Memc[fname]))
call erract (EA_WARN)
# Remove the image from the FITS cache if found.
do cindx=1, rf_cachesize {
if (rf_fit[cindx] == NULL)
next
if (streq (Memc[fname], rf_fname[1,cindx])) {
call mfree (rf_pextv[cindx], TY_INT)
call mfree (rf_pextn[cindx], TY_CHAR)
call mfree (rf_pixp[cindx], TY_INT)
call mfree (rf_hdrp[cindx], TY_INT)
call mfree (rf_fit[cindx], TY_STRUCT)
call mfree (rf_hdr[cindx], TY_CHAR)
rf_fit[cindx] = NULL
rf_lru[cindx] = 0
rf_fname[1,cindx] = EOS
}
}
status = OK
call sfree (sp)
end
|
