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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <imhdr.h>
include "imfort.h"
include "oif.h"
# IMF_MKPIXFNAME -- Generate the pixel file name. Leave the logical pixfile
# name in the image header, and return the pathname to the pixel file in the
# output argument.
procedure imf_mkpixfname (im, pixfile, maxch, ier)
pointer im #I image descriptor
char pixfile[maxch] #O receives pathname to pixfile
int maxch #I max chars out
int ier #O exit status code
int status, n
char suffix[2], hdr[STRLEN_HDR]
pointer sp, imdir, osdir, root, extn, subdir, fname, ip, op
int fnroot(), fnldir(), strncmp(), imgdirx()
string pixextn OIF_PIXEXTN
define done_ 91
begin
call smark (sp)
call salloc (imdir, SZ_PATHNAME, TY_CHAR)
call salloc (osdir, SZ_PATHNAME, TY_CHAR)
call salloc (root, SZ_PATHNAME, TY_CHAR)
call salloc (subdir, SZ_PATHNAME, TY_CHAR)
call salloc (fname, SZ_PATHNAME, TY_CHAR)
call salloc (extn, SZ_FNAME, TY_CHAR)
ier = OK
# Get the logical directory where the pixel file goes.
n = imgdirx (Memc[imdir], SZ_PATHNAME)
# If the imdir name begins with "HDR$", put the pixfile in same
# directory as the header or in a subdirectory, else put the pixel
# file in the named directory. If the pixel file goes in a HDR
# subdirectory, create the directory if it does not already exist.
# For IMFORT programs which are subject to the whims of the host
# system, be a little forgiving about the case of the HDR$.
call strcpy (Memc[imdir], hdr, STRLEN_HDR)
call strupr (hdr)
if (strncmp (hdr, HDR, STRLEN_HDR) == 0) {
call amovc (HDR, Memc[imdir], STRLEN_HDR)
ip = imdir + STRLEN_HDR
for (op=subdir; Memc[ip] != EOS && Memc[ip] != '/'; ip=ip+1) {
Memc[op] = Memc[ip]
op = op + 1
}
Memc[op] = EOS
# Make the subdirectory if it does not already exist.
if (Memc[subdir] != EOS) {
n = fnldir (IM_HDRFILE(im), Memc[osdir], SZ_PATHNAME)
call zfpath (Memc[osdir], Memc[fname], SZ_PATHNAME, n)
call zfsubd (Memc[fname], SZ_PATHNAME, Memc[subdir], n)
call strpak (Memc[fname], Memc[fname], SZ_PATHNAME)
call zfacss (Memc[fname], 0, DIRECTORY_FILE, status)
if (status == NO) {
call zfmkdr (Memc[fname], status)
if (status == ERR) {
ier = IE_MKDIR
goto done_
}
}
}
} else
call zfpath (Memc[imdir], Memc[imdir], SZ_PATHNAME, n)
# Make up the root name of the new pixel file.
if (fnroot (IM_HDRFILE(im), Memc[fname], SZ_PATHNAME) <= 0)
call strcpy (pixextn, Memc[fname], SZ_PATHNAME)
call strcat (".", Memc[fname], SZ_PATHNAME)
call strcat (pixextn, Memc[fname], SZ_PATHNAME)
call imf_trans (Memc[fname], Memc[root], Memc[extn])
# Get a unique pixel file name. If a file with the default pixel
# file name already exists in the current IMDIR, a suffix is found
# for the file which results in a unique file name (there is a
# concurrency loophole in this which can cause the uniqueness
# constraint to fail, but this is unlikely).
suffix[1] = 'a'
suffix[2] = 'a'
suffix[3] = EOS
for (n=0; ; n=n+1) {
# Construct filename "imdir$root.pix".
call strcpy (Memc[imdir], IM_PIXFILE(im), SZ_PATHNAME)
call strcat (Memc[root], IM_PIXFILE(im), SZ_PATHNAME)
call strcat (".", IM_PIXFILE(im), SZ_PATHNAME)
call strcat (pixextn, IM_PIXFILE(im), SZ_PATHNAME)
call imf_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), pixfile, maxch)
# Ensure that the filename is unique.
call strpak (pixfile, Memc[fname], SZ_PATHNAME)
call zfacss (Memc[fname], 0, 0, status)
if (status == YES) {
if (n == 0) {
for (op=root; Memc[op] != EOS; op=op+1)
;
} else {
if (suffix[2] == 'z') {
suffix[2] = 'a'
if (suffix[1] == 'z') {
ier = IE_PFNNUNIQ
goto done_
} else
suffix[1] = suffix[1] + 1
} else
suffix[2] = suffix[2] + 1
}
call strcpy (suffix, Memc[op], 2)
} else
break
}
done_
# Set the error message operand name if an error occurred.
if (ier != OK)
call im_seterrop (ier, IM_HDRFILE(im))
call sfree (sp)
end
|
