-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathheadpds.pro
219 lines (188 loc) · 7.55 KB
/
headpds.pro
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
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
;------------------------------------------------------------------------------
; NAME: HEADPDS
;
; PURPOSE: To read a PDS label into an array variable
;
; CALLING SEQUENCE: Result = HEADPDS (filename [,/SILENT,/FILE,/FORMAT])
;
; INPUTS:
; Filename: Scalar string containing the name of the PDS file to read
; OUTPUTS:
; Result: PDS label array constructed from designated record
;
; OPTIONAL INPUT:
; SILENT: suppresses any messages from the procedure
; FILE: to be indicated if the file does not contain the label
; [for purposes other than reading a label]
; FORMAT: to be indicated if the file is ^STRUCTURE file
;
; EXAMPLES:
; To read a PDS file TEST.PDS into a PDS header array, lbl:
; IDL> lbl = HEADPDS("TEST.PDS",/SILENT)
; To read a PDS file that may not contain a header:
; IDL> lbl = HEADPDS("TEST2.TXT",/FILE)
; To read a PDS format file FORMAT.FMT from the ^STRUCTURE:
; IDL> fmt = HEADPDS("FORMAT.FMT", /FORMAT)
;
; PROCEDURES USED:
; Functions: POINTPDS, PDSPAR, CLEAN, ADDEOBJ
;
; MODIFICATION HISTORY:
; Written by: Puneet Khetarpal [January 24, 2003]
;
; 29 Jan 2009, S. Martinez: Add [CR,LF] instead of [LF,CR].
; 01 Feb 2009, S. Martinez: Corrected to do not crash when file does not exist.
; 22 Jan 2014, BT.Carcich: Skip recursion if ,/FORMAT
;
; For detailed log of modifications to this routine, please see the
; changelog.txt file.
;------------------------------------------------------------------------------
function get_struct_name, label, objindex
; initialize variables:
objectname = "-1"
; obtain the line of objindex and split into two using '=':
line = label[objindex]
segs = strsplit(line, '=', /extract)
; clean the second element of separated line
objectname = clean(segs[0],/space)
return, strmid(objectname,1)
end
function headpds, input_filename, SILENT = silent, FILE = file, FORMAT = format
; Modified: A.Cardesin 19 May 2005
; input_filename was changed during procedure
filename=input_filename
; error protection:
on_error, 2
on_ioerror, signal
; check for number of parameters in function call, must be >= 1:
if (n_params() lt 1) then begin
print, "Error: Syntax - result = HEADPDS ( filename " + $
"[,/SILENT,/FILE,/FORMAT] )"
return, "-1"
endif
; check for input of optional keywords:
silent = keyword_set(silent)
file = keyword_set(file)
format = keyword_set(format)
; check whether the file exists and can be opened:
openr, unit, filename, error = err, /get_lun
if (err lt 0) then begin
print, "Error: file " + filename + " could not be opened - "
print, " File either corrupted or invalid file name."
;;A.Cardesin Modified 8 Jun 2005
;;close and free logical unit before return
CATCH,error_status
IF (error_status NE 0) THEN BEGIN
CATCH,/CANCEL
return,"-1"
ENDIF
close,unit & free_lun, unit
return, "-1"
endif
; check for correct PDS label file:
if (~file && ~format) then begin
temp = bytarr(160)
readu, unit, temp
if ((strpos(string(temp), "PDS_VERSION_ID") lt 0) && $
(strpos(string(temp), "SFDU_LABEL") lt 0) && $
(strpos(string(temp), "XV_COMPATIBILITY") lt 0)) then begin
print, "Error: label must contain viable PDS_VERSION_ID keyword"
;;A.Cardesin Modified 8 Jun 2005
;;close and free logical unit before return
close,unit & free_lun, unit
return, "-1"
endif
endif
; initialize label variables:
lbl = "" ; holds the label string array
flag = 0 ; set to -1 when END keyword is encountered
objarr = "-1" ; holds the name of the OBJECTs in stack
objcount = 0 ; the number of objects to be processed
linecountflag = 0 ; the current number of lines, acts as a flag
; for storing values into lbl variable
; inform user of status:
if (~silent) then begin
print, "Now reading header: ", filename
endif
; set up file unit pointer:
point_lun, unit, 0
; start reading the file and read until one had reached the "END"
; keyword in the file and until it is not the end of the file:
while (~flag && ~(eof(unit))) do begin
; read one line from file:
; Note- readf removes all \r\n characters from end of ln during read:
ln = ""
readf, unit, ln
; if not reading a "FILE" type then look for OBJECT and END_OBJECT
; keywords and set values appropriately, also pad the lines to 80
; bytes:
if (~file) then begin
struct = addeobj(ln, objarr, objcount) ; external routine
if (struct.flag eq -1) then begin
;;A.Cardesin Modified 8 Jun 2005
;;close and free logical unit before return
close,unit & free_lun, unit
return, "-1"
endif
ln = struct.ln
objarr = struct.array
objcount = struct.count
endif else begin
ln += string([13B, 10B])
endelse
; if lbl array has not been constructed, then assign lbl to ln
; else concatenate ln to lbl array and increment linecount:
if (~linecountflag) then begin
lbl = ln
linecountflag += 1
endif else begin
lbl = [lbl, ln]
endelse
; now check for "END" keyword in ln:
ln2 = ln
ln2 = clean(ln2, /space) ; external routine
if (ln2 eq "END") then flag = 1
endwhile
; close the file unit and free the unit number:
close, unit
free_lun, unit
; process ^STRUCTURE object in label if any:
;;; - Only if /FORMAT was not specified
;;; - To ensures this loop is only called once per label
IF NOT KEYWORD_SET(format) THEN BEGIN
struct = pdspar(lbl, "^STRUCTURE", COUNT=strcount, INDEX=strindex) ;; ^STRUCTURE
i = 0L
WHILE i LT strcount DO BEGIN
endobj = pdspar(lbl, "END_OBJECT", COUNT=eobjcount, INDEX=eobjindex)
; obtain the position where the contents of STRUCTURE file are
; to go in the lbl array, viz., before the last END_OBJECT keyword:
structpos = where (eobjindex gt strindex[i])
lblpos = eobjindex[structpos[0]]
lastelem = n_elements(lbl) - 1
; obtain the pointer attributes for STRUCTURE, and read the file:
objname = get_struct_name(lbl, strindex[i])
pointer = pointpds(lbl[strindex[i]-1:lastelem], filename, objname) ; external routine
if (pointer.flag eq -1) then begin
print, "Error: structure pointer file missing"
return, "-1"
endif
datafile = pointer.datafile
fmtlabel = headpds (datafile, /format)
; insert fmtlabel into lbl array:
lblpos = strindex[i] + 1
lbl = [lbl[0:lblpos - 1], fmtlabel, lbl[lblpos:lastelem]]
;strcount-- ;; 2008 May 20, smartinez: removed
struct = pdspar(lbl, "STRUCTURE", COUNT=strcount, INDEX=strindex)
i += 1
ENDWHILE
ENDIF ;;; IF NOT KEYWORD_SET(format)
return, lbl
; error processing:
signal:
on_ioerror, null
print, 'Error: unable to read file ' + filename
;;A.Cardesin Modified 8 Jun 2005
;;close and free logical unit before return
close,unit & free_lun, unit
return, -1
end