Viewing contents of file '../idllib/astron/pro/dbwrt.pro'
pro dbwrt,entry,index,append,noconvert=noconvert
;+
; NAME:
; DBWRT
; PURPOSE:
; procedure to update or add a new entry to a data base
;
; CALLING SEQUENCE:
; dbwrt, entry, [ index, append, /NoConvert ]
;
; INPUTS:
; entry - entry record to be updated or added if first
; item (entry number=0)
;
; OPTIONAL INPUTS:
; index - optional integer flag, if set to non zero then index
; file is updated. (default=0, do not update index file)
; (Updating the index file is time-consuming, and should
; normally be done after all changes have been made.
; append - optional integer flag, if set to non-zero the record
; is appended as a new entry, regardless of what the
; entry number in the record is. The entry number will
; be reset to the next entry number in the file.
; OUTPUTS:
; data base file is updated.
; If index is non-zero then the index file is updated.
; OPTIONAL INPUT KEYWORD:
; NoConvert - If set then don't convert to host format with an external
; database. Useful when the calling program decides that
; conversion isn't needed (i.e. on a big-endian machine), or
; takes care of the conversion itself.
; OPERATIONAL NOTES:
; !PRIV must be greater than 1 to execute
; HISTORY:
; version 2 D. Lindler Feb. 1988 (new db format)
; converted to IDL Version 2. M. Greason, STX, June 1990.
; William Thompson, GSFC/CDS (ARC), 28 May 1994
; Added support for external (IEEE) representation.
; Converted to IDL V5.0 W. Landsman 24-Nov-1997
;-
;-------------------------------------------------------------------
COMMON db_com,qdb,qitems,qdbrec
if N_params() LT 2 then index=0
if N_params() LT 3 then append=0
; Determine whether or not the database uses external data representation.
external = (qdb[119] eq 1) and (not keyword_set(noconvert))
; get some info on the data base
update = db_info( 'UPDATE' )
if update EQ 0 then message,'Database opened for read only'
len = db_info( 'LENGTH', 0 ) ;record length
qnentry = db_info( 'ENTRIES', 0 )
; determine if entry is correct size
s = size(entry)
if s[0] NE 1 then message,'Entry must be a 1-dimensional array'
if s[1] NE len then $
message,'Entry not the proper length of '+strtrim(len,2)+' bytes'
if s[2] NE 1 then $
message,'Entry vector (first parameter) must be a byte array'
; get entry number
if append then enum =0 else enum = dbxval(entry,3,1,0,4)
if ( enum GT qnentry ) or ( enum LT 0 ) then $
message,'Invalid entry number of '+strtrim(enum,2)+' (first value in entry)'
if enum EQ 0 then begin ;add new entry
qnentry = qnentry+1
qdb[84] = byte(qnentry,0,4)
enum = qnentry
dbxput,long(enum),entry,3,0,4
newentry = 1b
endif else newentry =0b
tmp = entry
if external then db_ent2ext, tmp
qdbrec[enum]=tmp
; update index file if necessary
if index EQ 0 then return
nitems = db_info( 'ITEMS', 0 ) ;Total number of items
indextype = db_item_info( 'INDEX', indgen(nitems)) ;Which ones are indexed?
indexed = where(indextype,nindex)
if nindex LE 0 then return ;If no indexed items, then we are done
indextype = indextype[indexed] ;Now contains only indexed items
unit = db_info( 'UNIT_DBX', 0 )
reclong = assoc(unit,lonarr(2),0)
h = reclong[0]
maxentries = h[1]
if external then ieee_to_host, maxentries
if newentry then $
if (maxentries LT qnentry) then begin ;Enough room for new indexed items?
print,'DBWRT -- maxentries too small'
print,'Rerun DBCREATE with maxentries in .dbd file at least ',qnentry
return
endif
reclong = assoc(unit,lonarr(7,nindex),8)
header = reclong[0]
if external then ieee_to_host,header
hitem = header[0,*] ;indexed item number
hblock = header[3,*]
sblock = header[4,*] & sblock = sblock[*]
iblock = header[5,*] & iblock = iblock[*]
ublock = header[6,*] & ublock = ublock[*]
db_item, indexed, itnum, ivalnum, idltype, startbyte, numvals, nbytes
pos = where(hitem EQ itnum )
for i = 0, nindex-1 do begin
v = dbxval( entry, idltype[i], numvals[i], startbyte[i], nbytes[i] )
sbyte = nbytes[i] * (enum-1)
isort = (indextype[i] EQ 3) or (indextype[i] EQ 4)
datarec = dbindex_blk(unit, sblock[pos[i]], 512, sbyte, idltype[i])
reclong = assoc(unit,lonarr(1),(iblock[pos]*512L))
case indextype[i] of
1: begin
tmp = v
if external then host_to_ieee, tmp
datarec[0] = tmp
end
2: begin
tmp = v
if external then host_to_ieee, tmp
datarec[0] = tmp
if (qnentry mod 512) EQ 0 then begin ;Update
nb = qnentry/512
hbyte = nbytes[i] * nb
datarec = dbindex_blk(unit,hblock[pos[i]],512,hbyte,idltype[i])
tmp = v
if external then host_to_ieee, tmp
datarec[0] = tmp
endif
end
3: begin ;SORT
datarec = dbindex_blk(unit,sblock[pos[i]],512,0,idltype[i])
values = datarec[0:(qnentry-1)] ;Read in old values
if external then ieee_to_host, values
reclong = dbindex_blk(unit,iblock[pos[i]],512,0,3)
sub = reclong[0:(qnentry-1)] ;Read in old indices
if external then ieee_to_host, sub
if enum lt qnentry then begin ;Change an old value?
sort_index = where(sub EQ enum) ;Which value to change
sort_index = sort_index[0]
if values[sort_index] EQ v $ ;Value remains the same so
then isort =0 $ ;don't bother sorting again
else values[sort_index] = v ;Update with new value
endif else values = [values,v] ;Append a new value
end
4: begin ;SORT/INDEX
values = datarec[qnentry-1,ublock*512] ;Update index record
if external then ieee_to_host, values
if enum lt qnentry then begin
if values[enum-1] EQ v then isort = 0 else values[enum-1] = v
endif else values = [values,v]
datarec = dbindex_blk(unit,ublock[pos[i]],512,sbyte,idltype[i])
tmp = v
if external then host_to_ieee, tmp
datarec[0] = tmp
end
else:
endcase
if isort then begin ;resort values?
sub = bsort(values)
values = values[sub]
nb = (qnentry + 511)/512
ind = indgen(nb)*512L
sval = values[ind]
;
datarec = dbindex_blk(unit, hblock[pos[i]], 512, 0, idltype[i])
tmp = sval
if external then host_to_ieee, tmp
datarec[0] = tmp
;
datarec = dbindex_blk(unit, sblock[pos[i]], 512, 0, idltype[i])
tmp = values
if external then host_to_ieee, tmp
datarec[0] = tmp
;
reclong = dbindex_blk(unit, iblock[pos[i]], 512, 0, 3)
tmp = sub+1
if external then host_to_ieee, tmp
reclong[0] = tmp
endif
endfor
return
end