; ------------------------------------------------------------------------------------------------ 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 .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 .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