pro db_item,items,itnum,ivalnum,idltype,sbyte,numvals,nbytes,errmsg=errmsg ;+ ; NAME: ; DB_ITEM ; PURPOSE: ; Returns the item numbers and other info. for an item name. ; EXPLANATION: ; Procedure to return the item numbers and other information ; of a specified item name ; ; CALLING SEQUENCE: ; db_item, items, itnum, ivalnum, idltype, sbyte, numvals, nbytes ; ; INPUTS: ; items - item name or number ; form 1 scalar string giving item(s) as list of names ; separated by commas ; form 2 string array giving list of item names ; form 3 string of form '$filename' giving name ; of text file containing items (one item per ; line) ; form 4 integer scalar giving single item number or ; integer vector list of item numbers ; form 5 Null string specifying interactive selection ; Upon return items will contain selected items ; in form 1 ; form 6 '*' select all items ; ; OUTPUTS: ; itnum - item number ; ivalnum - value(s) number from multiple valued item ; idltype - data type(s) (1=string,2=byte,4=i*4,...) ; sbyte - starting byte(s) in entry ; numvals - number of data values for item(s) ; It is the full length of a vector item unless ; a subscript was supplied ; nbytes - number of bytes for each value ; All outputs are vectors even if a single item is requested ; ; OPTIONAL INPUT KEYWORDS: ; ERRMSG = If defined and passed, then any error messages will ; be returned to the user in this parameter rather than depending ; on the MESSAGE routine in IDL. If no errors are encountered, ; then a null string is returned. In order to use this feature, ; ERRMSG must be defined first, e.g. ; ; ERRMSG = '' ; DB_ITEM, ERRMSG=ERRMSG, ... ; IF ERRMSG NE '' THEN ... ; ; PROCEDURE CALLS: ; DB_INFO, GETTOK, SCREEN_SELECT, SPEC_DIR ; ; REVISION HISTORY: ; Written: D. Lindler, GSFC/HRS, October 1987 ; Version 2, William Thompson, GSFC, 17-Mar-1997 ; Added keyword ERRMSG ; Converted to IDL V5.0 W. Landsman October 1997 ; Use STRSPLIT instead of GETTOK to parse form 1, W. Landsman July 2002 ; Fixed bug in pre-5.3 support, William Thompson, 22 May 2003 ;- ; ;------------------------------------------------------------------------ On_error,2 FORWARD_FUNCTION strsplit ;Pre V5.3 compatilibility if N_params() LT 2 then begin print,'Syntax - DB_ITEM,items,itnum,ivalnum,idltype,sbyte,numvals,nbytes' return endif ; data base common block ; common db_com,QDB,QITEMS,QLINK ; ; QDB(*,i) contains the following for each data base opened ; ; bytes ; 0-18 data base name character*19 ; 19-79 data base title character*61 ; 80-81 number of items (integer*2) ; 82-83 record length of DBF file (integer*2) ; 84-87 number of entries in file (integer*4) ; 88-89 position of first item for this file in QITEMS (I*2) ; 90-91 position of last item for this file (I*2) ; 92-95 Last Sequence number used (item=SEQNUM) (I*4) ; 96 Unit number of .DBF file ; 97 Unit number of .dbx file (0 if none exists) ; 98-99 Index number of item pointing to this file (0 for first db) ; 100-103 Number of entries with space allocated ; 104 Update flag (0 open for read only, 1 open for update) ; 119 Equals 1 if external data representation (IEEE) is used ; ; QITEMS(*,i) contains decription of item number i with following ; byte assignments: ; ; 0-19 item name (character*20) ; 20-21 IDL data type (integet*2) ; 22-23 Number of values for item (1 for scalar) (integer*2) ; 24-25 Starting byte position in original DBF record (integer*2) ; 26-27 Number of bytes per data value (integer*2) ; 28 Index type ; 29-97 Item description ; 98-99 Print field length ; 100 Flag set to one if pointer item ; 101-119 Data base this item points to ; 120-125 Print format ; 126-170 Print headers ; 171-172 Starting byte in record returned by DBRD ; 173-174 Data base number in QDB ; 175-176 Data base number this item points to ; ; ; QLINK(i) contains the entry number in the second data base ; corresponding to entry i in the first data base. ;------------------------------------------------------------------------- if n_elements(items) eq 0 then items = '' ; ; check if data base open ; if n_elements(qdb) lt 120 then begin message = 'data base file not open' goto, handle_error endif ; ; determine type of item list ------------------------------------------- ; vector=1 ;vector output flag s=size(items,/str) ndim = s.n_dimensions if s.type_name eq 'STRING' then begin ;string(s) if s.n_dimensions eq 0 then begin ;string scalar? if strtrim(items) eq '' then form=5 else $ ;null string - form 5 if strmid(items,0,1) eq '$' then form=3 $ ;filename - form 3 else form=1 ;scalar list - form 1 if strtrim(items) eq '*' then form=6 ;all items '*' - form 6 end else form=2 ;string vector - form 2 end else begin ;non-string form=4 ;integer - form 4 end s=size(qitems) if s[0] ne 2 then begin message = 'No data base opened' goto, handle_error endif qnumit=s[2] ;----------------------------------------------------------------------------- ; CONVERT INPUT ITEMS TO INTEGER LIST OR STRING LIST ; ; ; Form 4 ------------------ Integer ; If form eq 4 then begin if ndim eq 0 then begin itnum=intarr(1)+items ivalnum=intarr(1) ivalflag=intarr(1) goto,scalar ;speedy method end else begin itnum=items nitems=n_elements(itnum) ivalflag=bytarr(nitems) ivalnum=intarr(nitems) if (min(itnum) lt 0) or (max(itnum) ge qnumit) then begin message = 'Invalid item number specified' goto, handle_error endif goto,vector end end ; ; Form 3 ----------------- File name ; if form eq 3 then begin item_names=strarr(200) ;input buffer if strlen(items) gt 1 then filename=strmid(items,1,strlen(items)-1) $ else filename=strtrim(db_info('name',0))+'.items' openr,unit,filename,error=err,/get_lun ;open file if err lt 0 then begin message = 'Unable to open file ' + spec_dir(filename) + $ ' with item list' goto, handle_error endif nitems=0 while not eof(unit) do begin ;loop on items st='' readf,unit,st item_names[nitems]=st nitems=nitems+1 endwhile item_names=item_names[0:nitems-1] ;extract items free_lun,unit end ; ; form 1 ----------------- scalar string list 'item1,item2,item3...' ; if form eq 1 then begin if !VERSION.RELEASE GE '5.3' then $ item_names = strsplit(items,',',/EXTRACT) else begin item_names = str_sep(strtrim(items,2),',') item_names = item_names(where(item_names ne '')) endelse nitems = N_elements(item_names) endif ; ; form 2 -------------------------- string array ; if form eq 2 then begin item_names=items nitems=n_elements(items) end ; ; form 5 -------------------------- null string (interactive input) ; if form eq 5 then begin names=strtrim(qitems[0:19,*],2) desc=string(qitems[29:78,*]) screen_select,names,itnum,desc,'Select List of Items' if !err le 0 then begin message = 'No items selected' goto, handle_error endif ; nitems=n_elements(itnum) items = strtrim(names[itnum[0]],2) if nitems gt 1 then for i=1,nitems-1 do $ items = items +','+strtrim(names[itnum[i]],2) ivalflag=bytarr(nitems) ivalnum=intarr(nitems) goto,vector end ; ; Form 4 ------------------ '*' select all items ; If form eq 6 then begin nitems=db_info('items') ;number of items itnum=indgen(nitems) ivalflag=bytarr(nitems) ivalnum=intarr(nitems) goto,vector end ; ;------------------------------------------------------------------------- ; CONVERT STRING LIST TO INTEGER LIST AND PULL OFF SUBSCRIPT IF SUPPLIED ; ; names=strtrim(qitems[0:19,*],2) ;all possible item names ivalnum=intarr(nitems) ;selection of multi-value items ivalflag=bytarr(nitems) ;Flag for subscripted items itnum=intarr(nitems) ;integer item numbers ; ; loop on item names supplied ; for i=0,nitems-1 do begin ;loop on items st=strtrim(item_names[i],2) ;get item name=gettok(st,'(') ;get name ; ; subscript supplied ; if st ne '' then begin ;number supplied? ivalnum[i]=fix(gettok(st,')')) ;get number ivalflag[i]=1 end; ; ; data base name supplied ; if strpos(name,'.') ge 0 then begin ;data base name supplied dbname=gettok(name,'.') ; form is 'dbname.itemname' i1=db_info('item1',dbname) ;first item for the db i2=db_info('item2',dbname) ;last item for the db end else begin ;search all items i1=0 & i2=qnumit-1 end ; ; search for item name ; name=strupcase(name) ;convert to upper case j = where(names[i1:i2] eq name,nmatch) if nmatch eq 0 then begin message = 'Item '+ name +' is invalid' goto, handle_error endif itnum[i] =j[0] +i1 ;save item number endfor;i loop on items if nitems eq 1 then goto,scalar ;speedy method ; ;--------------------------------------------------------------------------- ; We now have ; 1) integer list of item numbers of length nitems ; 2) we have list of ivalnum (subscripts) with ; flag(s) ivalflag if subscript supplied ; EXTRACT OTHER PARAMETERS ; vector: ;---- vector processing idltype = fix(qitems[20:21,*],0,qnumit) numvals = fix(qitems[22:23,*],0,qnumit) sbyte = fix(qitems[171:172,*],0,qnumit) nbytes = fix(qitems[26:27,*],0,qnumit) idltype = idltype[itnum] numvals = numvals[itnum] sbyte = sbyte[itnum] nbytes = nbytes[itnum] ; ; add offset for subscripted variables ; sbyte=sbyte+ivalnum*nbytes ; ; if ivalflag is set we have subscripted item and don't want all ; values in vector ; pos=where(ivalflag, Npos) if Npos GT 0 then numvals[pos]=1 return ; ; ----------------------- scalar: ;------- scalar processing it=itnum[0] if (it lt 0) or (it ge qnumit) then begin message = 'Invalid item number '+strtrim(it,2)+' specified' goto, handle_error endif ; idltype=fix(qitems[20:21,it],0,1) numvals=fix(qitems[22:23,it],0,1) sbyte=fix(qitems[171:172,it],0,1) nbytes=fix(qitems[26:27,it],0,1) sbyte=sbyte+nbytes*ivalnum if ivalflag[0] then numvals[0]=1 return ; ; Error handling point. ; HANDLE_ERROR: IF N_ELEMENTS(ERRMSG) NE 0 THEN ERRMSG = 'DB_ITEM: ' + MESSAGE $ ELSE MESSAGE, MESSAGE end