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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
include <tbset.h>
include "tblerr.h"
# tbfpri -- copy primary header
# This routine may copy the primary header of an input FITS file to
# an output FITS file. The input header will only be copied under the
# following circumstances:
#
# The output file does not already exist.
# The intable and outtable file names imply they are FITS files
# (i.e. the filename extensions are ".fits", ".fit", or "%%f").
# The primary header/data unit of the input file has a null data
# portion (i.e. NAXIS = 0).
#
# If the input primary header was in fact copied, creating the output
# file, copied will be set to YES; otherwise, copied will be NO.
#
# Phil Hodge, 18-Jan-1999 Subroutine created.
# Phil Hodge, 8-Apr-1999 Call vfn_expand_ldir to get host OS file names.
# Phil Hodge, 12-Apr-1999 Call tbttyp to get file type;
# remove table type from calling sequence of tbparse.
# Phil Hodge, 1-Jun-1999 Declare ifd & ofd as two-element arrays.
procedure tbfpri (intable, outtable, copied)
char intable[ARB] # i: name of FITS file to be copied
char outtable[ARB] # i: name of new FITS file
int copied # o: YES if input header was copied to output
#--
pointer sp
pointer ifname, ofname # input & output file names
pointer os_infile, os_outfile # host operating system file names
pointer fname, extn # for discarding directory from output file name
pointer dummy # misc ignored strings
pointer intbl, cnv, url
int ifd[2] # C pointer for input (template) FITS file
int ofd[2] # C pointer for output FITS file
# These variables and equivalence statements are used to force 8-byte
# alignment of ifd and ofd.
#double d_ifd, d_ofd
#equivalence (ifd, d_ifd)
#equivalence (ofd, d_ofd)
int naxis # NAXIS from primary header of input
int status # zero is OK
int itype, otype # file type based on filename extension
int hdu # HDU number (ignored)
int exists # YES if the file exists
int blocksize
int nchar
int morekeys # extra space (none) in primary header
int fnroot(), fnextn(), tbparse(), tbttyp(), vot_to_fits()
int access(), strncmp()
bool is_votable()
errchk tbferr, tbparse, tbttyp, vfn_expand_ldir
begin
call smark (sp)
call salloc (ifname, SZ_FNAME, TY_CHAR)
call salloc (ofname, SZ_FNAME, TY_CHAR)
call salloc (intbl, SZ_PATHNAME, TY_CHAR)
call salloc (cnv, SZ_PATHNAME, TY_CHAR)
call salloc (url, SZ_PATHNAME, TY_CHAR)
call salloc (dummy, SZ_FNAME, TY_CHAR)
call salloc (os_infile, SZ_FNAME, TY_CHAR)
call salloc (os_outfile, SZ_FNAME, TY_CHAR)
# Get name of output file; i.e. strip off any extension name or
# number, row & column selectors.
nchar = tbparse (outtable, Memc[ofname], Memc[dummy], SZ_FNAME, hdu)
# Get file type, and check whether output file already exists.
otype = tbttyp (Memc[ofname], exists)
# Convert from iraf virtual file name to actual file name.
call vfn_expand_ldir (Memc[ofname], Memc[os_outfile], SZ_FNAME)
if (exists == YES || otype != TBL_TYPE_FITS) {
copied = NO
call sfree (sp)
return
}
# Check if we're opening a URL, and whether it is already cached.
call aclrc (Memc[cnv], SZ_PATHNAME)
call aclrc (Memc[intbl], SZ_PATHNAME)
if (strncmp ("http:", intable, 5) == 0) {
call strcpy (intable, Memc[url], SZ_PATHNAME)
call fcname ("cache$", Memc[url], "f", Memc[intbl], SZ_PATHNAME)
call strcpy (Memc[intbl], Memc[cnv], SZ_PATHNAME)
call strcat (".fits", Memc[cnv], SZ_PATHNAME)
if (access (Memc[cnv], 0, 0) == NO) {
call fcadd ("cache$", Memc[url], "", Memc[intbl], SZ_PATHNAME)
if (access (Memc[cnv],0,0) == YES && is_votable (Memc[cnv])) {
if (vot_to_fits (Memc[intbl], Memc[intbl]) != OK) {
call error (ER_TBCONVERT,
"tbtopn: cannot convert table format")
}
}
} else
call strcpy (Memc[cnv], Memc[intbl], SZ_PATHNAME)
} else
call strcpy (intable, Memc[intbl], SZ_PATHNAME)
# Get name of input file, and get file type.
nchar = tbparse (Memc[intbl], Memc[ifname], Memc[dummy], SZ_FNAME, hdu)
call vfn_expand_ldir (Memc[ifname], Memc[os_infile], SZ_FNAME)
itype = tbttyp (Memc[ifname], exists) # exists for input is ignored
# Only relevant for FITS tables.
if (itype != TBL_TYPE_FITS) {
copied = NO
call sfree (sp)
return
}
status = 0
ifd[2] = 0 # not needed for four-byte C pointers
ofd[2] = 0
# Get a unit number for the input file, and open the file.
call fsgiou (ifd, status)
blocksize = 2880
call fsopen (ifd, Memc[os_infile], 0, blocksize, status)
if (status != 0) {
call fsfiou (ifd, status)
call tbferr (status)
}
# Check whether the primary header/data unit contains a data portion.
# We'll only copy the primary header if there's no data.
call fsgkyj (ifd, "NAXIS", naxis, Memc[dummy], status)
if (status != 0)
call tbferr (status)
if (naxis == 0) { # no data portion
# Open the output file.
call fsgiou (ofd, status)
call fsinit (ofd, Memc[os_outfile], blocksize, status)
if (status != 0)
call tbferr (status)
# Copy the primary header.
morekeys = 0
call fscopy (ifd, ofd, morekeys, status)
if (status != 0)
call tbferr (status)
# Extract root and extension (discarding directory).
call salloc (fname, SZ_FNAME, TY_CHAR)
call salloc (extn, SZ_FNAME, TY_CHAR)
nchar = fnroot (Memc[os_outfile], Memc[fname], SZ_FNAME)
nchar = fnextn (Memc[os_outfile], Memc[extn], SZ_FNAME)
call strcat (".", Memc[fname], SZ_FNAME)
call strcat (Memc[extn], Memc[fname], SZ_FNAME)
call fsukys (ofd, "FILENAME", Memc[fname], "name of file", status)
if (status != 0)
call tbferr (status)
call fsclos (ofd, status)
call fsfiou (ofd, status)
copied = YES
} else {
# Input header will not be copied because the primary HDU
# does contain a data portion.
copied = NO
}
call fsclos (ifd, status)
call fsfiou (ifd, status)
call sfree (sp)
end
|
