;;----------------------------------------------------------------------------- ;; Name: POINTPDS ;; ;; Purpose: To process the pointer to an object in a PDS file ;; ;; Calling Sequence: ;; result = pointpds (label, filename, objectname) ;; ;; Input: ;; label - String array containing the PDS header ;; filename - Scalar string containing the name of the PDS file to read ;; objectname - The name of the object to process pointer information for ;; ;; Output: ;; result - a structure containing the name of the datafile and the skip ;; offset in bytes ;; ;; Optional input: none ;; ;; Examples: ;; To obtain information from TABLE.LBL on a TABLE object: ;; IDL> label = headpds ("TABLE.LBL", /SILENT) ;; IDL> pointer = pointpds (label, "TABLE.LBL", "TABLE") ;; IDL> help, /structure, pointer ;; FLAG 1 ;; DATAFILE "TABLE.TAB" ;; SKIP 2056 ;; ;; External routines: Pdspar, Remove ;; ;; Modification history: ;; Written by Puneet Khetarpal, August 2002 ;; 12 Feb 08, HJJ: Datset root (READPDS_PATH) is taken into account. ;; For a complete list of modifications, see changelog.txt file. ;; ;;----------------------------------------------------------------------------- function pointpds, label, fname, objname ; error protection: on_error, 1 ; obtain record bytes keyword value (must already exist): record_bytes = pdspar (label, "RECORD_BYTES") ; obtain pointer to objname: param = "\^" + objname point = pdspar (label, param, COUNT=pointercount) if (pointercount gt 1) then begin ; if multiple pointers, then error message, "Error: multiple pointers to " + objname + " object found." endif ; clean and save pointer as backup: point = clean(point[0], /space) savepoint = point ; remove parentheses from string: point = remove(point, ['(',')']) ; check for flag and remove it if found: byte_offset_flag = 0 ; initialize byte offset flag to 0 rightp = strpos (point, "") ; get start position of if (rightp gt -1) then begin ; if present byte_offset_flag++ ; increment byte offset flag point = strmid(point, 0, rightp) ; remove from pointer endif ; check for double quotes and extract: rightp = strpos (point, '"') ; get index for right quote position leftp = -1 ; init index for left quote position if (rightp gt -1) then begin ; if right quote present leftp = strpos (point,'"', rightp + 1) ; look for left quote position endif ; if there was a filename, save it: datafile = "" ; init data file name if (rightp gt -1 && leftp gt -1) then begin ; if file name found rightp++ ; increment right position length = leftp - rightp ; determine length of fname datafile = strmid (point, rightp, length) ; extract file name ; remove the file name from the pointer string: length = strlen(point) - leftp ; determine length left point = strmid (point, leftp + 1, length) ; extract the remaining endif else if (rightp eq -1 xor leftp eq -1) then begin ; else error message, "Error: badly formatted file pointer " + savepoint endif ; obtain bytes_offset or skip bytes: rightp = strpos (point, ",") ; look for a ',' char if (rightp gt -1) then begin ; if found rightp++ ; increment position length = strlen(point) ; get length of string point = strmid (point, rightp, length - rightp) ; extract remaining endif ; convert remaining string to long integer skip = (strlen(point) eq 0) ? 0 : long(clean(point, /space)) ; assign the skip bytes for byte offset flag: if ((~ byte_offset_flag) && (skip ne 0)) then begin skip = (skip - 1) * record_bytes[0] ; if records skip, then compute endif else if (byte_offset_flag && (skip ne 0)) then begin ; else skip-- ; decrement skip bytes by 1 endif ; if there is a datafile, then check: if (strlen(datafile) gt 0) then begin ; if not a null filename ; dir = fname ; set directory to filename ; rightp = strpos (dir, "/") ; find a '/' in name ; last_slash = rightp ; save '/' position ; while (rightp ge 0) do begin ; while there is more '/' ; last_slash = rightp ; rightp = strpos (dir, "/", rightp + 1) ; find the last '/' position ; endwhile ; if (last_slash gt 0) then begin ; if last '/' pos > 0 ; dir = strmid (dir, 0, last_slash + 1) ; extract dir name ; endif else begin ; else ; dir = "" ; no directory name needed ; endelse ; ; ; if data file is in mixed case: ; fname = dir + datafile ; store fname with directory ; openr, unit, fname, error = err, /get_lun ; open the file ; ; ; if real name is in lower case: ; if (err ne 0) then begin ; if error found ; fname = dir + strlowcase (datafile) ; try lowercase filename ; openr, unit, fname, error = err, /get_lun ; endif ; ; ; if real name is in upper case: ; if (err ne 0) then begin ; if still error ; fname = dir + strupcase (datafile) ; try all upcase filename ; openr, unit, fname, error = err, /get_lun ; endif dir = file_tok(fname, /PATH) fname = FILEPATH(datafile, ROOT_DIR=dir) IF (FILE_SEARCH(fname, /FOLD_CASE, /TEST_REGULAR, /TEST_READ) EQ '') THEN BEGIN dir = GETENV('READPDS_PATH') CASE (objname) OF 'STRUCTURE' : fname = FILEPATH(datafile, ROOT=dir, SUB='LABEL') 'CATALOG' : fname = FILEPATH(datafile, ROOT=dir, SUB='CATALOG') 'DATA_SET_MAP_PROJECTION' : fname = FILEPATH(datafile, ROOT=dir, SUB='CATALOG') 'INDEX_TABLE' : fname = FILEPATH(datafile, ROOT=dir, SUB='INDEX') 'DESCRIPTION' : fname = FILEPATH(datafile, ROOT=dir, SUB='DOCUMENT') 'TEXT' : fname = FILEPATH(datafile, ROOT=dir, SUB='DOCUMENT') ELSE : ; do nothing ENDCASE ENDIF openr, unit, fname, error = err, /get_lun if (err ne 0) then begin ; if still error, then issue error message, "Error: could not open data file: " + fname endif endif else begin ; else open the file for errors openr, unit, fname, error = err, /get_lun if (err ne 0) then begin message, "Error: could not re-open " + fname endif endelse ; close file and free the unit close, unit free_lun, unit ; store pointer information in a structure: pointer = create_struct("datafile", fname, "skip", skip) return, pointer end