pro dbopen,name,update,UNAVAIL=unavail   
;+
; Project     :	SOHO - CDS
;
; Name        :	
;	DBOPEN
; Purpose     :	
;	Routine to open an IDL database
;
; Explanation :	
;	Routine to open an IDL database
;
; Use         :	
;	dbopen, name, update
;
; Inputs      :	
;	name - (Optional) name or names of the data base files to open.
;		It has one of the following forms:
;
;		'name'		-open single data base file
;		'name1,name2,...,nameN' - open N files which are
;				connected via pointers.
;		'name,*'	-Open the data base with all data
;				bases connected via pointers
;		''		-Interactively allow selection of
;				the data base files.
;
;		If not supplied then '' is assumed.
;		name may optionally be a string array with one name
;		per element.
;
;	update - (Optional) Integer flag specifing openning for update.
;		0 	- Open for read only
;		1	- Open for update
;		2	- Open index file for update only
;		!PRIV must be 2 or greater to open a file for update.
;		If a file is opened for update only a single data base
;		can be specified.
;
; Opt. Inputs :	None.
;
; Outputs     :	None.
;
; Opt. Outputs:	None.
;
; Keywords    :	
;	UNAVAIL - If present, a "database doesn't exit" flag is returned
;	          through it.  0 = the database exists and was opened (if
;	          no other errors arose).  1 = the database doesn't exist.
;	          Also if present, the error message for non-existant databases
;	          is suppressed.  The action, however, remains the same.  If
;	          specifiying this, be sure that the variable passed exists
;	          before the call to DBOPEN.
;
; Calls       :	DB_INFO, DBCLOSE, FDECOMP, GETLOG, GETTOK, SCREEN_SELECT,
;		ZPARCHECK, LIST_WITH_PATH, FIND_WITH_DEF
;
; Common      :	DB_COM
;
; Restrictions:	None.
;
; Side effects:	
;	The .DBF and .dbx files are opened using unit numbers obtained by
; 	GET_LUN.  Descriptions of the files are placed in the common block
; 	DB_COM.
;
; Category    :	Utilities, Database.
;
; Prev. Hist. :	
;	Version 2, D. Lindler, Nov. 1987
;       For IDL Version 2  W. Landsman May 1990 -- Will require further 
;           modfication once SCREEN_SELECT is working
;	Modified to work under Unix, D. Neill, ACC, Feb 1991.
;
; Written     :	D. Lindler, GSFC/HRS, November 1987
;
; Modified    :	Version 1, William Thompson, GSFC, 29 March 1994
;			Incorporated into CDS library.
;		Version 2, William Thompson, GSFC/CDS (ARC), 1 June 1994
;			Added support for external (IEEE) representation.
;		Version 3, William Thompson, GSFC/CDS (ARC), 20 June 1994
;			Incorporated UNAVAIL keyword, added by M. Greason,
;			Hughes STX, Feb 1993.
;		Version 4, William Thompson, GSFC, 3 November 1994
;			Modified to allow ZDBASE to be a path string.
;               Version 5, CDP, RAL 25-Apr-95
;                       Changed error message to put out root file name.
;
; Version     :	Version 5, 25 April 1995
;
;-
;
;------------------------------------------------------------------------
On_error,2
;
; data base common block
;
common db_com,QDB,QITEMS,QDBREC
;
; 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 (integer*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 format field length
;	100	flag (1 if this items points to a data base)
;	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
;	177-178 Item number within the specific data base
;
;-------------------------------------------------------------------------
;
;
; check for valid input parameters
;
if n_params(0) lt 1 then name=''
if n_params(0) lt 2 then update=0
zparcheck,'DBOPEN',name,1,7,[0,1],'Data base name(s)'
zparcheck,'DBOPEN',update,2,[1,2,3,4,5],0,'Update flag'
;
; check privilege
;
if update and (!priv lt 2) then  $
	message,'!PRIV must be 2 or greater to open with update'
;
; check UNAVAIL
;
if n_elements(unavail) gt 0 then unav_flg = 1 $
                            else unav_flg = 0
unavail = 0
totret = 1
;---------------------------------------------------------------------
; 	PROCESS INPUT NAMES (CREATE STRING ARRAY)
;
; Process scalar name
;
s=size(name) & ndim=s(0)
if ndim eq 0 then begin
;
; process name=''
;
    if strtrim(name) EQ '' then begin
	names = list_with_path('*.dbh', 'ZDBASE')
	n = N_elements(names)
	fnames = strarr(n)
	for i=0,n-1 do begin
	   fdecomp,names(i),disk,dir,nam,qual,ver
	   fnames(i)=nam
	end
	screen_select,fnames,isel,'db_titles', $
		'Select data base file to open',1
	fnames=fnames(intarr(1)+isel)
      end else begin
;
; separate names into string array
;
	fnames=strarr(20)
	st=strtrim(name,2)
	num=0
	while st ne '' do begin
		fnames(num)=strtrim(gettok(st,','),2)
		st=strtrim(st,2)
		num=num+1
	end
	fnames=fnames(0:num-1)
    end
  end else begin
;
; name is already a string vector
;
    fnames=name
end
;
; if update, only one data base can be opened
;
if update then if N_elements(fnames) gt 1 then $
	message,'Only one file can be specified if mode is update'
;
;---------------------------------------------------------------
;
;	LOOP AND OPEN EACH DATA BASE
;
; close any data bases already open
;
dbclose
;
;
offset=0		;byte offset in dbrd record for data base
tot_items=0		;total number of items all opened data bases
get_lun,unit		;get unit number to use for .dbh files
dbno=0			;present data base number
while dbno lt n_elements(fnames) do begin
    dbname=strtrim(fnames(dbno))
;
; process * if second in list  -----------------------
;
    if dbname eq '*' then begin		;get data base names from pointers
	if dbno ne 1 then begin		;* must be second data base
	    message,'Invalid use of * specification',/continue
	    goto,ABORT   
	endif
	pointers=qitems(100,*)		;find pointer items
	good=where(pointers,n)
	if n eq 0 then goto,done	;no pointers
	pnames=string(qitems(101:119,*));file names for pointers
	fnames=[fnames(0),pnames(good)] ;new file list
	dbname=strtrim(fnames(1))	;new second name
    end
;
; open .dbh file and read contents ------------------------
;

    dbhname = find_with_def(dbname+'.dbh', 'ZDBASE')
    openr,unit,dbhname,ERROR=err,/SEGMENTED     
;
;  If /SEGMENTED doesn't work, then maybe the file was written in external
;  format.  Try /BLOCK instead.
;
    if err NE 0 then openr,unit,dbhname,ERROR=err,/BLOCK
    if err NE 0 then begin
	if unav_flg EQ 0 then begin
		message,'Error opening .dbh file '+ dbname,/CONTINUE
        	print,!SYSERR_STRING
	endif else totret = 0
	unavail = 1
	goto, ABORT 
    end
    db=bytarr(120,1)
    readu,unit,db
    external = db(119) eq 1	;Is external data rep. being used?
    totbytes=fix(db,82,1) & totbytes=totbytes(0)
    nitems=fix(db,80,1) & nitems=nitems(0) ;number of items or fields in file
    if external then begin
	ieee_to_host, totbytes	&  db(82) = byte(totbytes,0,2)
	ieee_to_host, nitems	&  db(80) = byte(nitems,0,2)
    endif
    items=bytarr(200,nitems)
    readu,unit,items
    close,unit
    if external then begin
	tmp = fix(items(20:27,*),0,4,nitems)
	ieee_to_host,tmp
	items(20,0) = byte(tmp,0,8,nitems)
;
	tmp = fix(items(98:99,*),0,1,nitems)
	ieee_to_host,tmp
	items(98,0) = byte(tmp,0,2,nitems)
;
	tmp = fix(items(171:178,*),0,4,nitems)
	ieee_to_host,tmp
	items(171,0) = byte(tmp,0,8,nitems)
    endif
;
; add computed information to items ---------------------------
;
    sbyte=fix(items(24:25,*),0,nitems)+offset
    for i=0,nitems-1 do begin
	items(171,i)=byte(sbyte(i),0,2)	;starting byte in DBRD record
	items(173,i)=byte(dbno,0,2)	;data base number
	items(177,i)=byte(i,0,2)	;item number
    end
    offset=offset+totbytes
;
; open .dbf file ---------------------------------
;
    get_lun,unitdbf
    dbf_file = find_with_def(dbname+'.dbf', 'ZDBASE')
    if update eq 1 then begin
         openu,unitdbf,dbf_file,/block
    endif else if dbno gt 0 then $ 
;
;  Modified so that file is always opened with /block.  Needed to support
;  external data format.  Also, more consistent with statement above.
;  William Thompson, 1 June 1994.
;
               openr,unitdbf,dbf_file,/block $
           else openr,unitdbf,dbf_file,/block,error=err
    if err ne 0 then begin
	message,'Error opening '+dbname+'.dbf',/continue
	free_lun,unitdbf
	goto,abort
    end
    p=assoc(unitdbf,lonarr(2))
    head = p(0)
    if external then ieee_to_host, head
    db(96)=unitdbf			;unit number of .dbf file
    db(84)=byte(head(0),0,4)		;number of entries
    db(92)=byte(head(1),0,4)		;last seqnum used
    db(88)=byte(tot_items,0,2)		;starting item number for this db
    tot_items=tot_items+nitems		;new total number of items
    db(90)=byte(tot_items-1,0,2)	;last item number for this db
    db(104)=update			;opened for update
;
; open index file if necessary -----------------------------
;
    index=where(items(28,*) gt 0,nindex)	;indexed items
    if nindex gt 0 then begin		;need to open index file.
	get_lun,unitind
	dbx_file = find_with_def(dbname+'.dbx', 'ZDBASE')
	if update gt 0 then $
                  openu,unitind,dbx_file,error=err,/block $
	   else openr,unitind,dbx_file,error=err,/block
	if err ne 0 then begin
		message,'Error opening index file for '+dbname,/continue
		free_lun,unitdbf
		free_lun,unitind
		goto,abort
	endif
	db(97)=unitind			;unit number for index file
    end
;
; add to common block ---------------------
;
    if dbno eq 0 then begin
	qdb=db
	qitems=items
      end else begin
	old=qdb
	qdb=bytarr(120,dbno+1)
        qdb(0,0) = old
        qdb(0,dbno) = db
	old=qitems
	qitems=bytarr(200,tot_items)
        qitems(0,0) = old
        qitems(0,tot_items-nitems) = items
    end
;
    dbno=dbno+1
end; loop on data bases
done: free_lun,unit
;--------------------------------------------------------------------
;		LINK PROCESSING
;
; determine linkages between data bases
;
numdb = N_elements(fnames)
if numdb gt 1 then begin
    pnames=strupcase(qitems(101:119,*))
    for i=1,numdb-1 do begin
	dbname=strupcase(qdb(0:18,i))	;name of the data base
	for j=0,tot_items-1 do if pnames(j) eq dbname then goto,found
;
; if we made it here we can not link the file -----------
;
	message,'Unable to link data base file '+dbname,/continue
	goto,abort
;
; found linkage item ------------------------------------
;
found:
	item_number=j		;number of item supplying link
	item_db=fix(qitems(173:174,item_number),0,1) & item_db=item_db(0)
	if item_db ge i then begin
		message,'Unable to link data base '+dbname + $
                        'to previous data base.',/continue
		print,'	Possible incorrect ordering of input data bases'
		goto,abort
	endif
	qitems(175,item_number)=byte(i,0,2)	;data base number pointed to
	qdb(98,i)=byte(item_number,0,2)		;item number pointing to this db
nextdb:
    endfor
endif
;
; create an assoc variable for the first db
;
unit=db_info('unit_dbf',0)
len=db_info('length',0)
qdbrec=assoc(unit,bytarr(len))
;----------------------------------------------------------------------------
; done
;
return
;
; abort
;
abort:
dbclose				;close any open data bases
free_lun,unit
if (totret NE 0) then retall else return
end