;------------------------------------------------------------------------------ ; NAME: TASCPDS ; ; PURPOSE: To read a PDS ascii table file into an IDL structure containing ; columns of the data table as elements ; ; CALLING SEQUENCE: Result = TASCPDS (filename, label, [/SILENT]) ; ; INPUTS: ; Filename: Scalar string containing the name of the PDS file to read ; Label: String array containing the table header information ; OUTPUTS: ; Result: Table structure constructed from designated records ; ; OPTIONAL INPUT: ; SILENT: suppresses any messages from the procedure ; ; EXAMPLES: ; To read an ascii table file TABLE.LBL into a structure, tab: ; IDL> label = HEADPDS ('TABLE.LBL',/SILENT) ; IDL> tab = TASCPDS ('TABLE.LBL',label,/SILENT) ; ; PROCEDURES USED: ; Functions: GET_VIABLE, PDSPAR, CLEAN, REMOVE, STR2NUM, POINTPDS ; ; MODIFICATION HISTORY: ; Adapted by John D. Koch from READFITS by Wayne Landsman, December,1994 ; March 1996, Michael Haken: Remove the prefix 'ASCII_' if part of ; data_type keyword in pds label. Tolerate ; improper line termination (carriage-return ; and/or line feed missing) in table but ; inform user of error. ; ; 21 Feb 2003, P. Khetarpal: Rewrote procedure for robustness, and ; included sub-procedures to clean up table ; array for proper conversion. POINTPDS is ; used to obtain pointer info. Many other ; changes have been made. The function now ; properly reads all ascii table files ; as defined in the PDS Standards Reference. ;------------------------------------------------------------------------------ function TASCPDS, fname, label, SILENT=silent ON_ERROR, 2 if N_params() LT 2 then begin print, 'Syntax: Result = TASCPDS (filename,label[,/SILENT])' return, -1 endif if keyword_set(SILENT) then silent = 1 else silent = 0 ; obtain viable objects: tab_objs = GET_VIABLE (label,'TABLE') ser_objs = GET_VIABLE (label,'SERIES') pal_objs = GET_VIABLE (label,'PALETTE') spe_objs = GET_VIABLE (label,'SPECTRUM') con_objs = GET_VIABLE (label,'CONTAINER') if tab_objs.count GT 0 then begin objarray = tab_objs.array objcount = tab_objs.count objindex = tab_objs.index endif else if ser_objs.count GT 0 then begin objarray = [objarray, ser_objs.array] objcount = objcount + ser_objs.count objindex = [objindex, ser_objs.index] endif else if pal_objs.count GT 0 then begin objarray = [objarray, pal_objs.array] objcount = objcount + pal_objs.count objindex = [objindex, pal_objs.index] endif else if spe_objs.count GT 0 then begin objarray = [objarray, spe_objs.array] objcount = objcount + spe_objs.count objindex = [objindex, spe_objs.index] endif if con_objs.count GT 0 then begin print, "WARNING: CONTAINER object found. Currently not supported by"+$ " PDSREAD" return, -1 endif ; obtain required keyword parameters: interform = PDSPAR (label, 'INTERCHANGE_FORMAT') if !ERR EQ -1 then begin message, 'Error: missing required INTERCHANGE_FORMAT keyword' endif else begin interform = interform[0] interform = CLEAN(interform, /SPACE) interform = REMOVE(interform, '"') if interform EQ 'BINARY' then message, $ 'Error: this is a binary table file; try TBINPDS.' endelse columns = PDSPAR (label,'COLUMNS') if !ERR EQ -1 then begin message, 'Error: missing required COLUMNS keyword.' endif else $ cols = fix(STR2NUM(columns[0])) X = PDSPAR (label, 'ROW_BYTES') if !ERR EQ -1 then begin message, 'Error: missing required ROW_BYTES keyword.' endif else $ X = long(X[0]) Y = PDSPAR (label,'ROWS',INDEX=Y_ind) if !ERR EQ -1 then begin message, 'Error: missing required ROWS keyword.' endif else $ Y = long(Y[0]) ; obtain column information: name = PDSPAR (label, 'NAME', INDEX=name_ind) if !ERR EQ -1 then begin message, 'Error: missing required NAME keywords' endif else begin count = cols while name_ind[0] LT Y_ind[0] do begin name = name[1:count+1] name_ind = name_ind[1:count+1] count = count - 1 endwhile columns = strarr(cols+1) columns[0] = "columns" endelse data_type = PDSPAR (label,'DATA_TYPE',COUNT=data_count,INDEX=data_ind) if !ERR EQ -1 then message, $ 'Error: missing required DATA_TYPE keywords.' length = PDSPAR (label,'BYTES',COUNT=byte_count,INDEX=byte_ind) if !ERR EQ -1 then message, $ 'Error: missing required BYTES keywords.' start_byte = PDSPAR (label,'START_BYTE',COUNT=strt_count,INDEX=strt_ind)-1 if !ERR EQ -1 then message, $ 'Error: missing required START_BYTE keywords.' ; clean data_types and names: for j = 0, cols-1 do begin param = ['"',"'","(",")"] name[j] = CLEAN (name[j]) name[j] = REMOVE (name[j], param) data_type[j] = CLEAN (data_type[j], /SPACE) data_type[j] = REMOVE (data_type[j], param) temp = str_sep(data_type[j], '_') if n_elements(temp) GT 1 then $ data_type[j] = temp[1] endfor columns[1:cols] = name ; get pointer information pointer = POINTPDS (label, fname, objarray[0]) datafile = pointer.datafile skip = pointer.skip if silent EQ 0 then begin str = cols*Y text = strtrim(string(cols),2)+' Columns and '+$ strtrim(string(Y),2)+' Rows' if str GT 0 then begin print, 'Now reading table with '+text endif else begin print, 'Warning: ROWS or COLUMNS = 0. No data read.' endelse endif ; read data: openr, unit, fname, /GET_LUN status = fstat(unit) XY = (status.size) - skip file = assoc(unit, bytarr(XY,/NOZERO),skip) filedata = file[0] close, unit free_lun, unit ; check for end-of-line characters and X dimension: bad_line_term = 0 cr = where(filedata EQ 10b, crcount) lf = where(filedata EQ 13b, lfcount) if cr[0] LT 0 then $ print, 'Error in table: no carriage return characters found. Proceeding.' if lf[0] LT 0 then begin print, 'Error in table: no line feed characters found. Proceeding.' goto, FORMATDATA endif if NOT (crcount EQ lfcount and total(cr-lf) EQ crcount) then begin print,'Error in table: Carriage return and line feed should ' + $ 'terminate each line. Proceeding.' bad_line_term = 1 endif if (lf[0]+1 NE X-1) then begin if NOT (bad_line_term) then $ print,'Error in label or table: row_bytes keyword set to ' + $ strcompress(X,/re)+'; actual value is '+$ strcompress(lf[0]+1,/re)+'. Proceeding.' X = lf[0]+1 goto, FORMATDATA endif ; formatting data and converting into string array: FORMATDATA: filedata = reform(filedata,X,Y) table = string(filedata) ; conversion of string into structure of appropriate column vectors data = CREATE_STRUCT ('column_names',columns) for k = 0, cols-1 do begin vect = 0 col_name = 'column'+strtrim(string(k+1),2) if k LT cols-1 then begin startpos = where(strt_ind GT name_ind[k] AND strt_ind LT name_ind[k+1]) typepos = where(data_ind GT name_ind[k] AND data_ind LT name_ind[k+1]) lenpos = where(byte_ind GT name_ind[k] AND byte_ind LT name_ind[k+1]) endif else begin startpos = where(strt_ind GT name_ind[k]) typepos = where(data_ind GT name_ind[k]) lenpos = where(byte_ind GT name_ind[k]) endelse start = start_byte[startpos] bytes = length[lenpos] vect = strmid(table,start[0],bytes[0]) type = data_type[typepos] type = type[0] if type NE 'CHARACTER' AND type NE 'TIME' AND type NE 'DATE' then begin for z = 0, n_elements(vect)-1 do begin param = ['"' , "'" , "(" , ")" , ","] vect[z] = REMOVE(vect[z],param) vect[z] = CLEAN(vect[z]) endfor endif CASE type OF 'INTEGER': data=CREATE_STRUCT(data,col_name,long(vect)) 'UNSIGNED_INTEGER': data=CREATE_STRUCT(data,col_name,long(vect)) 'REAL': data=CREATE_STRUCT(data,col_name,double(vect)) 'FLOAT': data=CREATE_STRUCT(data,col_name,double(vect)) 'CHARACTER': data=CREATE_STRUCT(data,col_name,vect) 'DOUBLE': data=CREATE_STRUCT(data,col_name,double(vect)) 'BYTE': data=CREATE_STRUCT(data,col_name,long(vect)) 'BOOLEAN': data=CREATE_STRUCT(data,col_name,long(vect)) 'TIME': data=CREATE_STRUCT(data,col_name,vect) 'DATE': data=CREATE_STRUCT(data,col_name,vect) else: message, $ type+' not a recognized data type!' ENDCASE endfor return, data end