;----------------------------------------------------------------------------------------
; NAME: PDSPAR
;
; PURPOSE: Obtain the value of a parameter in a PDS header
;
; CALLING SEQUENCE:
; result = PDSPAR( lbl, name [, ABORT, OBJECT=, MVAL=, COUNT=, INDEX=])
;
; INPUTS:
; Lbl: PDS header array, (e.g. as returned by SXHREAD or READPDS)
; string array, each element should have a length of 80
; characters
; Name: String name of the parameter to return.
;
; OUTPUTS:
; result: value of parameter in header. If parameter is double
; precision, float, long or string, the result is of that type.
;
; OPTIONAL INPUTS:
; OBJECT: string specifying object name and narrowing PDSPAR to
; return parameters only found inside that object
; ABORT: string specifying that PDSPAR should do a RETALL
; if a parameter is not found. ABORT should contain
; a string to be printed if the keyword parameter is not found.
; If not supplied PDSPAR will return with a negative
; !err if a keyword is not found.
;
; OPTIONAL OUTPUTS:
; COUNT: Optional keyword to return a value equal to the number of
; parameters found by PDSPAR, integer scalar
; MVAL: Optional keyword to return the value of requested keyword
; that exceeds the normal allowable string size that can be
; printed by the PRINT function. The 'zeroth' record of MVAL-
; MVAL(*,0) contains the number of following records that
; contain meaningful information.
; INDEX: Optional keyword to return an array of the line numbers
; where the values being returned were found in the PDS label.
;
; SIDE EFFECTS:
; Keyword COUNT returns the number of parameters found.
; !err is set to -1 if parameter not found, 0 for a scalar
; value returned.
;
;
; EXAMPLES:
; Given a PDS header, h, return the values of the axis dimension
; values. Then return the number of sample bits per pixel.
;
; IDL> x_axis = pdspar( h ,' LINES') ; Extract Xaxis value
; IDL> y_axis = pdspar( h ,' LINE_SAMPLES') ; Extract Yaxis value
;
; ; Extracts bits/pixel value for the IMAGE object
; IDL> bitpix = pdspar( h ,' SAMPLE_BITS', OBJECT='IMAGE')
;
;
; PROCEDURE:
; Each element of lbl is searched for a '=' and the part of each
; that preceeds the '=' is saved in the variable 'keyword', with
; any line that contains no '=' also saved in keyword. 'keyword'
; is then searched for elements that exactly match Name, if none
; are found then 'keyword' is searched for elements that contain Name.
; If either search succeeds then the characters that follow the '='
; in the matching lines are returned.
;
; An error occurs if both above searches fail.
;
; The values returned are converted to numeric value, if possible,
; by the STR2NUM function.
;
; NOTE:
;
; PDSPAR requires that the label being searched has records of
; standard 80 byte length (or 81 bytes for UNIX stream files).
;
; PROCEDURES USED:
; Functions: GET_INDEX
;
; MODIFICATION HISTORY:
; Written by: J. Koch [Jul 01, 1994]
; Some sections adapted from SXPAR.PRO by DMS.
; Last modified: L. Nagdimunov [Jan 23, 2015]
;
; For a complete list of modifications, see changelog.txt file.
;
;----------------------------------------------------------------------
;Added for 06 Aug 2008 Fix
function get_matching_char, ipchar
CASE ipchar OF
'"': return,'"'
'(': return,')'
'{': return,'}'
'[': return,']'
ELSE: return,'"'
ENDCASE
end
; Added by L.Nagdimunov 23Jan2015 (modified 14Dec2015)
; Returns an array of the lbl lines on which the END_OBJECT statement occurs for a given object name inside lbl
function find_object_end, lbl, object_name
objects = pdspar(lbl, "OBJECT", INDEX=obj_indx)
obj_mtch_indx = where(objects eq object_name, num_obj_mtch)
if (num_obj_mtch eq 0) then begin
print, 'Error: No object named ' + strtrim(object_name) + ' found.'
return, -1
endif
obj_start_indx = (obj_indx[obj_mtch_indx])
for i=0, n_elements(obj_start_indx)-1 do begin
new_end_idx = get_index(lbl, obj_start_indx[i])
end_idx = (n_elements(end_idx) eq 0) ? [new_end_idx] : [end_idx, new_end_idx]
endfor
return, end_idx
end
function PDSPAR, lbl, name, abort, OBJECT=object, MVAL=mvalue, COUNT=matches, INDEX = nfound
params = N_params()
if params LT 2 then begin
print,'Syntax - result = pdspar(lbl,name [,abort,OBJECT=,MVAL=,COUNT=,INDEX= ])'
return, -1
endif
value = 0
if params LE 2 then begin
abort_return = 0
abort = 'PDS Label'
endif else begin
abort_return = 1
endelse
if abort_return then On_error,1 else On_error,2
;Check for valid header
s = size(lbl) ;Check header for proper attributes.
if (s[0] NE 1) or (s[2] NE 7) then begin
message,abort+' (first parameter) must be a string array'
endif
;Copy name, make upper case ;line100
nam = strtrim(strupcase(name),2)
;Loop on lines of the header
; Added by L.Nagdimunov 23Jan2015 (modified 14Dec2015)
; Added OBJECT keyword
lbl_search = lbl
if keyword_set(object) then begin
objarray = pdspar(lbl, "OBJECT", INDEX=objarray_indicies)
objarray_matches = where(strupcase(objarray) eq strupcase(object))
; If no matching objects found (then we replace entire label with a blank
; so no results for anything can be found)
if (n_elements(objarray_matches) eq 1) then begin
if (objarray_matches eq -1) then lbl_search = ['']
; For matching objects found
endif else begin
obj_start_indx = objarray_indicies[objarray_matches]
obj_end_indx = find_object_end(strupcase(lbl), strupcase(object))
num_matching_objects = n_elements(objarray_matches)
for i=0, num_matching_objects-1 do begin
; Replace label content to be searched outside of OBJECTs of interest with blanks
if i eq 0 then begin
if obj_start_indx[i] gt 0 then lbl_search[0:obj_start_indx[i]-1] = ''
endif else begin
lbl_search[obj_end_indx[i-1]+1:obj_start_indx[i]-1] = ''
endelse
if i eq (num_matching_objects-1) then begin
if obj_end_indx[i] lt n_elements(lbl) then lbl_search[obj_end_indx[i]+1:*] = ''
endif
endfor
endelse
endif
;Modified A.Cardesin 2006Feb13: changed ' = ' into '='
key_end = strpos(lbl_search,'=') ;find '=' in all lines of lbl
r = size(key_end)
stopper = r[r[r[0]-1]]
keyword = strarr(stopper)
for j = 0,stopper-1 do begin
if key_end[j] LT 0 then keyword[j] = '*' $
else keyword[j]=strtrim(strmid(lbl_search[j],0,key_end[j]),2)
endfor
;Added for 05 Jul 2008 Fix
nfound = where(keyword EQ "DESCRIPTION", matches)
srch = '"'
if matches GT 0 then begin
for j = 0, matches - 1 do begin
res1 = strpos(lbl[nfound[j]],srch)
res2 = strpos(lbl[nfound[j]],srch,res1+1)
if (res2 EQ -1) then begin
start=nfound[j]+1
while (strpos(lbl[start],srch) EQ -1) do begin
keyword[start] = '*'
start += 1
endwhile
keyword[start] = '*'
endif
endfor
endif
nfound = where(keyword EQ nam, matches) ; index where the keyword matches nam
if matches EQ 0 then begin
nfound = where(strpos(keyword,nam) GT -1,matches)
endif
; Process string parameter and use STR2NUM to obtain numeric value
if matches GT 0 then begin
line = lbl[nfound]
nfd = size(nfound)
quitter = nfd[nfd[nfd[0]-1]]
svalue = strarr(quitter)
mvalue = strarr(quitter,100)
value = svalue
i = 0
while i LT quitter do begin
n = nfound[i]
knd = key_end[n]
retrn = strpos(line[i],string(10b))
if retrn EQ -1 then retrn = 80
;Modified A.Cardesin 2006Feb13: knd+1 (for '=') instead of knd+2 (for ' = ')
svalue[i] = strtrim(strmid(line[i],knd+1,retrn-knd-2),2)
spot = strpos(svalue[i],string(10b))
if spot GT 0 then svalue[i]=strtrim(strmid(svalue[i],0,spot-1),2)
; Modified by L.Nagdimunov 14Dec2015
; Look for cases where check values (e.g. quotes) do not start on same line as '='
if svalue[i] eq '' then begin
temp_svalue = svalue
; Loop over all lines following the keyword, looking for a value
for a=nfound[i]+1, n_elements(lbl)-1 do begin
; Stop search if a new keyword is found
if (strpos(lbl[a], '=') gt -1) then break
temp_retrn = strpos(line[i],string(10b))
if temp_retrn EQ -1 then temp_retrn = 80
temp_svalue[i] = strtrim(strmid(lbl[a], 0,temp_retrn),2)
spot = strpos(temp_svalue[i],string(10b))
if spot GT 0 then temp_svalue[i]=strtrim(strmid(temp_svalue[i],0,spot-1),2)
; Stop search if found value
if temp_svalue[i] ne '' then begin
svalue[i] = temp_svalue[i]
n = a
break
endif
endfor
endif
check = stregex(svalue[i],'["([{]')
if check GT -1 then begin
char_start = stregex(svalue[i],'["([{]',/extract)
char_end = get_matching_char(char_start)
k = n
c=strpos(svalue[i],char_end,check+1)
if c GT -1 then value[i]=strtrim(svalue[i],2) else begin
for a = 0, key_end[n]+1 do value[i]=value[i]+' '
value[i] = value[i] + svalue[i]
endelse
m = 0
m2 = 0
while c LT 0 do begin
k = k+1
m = m+1
m2=fix(m/24)
if m2 EQ 0 then value[i]=value[i] + ' ' + strtrim(lbl[k],2) $
else if m2 GT 0 then mvalue[i,m2]=mvalue[i,m2]+' '+strtrim(lbl[k],2) $
else print,'Illegal value of variable m2 ='+m2
c = strpos(lbl[k],char_end)
; if (c GT -1) then if(keyword[k+1] EQ '*') then c = -1
endwhile
mvalue[i,0]=fix(m2[0])
endif else begin
value[i]=str2num(strtrim(svalue[i],2))
endelse
i = i + 1
endwhile
endif else begin
if abort_return then message,'Keyword '+nam+' not found in '+abort ;150
!ERR = -1
endelse
; To print value and mvalue after running pdspar use:
; print,value(*)
; for d = 1,mvalue(*,0) do print,mvalue(*,d)
; where '*' is any number valid for value(*)
return,value
end