; ------------------------------------------------------------------------------------------------

PRO db_info__define

struct = { DB_INFO,        $ ; The structure name.
           db_name: "",     $ ; data base name.
           title: "",     $ ; data base title.
           n_items: 0,   $ ; number of items.
           record_length: 0,    $ ; record length of DBF file.
           n_entries: 0L,   $ ; number of entries in file.
           first_item_pos: 0,   $ ; position of first item for this file.
           last_item_pos: 0,    $ ; position of last item for this file.
           last_seq_number: 0L, $ ; Last sequence number used (item = SEQNUM).
           dbf_lun: 0,   $ ; Unit number of .dbf file (0 if none exists/open).
           dbx_lun: 0,   $ ; Unit number of .dbx file (0 if none exists/open).
           ptr_item_index: 0,   $ ; Index number of item pointing to this file (0 for first db).
           num_alloc_entries: 0,$ ; Number of entries with space allocated.
           update: 0,     $ ; Update flag (0 open for read only, 1 open for update).
           path: "",       $ ; Complete path to the database.
           external: 0   $ ; True if database is in external (IEEE) format.
         }

END

; ------------------------------------------------------------------------------------------------

PRO db_item_info__define

struct = { DB_ITEM_INFO,    $ ; The structure name.
           name: "",      $ ; item name.
           data_type: 0,    $ ; IDL data type.
           n_values: 0,     $ ; Number of values for item (1 for scalar).
           data_dbf_pos: 0, $ ; Starting byte position in original DBF record.
           data_dbf_size: 0,    $ ; Number of bytes per data value.
           index_type: 0,   $ ; Index type.
           description: "", $ ; Item description.
           print_fld_length: 0, $ ; Print field length.
           pointer: 0,   $ ; Flag set to one if pointer item.
           child : "",   $ ; Data base this item points to.
           db_name: "",     $ ; Database name that this item belongs to.
           print_format: "",    $ ; Print format.
           print_headers: "",   $ ; Print headers.
           dbrd_start_pos: 0,   $ ; Starting byte in record returned by DBRD.
           db_number: 0,    $ ; Data base number.
           db_child_number: 0   $ ; Data base number this item points to.
         }

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::error, ERRNO = errno, INFORMATIONAL = info, QUIET = quiet

;   ERROR
;
;   Common object error handling method.
;
; Syntax      : result = 0->ERROR ([KEYWORDS])
;
; Inputs      : None.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : ERRNO     = When set, indicates the error number of the error that
;            caused this method to be invoked.  Error numbers are
;            set solely by the invoking method.
;
;     INFORMATIONAL    = When set, no traceback information is printed.  This
;            keyword is useful when the calling method just wants
;            to display a message, not invoke an error.
;
;     QUIET       =  When set, no messages or other information is printed
;             by the method.
;
; Return Value: The value of the keyword ERRNO, if set.  Otherwise it returns 0.
;
; Restrictions: None.

; Give a default value to error value, if none was passed to us.

IF N_ELEMENTS (errno) EQ 0 THEN errno = 0

; Get the call stack and the calling routine's name.

HELP, CALLS = stack

calledby  = (STR_SEP (STRCOMPRESS (stack [1]), " ")) [0]

; Print the contents of the object message, if the quiet keyword has not been selected.

IF NOT KEYWORD_SET (quiet) THEN BEGIN

   MESSAGE, calledby + ': ' + self.msg, /CONTINUE, /NONAME,  INFORMATIONAL = info

ENDIF

; Provide traceback information, but only if the info keyword or quiet keyword is not set.

IF NOT (KEYWORD_SET (info) OR KEYWORD_SET (quiet)) THEN BEGIN

   PRINT,''
   PRINT, 'Traceback Report from ' + STRUPCASE (calledby) + ':'
   PRINT, ''

   FOR j = 1, N_ELEMENTS (stack) - 1 DO BEGIN

; Extract the module name from the jth line of the callstack

       module_name = (STR_SEP (STRCOMPRESS (stack [j]), " ")) [0]

; If this module corresponds a physical file, extract the  begining
; and ending position of the file name from jth line of the call stack

       src_pos_0 = STRPOS (stack [j], '<')
       src_pos_1 = STRPOS (stack [j], '>')

; If there was no physcial file, then both values will = -1.

       IF src_pos_0 NE -1 AND src_pos_1 NE -1 THEN BEGIN

; Extract the name of the physical file and the line the module was called from.

          module_src = STRMID (stack [j], src_pos_0 + 1, src_pos_1 - src_pos_0 - 1)

          ln_pos_0 = STRPOS (module_src, '(')
          ln_pos_1 = STRPOS (module_src, ')')

          module_ln  = STRMID (module_src, ln_pos_0 + 1, ln_pos_1 - ln_pos_0 - 1)

          module_src = STRMID (module_src, 0, ln_pos_0)

       ENDIF ELSE BEGIN

; Otherwise, just set module_ln and module_src to empty strings.

          module_ln  = ""
          module_src = ""

       ENDELSE

; Print out the information in a pretty format

       PRINT, module_name,                         FORMAT = '(5X, A, T30, $)'
       IF module_ln  NE "" THEN PRINT, module_ln,  FORMAT = '("at line:", A7, T18, $)'
       IF module_src NE "" THEN PRINT, module_src, FORMAT = '(A, $)'
       PRINT, ""

   ENDFOR

ENDIF

RETURN, errno

END

; ------------------------------------------------------------------------------------------------

PRO db_tools::cleanup

;   CLEANUP
;
;   Perform whatever operations are necessary prior to object destruction.
;
; Inputs      : None.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : None.
;
; Restrictions: None.

; Free any lingering heap variables.

PTR_FREE, self.uval

; Get rid of the db_tools_connect object, if it exists.

IF OBJ_VALID (self.db_tools_connect) THEN OBJ_DESTROY, self.db_tools_connect

; Get rid of the structure list used to hold the paths to previously located databases

OBJ_DESTROY, self.path_list

OBJ_DESTROY, self.info_list

IF self.remote AND self.client THEN BEGIN

   IF NOT self.idl_server->RPCCleanup () THEN BEGIN

      self.msg = 'Failed to execute method RPCCleanup.'

      tmp = self->error ()

   ENDIF

   OBJ_DESTROY, self.idl_server

ENDIF

END

; ------------------------------------------------------------------------------------------------

PRO db_tools::set_uvalue, val

;   SET_UVALUE
;
;   Allows the object to store a user value.  After a new user value is stored,
;   the user value will be deleted.  This method duplicates the equivalent
;   behavior in widgests.
;
; Syntax      : 0->SET_UVALUE, val
;
; Inputs      : val = The new user value to store in the object.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : None.
;
; Restrictions: None.

; Free the old uval.  We won't need it anymore

PTR_FREE, self.uval

; Create the new uval.

self.uval = PTR_NEW (val)

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::get_uvalue

;   GET_UVALUE
;
;   Returns the user value stored in the object.
;
; Syntax      : result = 0->GET_UVALUE ()
;
; Inputs      : None.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : None.
;
; Return Value: The user value stored in the object.
;
; Restrictions: None.

; Just return whatever uval points to.

RETURN, *self.uval

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::getmsg

;   GETMSG
;
;   Get the last error or other informational message generated by the object.
;
; Syntax      : result = 0->GETMSG ()
;
; Inputs      : None.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : None.
;
; Return Value: The last message generated by the object.
;
; Restrictions: None.

; Just return whatever the current message is.

RETURN, self.msg

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::check_querry, str, ERRMSG = errmsg, ERRPOS = errpos, DB_ITEM = db_item

;   CHECK_QUERRY
;
;   Parse and syntactly check a database query string.
;
;   This method will parse a database search string to make sure that it
;       is properly formed and semantically correct.  If no errors are detected,
;       it will return 0, otherwise it will return the error number of the first
;       error in the string.  The position of the error in the string as well as
;       text message describing the error are returned as keywords.
;
;   This method works by calling the method parse_srch_str to do check the
;   seach string for syntatic errors.  It then will check to make sure that
;   each field referred to by the search corresponds to an actual database
;   field.  However, this behavior is only enabled if the keyword DB_ITEM is
;   set to point to the result of the get_db_info method for the database that
;   search string will be queried against.
;
; Syntax      : result = 0->CHECK_QUERRY ( string, [KEYWORDS] )
;
; Inputs      : STR = The database query string to parse.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : ERRMSG  = When passed, on method exit this keyword will be set to
;        the text string describing the first error that was
;        encountered while processing the query string.
;
;     ERRPOS   = When passed, on method exit this keyword will be set to
;        the position of the first error that was encountered
;        while processing the query string.
;
;     DB_ITEM = This keyword allows the method to perform not just syntatic
;        checks but also a basic semantic check as well.  When used,
;        the method will check that all the items in the query string
;        actually exist in the database that is being searched.  In
;        order to use this feature, this keyword should be set to the
;        array of DB_ITEM_INFO structures that is returned by the method
;        get_db_info for the database being queried.
;
;
; Return Value: 0 in the case of successfull completion, otherwise it returns one of
;     the following error codes:
;
;       1 :    Syntax Error
;       2 :    Too Many Terms In Selection Statement
;       3 :    Incomplete Statement
;       4 :    Unexpected Statement Termination
;       5 :    Found Float/Integer Where String Was Expected
;       6 :    Found String Where Float/Integer Was Expected
;       8 :    Unkown Database Item
;       10:    Parser Error: Unexpected Machine State
;       21:    Lexor Error: Lexor Encounted Invalid State
;       22:    Lexor Error: Lexor Ended At Non-Terminal State
;       23:    Lexor Error: Token Run On
;
;     The return values of this method are the same as those returned by the
;     method parse_srch_str().
;
; Restrictions: None.

; Call parse_srch_str() in order to make sure that the search string is properly formed,
; if there are any errors detected in the search, then the position of the first error
; will be returned in in errpos.

result = self->parse_srch_str (str, ERRPOS = errpos, DB_SEARCH = db_search)

; Check if db_item has been defined.  If it is, in addition to doing to syntactic checks
; we will check that each item refered to in the search string is valid.

IF (result EQ 0) AND (N_ELEMENTS (db_item) NE 0) THEN BEGIN

   valid = db_item.name

   FOR i = 0, N_ELEMENTS (db_search) - 1 DO BEGIN

       exist = WHERE (valid EQ db_search [i].item)

       IF exist [0]  EQ -1 THEN BEGIN

          result = 8
          errpos = db_search [i].pos
          errval = db_search [i].item

          GOTO, LOOP_EXIT

       ENDIF

   ENDFOR

ENDIF

LOOP_EXIT:

; Create a text message to describe whatever error was detected.

CASE result OF

  1 : errmsg = 'Syntax Error'
  2 : errmsg = 'Too Many Terms In Selection Statement'
  3 : errmsg = 'Incomplete Statement'
  4 : errmsg = 'Unexpected Statement Termination'
  5 : errmsg = 'Found Float/Integer Where String Was Expected'
  6 : errmsg = 'Found String Where Float/Integer Was Expected'
  8 : errmsg = 'Unkown Database Item: ' + errval
  10: errmsg = 'Parser Error: Unexpected Machine State'
  21: errmsg = 'Lexor Error: Lexor Encounted Invalid State'
  22: errmsg = 'Lexor Error: Lexor Ended In A Non-Terminal State'
  23: errmsg = 'Lexor Error: Token Run On'

  ELSE :

ENDCASE

; Use the result of parse_srch_str() as the return value of this function.

RETURN, result

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::parse_srch_str, str, ERRPOS = errpos, DB_SEARCH = db_search

;   PARSE_SRCH_STR
;
;   Parse a database query string.
;
;   This method will parse a database search string to make sure that it is
;       properly formed and semantically correct.  If any errors were detected,
;   it will report the first character in the string that contains an error.
;
;   The method works by first calling the method lex_srch_str to convert the
;   search string into tokens.  It then proceeds to parse the token string
;   using a deterministic, stackless, state machine.  This works because the
;   grammar used to construct database search strings can be expressed
;   using regular expressions.
;
; Syntax      : result = 0->PARSE_SRCH_STR ( string, [KEYWORDS] )
;
; Inputs      : STR = The database query string to parse.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : ERRPOS  = When passed, on method exit this keyword will be set to
;        the position of the first error encountered in the
;        in the query string.
;
;     DB_SEARCH=When passed, on method exit this keyword will be set to
;        an array of named structures which completly describe the
;        search operation that was requested by the query string.
;
;        The SREQ structure is defined as follows:
;
;      {SREQ,         ;  Structure Name
;       item : "",        ;  Name of dababase field to search on.
;       op :   0,      ;  Search Operation (not currently defined).
;       nval : 0,   ;  Number of values to search against.
;       val  : STRARR (),  ;  An array of nval strings, each string
;               ;  contains on value to search on.
;       type : 0,   ;  Type of search.
;       pos  : 0     ;  Position of search in query string.
;       }
;
;
; Return Value: 0 in the case of successfull completion, otherwise it returns one of
;     the following error codes:
;
;       1 :    Syntax Error
;       2 :    Too Many Terms In Selection Statement
;       3 :    Incomplete Statement
;       4 :    Unexpected Statement Termination
;       5 :    Found Float/Integer Where String Was Expected
;       6 :    Found String Where Float/Integer Was Expected
;       8 :    Unkown Database Item
;       10:    Parser Error: Unexpected Machine State
;       21:    Lexor Error: Lexor Encounted Invalid State
;       22:    Lexor Error: Lexor Ended At Non-Terminal State
;       23:    Lexor Error: Token Run On
;
; Restrictions: None.

; Token Types

TK_NONE    =  0
TK_STRING  = -1
TK_INTEG   = -2
TK_FLOAT   = -3
TK_HHMMSS  = -4
TK_DATE    = -5

RIGHT_ARR = (BYTE ('>')) [0]
LEFT_ARR  = (BYTE ('<')) [0]
EQUAL_SGN = (BYTE ('=')) [0]
COMMA_SEP = (BYTE (',')) [0]
RT_PAREN  = (BYTE (')')) [0]
LT_PAREN  = (BYTE ('(')) [0]
RT_BRACK  = (BYTE (']')) [0]
LT_BRACK  = (BYTE ('[')) [0]

; Set max_terms to be largest number of values that can be used in a selection query.
; Currently this value is defined to be 10.

max_terms = 10

; Create a structure to hold a search request.

search = {SREQ,           $
          item : "",           $
          op   : 0,           $
          nval : 0,           $
          val  : STRARR (max_terms),       $
          type : 0,           $
          pos  : 0          $
          }

; Set db_search to a one element array of structures of type SREQ.   We
; will use this array to store database searches as we extract from the
; search string.

db_search = REPLICATE (search, 1)

; Set some flags to help us parse the search string.

accept= 0   ; TRUE if the parser was able to process the input string.
val   = 0   ; TRUE if the token is an INTEG, FLOAT, HHMMSS, or DATE.
tmp   = ""  ; Temperary Holder

; Counters and such to help run the state machine

token = 0   ; Token ID.
state = 0   ; Current Machine State.
nterm = 0   ; Number of terms in selection statement.
error = 0   ; Error number generated by machine.

; Get all tokens from the string.

res = self->lex_srch_str ( str, TLST = tlst, TVAL = tval, TPOS = tpos )

; Check if the lexor worked OK.  If it did not, then return the lexor error
; as a parser error.  We just add 20 to to the lexor error to get the equivalent
; parser error.

IF res NE 0 THEN BEGIN

   errpos = 0

   RETURN, res + 20

ENDIF

; Set n_tokens to the number tokens the lexor found in the search string.

n_tokens = N_ELEMENTS (tlst)

FOR i = 0, n_tokens - 1 DO BEGIN

    token = tlst [i]

    val = token EQ TK_INTEG OR      $
          token EQ TK_FLOAT OR      $
          token EQ TK_HHMMSS OR     $
          token EQ TK_DATE

    CASE state OF

      0   : BEGIN

        nterm = 0

        CASE 1 OF

          (token EQ TK_STRING) :  BEGIN

            tmp         = tval [i]
            search.pos  = tpos [i]

            state = 10

            END

          (val)                :  BEGIN

            search.val [nterm] = tval [i]
            search.type  = 0
            nterm = nterm + 1

            state = 100

            END

          ELSE                 :  error = 1

        ENDCASE

        END

      10  : BEGIN

        CASE token OF

          EQUAL_SGN : BEGIN

            search.item = tmp
            state = 30

            END

          RIGHT_ARR : BEGIN

            search.item = tmp
            state = 20

            END

          LEFT_ARR  :  state = 11

          ELSE      :  error = 1

        ENDCASE

        END

      11  : BEGIN

        CASE 1 OF

          (val)                :  BEGIN

            search.item = tmp
            search.type = 0
            search.type = 0

            search.val [nterm] = tval [i]
            nterm = nterm + 1

            state = 104

            END

          (token EQ TK_STRING) :  BEGIN

            search.item = tval [i]
            search.pos  = tpos [i]
            search.type = 1

            search.val [nterm] = tmp
            nterm = nterm + 1

            state = 12

            END

          ELSE                 :  error = 1

        ENDCASE

        END

      12  : BEGIN

        CASE token OF

      COMMA_SEP :  BEGIN

            state = 104
            i = i - 1

            END

          LEFT_ARR  :  state = 103

          ELSE      :  error = 1

        ENDCASE

        END

      20  : BEGIN

        IF (val) OR (token EQ TK_STRING) THEN BEGIN

           IF val THEN search.type = 0 ELSE search.type = 1

           search.val [nterm] = tval [i]
           nterm = nterm + 1

           state = 104

        ENDIF ELSE BEGIN

           error = 1

        ENDELSE

        END

      30  : BEGIN

        CASE 1 OF

          (val)                :  BEGIN

            search.type  = 0

            search.val [nterm] = tval [i]
            nterm = nterm + 1

            state = 31

            END

          (token EQ TK_STRING) :  BEGIN

            search.type  = 1

            search.val [nterm] = tval [i]
            nterm = nterm + 1

            state = 104

            END

          (token EQ LT_BRACK)  :  state = 50

          ELSE                 :  error = 1

        ENDCASE

        END

      31  : BEGIN

        CASE token OF

          LT_PAREN  :  state = 40
      COMMA_SEP :  BEGIN

            state = 104
            i = i - 1

            END

          ELSE      :  error = 1

        ENDCASE

        END

      40  : BEGIN

        CASE token OF

          TK_INTEG  : BEGIN

            search.val [nterm] = tval [i]
            nterm = nterm + 1

            state = 41

            END

          TK_FLOAT  : BEGIN

            search.val [nterm] = tval [i]
            nterm = nterm + 1

            state = 41

            END

          ELSE      :  error = 1

        ENDCASE

        END

      41  : BEGIN

        CASE token OF

          RT_PAREN  :  state = 104

          ELSE      :  error = 1

        ENDCASE

        END

      50  : CASE 1 OF

          (val)                :  BEGIN

            IF nterm EQ 0 THEN search.type = 0

            CASE 1 OF

              (search.type NE 0)  : error = 5
              (nterm LT max_terms): BEGIN

                search.val [nterm] = tval [i]
                nterm = nterm + 1

                state = 51

                END

              ELSE                : error = 2

            ENDCASE

            END

          (token EQ TK_STRING) :  BEGIN

            IF nterm EQ 0 THEN search.type = 1

            CASE 1 OF

              (search.type NE 1)  : error = 6
              (nterm LT max_terms): BEGIN

                search.val [nterm] = tval [i]
                nterm = nterm + 1

                state = 51

                END

              ELSE                : error = 2

            ENDCASE

            END

          ELSE                 :  error = 1

        ENDCASE

      51  : CASE token OF

          COMMA_SEP :  state = 50
          RT_BRACK  :  state = 104

          ELSE      :  error = 1

        ENDCASE

      100 : CASE token OF

          LEFT_ARR  :  BEGIN

            state = 101

            END

          ELSE      :  error = 1

        ENDCASE

      101 : CASE token OF

          TK_STRING :  BEGIN

            search.item = tval [i]
            search.pos  = tpos [i]

            state = 102

            END

          ELSE      :  error = 1

        ENDCASE

      102 : CASE token OF

          LEFT_ARR  :  state = 103

          ELSE      :  error = 1

        ENDCASE

      103 : BEGIN

        CASE 1 OF

          (val)  :  BEGIN

            IF search.type NE 0 THEN BEGIN

               error = 5

            ENDIF ELSE BEGIN

               search.val [nterm] = tval [i]
               nterm = nterm + 1

               state = 104

        ENDELSE

            END

          (token EQ TK_STRING) :  BEGIN

            IF search.type NE 1 THEN BEGIN

               error = 6

            ENDIF ELSE BEGIN

               search.val [nterm] = tval [i]
               nterm = nterm + 1

               state = 104

        ENDELSE

            END

      ELSE   :  error = 1

        ENDCASE

        END

      104 : BEGIN

        CASE token OF

      COMMA_SEP :  BEGIN

            search.nval = nterm
            db_search   = [db_search, search]

            state = 0

            END

          ELSE      :  error = 1

        ENDCASE

        END

      ELSE: error = 10

    ENDCASE

IF error NE 0 THEN GOTO, ERROR

ENDFOR

CASE state OF

  0    :  error  = 4
  10   :  error  = 3
  11   :  error  = 3
  12   :  accept = 1
  20   :  error  = 3
  30   :  error  = 3
  31   :  accept = 1
  40   :  error  = 3
  41   :  error  = 3
  50   :  error  = 3
  51   :  error  = 3
  100  :  error  = 3
  101  :  error  = 3
  102  :  error  = 3
  103  :  error  = 3
  104  :  accept = 1

  ELSE :  error  = 10

ENDCASE

IF accept THEN BEGIN

   search.nval = nterm
   db_search   = [db_search, search]
   db_search   = db_search [1:*]

   RETURN, 0

ENDIF

ERROR:

IF i GE n_tokens THEN BEGIN

   errpos = STRLEN (str) - 1

ENDIF ELSE BEGIN

   errpos = TPOS [i]

ENDELSE

RETURN, error

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::lex_srch_str, str, TLST = tlst, TVAL = tval, TPOS = tpos

;   LEX_SRCH_STR
;
;   Perform a lexical analysis of a database query string.
;
;   This function does a non-recursive lexical analysis of query strings to the
;   database.  Field names, dates and times are identified and assigned special
;   tokens in the result string.  All other charactres are passed straight through.
;   This method is designed to be used in conjuction  with the parse_srch_str
;       method.
;
;   The list of special token values is as follows:
;
;   String:     -1
;   Integer:  -2
;   Float:       -3
;   Hour/min/sec: -4
;   Date:     -5
;
;
; Syntax      : result = 0->LEX_SRCH_STR ( string, [KEYWORDS] )
;
; Inputs      : STR = The string to perform lexical analysis on.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : TLST    = When passed, on method exit this keyword will be set to
;        an array of integers.  Each integer in the array represents
;        a token that was extracted from the query string.  Tokens
;        are of two types: single characters that are represented by
;        by their ASCII value and multiple character tokens that
;        are represented by special (negative) token values.
;
;     TVAL = When passed, on method exit this keyword will be set to
;        an array of strings.  Each element of the array will be
;        set to the string value of the corresponding token in the
;        TLST array.
;
;     TPOS = When passed, on method exit this keyword will be set to
;        an array of integers.  Each element array is set the
;        position in the string at which the corresponding token
;        in the TLST array is located.
;
; Return Value: 0 in the case of successfull completion, otherwise it returns one of
;     the following error codes:
;
;       1 :   Lexor entered an invalid state.
;       2 :    Lexor ended at a non-terminal state.
;       3 :    Token run on.
;
; Restrictions: None.

; Token Types (to pass to PARSER)

TK_NONE    =  0
TK_STRING  = -1
TK_INTEG   = -2
TK_FLOAT   = -3
TK_HHMMSS  = -4
TK_DATE    = -5

; Byte values of selected ASCII characters.

UPPA = (BYTE ('A')) [0]
UPPZ = (BYTE ('Z')) [0]
LOWA = (BYTE ('a')) [0]
LOWZ = (BYTE ('z')) [0]
DIG0 = (BYTE ('0')) [0]
DIG9 = (BYTE ('9')) [0]

UNDERSCOR = (BYTE ('_')) [0]
RIGHT_ARR = (BYTE ('>')) [0]
LEFT_ARR = (BYTE ('<'))  [0]
EQUAL_SGN = (BYTE ('=')) [0]
MINUS_SGN = (BYTE ('-')) [0]
FWR_SLASH = (BYTE ('/')) [0]
BCK_SLASH = (BYTE ('\')) [0]
DEC_POINT = (BYTE ('.')) [0]
COMMA_SEP = (BYTE (',')) [0]
RT_PAREN  = (BYTE (')')) [0]
LT_PAREN  = (BYTE ('(')) [0]
RT_BRACK  = (BYTE (']')) [0]
LT_BRACK  = (BYTE ('[')) [0]
COLON     = (BYTE (':')) [0]
WSPACE    = (BYTE (' ')) [0]

; Set tlst and tpos to 1 element integer arrays.  The only value in each array
; will be 0  Set tval to a 1 element string array.  The only value in the array
; will be an empty string.

tlst = INTARR (1)
tpos = INTARR (1)
tval = STRARR (1)

; Make sure that str is a scalar

str = str [0]

; Get the string length

len = STRLEN (str)

; Convert the string into an array of bytes

bstr = BYTE (str)

; Set pointer to ptr to 0.  We will use ptr to process through the string.

ptr = 0

; Set tmp to hold values while we decide what to do with them.

tmp = BYTARR (256)
tmpptr = 0

; Analyze the string.  This is a bit faster then doing it one character at a time.

; Set lc to be byte array of the same length as the string.  Each elemement in
; lc that corresponds to a lower case character in the search string will be
; set to 1.

lc = BYTARR (len)
pos = WHERE (bstr LE LOWZ AND bstr GE LOWA)
IF pos [0] NE -1 THEN lc [pos] = 1

; Set uc to be byte array of the same length as the string.  Each elemement in
; uc that corresponds to a upper case character in the search string will be
; set to 1.

uc = BYTARR (len)
pos = WHERE (bstr LE UPPZ AND bstr GE UPPA)
IF pos [0] NE -1 THEN uc [pos] = 1

; Set digit to be byte array of the same length as the string.  Each elemement in
; digit that corresponds to a numerical digit character in the search string will be
; set to 1.

digit = BYTARR (len)
pos = WHERE (bstr LE DIG9 AND bstr GE DIG0)
IF pos [0] NE -1 THEN digit [pos] = 1

; Combine uc and lc together to form a byte array such that every element will be
; set to 1 if it corresponds to any type of alpha character in the search string.

alpha = uc OR lc

; Set tok to be an array of integers the same length as the search string.  We will
; use tok to store the value of each token as we collect it.

tok = INTARR (len)

; Set tmp to be an array of integers the same length as the search string.  We will
; use tmp as temporary storage to characters that we think might form part of a token,
; but which we are not sure about.

tmp = INTARR (len)

; Set some flags to help us collect tokens

found = 0   ; TRUE when a token has been completed (A FINAL state has been reached)
belch = 0   ; TRUE if the contents of the tmp array are to be disgarded
recrd = 0   ; TRUE if the contents of the tmp array are to be copied to the tok array.
eos   = 0   ; TRUE when the end of string has been reached
eatch = 0   ; TRUE if the next character should be stored in the tok array
store = 0   ; TRUE if the next character should be stored in the tmp array

; Counters and such to help run the state machine

token = 0   ; Token ID.
state = 0   ; Current Machine State.
tkptr = 0   ; Position pointer for tok array.
tmptr = 0   ; Position pointer for tmp array.
start = 0   ; Position of the initial character of the token in the string.
btrak = 0   ; Position in search string to back trak to if token can not be compoleted.
error = 0   ; Error status of machine.
nfnd  = 0   ; Number of completed tokens.

; Get all tokens from the string.

;   Machine State Table Meanings
;   ----------------------------------------------------------------------------------------
;
;   The machine used to accept tokens is based on the following states:
;   (states marked with an 'F' valid final states)
;
;   STATE ACCEPTS              COMMENTS
;   ===== =======              ========
;   0                          INITIAL STATE
;   1  F  A(A|D|_)*            Any alphanumeric token that begins with a letter
;   2  F  D+                   Any sequequence of digits, not includeing a decimal point
;   3  F  D+.D*                Any sequencence of digits which includes a decimal point
;   10 F  D                    Any single digit
;   11 F  DD                   Two digits
;   12 F  DDD                  Three digits
;   13 F  DDDD                 Four digits
;   20    D?:                  Partial HH:MM:SS
;   21    D?:D                 Partial HH:MM:SS
;   22    D?:DD                Partial HH:MM:SS
;   30    D?:D?:               Partial HH:MM:SS
;   31 F  D?:D?:D              HH:MM:SS
;   32 F  D?:D?:DD             HH:MM:SS
;   33 F  D?:D?:D?.D*          HH:MM:SS
;   40    -                    Minus Sign
;   100   DDDD\                Partial Date
;   101   DDDD\D               Partial Date
;   102   DDDD\DD              Partial Date
;   103   DDDD\DDD             Partial Date
;   110   DDDD\DDD:            Partial Date
;   111   DDDD\DDD:D           Partial Date
;   112   DDDD\DDD:DD          Partial Date
;   120   DDDD\DDD:D?:         Partial Date
;   121   DDDD\DDD:D?:D        Partial Date
;   122   DDDD\DDD:D?:DD       Partial Date
;   130   DDDD\DDD:D?:D?:      Partial Date
;   131F  DDDD\DDD:D?:D?:D     Date
;   132F  DDDD\DDD:D?:D?:DD    Date
;   133F  DDDD\DDD:D?:D?:D?.D+ Date
;
;   WHERE:    D is any single digit [0-9]
;             A is any single letter [a-z,A-Z]
;             * 0 or more repetitions
;             + 1 or more repetitions
;             ? 1 or 2 repetitions
;             | either/or

WHILE NOT eos AND NOT error DO BEGIN

  val = bstr [ptr]

  CASE 1 OF

    (alpha [ptr]) :  BEGIN

       CASE state OF

         0   : BEGIN state = 1 & eatch = 1 & END
         1   : eatch = 1
         2   : found = 1
         3   : found = 1
         10  : found = 1
         11  : found = 1
         12  : found = 1
         13  : found = 1
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 2   & belch = 1 & END
         22  : BEGIN state = 2   & belch = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : found = 1
         32  : found = 1
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 2   & belch = 1 & END
         102 : BEGIN state = 2   & belch = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 2   & belch = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : found = 1
         122 : found = 1
         130 : BEGIN state = 2   & belch = 1 & END
         131 : found = 1
         132 : found = 1
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    (digit [ptr]) : BEGIN

       CASE state OF

         0   : BEGIN state = 10  & store = 1 & END
         1   : eatch = 1
         2   : eatch = 1
         3   : eatch = 1
         10  : BEGIN state = 11  & store = 1 & END
         11  : BEGIN state = 12  & store = 1 & END
         12  : BEGIN state = 13  & store = 1 & END
         13  : BEGIN state = 2   & store = 1 & END
         20  : BEGIN state = 21  & store = 1 & END
         21  : BEGIN state = 22  & store = 1 & END
         22  : BEGIN belch = 1   & found = 1 & END
         30  : BEGIN state = 31  & store = 1 & END
         31  : BEGIN state = 32  & store = 1 & END
         32  : found = 1
         33  : store = 1
         40  : BEGIN eatch = 1   & state = 2 & END
         100 : BEGIN state = 101 & store = 1 & END
         101 : BEGIN state = 102 & store = 1 & END
         102 : BEGIN state = 103 & store = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 111 & store = 1 & END
         111 : BEGIN state = 112 & store = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 121 & store = 1 & END
         121 : BEGIN state = 122 & store = 1 & END
         122 : found = 1
         130 : BEGIN state = 131 & store = 1 & END
         131 : BEGIN state = 132 & store = 1 & END
         132 : found = 1
         133 : store = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    (val EQ WSPACE) : BEGIN

       CASE state OF

         0   : BEGIN & ptr = ptr + 1 & start = ptr & END
         1   : found = 1
         2   : found = 1
         3   : found = 1
         10  : found = 1
         11  : found = 1
         12  : found = 1
         13  : found = 1
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 2   & belch = 1 & END
         22  : BEGIN state = 2   & belch = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : found = 1
         32  : found = 1
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 2   & belch = 1 & END
         102 : BEGIN state = 2   & belch = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 2   & belch = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : found = 1
         122 : found = 1
         130 : BEGIN state = 2   & belch = 1 & END
         131 : found = 1
         132 : found = 1
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    (val EQ UNDERSCOR) : BEGIN

       CASE state OF

         0   : BEGIN eatch = 1 & found = 1 & END
         1   : eatch = 1
         2   : found = 1
         3   : found = 1
         10  : found = 1
         11  : found = 1
         12  : found = 1
         13  : found = 1
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 2   & belch = 1 & END
         22  : BEGIN state = 2   & belch = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : found = 1
         32  : found = 1
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 2   & belch = 1 & END
         102 : BEGIN state = 2   & belch = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 2   & belch = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : found = 1
         122 : found = 1
         130 : BEGIN state = 2   & belch = 1 & END
         131 : found = 1
         132 : found = 1
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    (val EQ COLON) : BEGIN

       CASE state OF

         0   : BEGIN eatch = 1   & found = 1 & END
         1   : found = 1
         2   : found = 1
         3   : found = 1
         10  : BEGIN state = 20  & store = 1 & END
         11  : BEGIN state = 20  & store = 1 & END
         12  : state = 2
         13  : state = 2
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 30  & store = 1 & END
         22  : BEGIN state = 30  & store = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : found = 1
         32  : found = 1
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 110 & store = 1 & END
         102 : BEGIN state = 110 & store = 1 & END
         103 : BEGIN state = 110 & store = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 120 & store = 1 & END
         112 : BEGIN state = 120 & store = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : BEGIN state = 130 & store = 1 & END
         122 : BEGIN state = 130 & store = 1 & END
         130 : BEGIN state = 2   & belch = 1 & END
         131 : found = 1
         132 : found = 1
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    (val EQ MINUS_SGN) : BEGIN

       CASE state OF

         0   : BEGIN state = 40  & eatch = 1 & END
         1   : found = 1
         2   : found = 1
         3   : found = 1
         10  : found = 1
         11  : found = 1
         12  : found = 1
         13  : found = 1
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 2   & belch = 1 & END
         22  : BEGIN state = 2   & belch = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : found = 1
         32  : found = 1
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 2   & belch = 1 & END
         102 : BEGIN state = 2   & belch = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 2   & belch = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : found = 1
         122 : found = 1
         130 : BEGIN state = 2   & belch = 1 & END
         131 : found = 1
         132 : found = 1
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    (val EQ DEC_POINT) : BEGIN

       CASE state OF

         0   : BEGIN eatch = 1   & found = 1 & END
         1   : found = 1
         2   : BEGIN state = 3   & eatch = 1 & END
         3   : found = 1
         10  : BEGIN state = 3   & eatch = 1 & recrd = 1 & END
         11  : BEGIN state = 3   & eatch = 1 & recrd = 1 & END
         12  : BEGIN state = 3   & eatch = 1 & recrd = 1 & END
         13  : BEGIN state = 3   & eatch = 1 & recrd = 1 & END
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 2   & belch = 1 & END
         22  : BEGIN state = 2   & belch = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : BEGIN state = 33  & store = 1 & END
         32  : BEGIN state = 33  & store = 1 & END
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 2   & belch = 1 & END
         102 : BEGIN state = 2   & belch = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 2   & belch = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : found = 1
         122 : found = 1
         130 : BEGIN state = 2   & belch = 1 & END
         131 : BEGIN state = 133 & store = 1 & END
         132 : BEGIN state = 133 & store = 1 & END
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    (val EQ BCK_SLASH) : BEGIN

       CASE state OF

         0   : BEGIN found = 1 & eatch = 1 & END
         1   : found = 1
         2   : found = 1
         3   : found = 1
         10  : found = 1
         11  : found = 1
         12  : found = 1
         13  : BEGIN state = 100 & store = 1 & END
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 2   & belch = 1 & END
         22  : BEGIN state = 2   & belch = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : found = 1
         32  : found = 1
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 2   & belch = 1 & END
         102 : BEGIN state = 2   & belch = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 2   & belch = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : found = 1
         122 : found = 1
         130 : BEGIN state = 2   & belch = 1 & END
         131 : found = 1
         132 : found = 1
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

    ELSE: BEGIN

       CASE state OF

         0   : BEGIN found = 1 & eatch = 1 & END
         1   : found = 1
         2   : found = 1
         3   : found = 1
         10  : found = 1
         11  : found = 1
         12  : found = 1
         13  : found = 1
         20  : BEGIN state = 2   & belch = 1 & END
         21  : BEGIN state = 2   & belch = 1 & END
         22  : BEGIN state = 2   & belch = 1 & END
         30  : BEGIN state = 2   & belch = 1 & END
         31  : found = 1
         32  : found = 1
         33  : found = 1
         40  : found = 1
         100 : BEGIN state = 2   & belch = 1 & END
         101 : BEGIN state = 2   & belch = 1 & END
         102 : BEGIN state = 2   & belch = 1 & END
         103 : BEGIN state = 2   & belch = 1 & END
         110 : BEGIN state = 2   & belch = 1 & END
         111 : BEGIN state = 2   & belch = 1 & END
         112 : BEGIN state = 2   & belch = 1 & END
         120 : BEGIN state = 2   & belch = 1 & END
         121 : found = 1
         122 : found = 1
         130 : BEGIN state = 2   & belch = 1 & END
         131 : found = 1
         132 : found = 1
         133 : found = 1

         ELSE: BEGIN error = 1 & GOTO, ERROR & END

       ENDCASE

       END

  ENDCASE

  IF recrd EQ 1 THEN BEGIN

     pos0 = tkptr
     pos1 = tkptr + (tmptr - 1)

     tok [pos0:pos1] = tmp [0:tmptr-1]

     tkptr = tkptr + tmptr
     tmptr = 0

     btrak = ptr

     recrd = 0

  ENDIF

  IF store THEN BEGIN

     store = 0

     tmp [tmptr] = val

     tmptr = tmptr + 1
     ptr   = ptr   + 1

  ENDIF

  IF eatch THEN BEGIN

     eatch = 0

     tok [tkptr] = val

     tkptr = tkptr + 1
     ptr   = ptr   + 1

     btrak = ptr

  ENDIF

  IF ptr GE len THEN BEGIN

     CASE state OF

       0   : found = 1
       1   : found = 1
       2   : found = 1
       3   : found = 1
       10  : found = 1
       11  : found = 1
       12  : found = 1
       13  : found = 1
       20  : BEGIN state = 2   & belch = 1 & END
       21  : BEGIN state = 2   & belch = 1 & END
       22  : BEGIN state = 2   & belch = 1 & END
       30  : BEGIN state = 2   & belch = 1 & END
       31  : found = 1
       32  : found = 1
       33  : found = 1
       40  : found = 1
       100 : BEGIN state = 2   & belch = 1 & END
       101 : BEGIN state = 2   & belch = 1 & END
       102 : BEGIN state = 2   & belch = 1 & END
       103 : BEGIN state = 2   & belch = 1 & END
       110 : BEGIN state = 2   & belch = 1 & END
       111 : BEGIN state = 2   & belch = 1 & END
       112 : BEGIN state = 2   & belch = 1 & END
       120 : BEGIN state = 2   & belch = 1 & END
       121 : found = 1
       122 : found = 1
       130 : BEGIN state = 2   & belch = 1 & END
       131 : found = 1
       132 : found = 1
       133 : found = 1

       ELSE: error = 2

     ENDCASE

     IF NOT belch THEN eos = 1

  ENDIF

  IF belch THEN BEGIN

     belch = 0

     tmptr = 0

     ptr   = btrak
     btrak = ptr

  ENDIF

  IF found THEN BEGIN

     IF tmptr GT 0 THEN BEGIN

        pos0 = tkptr
        pos1 = tkptr + (tmptr - 1)

        tok [pos0:pos1] = tmp [0:tmptr-1]

        tkptr = tkptr + tmptr
        tmptr = 0

         btrak = ptr

     ENDIF

     CASE state OF

       0   : token = FIX (val)
       1   : token = TK_STRING
       2   : token = TK_INTEG
       3   : token = TK_FLOAT
       10  : token = TK_INTEG
       11  : token = TK_INTEG
       12  : token = TK_INTEG
       13  : token = TK_INTEG
       20  : error = 2
       21  : error = 2
       22  : error = 2
       30  : error = 2
       31  : token = TK_HHMMSS
       32  : token = TK_HHMMSS
       33  : token = TK_HHMMSS
       40  : token = FIX (tok [0])
       100 : error = 2
       101 : error = 2
       102 : error = 2
       103 : error = 2
       110 : error = 2
       111 : error = 2
       112 : error = 2
       120 : error = 2
       121 : token = TK_DATE
       122 : token = TK_DATE
       130 : error = 2
       131 : token = TK_DATE
       132 : token = TK_DATE
       133 : token = TK_DATE

       ELSE: BEGIN error = 2 & GOTO, ERROR & END

     ENDCASE

     nfnd = nfnd + 1

     tlst = [tlst, token]
     tpos = [tpos, start]
     tval = [tval, STRING (BYTE (tok[0:tkptr - 1]))]

     state = 0
     found = 0
     token = 0
     tkptr = 0
     start = ptr

  ENDIF

ENDWHILE

; Knock of the first element in the arrays tval, tpos, and tlst.

IF N_ELEMENTS (tval) GT 1 THEN BEGIN

   tval = tval [1:*]
   tpos = tpos [1:*]
   tlst = tlst [1:*]

ENDIF

RETURN, 0

ERROR:

CASE error OF

  1 :   PRINT, "ERROR: Lexor at invalid state ", state
  2 :   PRINT, "ERROR: Lexor ended at a non-terminal state ", state
  3 :   PRINT, "ERROR: Token run on"

  ELSE:

ENDCASE

RETURN, error

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::getpath, dbname, QUIET = quiet

;   Return the path to the specified database.  This is used as a wrapper
;   for the function FIND_WITH_DEF.  Once the path to the requested database
;   is found, it is stored in a list.  Then whenever another request for the
;   path to this database comes along, it can be returned much quicker then
;   is possilble by using the function FIND_WITH_DEF.

; Make sure that we have a lower case file name

dbname = STRLOWCASE (dbname)

; Check if we have already found the path to this database.  If we have then it will be stored
; in the path_list object.  Use the get method to get the path of the requested database from the
; object.

p = self.path_list->get (dbname)

; Check if we found the path on the path list.  If we did, then we are done.  Simply return
; the path to the selected database.

IF N_TAGS (p) NE 0 THEN RETURN, p.path

; Oh well, we have to physically locate this database.

; Create the name of the database .dbh file

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "temp = FIND_WITH_DEF ('" + dbname + ".dbh' , 'ZDBASE')"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, ""

   ENDIF

; Retreive the err string from the remote IDL server.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'temp', VAL = temp) THEN BEGIN

      self.msg = 'Could not get variable temp from remote IDL server.'

      tmp = self->error ()

      RETURN, ""

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   temp = FIND_WITH_DEF (dbname + '.dbh', 'ZDBASE')

ENDELSE

; Make sure that we were able to find the database.  If not, then write a message to
; the user telling them what is going on.

IF temp EQ "" THEN BEGIN

   self.msg = 'Could not locate Database: ' + STRUPCASE (dbname) + '.'

   tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

; Return an empty string to indicate an error.

   RETURN, ""

ENDIF

; Break the fully qualified path name stored in temp into its component parts.

BREAK_FILE, temp, disk, dir, fname, ext

; Create the path to the database.  We will store this in p

p = disk + dir

; Check for a NULL path.  If it is, then change to "." + the correct delimeter

IF p EQ "" THEN BEGIN

   p = '.'

   IF self.remote AND self.client THEN p = p + self.remot_delim ELSE p = p + self.local_delim

ENDIF

; Add the path onto the path list.  Do this by creating a path structure and then using
; the add method to place it in the path list.

pnode      = {PATH_NODE, path: p, INHERITS XLIST_BASE_NODE}
pnode.path = p
pnode.name = dbname

self.path_list->add, pnode

; OK, finished.  Return the path to the requested database.

RETURN, p

END

; ------------------------------------------------------------------------------------------------

PRO db_tools::get_db_info, dbname, DB_DESC = db, DB_ITEM = db_item, QUIET = quiet

;               GET_DB_INFO
;
;               Get information about a database.
;
;               This routine will return information about a specific database.
;               Information will be returned in two different structures.  The first
;               structure provides a general description of the database.  The second
;               structure (really an array of structures) provides information about
;               every item that is defined within the database.  The database is not
;               required to be open for this routine to work.
;
; Syntax      : 0->GET_ENTRIES, database, [KEYWORDDS]

;               Note:    At least one keyword must be specified or the method will
;                        not perform any useful function.
;
; Inputs      : DBNAME  = The name of the database.  The program looks for a
;                         file with the given name, and the extension .dbf in
;                         either the current directory, or the path given by
;                         the environment variable ZDBASE.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : DB_DESC = When defined, on method return it will be set to the
;                         DB_INFO structure.  This structure gives some basic
;                         information about the database.
;
;               DB_ITEM  = When defined, on method return it will be set to
;                          an array of DB_ITEM_INFO structures.  There will be
;                          one of these structures in the array for every item
;                          in the database.  This structure gives detailed
;                          information about a database item.
;
;               QUIET    = If set, then do not print messages.
;
; Restrictions: None.

; Make sure that the dbname parameter is specified

IF N_ELEMENTS (dbname) EQ 0 THEN BEGIN

   self.msg = 'method requires at least the database name be specified.'

   tmp = self->error ()

   RETURN

ENDIF

; Make sure that we have a lower case file name

dbname = STRLOWCASE (dbname)

; Check if we have already cached the information about this database.  If we
; have, then can return the cacthed data structures instead of having to
; regenerate this information.

i = self.info_list->get (dbname)

IF OBJ_VALID (i) THEN BEGIN

   db       =  i->get_cached_db_info ()
   db_item  =  i->get_cached_db_item ()

   RETURN

ENDIF

; Get a path to the database.

dbpath = self->getpath ( dbname )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN BEGIN

      db = -1
      db_item = -1

      RETURN

ENDIF

; Get a logical unit number

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = 'GET_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   GET_LUN, unit

ENDELSE

; Try to open the .dbh file as a segmented file.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "OPENR, unit, '" + dbpath + dbname + ".dbh', ERROR = err, /SEGMENTED"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Retreive the err string from the remote IDL server.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'err', VAL = err) THEN BEGIN

      self.msg = 'Could not get variable err from remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   OPENR, unit, dbpath + dbname + '.dbh', ERROR = err, /SEGMENTED

ENDELSE

; If /SEGMENTED doesn't work, then maybe the file was written in external
; format.  Try /BLOCK instead.

IF err NE 0 THEN BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

   IF self.remote AND self.client THEN BEGIN

      cmd = "OPENR, unit, '" + dbpath + dbname + ".dbh', ERROR = err, /BLOCK"

      IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

         self.msg = 'Could not execute command on remote IDL server.'

         tmp = self->error ()

         RETURN

      ENDIF

; Retreive the err string from the remote IDL server.

      IF NOT self.idl_server->RPCGetVariable (NAME = 'err', VAL = err) THEN BEGIN

         self.msg = 'Could not get variable err from remote IDL server.'

         tmp = self->error ()

         RETURN

      ENDIF

   ENDIF ELSE BEGIN

; Otherwise we can do this locally.

      OPENR, unit, dbpath + dbname + '.dbh', ERROR = err, /BLOCK

   ENDELSE

   IF err NE 0 THEN BEGIN

; Oops, can't open the file.  Create an error message.

      self.msg = 'Error opening .dbh file '+ dbname

; Add the name of the host if we were trying to open the file in a remote IDL session.

      self.msg = self.msg + ' on remote host ' + self.hostname

      tmp = self->error ()

      db = -1
      db_item = -1

      RETURN

   ENDIF

ENDIF

; Read in the database description.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

   cmd = 'buf = BYTARR (120)'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Read the databasae discription into the buffer.

   cmd = 'READU, unit, buf'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Get the contents of buf from the remote IDL session.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'buf', VAL = buf) THEN BEGIN

      self.msg = 'Could not get variable buf from remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   buf = BYTARR (120)

   READU, unit, buf

ENDELSE

; Set the external flag based on the database header.

external = buf [119] EQ 1

; Extract all of the useful information from the database description

name          = STRTRIM (STRING (buf [0:18]))
title         = STRTRIM (STRING (buf [19:79]))
nitems        = FIX (buf, 80)
record_length = FIX (buf, 82)

; If the database is in external format, then we will have to convert numbers
; in IEEE representation to host format.

IF external THEN BEGIN

   IEEE_TO_HOST, nitems
   IEEE_TO_HOST, record_length

ENDIF

;  Set up the structure and populate it.

db = {DB_INFO}

db.db_name = name
db.path = dbpath
db.title = title
db.n_items = nitems
db.record_length = record_length
db.external = external

; Read in the array of item descriptions

; Recreate the buffer array.

buf = BYTARR (200, nitems)

; Check if we are using a remote instance of this database.  If we are, then we will have
; copy the buffer array to the remote IDL server.

IF self.remote AND self.client THEN BEGIN

   IF NOT self.idl_server->RPCSetVariable (NAME = 'buf', VAL = buf) THEN BEGIN

      self.msg = 'Could not send variable buf to remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF

; Read in the first item description.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Read the first databasae item discription into the buffer.

   cmd = 'READU, unit, buf'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Get the contents of buf from the remote IDL session.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'buf', VAL = buf) THEN BEGIN

      self.msg = 'Could not get variable buf from remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   READU, unit, buf

ENDELSE

; Create an array of items description structures

db_item = REPLICATE ({DB_ITEM_INFO}, nitems)

; Loop to process of the the item definitions

FOR i = 0, nitems - 1 DO BEGIN

; Get all the information for one item together.

   rec = buf [*, i]

; Extract all of the useful information from each item  description

   name             = STRTRIM (STRING (rec [0:19]))
   data_type        = FIX (rec, 20)
   n_values         = FIX (rec, 22)
   data_dbf_pos     = FIX (rec, 24)
   data_dbf_size    = FIX (rec, 26)
   index_type       = FIX (rec [28])
   description      = STRTRIM (STRING (rec [29:97]))
   print_fld_length = FIX (rec, 98)
   pointer          = rec [100] EQ 1
   child            = STRTRIM (STRING (rec [101:119]))
   print_format     = STRING (rec [120:125])
   print_headers    = STRING (rec [126:170])

; If the database is in external format, then we will have to convert numbers
; in IEEE representation to host format.

   IF external THEN BEGIN

      IEEE_TO_HOST, data_type
      IEEE_TO_HOST, n_values
      IEEE_TO_HOST, data_dbf_pos
      IEEE_TO_HOST, data_dbf_size
      IEEE_TO_HOST, index_type
      IEEE_TO_HOST, print_fld_length

   ENDIF

; Populate the structure

   db_item [i].name             = name
   db_item [i].data_type        = data_type
   db_item [i].n_values         = n_values
   db_item [i].data_dbf_pos     = data_dbf_pos
   db_item [i].data_dbf_size    = data_dbf_size
   db_item [i].index_type       = index_type
   db_item [i].description      = description
   db_item [i].print_fld_length = print_fld_length
   db_item [i].pointer          = pointer
   db_item [i].child            = child
   db_item [i].db_name          = db.db_name
   db_item [i].print_format     = print_format
   db_item [i].print_headers    = print_headers

ENDFOR

; Close the current file and open the .dbf file.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Close the device

   cmd = 'FREE_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Get a logical unit number

   cmd = 'GET_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Try to open the .dbf file as a block file.

   cmd = "OPENR, unit, '" + dbpath + dbname + ".dbh', ERROR = err, /BLOCK"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Retreive the err string from the remote IDL server.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'err', VAL = err) THEN BEGIN

      self.msg = 'Could not get variable err from remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

; Close the device

   FREE_LUN, unit

; Get a logical unit number

   GET_LUN, unit

; Try to open the .dbf file as a block file.

   OPENR, unit, dbpath + dbname + '.dbf', ERROR=err, /BLOCK

ENDELSE

IF err NE 0 THEN BEGIN

   self.msg = 'Error opening .dbf file '+ dbname + '.dbf'

; Add the name of the host if we were trying to open the file in a remote IDL session.

      self.msg = self.msg + ' on remote host ' + self.hostname

   tmp = self->error ()

   db = -1
   db_item = -1

; Close the device

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the command to do this on the remote session.

   IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

      cmd = 'FREE_LUN, unit'

      IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

         self.msg = 'Could not execute command on remote IDL server.'

         tmp = self->error ()

         RETURN

      ENDIF

   ENDIF ELSE BEGIN

; Otherwise we can do this locally.

      FREE_LUN, unit

   ENDELSE

   RETURN

ENDIF

; Read in the head of the .dbf file.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

   cmd = 'buf = BYTARR (16)'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Read the databasae discription into the buffer.

   cmd = 'READU, unit, buf'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Get the contents of buf from the remote IDL session.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'buf', VAL = buf) THEN BEGIN

      self.msg = 'Could not get variable buf from remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   buf = BYTARR (16)

   READU, unit, buf

ENDELSE

n_entries       = LONG (buf, 0)
last_seq_number = LONG (buf, 4)

; If the database is in external format, then we will have to convert numbers
; in IEEE representation to host format.

IF external THEN BEGIN

   IEEE_TO_HOST, n_entries
   IEEE_TO_HOST, last_seq_number

ENDIF

db.n_entries       = n_entries
db.last_seq_number = last_seq_number

; Close the device

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the command to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

   cmd = 'FREE_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   FREE_LUN, unit

ENDELSE

; OK, we got the information about the requested database, cache it so that we
; don't have to regenerate this information again.

node = OBJ_NEW ('DB_TOOLS_INFO_OBJ', dbname,                     $
                                     CACHED_DB_INFO = db,        $
                                     CACHED_DB_ITEM = db_item)

self.info_list->add, node

RETURN

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::get_entries, dbname, QUIET = quiet

;               GET_ENTRIES
;
;               Return the number of entries in the specified database.  The database does
;               does need to be opened for this function to work.
;
; Syntax      : result = 0->GET_ENTRIES ( database )
;
; Inputs      : DATABASE = The name of the database.  The program looks for a
;                          file with the given name, and the extension .dbf in
;                          either the current directory, or the path given by
;                          the environment variable ZDBASE.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : None.
;
; Return Value: The number of entries currently stored in the database.
;
; Restrictions: None.

IF N_ELEMENTS (dbname) EQ 0 THEN BEGIN

   self.msg = 'method requires the database name be specified.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Get a path to the database.

dbpath = self->getpath ( dbname )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN RETURN, -1

; Get a logical unit number

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = 'GET_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   GET_LUN, unit

ENDELSE

; Try to open the .dbh file as a block file.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "OPENR, unit, '" + dbpath + dbname + ".dbh', ERROR = err, /BLOCK"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Retreive the err string from the remote IDL server.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'err', VAL = err) THEN BEGIN

      self.msg = 'Could not get variable err from remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   OPENR, unit, dbpath + dbname + '.dbh', ERROR = err, /BLOCK

ENDELSE

IF err NE 0 THEN BEGIN

   self.msg = 'Error opening .dbh file '+ dbname + '.dbh'

   tmp = self->error ()

   FREE_LUN, unit

   RETURN, -1

ENDIF

; Read in the database description.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

   cmd = 'buf = BYTARR (120)'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Read the databasae discription into the buffer.

   cmd = 'READU, unit, buf'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Get the contents of buf from the remote IDL session.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'buf', VAL = buf) THEN BEGIN

      self.msg = 'Could not get variable buf from remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   buf = BYTARR (120)

   READU, unit, buf

ENDELSE

; Set the external flag based on the database header.

external = buf [119] EQ 1

; Close the current file and open the dbf file.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Close the device

   cmd = 'FREE_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Get a logical unit number

   cmd = 'GET_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Try to open the .dbf file as a block file.

   cmd = "OPENR, unit, '" + dbpath + dbname + ".dbh', ERROR = err, /BLOCK"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Retreive the err string from the remote IDL server.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'err', VAL = err) THEN BEGIN

      self.msg = 'Could not get variable err from remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

; Close the dbh device

   FREE_LUN, unit

; Get a logical unit number

   GET_LUN, unit

; Try to open the .dbf file as a block file.

   OPENR, unit, dbpath + dbname + '.dbf', ERROR=err, /BLOCK

ENDELSE

IF err NE 0 THEN BEGIN

   self.msg = 'Error opening .dbf file '+ dbname + '.dbf'

   tmp = self->error ()

; Close the device

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the command to do this on the remote session.

   IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

      cmd = 'FREE_LUN, unit'

      IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

         self.msg = 'Could not execute command on remote IDL server.'

         tmp = self->error ()

         RETURN, -1

      ENDIF

   ENDIF ELSE BEGIN

; Otherwise we can do this locally.

      FREE_LUN, unit

   ENDELSE

   RETURN, -1

ENDIF

; Read in the head of the .dbf file.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

   cmd = 'buf = BYTARR (8)'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Read the databasae discription into the buffer.

   cmd = 'READU, unit, buf'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Get the contents of buf from the remote IDL session.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'buf', VAL = buf) THEN BEGIN

      self.msg = 'Could not get variable buf from remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   buf = BYTARR (8)

   READU, unit, buf

ENDELSE

; Extract the number of database entries from the head of the file.

n_entries = LONG (buf, 0)

; If the database is in external format, then we will have to convert numbers
; in IEEE representation to host format.

IF external THEN IEEE_TO_HOST, n_entries

; Close the device

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the command to do this on the remote session.

IF self.remote AND self.client THEN BEGIN

; Generate the buffer on the remote system.

   cmd = 'FREE_LUN, unit'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   FREE_LUN, unit

ENDELSE

; Return the number of database entries.

RETURN, n_entries

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::exp_ptr_items, items

;   EXP_PTR_ITEMS
;
;   Expand an array of database fields to include fields from child
;   databases.
;
;   This routine takes the array of database items returned by db_info and
;   expands any items that point to a child database  (so called pointer
;   items).  That is, the routine first finds the child database of each
;   pointer item.  It then replaces the pointer item with the actual list of
;   items from the child database that the pointer item references.   This;   process is repeated until there are no more pointer items in the list.
;
; Syntax      : list = 0->EXP_PTR_ITEMS ( ITEMS )
;
; Examples    : 0->GET_DB_INFO, database, DB_ITEM = db_item
;           list = 0->EXP_PTR_ITEMS (db_item)
;
; Inputs      : ITEM    = An array of item description structures returned by the
;               method GET_DB_INFO.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : None.
;
; Return Value: An array of item description structures in the same format as
;     returned by the DB_ITEM keyword to the get_db_info method, except
;     with any items from child database included in the array in
;     place of the ptr items.
;
; Restrictions: None.

; Copy the values passed in the parameter items to lst

lst = items

; Set the flag lst_ok to 0 (TRUE).  The state of this flag will indicate if the lst parameter
; that was passed to us was acceptable.

lst_ok = 0

; Make sure that the lst parameter is specified

IF N_ELEMENTS (lst) NE 0 THEN BEGIN

; Get the numeric type of the lst parameter.

; First, set s to the size array for the lst parameter.

   s = SIZE (lst)

; Now extract the varible type from the appropiate value of the size array.

   type  = s [s[0] + 1]

; Check to make sure that lst is a an array of DB_ITEM_INFO structures

   IF type EQ 8 THEN IF TAG_NAMES (lst, /STRUCTURE_NAME) EQ 'DB_ITEM_INFO' THEN lst_ok = 1

ENDIF

; Check the lst_ok flag to make sure that the parameter that was passed to us was acceptable.
; If it was not, then we will call the error method and exit.

IF NOT lst_ok THEN BEGIN

   self.msg = 'EXP_PTR_ITEMS method requires an array of DB_ITEM_INFO structures as a parameter.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Main loop to search through the database item list that was passed to us and to replace any
; items that point to child databases with the actual item list from the database that is pointed
; to.

; Set done to 0 (FALSE).  done becomes true when there are no more pointer items left to process.

done = 0

; Outer loop to continue making passes through the item list until done becomes 1 (TRUE).

WHILE NOT done DO BEGIN

; Set done to 1 (TRUE).  If we find any pointer items then we will reset done to 0 (FALSE).

   done = 1

; Set ind to the indexes of all the items in the list that are pointers to other databases.

   ind = WHERE (lst.pointer NE 0)

; Set i to the first index in ind (may be -1 if no items were found)

   i = ind [0]

; Check if ind is set to -1.  If it is, then there are no items in the list that need to be
; expanded.  Otherwise, there are still pointer item in the list.

   IF i NE -1 THEN BEGIN

; Set done back to 0.  We will need at least one more pass through the outer loop.

      done = 0

; Get the child and parent values from the item descriptor.

      child  = lst [i].CHILD

      self->GET_DB_INFO, child, DB_ITEM = tmp

      tmp = tmp [1:*]

      last = N_ELEMENTS (lst) - 1

      CASE i OF

        0 :     lst = [tmp, lst [1:*]]
        last :  lst = [lst [0:last-1], tmp]

        ELSE :  lst = [lst [0:i-1], tmp, lst [i+1:last]]

      ENDCASE

   ENDIF

ENDWHILE

RETURN, lst

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::get_struct, db_item, QUIET = quiet

;
;   GET_STRUCT
;
;   Create a structure based on an array of database item descriptors.
;
;   This method creates a structure that can be used to add a record into
;   a database.  The method takes as a parameter the array of item
;   description structures that is created by the get_db_info method.  It
;   then creates a structure that has one tag for every item descriptor in
;   array except for the entry item.  The names of the structure tags are
;       the same as the names of the items from the database.
;
;
; Syntax      : 0->GET_DB_INFO, database, DB_ITEM = db_item
;           struct = 0->GET_STRUCT (db_item, [KEYWORD] )
;
; Inputs      : db_item = An array of item description structures returned by the
;               method GET_DB_INFO.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    :  QUIET    If set, then do not print messages.
;
; Return Value: A structure where each tag corresponds to one element in the db_item
;     array that was passed to the function as a parameter.
;
; Restrictions: None.

; Create a list of indices into the array of database item description structures
; to access all the database items except the entry item

ind = WHERE (db_item.name NE 'ENTRY')

; Make sure that we have at least one item that is not the entry item.

IF ind [0] EQ - 1 THEN BEGIN

   self.msg = 'Can not create a record structure corresponding to the requested database."

   tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

   RETURN, 0

ENDIF

; Find the number of database items we are going to use to create the structure.

nitem = N_ELEMENTS (ind)

; Create the initial structure.  After we create it, then we will add tags to it.

; Set val to the same type as tag i from the record structure.

CASE db_item [ind [0]].data_type OF

   1 : val = BYTE (0)   ; Byte Value
   2 : val = FIX (0)    ; Integer Value
   3 : val = LONG (0)   ; Long Integer Value
   4 : val = FLOAT (0)  ; Floating Point Value
   5 : val = DOUBLE (0) ; Double Precision Floating Point Value
   6 : val = COMPLEX (0)    ; Complex Value
   7 : val = ""     ; String Value
   9 : val = DCOMPLEX (0)   ; Double Precision Complex Value

   ELSE :  BEGIN            ; Oops, some type that we can't handle.

             self.msg = 'Can not create structure with tag of type: ' +     $
                        STRTRIM (STRING (db_item [ind [0]].data_type, 2))

             tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

             RETURN, 0

           END

ENDCASE

; Use val and the name dababase item 0 to create an anonymous structure.

s = CREATE_STRUCT (db_item [ind [0]].name, val)

; Now use a loop to process the rest of database item description structures.

FOR i = 1, nitem - 1 DO BEGIN

; Set val to the same type as tag i from the record structure.

   CASE db_item [ind [i]].data_type OF

      1 : val = BYTE (0)    ; Byte Value
      2 : val = FIX (0)     ; Integer Value
      3 : val = LONG (0)    ; Long Integer Value
      4 : val = FLOAT (0)   ; Floating Point Value
      5 : val = DOUBLE (0)  ; Double Precision Floating Point Value
      6 : val = COMPLEX (0) ; Complex Value
      7 : val = ""   ; String Value
      9 : val = DCOMPLEX (0)    ; Double Precision Complex Value

      ELSE :  BEGIN            ; Oops, some type that we can't handle.

                self.msg = 'Can not create structure with tag of type: ' +  $
                           STRTRIM (STRING (db_item [ind [i]].data_type, 2))

                tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

                RETURN, 0

              END

   ENDCASE

; Add a tag to structure s using val and the name dababase item i.

   s = CREATE_STRUCT (s, db_item [ind [i]].name, val)

ENDFOR

RETURN, s

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::listopen, NOPEN = nopen

;   LISTOPEN
;
;   Create a list of all the open databases.
;
;   Lists any currently open databases.  Since the current implementation
;   only allows one database to be open at a time, only one database will
;   ever be listed.
;
; Syntax      : RESULT = O->LISTOPEN ( [KEYWORD] )
;
; Inputs      : None.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : NOPEN   = The number of currently open databases.
;
; Returns     :     An array of strings, where each element is the name of
;      an open database.
;
; Restrictions: None.

; Check if any databases are currently open.

IF DB_INFO ('OPEN') EQ 0 THEN BEGIN

; Ooops. No open databases.

   nopen = 0

; Set msg to an appropiate error message

   self.msg = 'LIST OPEN failed.  No database is curently open.'

; Return the empty string as the result of this function

   RETURN, ""

ENDIF

; Get the array of logical unit numbers corresponding to each open database

unitlst = DB_INFO ('UNIT_DBX')

; Set nopen to the number of databases with open .dbx files.

nopen = N_ELEMENTS (unitlst)

; Create a vector to hold the list of database names.

namelst = STRARR (nopen)

; Loop to retrieve the name of each open database.

FOR i = 0, nopen - 1 DO BEGIN

; Use FSTAT to get the file status of each file attached to one of the
; logical unit numbers in our list.

   fstatus = FSTAT (unitlst [i])

; Use STR_SEP to break up the path/file name until we can extract just the
; name of the database.

   tmp = STR_SEP (fstatus.name, '/')

   namelst [i] = (STR_SEP (tmp [N_ELEMENTS (tmp) - 1], '.')) [0]

ENDFOR

;  Return our list of open databases

RETURN, namelst

END

; ------------------------------------------------------------------------------------------------

;
;   UNLOCK_DATABASE
;
;   Unlock a database that is currently locked.
;
;   Remove the lock file of a database that is currently locked.
;
;
; Syntax      : 0->UNLOCK_DATABASE, database, [KEYWORKDS]
;
; Inputs      : database = The name of the database.  The program looks for a
;                          file with the given name, and the extension .dbf in
;                          either the current directory, or the path given by
;                          the environment variable ZDBASE.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    :  STATUS   The result (0 = Failure / 1 = Success) of the operation.
;
;      KEY      Key to the lock file.  If passed, then the lock will
;                         only be removed if it matches the key stored in the lock
;                         file.
;
;                QUIET    If set, then do not print messages.
;
; Restrictions: Must have write access in the directory containing the database
;               files.

PRO db_tools::unlock_database, dbase, STATUS = status, QUIET = quiet, KEY = key

; Set status to 0.  This will be used to indicate the result of the operation.

status = 0

; Check the input parameters.  Make sure that at least the name of the database has
; been passed to us.

IF N_PARAMS () NE 1 THEN BEGIN

   self.msg = 'USE:  0->UNLOCK_DATABASE, database, STATUS = status, QUIET = quiet, KEY = key'

   tmp = self->error ()

   RETURN

ENDIF

; Get a path to the database.

dbpath = self->getpath ( dbase, QUIET = quiet )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN RETURN

; Set lockfile to the fully qualified name of the database lock file.

lockfile = dbpath + dbase + '.lock'

; Check if a lock file exists.  If it does then we may be able to remove it.

IF FILE_EXIST (lockfile) THEN BEGIN

; Check if a key value was passed through the keyword KEY.  If it was, then we have to
; make sure that matches the key stored in the lock file before we can remove it.

   IF KEYWORD_SET (key) THEN BEGIN

; Initialize tstring and fkey.  tstring holds the expiration time of the lock file.
; fkey holds the numeric key of the lockfile.

      tstring = ''
      fkey    = 0

; Try to open the lock file.

      OPENR, lun, lockfile, /GET_LUN

; Read the expiration time and numeric key from the lockfile.

      READF, lun, tstring
      READF, lun, fkey

; Close the lock file.

      FREE_LUN, lun

; Check that the key that was passed to us matches the key in the lock file.

      IF key NE fkey THEN BEGIN

; Oops.  The key does not match the lock file.  Let the user know what happened.

         self.msg = 'Key does not match value stored in lock.  Lock file not removed.'

         tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

; Nothing else to do, so just return.

         RETURN

      ENDIF

   ENDIF

; OK, go ahead and delete the lock file.

   OPENR, lun, /GET_LUN, lockfile, /DELETE

   FREE_LUN, lun

; Reset status to 1 (Success).

   status = 1

ENDIF ELSE BEGIN

; Oops. The database is not currently locked.  Let the user know whats up.

   self.msg = 'Database: ' + dbase + ' is not currently locked.'

   tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

ENDELSE

RETURN

END

; ------------------------------------------------------------------------------------------------

;
;   CHECK_LOCK
;
;   Check if a database is locked for writing.
;
;   Check if a database is locked for writing.  Returns an integer to inidicate
;   the status of that database.  A value of 1 indicates that the database is
;   currently locked, a value of 0 indicates that it is currently unlocked.
;
;
; Syntax      : RESULT = O->CHECK_LOCK ( DATABASE, [KEYWORD] )
;
; Inputs      : DATABASE = The name of the database.  The program looks for a
;                          file with the given name, and the extension .dbf in
;                          either the current directory, or the path given by
;                          the environment variable ZDBASE.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : LOCKFILE = The complete name of the file <database>.lock,
;                          including the path.
;
; Returns     :     1 if the database is locked, 0 if it is unlocked.
;
; Restrictions: None.

FUNCTION db_tools::check_lock, dbase, LOCKFILE = lockfile

; Set the status to 0 (No Lock File).  If the database is locked then it will be reset
; to 1.

status = 0

; Check the input parameters.  Make sure that we were at least passed the name of the
; database to check.

IF N_PARAMS () NE 1 THEN BEGIN

   self.msg = 'USE:  status = 0->CHECK_LOCK (database, LOCKFILE = lockfile)'

   tmp = self->error ()

   RETURN, status

ENDIF

; Get a path to the database.

dbpath = self->getpath ( dbase, QUIET = QUIET )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN RETURN, 0

; Set lockfile to the fully qualified name of the database lock file.

lockfile = dbpath + dbase + '.lock'

; Check if the lockfile exists.  If it does then we will have to make sure that it has
; not expired.

IF FILE_EXIST (lockfile) THEN BEGIN

; Get the current time.

   GET_UTC, utc

; Convert the current time to TAI format.

   tnow = UTC2TAI (utc)

; Initialize tstring.  tstring holds the expiration time of the lock file.

   tstring = ''

; Try to open the lock file.

   OPENR, lun, lockfile, /GET_LUN

; Read the expiration time from the lock file.

   READF, lun, tstring

; Close the lock file.

   FREE_LUN, lun

; Convert the expiration time of the lock file to TAI format.

   tfile = UTC2TAI (STR2UTC (tstring))

; Set the value of status based on whether the lock file has expired yet.

   IF tnow LT tfile THEN status = 1

ENDIF

; Return status as the result of the function.

RETURN, status

END

; ------------------------------------------------------------------------------------------------

;
;   LOCK_DATABASE
;
;   Lock a database for write operations.
;
;   Locks a catalog database for write access.  If another process
;   has the catalog locked, then wait until it is unlocked before
;   locking it.
;
;   An empty file called <database>.LOCK (e.g. experiment.LOCK) is
;   created in the same directory as the database.  This signals to
;   other processes that the database is locked.
;
; Syntax      : KEY = O->LOCK_DATABASE ( DATABASE, [KEYWORDS] )
;
; Examples    : key = O->LOCK_DATABASE  ('experiment')
;               ... write to database, e.g. using O->DB_REC_ADD ...
;               O->UNLOCK_DATABASE, LOCKFILE, KEY = key
;
; Inputs      : DATABASE = The name of the database.  The program looks for a
;                          file with the given name, and the extension .dbf in
;                          either the current directory, or the path given by
;                          the environment variable ZDBASE.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : NOEXP   = If set, then the lock will never expire.
;
;     WTIME    = Length of time to wait for a database to be unlocked so
;        that it can then be locked by this method.  If no
;        value is passed through this keyword and the database is
;        already locked, then this method will immediately give
;        up trying to lock the database and fail (returning 0).
;
;     EXPIRE   = Length of time for the lock to remain in force.  The
;        default is for locks to expire after 6 hours.
;
;     FORCE    = If set, then force the lock to succeed.  If the database
;        is already locked, then the old lock will be removed and
;        a new lock installed.
;
;     KEY  = Key of the current file lock.  If the database is already
;        locked and the value passed through this parameter matches
;        its key, then the old lock will be removed and a new lock
;        installed.  Otherwise the method fails and a 0 is returned.
;
;     LF   = The fully qualified name and path of the lock file.
;
;     QUIET    = If set, then warning or informational messages are not
;        not displayed.
;
; Returns     :     A key which can be used to unlock the database (if keys
;      are implemented).  If the method failed then it will
;      return 0 which is an invalid key.
;
; Restrictions: Must have write access in the directory containing the database
;               files.

FUNCTION db_tools::lock_database, dbase,       $
                                  NOEXP  = noexp,    $
                                  WTIME  = wtime,    $
                                  EXPIRE = expire,   $
                                  FORCE  = force,    $
                                  KEY    = key,        $
                                  LF     = lf,       $
                                  QUIET  = quiet

; Set the rmlock flag.  If we can remove an already existing lock file,
; then this flag will be reset to 1.

rmlock = 0

; Set the value for newkey.  This is the key to the lock file.  If we fail to create
; a lock file, then it will be zero (invalid key).

newkey = 0

; Check the input parameters.  Make sure that we were at least passed the name of the
; database to lock.

IF N_PARAMS () NE 1 THEN BEGIN

   self.msg = 'USE:  key = 0->LOCK_DATABASE (database [,KEYWORDS])'

   tmp = self->error ()

   RETURN, newkey

ENDIF

; Check if the user passed the parameter KEY.  If the parameter was not passed then
; set it to 0 (no key).

IF NOT KEYWORD_SET (key) THEN key = 0

; Set the expiration time.  If an expiration time is not specified and the /NOEXP keyword is
; not used then set the expiration time to 6 hours.

IF N_ELEMENTS (expire) EQ 0 THEN expire = 60.D * 60.D * 6.D

; Get the current time.

GET_UTC, utc

; Set the expiration time.

; Check if the NOEXP keyword is set.  If it is, then set the expiration time to a point
; in the very, very far future.

IF KEYWORD_SET (noexp) THEN BEGIN

   texp = utc

   texp.mjd  = 999999L
   texp.time = 0L

; Otherwise set the experation time to the current time plus the number of seconds that
; was passed through the keyword EXPIRE

ENDIF ELSE BEGIN

   texp = TAI2UTC (UTC2TAI (utc) + DOUBLE (expire))

ENDELSE

; Get a path to the database.

dbpath = self->getpath ( dbase, QUIET = quiet )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN RETURN, 0

; Set lf to the fully qualified name of the database lock file.

lf = dbpath + dbase + '.lock'

; Check if the lockfile exists.  If it does then we will either have to remove it (by
; setting the rmlock flag to 1) or exit without locking the database.

IF FILE_EXIST (lf) THEN BEGIN

; Initialize tstring and fkey.  tstring holds the expiration time of the lock file.
; fkey holds the numeric key of the lockfile.

   tstring = ''
   fkey    = 0

; Get the current time in TAI format.

   tnow = UTC2TAI (utc)

; Try to open the lock file.

   OPENR, lun, lf, /GET_LUN

; Read the expiration time and numeric key from the lockfile.

   READF, lun, tstring
   READF, lun, fkey

; Close the lock file.

   FREE_LUN, lun

; Convert the expiration time into TAI format.

   tfile = UTC2TAI (STR2UTC (tstring))

; Check if the keyword FORCE was set.  If it was we can remove the lock file.

   IF KEYWORD_SET (force) THEN rmlock = 1

; Check if the key in the lock file matches the value passed through the keyword KEY.
; If it does, then we can remove the lockfile.

   IF fkey EQ key THEN rmlock = 1

; Check if the time stored in the lockfile is less then the current time.  If it is
; then the lockfile has expired and we can remove the lockfile.

   IF tfile LE tnow THEN rmlock = 1

; If we can not automatically remove the lockfile, then we may want to wait for it
; to be removed by whoever set it...

   IF NOT rmlock THEN BEGIN

; Check if a value was passed through the keyword WTIME. This is the length of time we
; will wait for the lockfile to be removed.

      IF KEYWORD_SET (wtime) THEN BEGIN

; Tell the user that a lock file already exist for the database.

         self.msg  = "Lock file present."

         tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

; Tell the user how long we will wait for the lock file to be removed.

         self.msg  = STRING (wtime, FORMAT = '("Will wait ", I0, " s for it to unlock.")')

         tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

; Check to make sure that we still have some time to wait.  The waiting loop exits when we have
; waited the alloted time for the lockfile to be removed (kept in wtime) or the lockfile is
; removed by whoever locked the database.

         WHILE (wtime NE 0) DO BEGIN

; Calculate the inverval that we should wait.  This will be at most 15 s.

            interval = wtime < 15

; Reduce wtime by the current wait interval.

            wtime = wtime - interval

; Wait for interval to pass.

            WAIT, interval

; Check if the lock file is still there.  If it is not, then break out of the loop and goto
; section of code where create a new lockfile.

            IF NOT FILE_EXIST (lf) THEN GOTO, PLACE_LOCK

         ENDWHILE

      ENDIF

; Oops.  We could not remove the old lockfile and so can not create a new lockfile.  Tell the
; user what is going on.

      self.msg = 'Could not lock database due to an existing lock file.'

      tmp = self->error ( /INFORMATIONAL, QUIET = quiet )

; Return 0 (FAILURE) and were done.

      RETURN, 0

   ENDIF

ENDIF

; Check if the remove lock file flag is set.  If it is, then remove the lock file.

IF rmlock THEN BEGIN

   OPENR, lun, /GET_LUN, lf, /DELETE

   FREE_LUN, lun

ENDIF

;  Lock the database.

PLACE_LOCK:

; Create the lockfile.

OPENW, lun, lf, /GET_LUN

; Create a (hopefully) unique key for the lock file, that is non-zero.

REPEAT BEGIN

  GET_UTC, tnow
  tai = UTC2TAI (tnow)
  newkey = LONG ((tai * 1000) mod 10000)

END UNTIL newkey NE 0

; Write the time and the key value into the lock file.

PRINTF, lun, UTC2STR (texp)
PRINTF, lun, newkey, FORMAT = '(I0)'

; Free the LUN used to create the lock file.

FREE_LUN, lun

; Return the key to the new lockfile.

RETURN, newkey

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::compare_records, r1,                                    $
                                    r2,                                    $
                                    IGNORE = ignore,                       $
                                    CORRECT_STR_SIZE = correct_str_size,   $
                                    ERROR = error

IF N_TAGS (r1) EQ 0 THEN BEGIN

   error = 'Parameters to this method must consist of structures.'

   RETURN, -1

ENDIF

; Check to make sure that r1 and r2 have the same number of tags.  We probably should check that
; they are the same record, but that would take too long.

IF N_TAGS (r1) NE N_TAGS (r2) THEN BEGIN

   error = 'Records must each consist of the same structure.'

   RETURN, -1

ENDIF

; Make sure ignore is an array with at least one element.  We use -1 since that is
; gauranteed not to conflict with any actual structure tag.

IF N_ELEMENTS (ignore) EQ 0 THEN ignore = [-1]

; Set correct_str_size to 0 (its default value) if it is not otherwise defined.

IF KEYWORD_SET (correct_str_size) THEN correct_str_size = 1 ELSE correct_str_size = 0

; Set up res as an integer array to store the results of our comparison.

res = INTARR (N_TAGS (r1))

; Set up test as an integer array consisting of all the tags indices that we
; are suppose to compare (all except those flag in the IGNORE keyword).

test = INTARR (N_TAGS (r1))

test [*] = -1

FOR i = 0, N_TAGS (r1) - 1 DO BEGIN

    IF WHERE (ignore EQ i) EQ -1 THEN test [i] = i

ENDFOR

test = WHERE (test NE -1)

; Cycle through the tags of both structures doing a simple equality comparisson on each. If
; a pair fail the comparisson, then record this by setting the equivalent indice in the res
; array to 1.  However, we only do the comparison if the structure tag is not on the list
; of structure tags to ignore.

FOR i = 0, N_ELEMENTS (test) - 1 DO BEGIN

    a = r1.(test [i])
    b = r2.(test [i])

    IF (SIZE (a, /TYPE) EQ 7) AND (correct_str_size) THEN BEGIN

       IF STRLEN (a) GT STRLEN (b) THEN a = STRMID (a, 0, STRLEN (b))

       IF STRLEN (b) GT STRLEN (a) THEN b = STRMID (b, 0, STRLEN (a))

    ENDIF

    IF a NE b THEN BEGIN

       res [test [i]] = 1

    ENDIF

ENDFOR

; Use the where function to find which comparissons failed.  This is the result taht we will
; return.

RETURN, WHERE (res EQ 1)

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::check_record, dbase,        $
                                 rec,      $
                                 NOSTRICT = nostrict,   $
                                 QUIET = quiet

;               CHECK_RECORD
;
;               This method performs a set of consistency checks on a record prior to it being
;               added to a database.  SInce records are represented as IDL structures, most of
;               these checks insure that the structure being used correctly instantiates the
;               database it is being used to access.  The following checks are performed:
;
;               Structure Checks:    Make sure that structure being used to access a
;                                    database has a tag whose name matches one of the
;                                    fields in the database.  If the strict option is
;                                    set then the structure must have one tag for every
;                                    field in the database.
;
;               Type Checks:         The type of each structure tag is checked against
;                                    the type of its equivalent field in the database.
;
;               Scalar Check:        Each structure tag is required to refer to a
;                                    single value (scalar).  This resriction is
;                                    internal and may be lifted in the future.
;
;               This method also calculates an array which matches the position of each structure
;               tag to the position of the database field to which that tag refers.  In the future
;               this functionality may be moved to another method.
;
; Syntax      : R = O->CHECK_RECORD ( DATABASE, REC, [KEYWORDS] )
;
; Inputs      : DBASE   = The name of the database.  The program looks for a
;                         file with the given name, and the extension .dbf in
;                         either the current directory, or the path given by
;                         the environment variable ZDBASE.
;
;               REC     = A structure (or array of structures)  where each tag corresponds
;                         to field in target database.  Note that the structure must have
;                         a tag for each field in the database except for the ENTRY field.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : QUIET   = If set, then warning or informational messages are not
;                         not displayed.
;
;               NOSTRICT= If set, then allow the record structure to contain tags that do
;                         not exist in the database the record is being checked against.
;
; Returns     :           An array which matches the position of each structure tag to the
;                         position of the database field to which that tag refers.  This is
;                         mainly for the use of the db_rec_add method.  If the method failed
;                         then it returns -1.
;
; Restrictions: The system variable !PRIV must be set to a value of 2 or greater.

; Make sure that at least a database name and sample record was passed to us.

IF N_PARAMS () LT 2 THEN BEGIN

   self.msg = 'USE: index = O->DB_CHECK_RECORD ( dbase, record ) '

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check that a string was passed as the name of the database to check the database against..

IF DATATYPE (dbase, 2) NE 7 THEN BEGIN

   self.msg = 'Method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check that records being checked are of type STRUCTURE.

IF DATATYPE (rec [0], 2) NE 8 THEN BEGIN

   self.msg = 'Method requires that records being checked be a structure.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Find the number of databases that we supposed to check against.

ndb = N_ELEMENTS (db)

; Find the number of records that are being checked.

n_rec = N_ELEMENTS (rec)

; Get the tag names from the structure passed to us in the rec parameter.

item = TAG_NAMES (rec [0])

; Find the number of items that we are extracting.

n_item = N_ELEMENTS (item)

; Create an array to hold the item descriptions from each database that we are
; validating the record against.

dbx = REPLICATE ({DB_ITEM_INFO}, 1)

; Get some information about the database that we are going to match to the record.
; We will have to call get_db_info once for each database that we are checking the
; record against.

FOR i = 0, N_ELEMENTS (dbase) - 1 DO BEGIN

; Call the get_db_info method to get data on each database.

   self->get_db_info, dbase [i], DB_DESC = db_desc, DB_ITEM = db_item

; Check if the call to get_db_info succeeded.  If it did not, then will just quit.

   IF N_TAGS (db_desc) EQ 0 THEN RETURN, -1

; Copy the item descriptions from the database into the dbx array.

   dbx = [dbx, db_item]

ENDFOR

; Remove the dummy item structure from the dbx array.

dbx = dbx [1:*]

; Remove non-unique database items

; Create a sort list of indexes into the dbx array.

srt = SORT (dbx.name)

; Now filter out all the indexes that refer to duplicate array entries.

unq = UNIQ (dbx [srt].name)

; Now get rid of any duplicate entries in the dbx array.  Make sure that we just
; get rid of duplicate entries, not sort the dbx array as well.

dbx = dbx [(srt [unq]) [SORT (srt [unq])]]

; Create a array of indices that map structure tags to database items

ind = INTARR (N_ELEMENTS (dbx))

; Make sure that the structure has enough tags in it.  This is the first step to
; validate that the structure matches the database that it is to populate.  However if
; NOSTRICT keyword was set, then we will skip this test.

IF NOT KEYWORD_SET (nostrict) THEN BEGIN

   IF n_item NE N_ELEMENTS (dbx) - 1 THEN BEGIN

; Collapse the array of database names into a sigle comma seperated string.

      dbname = dbase [0]

      FOR i = 1, N_ELEMENTS (dbase) - 1 DO dbname = dbname + ", " + dbase [i]

; Create the error message and call the error function.

      self.msg = 'Number of tags in structure does not match database ' + dbname + '.'

      tmp = self->error (/INFORMATIONAL, QUIET = quiet)

      RETURN, -1

   ENDIF

ENDIF

; Attempt to validate the structure by making sure that the IDL type of each tag in
; structure matches that of its equivalent database item.

FOR i = 0, n_item - 1 DO BEGIN

  FOR j = 0,  N_ELEMENTS (dbx) - 1 DO BEGIN

      IF item [i] EQ dbx [j].name THEN BEGIN

         ind [j] = i

         IF DATATYPE (rec [0].(i), 2) NE dbx [j].data_type THEN BEGIN

            self.msg = 'Data type of tag ' + item [i] + ' must match equivalent '
            self.msg = self.msg + 'item in database: ' + dbx [j].db_name + '.'

            tmp = self->error (/INFORMATIONAL, QUIET = quiet)

            RETURN, -1

         ENDIF

         FOR k = 0, n_rec - 1 DO BEGIN

; Check if the item is of type char.  In this case, we must also make sure that the
; number of characters in the structure tag is less then or equal to number characters
; that is allocated for that database item.

            IF dbx [j].data_type EQ 7 THEN BEGIN

               IF STRLEN (rec [k].(i)) GT (dbx [j].data_dbf_size) THEN BEGIN

                  self.msg = 'Tag ' +                $
                             item [i] +                  $
                             ' must be no longer then ' +           $
                             STRING (dbx [j].data_dbf_size, FORMAT = '(I0)') +   $
                             ' characters.'

                  tmp = self->error (/INFORMATIONAL, QUIET = quiet)

                  RETURN, -1

               ENDIF

            ENDIF

            IF N_ELEMENTS (rec [k].(i)) NE 1 THEN BEGIN

               self.msg = 'Tag ' + item [i] + ' must be a scalar.'

               tmp = self->error (/INFORMATIONAL, QUIET = quiet)

               RETURN, -1

            ENDIF

         ENDFOR

         GOTO, LOOP_BREAK

      ENDIF

  ENDFOR

; Oops, if we got to here, then we have tag name that does not match an equivalent item
; in the database.  If the /NOSTRICT keyword was set, then this is OK.  Otherwise,
; this is an error and we should flag the error and return.

  IF NOT KEYWORD_SET (nostrict) THEN BEGIN

     self.msg = 'No equivalent item in database to structure tag ' + item [i] + '.'

     tmp = self->error (/INFORMATIONAL, QUIET = quiet)

     RETURN, -1

  ENDIF

LOOP_BREAK:

ENDFOR

; Looks like we verified every item in the structure.  Return the index file we created as
; result of this function.

RETURN, ind

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::db_edit_entry, dbase, list, index, NOLOCK = nolock, QUIET = quiet

IF N_PARAMS () LT 3 THEN BEGIN

   self.msg = 'USE: result = O->DB_EDIT_ENTRY (dbase, list, index, [KEYWORDS])

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check that a string was passed as the name of the database to add the records to.

IF DATATYPE (dbase, 2) NE 7 THEN BEGIN

   self.msg = 'Method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Make sure that the value of !PRIV is at least 2 (Needed to open the database for writing).

IF !PRIV LT 2 THEN BEGIN

   self.msg = '!PRIV must be 2 or greater to write into the database.'

   tmp = self->error ()

   RETURN, -1

ENDIF

STOP

; Set the noverify keyword based on the value that was passed as the parameter NOVERIFY.

IF KEYWORD_SET (noverify) THEN noverify = 1 ELSE noverify = 0

; Figure out how many items are in the list of values that we are adding to the database

n_item = N_ELEMENTS (list)

; Get a path to the database.

dbpath = self->getpath ( dbase, QUIET = quiet )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN RETURN, -1

; Get some information about the target database and the items in the target database.

self->get_db_info, dbase, DB_DESC = db, DB_ITEM = db_item

; Check if the call to get_db_info succeeded.  If it did not, then we will just quit.

IF N_TAGS (db) EQ 0 THEN RETURN, -1

; Check if we are to lock the database.

IF NOT KEYWORD_SET (nolock) THEN BEGIN

   status = self->lock_database (dbase, /QUIET, EXPIRE = 300.0)

   IF status EQ 0 THEN BEGIN

      self.msg = 'Database can not be accessed.  Locked by another user.

      tmp = self->error (/INFORMATIONAL, QUIET = quiet)

      RETURN, -1

   ENDIF

ENDIF

; Get the current record at the requested index.

self->db_get_record, dbase, index, current_record, /ALL_FIELDS, /RETURN_LIST, QUIET = quiet

; Replace the fields in the current record with the ones from list where there are
; duplicates.

; Loops through all elements in the list passed to this method looking for matches in
; the record just retrieved from the database.

FOR i = 0, N_ELEMENTS (list) - 1 DO BEGIN

; Check if the ith element in the list passed to this method corresponds to any field in
; record we just retrieved from the database.

   ind = WHERE (list[i].key EQ current_record.key)

; Check if we found a match

    IF ind [0] NE -1 THEN BEGIN

; Replace fields in the current record with their equivalant from the list that was
; passed to this method.

       current_record [ind [0]] = list [i]

    ENDIF

ENDFOR

; Sort the list of field structures by key name.

current_record = current_record [SORT (current_record.key)]

; Open the database for update.

DBOPEN, dbase, 1

IF db.external THEN noconvert = IS_IEEE_BIG () ELSE noconvert = 1B

entry = MAKE_ARRAY (DIMEN = db.record_length, /BYTE)

; Add the data for entry item into the record that we are creating.

nbyte = LONG (db_item [0].n_values) * LONG (db_item [0].data_dbf_size)

DBXPUT, LONG (index), entry, db_item [0].data_type, db_item [0].data_dbf_pos, nbyte

; Get rid of the 'ENTRY' database item description.

db_item = db_item [WHERE (db_item.name NE 'ENTRY')]

; Sort the database item description structures by item name.

db_item = db_item [SORT (db_item.name)]

nbyte = LONG (db_item.n_values) * LONG (db_item.data_dbf_size)

; Set l to 0.  We will l to point to the list value that we currently copying
; into the database record that we are constructing.

l = 0

FOR i = 0, db.n_items - 2 DO BEGIN

;  i1 = i * db_item [i].n_values
;  i2 = i1 + db_item [i].n_values - 1

    pos = WHERE (db_item[i].name EQ current_record [l:*].key, cnt)

; Check whether we were able to find a list keyword/value pair that matches
; the name of db_item i.  If we didn't then we are going to have flag the
; error and quit.

    IF cnt EQ 0 THEN BEGIN

       self.msg = "Can not locate list value that matches item: " + db_item[i].name

       tmp = self->error (/INFORMATIONAL, QUIET = quiet)

       IF NOT KEYWORD_SET (nolock) THEN self->unlock_database, dbase, QUIET = quiet

       RETURN, -1

    ENDIF

; Reset l to the position of the list item that matches the next database item.

    l = pos [0] + l

; Set val to the same type as database item i.

    CASE db_item [i].data_type OF

       1 : val = BYTE (0)   ; Byte Value
       2 : val = FIX (0)    ; Integer Value
       3 : val = LONG (0)   ; Long Integer Value
       4 : val = FLOAT (0)  ; Floating Point Value
       5 : val = DOUBLE (0) ; Double Precision Floating Point Value
       6 : val = COMPLEX (0)    ; Complex Value
       7 : val = ""     ; String Value
       9 : val = DCOMPLEX (0)   ; Double Precision Complex Value

       ELSE :  BEGIN            ; Oops, some type that we can't handle.

                 self.msg = 'Can not copy value into database with type: ' +    $

                            STRTRIM (STRING (db_item [i].data_type), 2)

                 tmp = self->error (/INFORMATIONAL, QUIET = quiet)

                 IF NOT KEYWORD_SET (nolock) THEN self->unlock_database, dbase, QUIET = quiet

                 RETURN, -1

               END

    ENDCASE

; Check if the structure tag requires a byte and the value is either 'T' or 'F'.  In this
; case what we are dealing with is a logical value. We will convert T to 1 and F to 0.

    IF db_item [i].data_type EQ 1 AND current_record [l].val EQ 'T' THEN current_record [l].val = '1'
    IF db_item [i].data_type EQ 1 AND current_record [l].val EQ 'F' THEN current_record [l].val = '0'

; Convert the value string from the array of list items into the appropiate value
; to add into the database.

    READS, STRTRIM (current_record [l].val, 2), val

    DBXPUT, val, entry, db_item [i].data_type, db_item [i].data_dbf_pos, nbyte [i]

; Increment l

    l = l + 1

ENDFOR

; Add the entry we just created into the database

STOP

DBWRT, entry

RETURN, index

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::db_list_add, dbase,                  $
                                list,                   $
                                index,                  $
                                NOLOCK = nolock,        $
                                QUIET = quiet,          $
                                NOINDEX = noindex,      $
                                NOVERIFY = noverify,    $
                                NOSORT = NOSORT,        $
                                NOSTRICT = nostrict

;   DB_LIST_ADD
;
;   Add a record to a database.
;
;   This method takes a list and adds it as new record to a database.  A list is an
;   array of structures.  Each structure contains two tags, a keyword tag and a value
;   tag (both defined as char).  The keyword tagis used to indicate that database field
;   that the value will be added into while the value tag provides that value that will
;   be added into the database.  The value is converted from character value to a
;   numerical value (if necessary) based on the type database field.
;
;   This method creates the database record directly from the list and thus does not
;   require the structure conversions that the db_rec_add method requires.
;
; Syntax      : R = O-DB_LIST_ADD ( DATABASE, LIST, [INDEX], [KEYWORDS] )
;
; Inputs      : DBASE   = The name of the database.  The program looks for a
;                         file with the given name, and the extension .dbf in
;                         either the current directory, or the path given by
;                         the environment variable ZDBASE.
;
;               LIST    = An array of anonamous structures that collectively represents
;                         a single database record.  Each structre is of the following
;                         form:
;                         { KEY : "STRING", ; Name of database field.
;                           VAL : "STRING"  ; Value to insert in database field.
;                         }
;
; Opt. Inputs : INDEX   = Index of a record in the database.  If this input is specified
;                         then this function replaces this record instead adding it
;                         to the database.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : QUIET   = If set, then warning or informational messages are not
;        not displayed.
;
;     NOLOCK   = If set, then do not lock the database before writing to it. If it
;        is used, then the calling function/method is responsible for database
;        locking.
;
;     NOINDEX  = If set, then do not update the index files after adding the records
;        into the database.
;
;     NOVERIFY= If set, then check that each item in the list matches its
;        corresponding database field.
;
;     NOSORT   = If set, then do not sort the list of values prior to adding them
;        into the database.
;
;     NOSTRICT= If set, then allow the list values to contain items that do not
;        exist in the database the record is being added to.
;
; Returns     :     An array that contains the entry number of the record that we added
;      to the database.  If the method failed then it returns -1.
;
; Restrictions: The system variable !PRIV must be set to a value of 2 or greater.

; Check if we were passed the correct number of parameters.

IF N_PARAMS () LT 2 THEN BEGIN

   self.msg = 'USE: result = O->DB_LIST_ADD (dbase, list)

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check that a string was passed as the name of the database to add the records to.

IF DATATYPE (dbase, 2) NE 7 THEN BEGIN

   self.msg = 'Method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Make sure that the value of !PRIV is at least 2 (Needed to open the database for writing).

IF !PRIV LT 2 THEN BEGIN

   self.msg = '!PRIV must be 2 or greater to write into the database.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check if an index parameter has been specified.  If it hasn't then set it to 0.

IF N_ELEMENTS (index) EQ 0 THEN index = 0

; Set the noverify keyword based on the value that was passed as the parameter NOVERIFY.

IF KEYWORD_SET (noverify) THEN noverify = 1 ELSE noverify = 0

; Set the nostrict keyword based on the value that was passed as the parameter NOSTRICT.

IF KEYWORD_SET (nostrict) THEN nostrict = 1 ELSE nostrict = 0

; Unless the nosort keyword is set, sort the list of values we are adding to the database.

IF NOT KEYWORD_SET (nosort) THEN list = list [SORT (list.key)]

; Figure out how many items are in the list of values that we are adding to the database

n_item = N_ELEMENTS (list)

; Get a path to the database.

dbpath = self->getpath ( dbase, QUIET = quiet )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN RETURN, -1

; Get some information about the target database and the items in the target database.

self->get_db_info, dbase, DB_DESC = db, DB_ITEM = db_item

; Check if the call to get_db_info succeeded.  If it did not, then we will just quit.

IF N_TAGS (db) EQ 0 THEN RETURN, -1

; Make sure that the list has enough keyword/value pairs in it.  This is the first step to
; validate that the list matches the database that it is to populate.  However if
; NOSTRICT keyword was set, then we will skip this test.

IF NOT KEYWORD_SET (nostrict) THEN BEGIN

   IF n_item NE N_ELEMENTS (db_item) - 1 THEN BEGIN

; Create the error message and call the error function.

      self.msg = 'Number of tags in list does not match database ' + dbname + '.'

      tmp = self->error (/INFORMATIONAL, QUIET = quiet)

      RETURN, -1

   ENDIF

ENDIF

; Check if we are to lock the database.

IF NOT KEYWORD_SET (nolock) THEN BEGIN

   status = self->lock_database (dbase, /QUIET, EXPIRE = 300.0)

   IF status EQ 0 THEN BEGIN

      self.msg = 'Database can not be accessed.  Locked by another user.

      tmp = self->error (/INFORMATIONAL, QUIET = quiet)

      RETURN, -1

   ENDIF

ENDIF

; Open the database for update.

DBOPEN, dbase, 1

IF db.external THEN noconvert = IS_IEEE_BIG () ELSE noconvert = 1B

entry = MAKE_ARRAY (DIMEN = db.record_length, /BYTE)

; Add the data for entry item into the record that we are creating.

nbyte = LONG (db_item [0].n_values) * LONG (db_item [0].data_dbf_size)

DBXPUT, LONG (index), entry, db_item [0].data_type, db_item [0].data_dbf_pos, nbyte

; Get rid of the 'ENTRY' database item description.

db_item = db_item [WHERE (db_item.name NE 'ENTRY')]

; Sort the database item description structures by item name.

db_item = db_item [SORT (db_item.name)]

nbyte = LONG (db_item.n_values) * LONG (db_item.data_dbf_size)

; Set l to 0.  We will l to point to the list value that we currently copying
; into the database record that we are constructing.

l = 0

FOR i = 0, db.n_items - 2 DO BEGIN

;  i1 = i * db_item [i].n_values
;  i2 = i1 + db_item [i].n_values - 1

    IF nostrict EQ 1 THEN BEGIN

       pos = WHERE (db_item[i].name EQ list [l:*].key, cnt)

; Check whether we were able to find a list keyword/value pair that matches
; the name of db_item i.  If we didn't then we are going to have flag the
; error and quit.

       IF cnt EQ 0 THEN BEGIN

          self.msg = "Can not locate list value that matches item: " + db_item[i].name

          tmp = self->error (/INFORMATIONAL, QUIET = quiet)

          IF NOT KEYWORD_SET (nolock) THEN self->unlock_database, dbase, QUIET = quiet

          RETURN, -1

       ENDIF

; Reset l to the position of the list item that matches the next database item.

       l = pos [0] + l

    ENDIF ELSE BEGIN

       IF noverify EQ 0 THEN BEGIN

          IF STRUPCASE (list [l].key) NE db_item [i].name THEN BEGIN

              self.msg = 'List item : ' + list [l].key +       $
                         ' does not match expected database item ' +    $
                         db_item [i].name

              tmp = self->error (/INFORMATIONAL, QUIET = quiet)

              IF NOT KEYWORD_SET (nolock) THEN self->unlock_database, dbase, QUIET = quiet

              RETURN, -1

          ENDIF

       ENDIF

    ENDELSE

; Set val to the same type as database item i.

    CASE db_item [i].data_type OF

       1 : val = BYTE (0)   ; Byte Value
       2 : val = FIX (0)    ; Integer Value
       3 : val = LONG (0)   ; Long Integer Value
       4 : val = FLOAT (0)  ; Floating Point Value
       5 : val = DOUBLE (0) ; Double Precision Floating Point Value
       6 : val = COMPLEX (0)    ; Complex Value
       7 : val = ""     ; String Value
       9 : val = DCOMPLEX (0)   ; Double Precision Complex Value

       ELSE :  BEGIN            ; Oops, some type that we can't handle.

                 self.msg = 'Can not copy value into database with type: ' +    $

                            STRTRIM (STRING (db_item [i].data_type), 2)

                 tmp = self->error (/INFORMATIONAL, QUIET = quiet)

                 IF NOT KEYWORD_SET (nolock) THEN self->unlock_database, dbase, QUIET = quiet

                 RETURN, -1

               END

    ENDCASE

; Check if the structure tag requires a byte and the value is either 'T' or 'F'.  In this
; case what we are dealing with is a logical value. We will convert T to 1 and F to 0.

    IF db_item [i].data_type EQ 1 AND list [l].val EQ 'T' THEN list [l].val = '1'
    IF db_item [i].data_type EQ 1 AND list [l].val EQ 'F' THEN list [l].val = '0'

; Convert the value string from the array of list items into the appropiate value
; to add into the database.

    READS, STRTRIM (list [l].val, 2), val

    DBXPUT, val, entry, db_item [i].data_type, db_item [i].data_dbf_pos, nbyte [i]

; Increment l

    l = l + 1

ENDFOR

; Add the entry we just created into the database

DBWRT, entry, NOCONVERT = noconvert

; Check if the keyword noindex is specified.  If it was, then we will skip creating an
; index file.

IF NOT KEYWORD_SET (noindex) THEN BEGIN

; Check whether we need to update the index file.  If any of the database items are
; marked for indexing, then we will go ahead and index the database.

   IF TOTAL (db_item.index_type) GE 1 THEN DBINDEX

ENDIF

; Close the database.

DBCLOSE

; If we locked the database, then unlock it now.

IF NOT KEYWORD_SET (nolock) THEN self->unlock_database, dbase, QUIET = quiet

; If we added a new record to the database then create an array that contains the
; entry number of the record that we added to the database.  This will be usefull
; if the operation has to be rolled back.  Otherwise, if we just replaced a record
; then return index of the record replaced.

IF index NE 0 THEN BEGIN

   newrec = [index]

ENDIF ELSE BEGIN

   newrec = LONG (INDGEN (1) + (db.n_entries + 1))

ENDELSE

RETURN, newrec

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::db_get_full_record, dbase, index

;               DB_GET_FULL_RECORD
;
;               Get all fields of a record (including child databases)
;
; Syntax      : R = O-DB_GET_FULL_RECORD ( DATABASE, REC, [KEYWORDS] )
;
; Inputs      : DBASE   = The name of the database.  The program looks for a
;                         file with the given name, and the extension .dbf in
;                         either the current directory, or the path given by
;                         the environment variable ZDBASE.
;
;               REC     = A structure (or array of structures)  where each tag corresponds
;                         to field in target database.  Note that the structure must have
;                         a tag for each field in the database except for the ENTRY field.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.

IF N_PARAMS () LT 1 THEN BEGIN

   self.msg = 'USE: O->DB_GET_FULL_RECORD, dbase, record'

   tmp = self->error ()

   RETURN, -1

ENDIF

IF DATATYPE (dbase, 2) NE 7 THEN BEGIN

   self.msg = 'DB_GET_FULL_RECORD method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Call the method DB_GET_RECORD extract all fields from the database record pointed to by the
; paremeter index.  Fields are extracted as an array of structures.

self->db_get_record, dbase, index,  rval, /ALL_FIELDS, /RETURN_LIST

; Recopy the list of structures into a new list of structures which 3 keywords (key, db, val)
; instead the structures returned by the DB_GET_RECORD method.

x = REPLICATE ({db:'', key:'', val:''}, N_ELEMENTS (rval))

x.db  = dbase
x.key = rval.key
x.val = rval.val

rval = x

; Call the method GET_DB_INFO to get information about each field in the database.

self->get_db_info, dbase, DB_ITEM = lst

; Reformat the list of field descriptors to get rid of the initial (ENTRY) descriptor since
; field is never returned as part of search results.

lst = lst [1:*]

; Main loop to search through the database item list that was passed to us and to replace any
; items that point to child databases with the actual item list from the database that is pointed
; to.

; Set done to 0 (FALSE).  done becomes true when there are no more pointer items left to process.

done = 0

; Outer loop to continue making passes through the item list until done becomes 1 (TRUE).

WHILE NOT done DO BEGIN

; Set done to 1 (TRUE).  If we find any pointer items then we will reset done to 0 (FALSE).

   done = 1

; Set ind to the indexes of all the items in the list that are pointers to other databases.

   ind = WHERE (lst.pointer NE 0)

; Set i to the first index in ind (may be -1 if no items were found)

   i = ind [0]

; Check if ind is set to -1.  If it is, then there are no items in the list that need to be
; expanded.  Otherwise, there are still pointer item in the list.

   IF i NE -1 THEN BEGIN

; Set done back to 0.  We will need at least one more pass through the outer loop.

      done = 0

; Get the child and parent values from the item descriptor.

      child  = lst [i].CHILD

      rind    = WHERE (lst [i].name EQ rval.key)

      ptr     = FIX (rval [rind].val)

; Call the method GET_DB_INFO to get information about each field in the child database.

      self->get_db_info, child, DB_ITEM = tmp

; Reformat the list of field descriptors to get rid of the initial (ENTRY) descriptor since
; field is never returned as part of search results.

      tmp = tmp [1:*]

; Call the method DB_GET_RECORD extract all fields from the database record pointed to by the
; paremeter index.  Fields are extracted as an array of structures.

      self->db_get_record, child, ptr,  tval, /ALL_FIELDS, /RETURN_LIST

; Recopy the list of structures into a new list of structures which 3 keywords (key, db, val)
; instead the structures returned by the DB_GET_RECORD method.

      x = REPLICATE ({db:'', key:'', val:''}, N_ELEMENTS (tval))

      x.db  = child
      x.key = tval.key
      x.val = tval.val

      tval = x

; Set last to index of the last element in the list of field description structure.

      last = N_ELEMENTS (lst) - 1

      CASE i OF

        0 :     BEGIN

                  lst  = [tmp,  lst [1:*]]
                  rval = [tval, rval [1:*]]

                END

        last :  BEGIN

                  lst  = [lst  [0:last-1],  tmp]
                  rval = [rval [0:last-1], tval]

                END

        ELSE :  BEGIN

                  lst  = [lst  [0:i-1], tmp,  lst  [i+1:*]]
                  rval = [rval [0:i-1], tval, rval [i+1:*]]

                END

      ENDCASE

   ENDIF

ENDWHILE

RETURN, rval

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::db_rec_add, dbase,                  $
                               rec,                    $
                               index,                  $
                               NOLOCK = nolock,        $
                               QUIET = quiet,          $
                               NOINDEX = noindex

;               DB_REC_ADD
;
;               Add record(s) into a database.
;
;               This method will add a record (single or multiple) into a database.  The record
;               is represented as a structure where each of the structure tags is expected to be
;               the name of a database field.  The success of the operation is returned as the
;               the result of the method.
;
; Syntax      : R = O-DB_REC_ADD ( DATABASE, REC, [KEYWORDS] )
;
; Inputs      : DBASE   = The name of the database.  The program looks for a
;                         file with the given name, and the extension .dbf in
;                         either the current directory, or the path given by
;                         the environment variable ZDBASE.
;
;               REC     = A structure (or array of structures)  where each tag corresponds
;                         to field in target database.  Note that the structure must have
;                         a tag for each field in the database except for the ENTRY field.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : QUIET   = If set, then warning or informational messages are not
;                         not displayed.
;
;               NOLOCK   = If set, then do not lock the database before writing to it. If it
;                          is used, then the calling function/method is responsible for database
;                          locking.
;
;               NOINDEX  = If set, then do not update the index files after adding the records
;                          into the database.
;
; Returns     :            An array that contains the entry number of each record that we added
;                          to the database.  If the method failed then it returns -1.
;
; Restrictions: The system variable !PRIV must be set to a value of 2 or greater.

; Check if we were passed the correct number of parameters.

IF N_PARAMS () LT 2 THEN BEGIN

   self.msg = 'USE: O->DB_REC_ADD, dbase, record'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check that a string was passed as the name of the database to add the records to.

IF DATATYPE (dbase, 2) NE 7 THEN BEGIN

   self.msg = 'Method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check that records being added to the dabase are in structure format.

IF DATATYPE (rec [0], 2) NE 8 THEN BEGIN

   self.msg = 'Method requires that records being added to the database be a structure.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Make sure that the value of !PRIV is at least 2 (Needed to open the database for writing).

IF !PRIV LT 2 THEN BEGIN

   self.msg = '!PRIV must be 2 or greater to write into the database.'

   tmp = self->error ()

   RETURN, -1

ENDIF

; Check if an index parameter has been specified.  If it hasn't then set it to 0.

IF N_ELEMENTS (index) EQ 0 THEN index = 0

; Find the number of records that are being added into the database.

n_rec = N_ELEMENTS (rec)

; Get the tag names from the structure passed to us in the rec parameter.

item = TAG_NAMES (rec [0])

; Find the number of items that we are extracting.

n_item = N_ELEMENTS (item)

; Get a path to the database.

dbpath = self->getpath ( dbase, QUIET = quiet )

; Check for errors. If path is a  NULL string then the method failed.

IF dbpath EQ "" THEN RETURN, -1

; Get some information about the target database and the items in the target database.

self->get_db_info, dbase, DB_DESC = db, DB_ITEM = db_item

; Check if the call to get_db_info succeeded.  If it did not, then will just quit.

IF N_TAGS (db) EQ 0 THEN RETURN, -1

; Verify that we can add the record(s) into the database.  The result of this function call (if it
; succeeds is array that structure tags to their corresponding database items.  If it fails, it
; returns -1.

ind = self->check_record ( dbase, rec, QUIET = quiet )

; Check if the call to check record succeeded.  If it did not, then just return.

IF ind [0] EQ -1 THEN RETURN, -1

; Check if we are to lock the database.

IF NOT KEYWORD_SET (nolock) THEN BEGIN

   status = self->lock_database (dbase, /QUIET, EXPIRE = 300.0)

   IF status EQ 0 THEN BEGIN

      self.msg = 'Database can not be accessed.  Locked by another user.

      tmp = self->error (/INFORMATIONAL, QUIET = quiet)

      RETURN, -1

   ENDIF

ENDIF

; Open the database for update.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBOPEN, 1'" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBOPEN, dbase, 1

ENDELSE

IF db.external THEN noconvert = IS_IEEE_BIG () ELSE noconvert = 1B

entry = MAKE_ARRAY (DIMEN = db.record_length, /BYTE)

nbyte = LONG (db_item.n_values) * LONG (db_item.data_dbf_size)

FOR i = 0L, n_rec - 1 DO BEGIN

  i1 = i * db_item [i].n_values
  i2 = i1 + db_item [i].n_values - 1

;nbyte = LONG (db_item [0].n_values) * LONG (db_item [0].data_dbf_size)

;DBXPUT, LONG (index), entry, db_item [0].data_type, db_item [0].data_dbf_pos, nbyte

; Get rid of the 'ENTRY' database item description.

;db_item = db_item [WHERE (db_item.name NE 'ENTRY')]

; DBXPUT, 0L, entry, db_item [0].data_type, db_item [0].data_dbf_pos, nbyte [0]

  DBXPUT, LONG (index), entry, db_item [0].data_type, db_item [0].data_dbf_pos, nbyte [0]

  FOR j = 1, db.n_items - 1 DO BEGIN

     DBXPUT, rec [i].(ind [j]), entry, db_item [j].data_type, db_item [j].data_dbf_pos, nbyte [j]

  ENDFOR

; Add the entry we just created into the database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate the commands to this on the remote session.

  IF self.remote AND self.client THEN BEGIN

     IF NOT self.idl_server->RPCSetVariable (NAME = 'noconvert', VAL = noconvert) THEN BEGIN

        self.msg = 'Could not send variable noconvet to remote IDL server.'

        tmp = self->error ()

        RETURN, -1

     ENDIF

     cmd = 'DBWRT, entry, NOCONVERT = noconvert'

     IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

        self.msg = 'Could not execute command on remote IDL server.'

        tmp = self->error ()

        RETURN, -1

     ENDIF

  ENDIF ELSE BEGIN

      DBWRT, entry, NOCONVERT = noconvert

  ENDELSE

ENDFOR

; Check if the keyword noindex is specified.  If it was, then we will skip creating an
; index file.

IF NOT KEYWORD_SET (noindex) THEN BEGIN

; Check whether we need to update the index file.  If any of the database items are
; marked for indexing, then we will go ahead and index the database.

   IF TOTAL (db_item.index_type) GE 1 THEN BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

      IF self.remote AND self.client THEN BEGIN

         cmd = 'DBINDEX'

         IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

            self.msg = 'Could not execute command on remote IDL server.'

            tmp = self->error ()

            RETURN, -1

         ENDIF

      ENDIF ELSE BEGIN

         DBINDEX

      ENDELSE

   ENDIF

ENDIF

; Close the database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBCLOSE, '" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBCLOSE, dbase

ENDELSE

; If we locked the database, then unlock it now.

IF NOT KEYWORD_SET (nolock) THEN self->unlock_database, dbase, QUIET = quiet

; Create an array that contains the entry number of each record that we added to the database.
; This will be usefull if the operation has to be rolled back.

newrec = LONG (INDGEN (n_rec) + (db.n_entries + 1))

RETURN, newrec

END

; ------------------------------------------------------------------------------------------------

PRO db_tools::db_get_record, dbase,                                   $
                             index,                                   $
                             rec,                                     $
                             QUIET = quiet,                           $
                             ALL_FIELDS = all_fields,                 $
                             RETURN_LIST = return_list

;               DB_GET_RECORD
;
;               Get predetermined records from a database.
;
;               This method will retrieve a predetermined set of records from the database based
;               on an array indexes passed to this method. The routine expects a structure to be
;               passed in the parameter rec.  Each of the structure tags is expected to be the name
;               of a database field.
;
;               Note that not all the database fields need to have tags rec structure, only
;               tags for database fields that are of interest.  The result of the database query
;               is returned as an array of the same structures via the rec parameter.
;
;               If the /ALL_FIELDS keyword is specified, then the record parameter is ignored and
;               all fields in the record.
;
; Syntax      : O-DB_GET_RECORD, DATABASE, REC, NREC, [KEYWORD]
;
; Inputs      : DBNAME  = The name of the database.  The program looks for a
;                         file with the given name, and the extension .dbf in
;                         either the current directory, or the path given by
;                         the environment variable ZDBASE.
;
;               REC     = An structure where each tag corresponds to field in
;                         target database.
;
; Opt. Inputs : None.
;
; Outputs     : NREC    = The number of structures returned via the REC parameter.
;                         If the database search did not result in any hits, then
;                         this parameter will be 0.
;
;               REC     = An array of structures.  The structures will be same as
;                         the structure that was passed to the method by this
;                         parameter on input.  Each structure will contain the
;                         data from one of the database records that matched the
;                         search string.
;
; Opt. Outputs: None.
;
; Keywords    : QUIET   = If set, then warning or informational messages are not
;               not displayed.
;
; Restrictions: None.

; Check if we were passed the correct number of parameters.

IF N_PARAMS () LT 2 THEN BEGIN

   self.msg = 'USE: O->DB_GET_RECORD, dbase, index_array, [record], [keywords]'

   tmp = self->error ()

   RETURN

ENDIF

IF DATATYPE (dbase, 2) NE 7 THEN BEGIN

   self.msg = 'DB_GET_RECORD method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN

ENDIF

IF DATATYPE (rec, 2) NE 8 AND NOT KEYWORD_SET (all_fields) THEN BEGIN

   self.msg = 'DB_GET_RECORD method requires that sample record be a structure.'

   tmp = self->error ()

   RETURN

ENDIF

IF KEYWORD_SET (return_list) AND N_ELEMENTS (index) GT 1 THEN BEGIN

   self.msg = 'KEYWORD RETURN_LIST is invalid when used with multiple record indices.'

   tmp = self->error ()

   RETURN

ENDIF

; Open the requested database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBOPEN, '" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBOPEN, dbase

ENDELSE

;  Check if the /ALL_FIELDS is set.  If it is, then we need to querry the
;  list of fields using the GET_DB_INFO method.

IF KEYWORD_SET (all_fields) THEN BEGIN

   self->GET_DB_INFO, dbase, DB_ITEM = db_item

; Construct the querry record from the information returned the GET_DB_INFO method.

   rec = self->GET_STRUCT ( db_item, QUIET = quiet )

ENDIF

; Get the tag names from the structure passed to us in the rec parameter.

items = TAG_NAMES (rec)

; Find the number of items that we are extracting.

nitems = N_ELEMENTS (items)

; Remove duplicate elements from the list indexes.  This may be necessary depending on
; the list that was passed to us from the user.

list = index [UNIQ (index)]

; Check if we are using a remote instance of this database.  If we are, then we will have
; copy the list variables to the remote IDL server.

IF self.remote AND self.client THEN BEGIN

   IF NOT self.idl_server->RPCSetVariable (NAME = 'list', VAL = list) THEN BEGIN

      self.msg = 'Could not send variable list to remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF

; Find the number records that the search has returned

nrec = N_ELEMENTS (list)

; Check if the keyword RETURN_LIST was set.  If it was, then create an arrary of list
; structures containing key and val tags.  We can fill in the key tags now with the
; contents of the item array.

IF KEYWORD_SET (return_list) THEN BEGIN

   rec = REPLICATE ({key: "", val: ""}, nitems)

   rec.key = items

ENDIF ELSE BEGIN

; If the keyword RETURN_LIST was not passed to this method, then create an array of structures
; to hold the results of the search, one structure will be used to hold each database record.

   rec = REPLICATE (rec [0], nrec)

ENDELSE

; Set last to the number of the last iteration through the loop we will need
; to completely extract the data from all the requested items.

last = FIX ((nitems - 1) / 10)

; Set a bunch of place holder variables to contain the results of the database search.  Each
; placeholder variable will contain the contents of one database field.

aa = 0
bb = 0
cc = 0
dd = 0
ee = 0
ff = 0
gg = 0
hh = 0
ii = 0
jj = 0

; Check if we are using a remote instance of this database.  If we are, then we will have
; create these variables on the remote system as well.

IF self.remote AND self.client THEN BEGIN

; Send the command to create the necessary place holder variables..

   cmd = 'aa = 0 & bb = 0 & cc = 0 & dd = 0 & ee = 0 & ff = 0 & gg = 0 & hh = 0 & ii = 0 & jj = 0'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF

; Get the values from the database for the selected items

FOR i = 0, last DO BEGIN

   i0 = i * 10

   IF i EQ last THEN nind = nitems - i0 ELSE nind = 10

   ind = INDGEN (nind) + i0

   str = ""

   FOR j = 0, nind - 2 DO str = str + items [ind [j]] + ", "

   str = str + items [ind [nind - 1]]

   str = str [0]

; Check if we are using a remote instance of this database.  If we are, then we will have
; copy the str variable to the remote IDL server.

   IF self.remote AND self.client THEN BEGIN

; Copy the variable str to the remote IDL server.

      IF NOT self.idl_server->RPCSetVariable (NAME = 'str', VAL = str) THEN BEGIN

         self.msg = 'Could not send variable str to remote IDL server.'

         tmp = self->error ()

         RETURN

      ENDIF

; Send the command the querry the values of the selected fields from the database.

      cmd = 'DBEXT, list, str, aa, bb, cc, dd, ee, ff, gg, hh, ii, jj'

      IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

         self.msg = 'Could not execute command on remote IDL server.'

         tmp = self->error ()

         RETURN

      ENDIF

   ENDIF ELSE BEGIN

; OK, we are doing this locally.

      DBEXT, list, str, aa, bb, cc, dd, ee, ff, gg, hh, ii, jj

   ENDELSE

; STOP

; Now copy the contents of each of the placeholder variables into the record structure.  Note
; that if we are doing this remotely, then we have to get each placeholder variable from the
; remote IDL server.

   SWITCH nind OF

     10 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable jj from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'jj', VAL = jj) THEN BEGIN

              self.msg = 'Could not get variable jj from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 9].val = STRING (jj) ELSE rec.(i0 + 9) = jj

        END

      9 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable ii from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'ii', VAL = ii) THEN BEGIN

              self.msg = 'Could not get variable ii from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 8].val = STRING (ii) ELSE rec.(i0 + 8) = ii

        END

      8 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable hh from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'hh', VAL = hh) THEN BEGIN

              self.msg = 'Could not get variable hh from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 7].val = STRING (hh) ELSE rec.(i0 + 7) = hh

        END

      7 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable gg from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'gg', VAL = gg) THEN BEGIN

              self.msg = 'Could not get variable gg from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 6].val = STRING (gg) ELSE rec.(i0 + 6) = gg

        END

      6 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable ff from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'ff', VAL = ff) THEN BEGIN

              self.msg = 'Could not get variable ff from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 5].val = STRING (ff) ELSE rec.(i0 + 5) = ff

        END

      5 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable ee from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'ee', VAL = ee) THEN BEGIN

              self.msg = 'Could not get variable ee from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 4].val = STRING (ee) ELSE rec.(i0 + 4) = ee

        END

      4 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable dd from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'dd', VAL = dd) THEN BEGIN

              self.msg = 'Could not get variable dd from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 3].val = STRING (dd) ELSE rec.(i0 + 3) = dd

        END

      3 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable cc from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'cc', VAL = cc) THEN BEGIN

              self.msg = 'Could not get variable cc from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 2].val = STRING (cc) ELSE rec.(i0 + 2) = cc

        END

      2 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable bb from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'bb', VAL = bb) THEN BEGIN

              self.msg = 'Could not get variable bb from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0 + 1].val = STRING (bb) ELSE rec.(i0 + 1) = bb

        END

      1 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable aa from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'aa', VAL = aa) THEN BEGIN

              self.msg = 'Could not get variable aa from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        IF KEYWORD_SET (return_list) THEN rec [i0].val = STRING (aa) ELSE rec.(i0) = aa

        END

   ENDSWITCH

ENDFOR

; Close the database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBCLOSE, '" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBCLOSE, dbase

ENDELSE

RETURN

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::db_find_all_records, dbase, search, COUNT = count

; Perform multiple searches on a database to find all the indices of records that satisfy
; any of (LOGICAL OR) of the search criterion.

; Open the requested database

self.db_tools_connect->open, dbase

; Check if search contains any empty strings.  If it does, then remove them.

s = WHERE (search NE '')

search = search [s]

; Set count to 0.  We will use count to keep track of number of records we
; find.

count = 0

; Set first_res to 1.  We will us the first_res flag to indicate that this is the
; first batch of records that we have sucessfully found in our database search.

first_res = 1

; Process each element in the search string array.

FOR i = 0, N_ELEMENTS (search) - 1 DO BEGIN

; Find the indices of the database records that are selected by the ith search
; string.

  f = self.db_tools_connect->find ( search [i], COUNT = cnt )

; Check if any records matched the search criterion.  If none did then trigger the next
; interation of the loop.

  IF cnt EQ 0 THEN CONTINUE

; OK, add new indices that we found to the array of indices that we will
; return as the result of this function.  If this is the first batch of indices
; that we have found (indicated by the first_res flag) then process it as a
; seperate case.

  IF first_res EQ 1 THEN BEGIN

     found = f

     first_res = 0

  ENDIF ELSE BEGIN

     found = [found, f]

  ENDELSE

; Update count.

  count = count + cnt

ENDFOR

; Close the database

self.db_tools_connect->close

; Check if we got any record indices.  If we did then lets sort them.

IF count NE 0 THEN BEGIN

; Sort the array of indices.

   found = found [SORT (found)]

; Pick out the unique indices.

   found = found [UNIQ (found)]

ENDIF ELSE BEGIN

; Othersise, set found to -1

   found = -1

ENDELSE

RETURN, found

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::db_find_records, dbase, search

; Open the requested database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBOPEN, '" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBOPEN, dbase

ENDELSE

; Generate a list of entries that satisfy the search string.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to get the list of entries from the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = 'msg = ""'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

   cmd = "found = DBFIND ('" + search + "', /SILENT, ERRMSG = msg)"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Get the result of the message variable.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'msg', VAL = msg) THEN BEGIN

      self.msg = 'Could not get variable msg from remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Get the result of the found variable.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'found', VAL = found) THEN BEGIN

      self.msg = 'Could not get variable msg from remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   msg = ""

   found = DBFIND (search, /SILENT, ERRMSG = msg)

ENDELSE

; Close the database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBCLOSE, '" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, -1

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBCLOSE, dbase

ENDELSE

RETURN, found

END

; ------------------------------------------------------------------------------------------------

PRO db_tools::db_rec_search, dbase, search, rec, nrec, QUIET = quiet, INDEX = index

;               DB_REC_SEARCH
;
;               Get records from a database.
;
;               This method will perform a database search based on the string passed in the
;               search parameter.  The routine expects a structure to be passed in the parameter
;               rec.  Each of the structure tags is expected to be the name of a database field.
;               Note that not all the database fields need to have tags rec structure, only
;               tags for database fields that are of interest.  The result of the database query
;               is returned as an array of the same structures via the rec parameter.
;
; Syntax      : O-DB_REC_SEARCH, DATABASE, REC, NREC, [KEYWORD]
;
; Inputs      : DBNAME  = The name of the database.  The program looks for a
;                         file with the given name, and the extension .dbf in
;                         either the current directory, or the path given by
;                         the environment variable ZDBASE.
;
;               SEARCH  = Any valid UiT database search string.  See the
;                         documentation of the DBFIND procedure for details.
;
;               REC     = An structure where each tag corresponds to field in
;                         target database.
;
; Opt. Inputs : None.
;
; Outputs     : NREC    = The number of structures returned via the REC parameter.
;                         If the database search did not result in any hits, then
;                         this parameter will be 0.
;
;               REC     = An array of structures.  The structures will be same as
;                         the structure that was passed to the method by this
;                         parameter on input.  Each structure will contain the
;                         data from one of the database records that matched the
;                         search string.
;
; Opt. Outputs: None.
;
; Keywords    : QUIET   = If set, then warning or informational messages are not
;               not displayed.
;
; Restrictions: None.

; Check if we were passed the correct number of parameters.

IF N_PARAMS () LT 3 THEN BEGIN

   self.msg = 'USE: O->DB_REC_SEARCH, dbase, search_str, record, [n_records]'

   tmp = self->error ()

   RETURN

ENDIF

IF DATATYPE (dbase, 2) NE 7 THEN BEGIN

   self.msg = 'DB_REC_SEARCH method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN

ENDIF

IF DATATYPE (search, 2) NE 7 THEN BEGIN

   self.msg = 'DB_REC_SEARCH method requires that the search string be of string type.'

   tmp = self->error ()

   RETURN

ENDIF

IF DATATYPE (rec, 2) NE 8 THEN BEGIN

   self.msg = 'DB_REC_SEARCH method requires that sample record be a structure.'

   tmp = self->error ()

   RETURN

ENDIF

; Open the requested database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBOPEN, '" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBOPEN, dbase

ENDELSE

; Get the tag names from the structure passed to us in the rec parameter.

items = TAG_NAMES (rec)

; Find the number of items that we are extracting.

nitems = N_ELEMENTS (items)

; Generate a list of entries that satisfy the search string.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to get the list of entries from the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = 'msg = ""'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

   cmd = "found = DBFIND ('" + search + "', /SILENT, ERRMSG = msg)"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Get the result of the message variable.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'msg', VAL = msg) THEN BEGIN

      self.msg = 'Could not get variable msg from remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

; Get the result of the found variable.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'found', VAL = found) THEN BEGIN

      self.msg = 'Could not get variable msg from remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   msg = ""

   found = DBFIND (search, /SILENT, ERRMSG = msg)

ENDELSE

IF found [0] LE 0 THEN BEGIN

   rec  = -1
   nrec = 0

   IF msg NE "" THEN BEGIN

      self.msg = msg

   ENDIF ELSE BEGIN

      dbase = STRUPCASE (dbase)

      self.msg = "No records found meeting search criterion in database: " + dbase [0]

   ENDELSE

   tmp = self->error (/INFORMATIONAL, QUIET = quiet)

   RETURN

ENDIF

; Remove duplicate elements from the list

list = found [UNIQ (found)]

; Copy the list into index.

index = list

; Check if we are using a remote instance of this database.  If we are, then we will have
; copy the list variable to the remote IDL server.

IF self.remote AND self.client THEN BEGIN

   IF NOT self.idl_server->RPCSetVariable (NAME = 'list', VAL = list) THEN BEGIN

      self.msg = 'Could not send variable list to remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF

; Find the number records that the search has returned

nrec = N_ELEMENTS (list)

; Create an array of structures to hold the results of the search, one structure will
; be used to hold each database record.

rec = REPLICATE (rec [0], nrec)

; Set last to the number of the last iteration through the loop we will need
; to completely extract the data from all the requested items.

last = FIX ((nitems - 1) / 10)

; Set a bunch of place holder variables to contain the results of the database search.  Each
; placeholder variable will contain the contents of one database field.

aa = 0
bb = 0
cc = 0
dd = 0
ee = 0
ff = 0
gg = 0
hh = 0
ii = 0
jj = 0

; Check if we are using a remote instance of this database.  If we are, then we will have
; create these variables on the remote system as well.

IF self.remote AND self.client THEN BEGIN

; Send the command to create the necessary place holder variables..

   cmd = 'aa = 0 & bb = 0 & cc = 0 & dd = 0 & ee = 0 & ff = 0 & gg = 0 & hh = 0 & ii = 0 & jj = 0'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF

; STOP

; Get the values from the database for the selected items

FOR i = 0, last DO BEGIN

   i0 = i * 10

   IF i EQ last THEN nind = nitems - i0 ELSE nind = 10

   ind = INDGEN (nind) + i0

   str = ""

   FOR j = 0, nind - 2 DO str = str + items [ind [j]] + ", "

   str = str + items [ind [nind - 1]]

   str = str [0]

; Check if we are using a remote instance of this database.  If we are, then we will have
; copy the str variable to the remote IDL server.

   IF self.remote AND self.client THEN BEGIN

; Copy the variable str to the remote IDL server.

      IF NOT self.idl_server->RPCSetVariable (NAME = 'str', VAL = str) THEN BEGIN

         self.msg = 'Could not send variable str to remote IDL server.'

         tmp = self->error ()

         RETURN

      ENDIF

; Send the command the querry the values of the selected fields from the database.

      cmd = 'DBEXT, list, str, aa, bb, cc, dd, ee, ff, gg, hh, ii, jj'

      IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

         self.msg = 'Could not execute command on remote IDL server.'

         tmp = self->error ()

         RETURN

      ENDIF

   ENDIF ELSE BEGIN

; OK, we are doing this locally.

      DBEXT, list, str, aa, bb, cc, dd, ee, ff, gg, hh, ii, jj

   ENDELSE

; Now copy the contents of each of the placeholder variables into the record structure.  Note
; that if we are doing this remotely, then we have to get each placeholder variable from the
; remote IDL server.

   SWITCH nind OF

     10 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable jj from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'jj', VAL = jj) THEN BEGIN

              self.msg = 'Could not get variable jj from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 9) = jj

        END

      9 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable ii from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'ii', VAL = ii) THEN BEGIN

              self.msg = 'Could not get variable ii from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 8) = ii

        END

      8 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable hh from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'hh', VAL = hh) THEN BEGIN

              self.msg = 'Could not get variable hh from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 7) = hh

        END

      7 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable gg from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'gg', VAL = gg) THEN BEGIN

              self.msg = 'Could not get variable gg from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 6) = gg

        END

      6 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable ff from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'ff', VAL = ff) THEN BEGIN

              self.msg = 'Could not get variable ff from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 5) = ff

        END

      5 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable ee from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'ee', VAL = ee) THEN BEGIN

              self.msg = 'Could not get variable ee from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 4) = ee

        END

      4 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable dd from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'dd', VAL = dd) THEN BEGIN

              self.msg = 'Could not get variable dd from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 3) = dd

        END

      3 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable cc from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'cc', VAL = cc) THEN BEGIN

              self.msg = 'Could not get variable cc from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 2) = cc

        END

      2 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable bb from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'bb', VAL = bb) THEN BEGIN

              self.msg = 'Could not get variable bb from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0 + 1) = bb

        END

      1 : BEGIN

; Check if we are using a remote instance of this database.  If we are, then we will have
; retreive the variable aa from the remote IDL server.

        IF self.remote AND self.client THEN BEGIN

           IF NOT self.idl_server->RPCGetVariable (NAME = 'aa', VAL = aa) THEN BEGIN

              self.msg = 'Could not get variable aa from remote IDL server.'

              tmp = self->error ()

              RETURN

           ENDIF

        ENDIF

        rec.(i0) = aa

        END

   ENDSWITCH

ENDFOR

; Close the database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBCLOSE, '" + STRING (dbase) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBCLOSE, dbase

ENDELSE

RETURN

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::db_rec_exists, dbname, item, val, QUIET = quiet, INDEX = index

;               DB_REC_EXISTS
;
;               Verify that a database record or records exists.
;
;               This method is designed to check if records with certain values exist within a
;               database.  An array of database field names and values are passed to this
;               method.  The method then checks the database to see a if record with the
;               required values exists in the database.  This method returns a
;               value based on whether the requested record exists.
;
;               This method is useful if when it is not nescessary to locate a record, but
;               to determine if it exists.
;
; Syntax      : R = O->DB_REC_EXISTS (DATABASE, ITEM, VAL, [KEYWORD] )
;
; Examples    : print,  O->DB_REC_EXISTS ( 'experiment', "SEQNUM", "1" )
;
; Inputs      : DBNAME   = The name of the database.  The program looks for a
;                          file with the given name, and the extension .dbf in
;                          either the current directory, or the path given by
;                          the environment variable ZDBASE.
;
;               ITEM     = An array of character strings where each string
;                          specifies the name of a database field.database fields.
;
;               VAL      = An array of character strings where each string
;                          specifies a value.  In order for the search to succeed,
;                          the target database must have at least one record such
;                          fields specified in item have the values specified in
;                          val.  Note: only value per item is allowed.  Fields
;                          be equal to the requested value.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : QUIET   = If set, then warning or informational messages are not
;                         not displayed.
;
;               INDEX   = Will contain on exit the index of the first record found in the
;                         database that meets the search criterion.
;
; Returns     : 1 if the requested record exists, 0 if it does not.
;
; Restrictions: None.

; Check if we were passed the correct number of parameters.

IF N_PARAMS () LT 3 THEN BEGIN

   self.msg = 'USE: result = O->DB_REC_EXIST ( dbase, item, value )'

   tmp = self->error ()

   RETURN, 0

ENDIF

; Check that a string was passed as the name of the database to add the records to.

IF DATATYPE (dbname, 2) NE 7 THEN BEGIN

   self.msg = 'Method requires that the database name be of string type.'

   tmp = self->error ()

   RETURN, 0

ENDIF

; Check that the name of the item to use to index a database record is of string type.

IF DATATYPE (item, 2) NE 7 THEN BEGIN

   self.msg = 'Method requires that the name of a database item be specified as a string.'

   tmp = self->error ()

   RETURN, 0

ENDIF

; Create an array to hold the item descriptions from each database that we are
; validating the record against.

dbx = REPLICATE ({DB_ITEM_INFO}, 1)

; Get some information about the database that we are going to match to the record.
; We will have to call get_db_info once for each database that we are checking the
; record against.

FOR i = 0, N_ELEMENTS (dbname) - 1 DO BEGIN

; Call the get_db_info method to get data on each database.

   self->get_db_info, dbname [i], DB_ITEM = db_item

; Check if the call to get_db_info succeeded.  If it did not, then will just quit.

   IF N_TAGS (db_item) EQ 0 THEN BEGIN

   self.msg = 'Method requires that the database name be of string type.'

      self.msg = 'Could not accesses descriptor for database: ' + dbname [i]

      tmp = self->error ()

      RETURN, -1

   ENDIF

; Copy the item descriptions from the database into the dbx array.

   dbx = [dbx, db_item]

ENDFOR

; Remove the dummy item structure from the dbx array.

dbx = dbx [1:*]

; Remove non-unique database items

; Create a sorted list of indexes into the dbx array.

srt = SORT (dbx.name)

; Now filter out all the indexes that refer to duplicate array entries.

unq = UNIQ (dbx [srt].name)

; Now get rid of any duplicate entries in the dbx array.  Make sure that we just
; get rid of duplicate entries, not sort the dbx array as well.

dbx = dbx [(srt [unq]) [SORT (srt [unq])]]

; Convert the item name to uppercase, if it is lowercase.

item = STRUPCASE (item)

; Check if item name that was requested is actually an item in the specified database.

FOR i = 0, N_ELEMENTS (item) - 1 DO BEGIN

   IF (WHERE (dbx.name EQ item [i])) [0] EQ -1 THEN BEGIN

      dbname = STRUPCASE (dbname)

      self.msg = 'Item : ' + item [i] + ' not found in database(s) : ' + dbname [0]

      FOR j = 1, N_ELEMENTS (dbname) - 1  DO self.msg = self.msg + ', ' + dbname [j]

      tmp = self->error (/INFORMATIONAL, QUIET = quiet)

      RETURN, 0

   ENDIF

ENDFOR

; Open the database

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBOPEN, '" + STRING (dbname) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, 0

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBOPEN, dbname

ENDELSE

; Construct the search string from the parameters that were passed to the method.

srch = item [0] + " = " + STRTRIM (val [0], 1)

FOR i = 1, N_ELEMENTS (item) - 1  DO BEGIN

    srch = srch + ', ' + item [i] + " = " + STRTRIM (val [i], 1)

ENDFOR

; Try to locate any records that contain the requested database item set to the
; requested value.  We will call the procedure DBFIND to do this.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to get the list of entries from the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = 'msg = ""'

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, 0

   ENDIF

   cmd = "found = DBFIND ('" + srch + "', /SILENT, ERRMSG = msg)"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, 0

   ENDIF

; Get the result of the message variable.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'msg', VAL = msg) THEN BEGIN

      self.msg = 'Could not get variable msg from remote IDL server.'

      tmp = self->error ()

      RETURN, 0

   ENDIF

; Get the result of the found variable.

   IF NOT self.idl_server->RPCGetVariable (NAME = 'found', VAL = found) THEN BEGIN

      self.msg = 'Could not get variable msg from remote IDL server.'

      tmp = self->error ()

      RETURN, 0

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

; Set msg to an empty string

   msg = ""

; Query a local copy of the database.

   found = DBFIND (srch, /SILENT, ERRMSG = msg)

ENDELSE

; Close the database.

; Check if we are using a remote instance of this database.  If we are, then we will have
; generate a command to this on the remote session.

IF self.remote AND self.client THEN BEGIN

   cmd = "DBCLOSE, '" + STRING (dbname) + "'"

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

      RETURN, 0

   ENDIF

ENDIF ELSE BEGIN

; Otherwise we can do this locally.

   DBCLOSE, dbname

ENDELSE

; Check if we found anything

IF found [0] LE 0 THEN BEGIN

; Ooops, could not find the requested record.  If we got error message from DBFIND, then
; use that as our error message, otherwise we will create our own.

   IF msg NE "" THEN BEGIN

      self.msg = msg

   ENDIF ELSE BEGIN

      dbname = STRUPCASE (dbname)

      self.msg = "No records found meeting search criterion in database(s) : " + dbname [0]

      FOR j = 1, N_ELEMENTS (dbname) - 1  DO self.msg = self.msg + ', ' + dbname [j]

   ENDELSE

; Flag the error.

   tmp = self->error (/INFORMATIONAL, QUIET = quiet)

; Return 0 to indicate the error

   RETURN, 0

ENDIF

; Ah, found what we were looking for, return 1 to indicate success.

index = found [0]

RETURN, 1

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::send_remote_cmd, cmd

;               SEND_REMOTE_CMD
;
;               Send a command to a remote IDL session...
;
; Inputs      : cmd       The command to send to the remote IDL system
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : None.
;
;
; Return Value: Returns 1 if the command was successfully executed on the
;               remote system, otherwise returns 0 (including if it is not
;               connected to a remote system.
;
; Restrictions: None.

; Initialize result to 0.  If we succeed in sending the command, we will change it.

result = 0

; Check if we are using a remote instance of this database.  If we are, then we can send
; the command to the remote system.

IF self.remote AND self.client THEN BEGIN

   IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

      self.msg = 'Could not execute command on remote IDL server.'

      tmp = self->error ()

   ENDIF ELSE BEGIN

      WHILE (1) DO BEGIN

; Use the RPCOuputGetStr() method to pick up one line output from the remote serever's buffer.

         IF NOT self.idl_server->RPCOutputGetStr (LINE = line, FLAGS = flags) THEN RETURN, 0

; OK, check the value returned with the FLAGS keyword.  If this is -1, then the buffer is now
; empty and we can exit this loop.

         IF flags EQ -1 THEN BREAK

; Otherwise, we have a line from the buffer, so lets display it.

         self.msg = self.host + '> ' + line

         tmp = self->error (/INFORMATIONAL, QUIET = quiet)

      ENDWHILE

      result = 1

   ENDELSE

ENDIF

RETURN, result

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::init, UVALUE      = uvalue,          $
                         REMOTE      = remote,          $
                         CLIENT      = client,          $
                         SERVER      = server,          $
                         HOST        = host,            $
                         _EXTRA      = extra,           $
                         PM_HOSTNAME = pm_hostname,     $
                         PM_ADDRESS  = pm_address

;               INIT
;
;               Perform object initialization.
;
; Inputs      : None.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : UVALUE  = If pased then the value this keyword is set to will be
;                         the user value of the object.  A new user value may be
;                         set by calling the method set_uval.
;
;               REMOTE  = If set, the object initializes itself in a client sever
;                         configuration capable of accessing a remote database.  Otherwise, it will
;                         be set up for local database acess only (faster).
;
;               CLIENT  = Allowed only if the REMOTE keyword is passed and set to
;                         to TRUE.  Indicates that the object will be acting as the client for a
;                         remote database instance.  In this case, the object will create a IDL RPC
;                         client object to comunicate with a remote session.  In addition, it will
;                         create a server instance of the object within the remote session in order
;                         to access the remote database.
;
;               SERVER  = Allowed only if the REMOTE keyword is passed and set to
;                         to TRUE.  Indicates that the object will be acting as the server for a
;                         remote client.  In this case the server translate the string and array
;                         based input from the client into structures which can be used to access
;                         the database.  This is the default option if the REMOTE keyword is passed.
;
;               HOST    = Allowed only if both the REMOTE keyword and the CLIENT
;                         keyword are passed and set to TRUE.  This is the address of the remote
;                         system to act as the  database server.
;
; Return Value: 1 (object initialization success).
;
; Restrictions: None.

; Set the uval, if specified

IF N_ELEMENTS (uvalue) NE 0 THEN BEGIN

  self.uval = PTR_NEW (uvalue)

ENDIF

; Initialize a structure list to hold the paths to previously located databases

self.path_list = OBJ_NEW ('XLIST')

self.info_list = OBJ_NEW ('OBJ_LIST')

; Make sure the !PRIV system variable is defined.  We have to do this or else
; the DBOPEN call may fail.

DEFSYSV, '!PRIV', EXIST = e

IF NOT e THEN DEFSYSV, '!PRIV', 0

; Initialize the remonte instance variables to their default value.

self.remote = 0
self.client = 0
self.server = 0
self.host   = 0

self.idl_server = OBJ_NEW ()

; Find the local delimeter.

self.local_delim = get_delim ()

; Check if the object is being started in REMOTE mode or as a local instance.

IF KEYWORD_SET (remote) THEN BEGIN

; Set the remote flag.

   self.remote = 1

; Check if the client flag is checked.  If it is, then check if a remote host has been given.
; Note: we can't be a client withoug also setting up a remote host.

   IF KEYWORD_SET (client) THEN BEGIN

; set the client flag

      self.client = 1

; Check if a value was passed through the keyword host.  Since no (resonable) default host
; can be set, we must have a value for this parameter.

      IF KEYWORD_SET (host) THEN BEGIN

; Try to create the an IDL_RPC_CLIENT object to connect to the server.

         self.idl_server = OBJ_NEW ('IDL_RPC_CLIENT')

; Check if we were able to create the IDL_RPC_CLIENT object.  If the object creation failed, then
; flag the error and quit.

         IF NOT OBJ_VALID (self.idl_server) THEN BEGIN

            self.msg = 'Attempt to create IDL_RPC_CLIENT object failed.'

            tmp = self->error ()

            RETURN, 0

         ENDIF

; Set the hostname of the remote IDL server.  If this method fails, then flag the error and quit.

         IF NOT self.idl_server->RPCInit (HOSTNAME = host,           $
                                          PM_ADDRESS = pm_address,   $
                                          PM_HOSTNAME = pm_hostname) THEN BEGIN

            self.msg = 'Attempt to connect to host: ' + host + ' failed.'

            tmp = self->error ()

            RETURN, 0

         ENDIF

; Set the remote client to capture 10 lines of output.  Again if this method fails, then flag the error
; and quit.

         IF NOT self.idl_server->RPCOutputCapture (10) THEN BEGIN

            self.msg = 'Attempt to set ouput capture on server failed.'

            tmp = self->error ()

            RETURN, 0

         ENDIF

; Set self.host to the name of the remote database host.

         self.host = host
; Setup a command to find out what file path delimeter to use on the remote system.

         cmd = "rdelim = get_delim ()"

; Execute the command string to find out what the remote delimeter is.

         IF NOT self.idl_server->RPCExecuteStr (cmd) THEN BEGIN

            self.msg = 'Could not execute command on remote IDL server.'

            tmp = self->error ()

            RETURN, 0

         ENDIF

; Get the contents of the rdelim variable.

         IF NOT self.idl_server->RPCGetVariable (NAME = 'rdelim', VAL = rdelim) THEN BEGIN

            self.msg = 'Could not get variable rdelim from remote IDL server.'

            tmp = self->error ()

            RETURN, 0

         ENDIF

; Set the remote delimeter

         self.remote_delim = rdelim

      ENDIF ELSE BEGIN

; Ooops, no host.  Flag an error and get out.

         self.msg = 'Attempt to initialize object in client mode without specifing a remote host.'

         tmp = self->error ()

         RETURN, 0

      ENDELSE

; Ok, not a client.  Check if the server keyword was set and passed.

   ENDIF ELSE IF KEYWORD_SET (server) THEN BEGIN

; Set the server flag.

      self.server = 1

   ENDIF ELSE BEGIN

; Niether server or client.  Flag an error and get out.

      self.msg = 'Attempt to initialize object as a remote instance without setting client or server flag.'

      tmp = self->error ()

      RETURN, 0

   ENDELSE

ENDIF ELSE BEGIN

; Otherwise a local database is being accessed.  In this case we can use the db_connect
; object.

   self.db_tools_connect = OBJ_NEW ('DB_TOOLS_CONNECT_LOCAL')

ENDELSE

; All done.

RETURN, 1

END

; ------------------------------------------------------------------------------------------------

FUNCTION db_tools::get_db_host, REMOTE = remote

;               GET_DB_HOST
;
;               Return the host system that is acting as the database server..
;
; Inputs      : None.
;
; Opt. Inputs : None.
;
; Outputs     : None.
;
; Opt. Outputs: None.
;
; Keywords    : REMOTE  = If pased then the value will be set to one if the
;                         database is being hosted by a remote system.  Otherwise
;                         the value will be 0.
;
;
; Return Value: The name host system that is acting as the database server.  If the
;               the database exists localy, then the value 'LOCAL" will be returned.
;
; Restrictions: None.

; Set the keyword remote to the value of the object data item remote

remote = self.remote

; Return the database host name.

IF self.remote THEN BEGIN

   RETURN, self.host

ENDIF ELSE BEGIN

   RETURN, 'LOCAL'

ENDELSE

END

; ------------------------------------------------------------------------------------------------

PRO db_tools__define

obj = { DB_TOOLS,                       $ ; The object class name.
        uval:            PTR_NEW (),    $ ; User value.
        msg:             "",            $ ; Error or information message.
        path_list :      OBJ_NEW (),    $ ; structure list to hold database paths
        info_list :      OBJ_NEW (),    $ ; object list hold cached results of get_db_info method.
        remote:          0,             $ ; Flag: True when a non-local database is being accessed.
        client:          0,             $ ; Object is the client instance of a database.
        server:          0,             $ ; Object is the server instance of a database.
        local_delim:     '',            $ ; Local system path delimeter.
        remote_delim:    '',            $ ; Delimeter of remote system (only if client instance)
        idl_server:      OBJ_NEW  (),   $ ; IDL RPC client object.
        db_tools_connect:OBJ_NEW  (),   $ ; Connection object for connecting to a database.
        host:           ""              $ ; Name of remote IDL host
      }

END