pro dbwrt,entry,index,append ;+ ; Project : SOHO - CDS ; ; Name : ; DBWRT ; Purpose : ; Procedure to update or add a new entry to a data base ; Explanation : ; Procedure to update or add a new entry to a data base ; Use : ; dbwrt, entry, [ index, append ] ; Inputs : ; entry - entry record to be updated or added if first ; item (entry number=0) ; ; Opt. 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. ; ; Opt. Outputs: None. ; ; Keywords : None. ; ; Calls : BSORT, DB_INFO, DB_ITEM, DB_ITEM_INFO, DBINDEX_BLK, DBXPUT, ; DBXVAL ; ; Common : DB_COM ; ; Restrictions: ; !PRIV must be greater than 1 to execute ; ; Side effects: None. ; ; Category : Utilities, Database. ; ; Prev. Hist. : ; version 2 D. Lindler Feb. 1988 (new db format) ; converted to IDL Version 2. M. Greason, STX, June 1990. ; ; Written : D. Lindler, GSFC/HRS, February 1988 ; ; Modified : Version 1, William Thompson, GSFC, 28 March 1994 ; Incorporated into CDS library. ; Version 2, William Thompson, GSFC/CDS (ARC), 28 May 1994 ; Added support for external (IEEE) representation. ; ; Version : Version 2, 28 May 1994 ;- ; ;------------------------------------------------------------------- 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 ; 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