;+ ; NAME: ; CMSV_WREC ; ; AUTHOR: ; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770 ; craigm@lheamail.gsfc.nasa.gov ; ; PURPOSE: ; Write SAVE-formatted record header to output block or file ; ; CALLING SEQUENCE: ; CMSV_WDATA, BLOCK, POINTER, DATA, IDENT, UNIT=UNIT, $ ; INITIALIZE=INITIALIZE, NO_DATA=NO_DATA, $ ; NO_TYPE=NO_TYPE, COMPATIBILITY=COMPAT, $ ; BLOCK_TYPE=BLOCK_TYPE, BLOCK_NAME=BLOCK_NAME, ; NEXT_BLOCK=NEXT_BLOCK, $ ; [ ... EXTRA KEYWORDS ... ] ; OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG ; ; DESCRIPTION: ; ; This procedure writes most types of IDL SAVE record, including the ; header and contents. The header consists of four bytes at the ; beginning of each record which indentifies the type and size of ; the record. This procedure also writes the contents of certain ; records, as noted below. ; ; Users can specify the block type by passing the BLOCK_TYPE or ; BLOCK_NAME keywords. The values listed in the following table are ; supported. CMSV_WREC writes the contents of essentially all ; record types as well. Some records do not contain any contents at ; all (those entries marked with an [empty]) and thus require no ; further processing. ; ; BLOCK_TYPE BLOCK_TYPE WRITE RECORD CONTENTS WITH... ; ; 0 = 'START_MARKER' [empty] ; 1 = 'COMMON_BLOCK' [this procedure] ; 2 = 'VARIABLE' [this procedure] ; 3 = 'SYSTEM_VARIABLE' [this procedure] ; 6 = 'END_MARKER' [empty] ; 10 = 'TIMESTAMP' [this procedure] ; 12 = 'COMPILED' no published procedure ; 13 = 'IDENTIFICATION' [this procedure] ; 14 = 'VERSION' [this procedure] ; 15 = 'HEAP_INDEX' [this procedure] ; 16 = 'HEAP_DATA' [this procedure] ; 17 = 'PROMOTE64' [empty] ; 19 = 'NOTICE' [this procedure] ; ; For records that contain variable data, the external procedures ; CMSV_WVTYPE and/or CMSV_WDATA may be used, however it is not ; recommended, since the record header must finally be re-written by ; the user. Users can write the entire record with this procedure. ; ; After issuing a POINT_LUN, or after writing the BLOCK to disk, the ; block cache in BLOCK must be reset using the /INITIALIZE keyword. ; ; ================================================================== ; Research Systems, Inc. has issued a separate license intended ; to resolve any potential conflict between this software and the ; IDL End User License Agreement. The text of that license ; can be found in the file LICENSE.RSI, included with this ; software library. ; ================================================================== ; ; SPECIFIC RECORD TYPES ; ; CMSV_WREC reads certain specific record types automatically based ; on data passed in the DATA parameter. ; ; Records of type 'VARIABLE' (2), 'SYSTEM_VARIABLE' (3) and ; 'HEAP_DATA' (16) require both the DATA and IDENT parameters. For ; the first two record types, the IDENT parameter is the name of the ; variable, as a scalar string. Variable names should be valid IDL ; variable names, uppercase, and have no embedded spaces. For the ; 'HEAP_DATA' record type, the IDENT parameter is the heap index ; value, as described below. The DATA itself can be any supported ; IDL variable type (as described in CMSV_WVTYPE). ; ; For records that accept data in the form of a structure, as listed ; below, the listed structure tag entries are optional. If the user ; does not provide a value, then a suitable default will be computed ; by this procedure (listed in parentheses). ; ; A record of type 'VERSION' (14) has the following structure: ; ; { FORMAT_VERSION: 0L, $ ; Format version number of file (5) ; ARCH: '', $ ; !VERSION.ARCH of creating host ; OS: '', $ ; !VERSION.OS of creating host ; RELEASE: '' } ; !VERSION.RELEASE of creating host ; ; A record of type 'TIMESTAMP' (10) has the following structure: ; ; { SAVE_DATE: '', $ ; Date the save file was created (SYSTIME(0)) ; SAVE_USER: '', $ ; User name who created file ('UNKNOWN') ; SAVE_HOST: '' } ; Host name that created file ('UNKNOWN') ; ; Save files created by IDL version 4 do not contain a timestamp ; record. Under Unix this procedure will attempt to discover the ; user and host names automatically. ; ; A record of type 'IDENTIFICATION' (13) has the following ; structure: ; ; { AUTHOR: '', $ ; Author of SAVE file ('') ; TITLE: '', $ ; Title of SAVE file ('') ; IDCODE: '' } ; Identifying code for SAVE file ('') ; ; It appears that this record is not used in IDL version 5 or later. ; ; A record of type 'COMMON_BLOCK' (1) defines a named common block ; and its variables. A common block descriptor consists of an array ; of strings whose first element is the common block name, and whose ; remaining elements are the common block variable names. Thus, a ; common block descriptor must have at least two elements. No ; variable data are stored with the common block definition. ; ; When a record of type 'NOTICE' (19) defines a notice to be ; included in the save file. It is a structure with one field: ; {TEXT: ''}, where TEXT is the text content of the notice. ; ; A record of type 'HEAP_INDEX' (15) defines the heap index in a ; SAVE file. The heap index specifies a list of which heap ; variables are stored in the current save file. These indices are ; simply numbers which identify each heap variable (i.e., ; "" would have an index of 2). The heap index can use ; any numbers to identify the heap data; however it is required that ; all index entries have corresponding heap data values. ; ; WRITING HEAP DATA ; ; If your data contains heap data and/or pointers, then users must ; take special care in writing their data. Writing heap data is ; actually more straightforward than reading it. There are several ; steps involved which can be summarized as followed: (1) take ; inventory of HEAP data; (2) write HEAP_INDEX record; (3) write one ; HEAP_DATA record for each heap variable; and (4) write any other ; variables using the heap index. ; ; (1) Take inventory of heap data. Before writing any data to the ; SAVE file, use the CMSV_PTRSUM procedure to discover all ; pointer variables in the data set, like so: ; ; cmsv_ptrsum, var, ptrlist ; ; PTRLIST contains an array of any heap variables pointed to by ; VAR (including structures or pointed-to variables). If ; multiple variables are to be written, then the inventory must ; contain the union of all heap variables. ; ; (2) Write a HEAP_INDEX record. The heap index is an array of long ; integers which identify the heap variables. In principle it ; doesn't matter which integers are used, however there must be ; a one-to-one correspondence between the entries in the heap ; index and the heap identifiers used in the next step. In this ; example a simple LINDGEN is used: ; ; index = lindgen(n_elements(ptrlist)) ; cmsv_wrec, block, pointer, index, block_name='HEAP_INDEX', $ ; offset=offset ; ; (3) Write one HEAP_DATA record for each heap variable. Issue one ; CMSV_WREC call for each entry in PTRLIST, as follows for the ; ith heap variable: ; ; cmsv_wrec, block, pointer, ptrlist(i), block_name='HEAP_DATA', $ ; ptr_index=index, ptr_data=ptrlist, offset=offset ; ; Note that the PTR_INDEX and PTR_DATA keywords are required ; because heap data may itself contain pointers. The PTR_INDEX ; and PTR_DATA keywords enable the CMSV_WREC procedure to write ; appropriate descriptors when it encounters pointers. ; ; (4) Write remaining data. For the ith variable, use: ; ; cmsv_wrec, block, pointer, var(i), name(i), block_name='VARIABLE',$ ; ptr_index=index, ptr_data=ptrlist, offset=offset ; ; As above, using the PTR_INDEX and PTR_DATA keywords will allow ; the CMSV_WREC procedure to write the appropriate data. ; ; ; BLOCK, POINTER, OFFSET ; ; This procedure writes data to a byte array or a file. If the UNIT ; keyword is specified then file is sent to the specified unit ; number rather than to the buffer BLOCK. However, the intent is ; for users to accumulate a significant amount of data in a BLOCK ; and then write it out with a single call to WRITEU. Users should ; be aware that the block can be larger than the buffered data, so ; they should use something like the following: ; ; WRITEU, UNIT, BLOCK(0:POINTER-1) ; ; When library routines do indeed write buffered BLOCK data to disk, ; they will appropriately reset the BLOCK and POINTER. Namely, ; BLOCK will be reset to empty, and POINTER will be reset to zero. ; OFFSET will be advanced the according number of bytes. ; ; The terminology is as follows: BLOCK is a byte array which ; represents a portion of, or an entire, IDL SAVE file. The block ; may be a cached portion of an on-disk file, or an entire in-memory ; SAVE file. POINTER is the current file pointer within BLOCK ; (i.e., the next byte to be read is BLOCK[POINTER]). Hence, a ; POINTER value of 0 refers to the start of the block. OFFSET is ; the file offset of the 0th byte of BLOCK; thus "POINT_LUN, ; OFFSET+POINTER" should point to the same byte as BLOCK[POINTER]. ; The following diagram shows the meanings for BLOCK, POINTER and ; OFFSET schematically: ; ; ; 0 <- OFFSET -> | ; FILE |----------------|------*--------|---------> ; ; BLOCK |------*--------| ; 0 ^ POINTER ; ; ; This procedure is part of the CMSVLIB SAVE library for IDL by ; Craig Markwardt. You must have the full CMSVLIB core package ; installed in order for this procedure to function properly. ; ; ; INPUTS: ; ; BLOCK - a byte array, a cache of the SAVE file. Users will ; usually not access this array directly. Users are advised ; to clear BLOCK after calling POINT_LUN or writing the ; block to disk. ; ; POINTER - a long integer, a pointer to the next byte to be read ; from BLOCK. CMSVLIB routines will automatically ; advance the pointer. ; ; DATA - the record contents to be written, as describe above. ; ; IDENT - for record types 'VARIABLE' (2) and 'SYSTEM_VARIABLE' (3), ; the name of the variable as a scalar string. For record ; type 'HEAP_DATA' (16), the heap index identifier as a ; scalar long integer. ; ; KEYWORDS: ; ; BLOCK_NAME - a scalar string specifying the record type, as ; described above. The BLOCK_TYPE keyword takes ; precedence over BLOCK_NAME. ; ; BLOCK_TYPE - a scalar integer specifying the record type, as ; described above. ; ; NEXT_BLOCK - if specified, the file offset of the next record ; location. ; Default: the offset will be computed automatically. ; ; INITIALIZE - if the keyword is set, then the BLOCK is emptied and ; the POINTER is reset before any new data is written. ; ; NO_TYPE - if set, no type descriptor or data are written for ; variable records. ; ; NO_DATA - if set, no data are written for variable records. ; ; ; TEMPORARY - if set, then the input DATA are discarded after being ; written, as a memory economy provision. ; ; PTR_INDEX - a heap index array for the data being written, if any ; heap data records have been written. ; Default: no pointers are written ; ; PTR_DATA - an array of pointers, pointing to the heap values being ; written. ; Default: no pointers are written ; ; UNIT - a file unit. If specified then data are directed to the ; file unit rather than to the buffer BLOCK. ; ; OFFSET - the file offset of byte zero of BLOCK. ; Upon output, if the file pointer is advanced, OFFSET will ; also be changed. ; (OFFSET is not currently used by this routine) ; Default: 0 ; ; COMPATIBILITY - a string, which describes the format to be used in ; the output file. Possible values are: ; ; 'IDL4' - format of IDL version 4; ; 'IDL5' - format of IDL versions 5.0-5.3; ; 'IDL6' - not supported yet, for versions 5.4-above; ; 'RIVAL1' - same as 'IDL5', plus a directory entry is ; written to the file. ; Note that files written in IDL5 format may still be ; readable by IDL v.4. ; Default: 'IDL5' ; ; STATUS - upon return, this keyword will contain 1 for success and ; 0 for failure. ; ; ERRMSG - upon return with a failure, this keyword will contain the ; error condition as a string. ; ; EXAMPLE: ; ; ; SEE ALSO: ; ; CMRESTORE, SAVE, RESTORE, CMSVLIB ; ; MODIFICATION HISTORY: ; Written, 2000 ; Documented, 24 Jan 2001 ; Added notification about RSI License, 13 May 2002, CM ; Added NOTICE record type, 09 Jun 2003, CM ; NOTE: remember to modify CMSVLIB.PRO when changing library! ; ; $Id: cmsv_wrec.pro,v 1.10 2009/11/22 22:50:49 craigm Exp $ ; ;- ; Copyright (C) 2000-2001, 2003, Craig Markwardt ; This software is provided as is without any warranty whatsoever. ; Permission to use, copy, modify, and distribute modified or ; unmodified copies is granted, provided this copyright and disclaimer ; are included unchanged. ;- pro cmsv_wcomm, block, pointer, names, $ status=status, errmsg=errmsg status = 0 sz = size(names) if sz(sz(0)+1) NE 7 then begin errmsg = 'ERROR: CMSV_WCOMM: DATA must contain an array of strings' return endif ncommon = n_elements(names) if ncommon LT 2 then begin errmsg = 'ERROR: CMSV_WCOMM: DATA must contain at least two elements' return endif cmsv_wraw, /long, block, pointer, ncommon, $ status=status, errmsg=errmsg if status EQ 0 then return cmsv_wraw, /string, block, pointer, names, $ status=status, errmsg=errmsg return end pro cmsv_wheap, block, pointer, indices, $ status=status, errmsg=errmsg ;; HEAP_INDEX ;; LONG - N_HEAP - number of heap values ;; LONGxN_HEAP - heap indices n_heap = n_elements(indices) if n_heap LE 0 then return cmsv_wraw, /long, block, pointer, [n_heap, indices], $ status=status, errmsg=errmsg return end pro cmsv_wstamp, block, pointer, offset=offset, $ status=status, errmsg=errmsg, $ save_date=save_date, save_user=save_user, $ save_host=save_host, _extra=extra common cmsv_wstamp_state, username, hostname status = 1 ;; Retrieve the username -- we need some Windows help here! if n_elements(save_user) EQ 0 then begin if n_elements(username) NE 1 then begin xusername = (getenv('USER'))(0) if xusername EQ '' then begin xusername = (getenv('LOGNAME'))(0) if xusername EQ '' then begin if !version.os_family EQ 'unix' then $ spawn, 'whoami', xusername if xusername(0) EQ '' then $ xusername = 'UNKNOWN' endif endif username = xusername(0) endif save_user = username endif ;; Retrieve the hostname -- we need some Windows help here! if n_elements(save_host) EQ 0 then begin if n_elements(hostname) NE 1 then begin xhostname = (getenv('HOST'))(0) if xhostname EQ '' then begin if !version.os_family EQ 'unix' then $ spawn, 'hostname', xhostname if xhostname(0) EQ '' then $ xhostname = 'UNKNOWN' endif hostname = xhostname(0) endif save_host = hostname endif if n_elements(save_date) EQ 0 then save_date = systime(0) ;; TIMESTAMP ;; BYTEx400 - empty (?) legacy area ;; STRING - save date (as a string) ;; STRING - user name ;; STRING - hostname pointer = pointer + '400'xl ;; Advance over 400 byte blank space cmsv_wraw, /string, block, pointer, $ strtrim([save_date(0), save_user(0), save_host(0)],2), $ status=status, errmsg=errmsg end pro cmsv_wversion, block, pointer, status=status, errmsg=errmsg, $ format_version=major_release, arch=arch, os=os, $ release=release, compatible=compat0, _extra=extra if n_elements(major_release) EQ 0 then major_release = 5L if n_elements(arch) EQ 0 then arch = !version.arch if n_elements(os) EQ 0 then os = !version.os if n_elements(release) EQ 0 then release = !version.release if n_elements(compat0) GT 0 then begin compat = strupcase(strtrim(compat0(0),2)) case compat of 'IDL4': major_release = 4L 'IDL5': major_release = 5L 'IDL6': major_release = 6L 'RIVAL1': major_release = 5L ELSE: begin errmsg = 'ERROR: CMSV_WREC: unrecognized COMPAT value' status = 0 return end endcase endif ;; VERSION_STAMP ;; LONG - Major version number ;; STRING_DATA - Host architecture ( = !version.arch ) ;; STRING_DATA - Host OS ( = !version.os ) ;; STRING_DATA - IDL release ( = !version.release ) cmsv_wraw, /long, block, pointer, floor(major_release(0)), $ status=status, errmsg=errmsg if status EQ 0 then return cmsv_wraw, /string, block, pointer, $ strtrim([arch(0), os(0), release(0)],2), $ status=status, errmsg=errmsg return end pro cmsv_wident, block, pointer, status=status, errmsg=errmsg, $ author=author, title=title, idcode=idcode, $ _EXTRA=extra if n_elements(author) EQ 0 then author = '' if n_elements(title) EQ 0 then title = '' if n_elements(idcode) EQ 0 then idcode = '' cmsv_wraw, /string, block, pointer, $ strtrim([author(0), title(0), idcode(0)],2), $ status=status, errmsg=errmsg return end ; --------------------------- Read Notice -------------------- pro cmsv_wnotice, block, pointer, status=status, errmsg=errmsg, $ text=text, _EXTRA=extra ;; NOTICE ;; STRING - notice text if n_elements(text) EQ 0 then text = '' cmsv_wraw, /string, block, pointer, strtrim(text,2), $ status=status, errmsg=errmsg return end pro cmsv_wrec, block, pointer, data, name, unit=unit, offset=offset0, $ initialize=init, finish=finish, no_data=nodata, no_type=notype,$ block_type=blocktype, block_name=blockname, next_block=np, $ compatibility=compat, $ status=status, errmsg=errmsg, _EXTRA=extra common cmsave_block_names, block_ntypenames, block_typenames if n_elements(block_ntypenames) EQ 0 then begin cmsv_rrec, /qblocknames endif if keyword_set(init) then begin pointer = 0L block = 0 & dummy = temporary(block) endif if n_elements(pointer) EQ 0 then pointer = 0L if n_elements(blocktype) EQ 0 then begin wh = where(strupcase(blockname(0)) EQ block_typenames, ct) if ct EQ 0 then begin errmsg = 'ERROR: CMSV_WREC: block type '+blockname(0)+' is unknown' status = 0 return endif blocktype = wh(0) endif ;; Store position of file pointer at beginning of record p0 = pointer rechead = lonarr(4) rechead(0) = long(floor(blocktype(0))) if n_elements(offset0) EQ 0 then offset = 0L $ else offset = floor(offset0(0)) ;; Default pointer to next block assumes no data in record if n_elements(np) GT 0 then rechead(1) = floor(np(0)) $ else rechead(1) = offset + p0 + 4*4 cmsv_wraw, /long, block, pointer, rechead, $ status=status, errmsg=errmsg if status EQ 0 OR keyword_set(finish) then return p1 = pointer blockname = block_typenames(blocktype(0) < block_ntypenames) vdata = (blockname EQ 'VARIABLE' OR blockname EQ 'SYSTEM_VARIABLE' OR $ blockname EQ 'HEAP_DATA') if vdata AND keyword_set(notype) then return case blockname of 'COMMON_BLOCK': cmsv_wcomm, block, pointer, data, $ status=status, errmsg 'TIMESTAMP': cmsv_wstamp, block, pointer, $ status=status, errmsg=errmsg, _EXTRA=data 'VERSION': cmsv_wversion, block, pointer, compatible=compat, $ status=status, errmsg=errmsg, _EXTRA=data 'IDENTIFICATION': cmsv_wident, block, pointer, $ status=status, errmsg=errmsg, _EXTRA=data 'HEAP_INDEX': cmsv_wheap, block, pointer, data, $ status=status, errmsg=errmsg 'VARIABLE': cmsv_wvtype, block, pointer, data, name, $ status=status, errmsg=errmsg 'SYSTEM_VARIABLE': cmsv_wvtype, block, pointer, data, name, $ status=status, errmsg=errmsg, /system 'HEAP_DATA': cmsv_wvtype, block, pointer, data, name, $ status=status, errmsg=errmsg, /heap ELSE: dummy = 1 endcase if status EQ 0 then return ;; If UNIT is specified then we write out the accumulated BLOCK data ;; up to this point. CMSV_WDATA will write out its own data. if n_elements(unit) GT 0 AND pointer GT 0 then begin offset1 = offset unit1 = floor(unit(0)) writeu, unit1, block(0:pointer-1) ;; Reinitialize state if n_elements(block) GT 65536L then begin ;; Clear the block if it is too large block = 0 & dummy = temporary(block) if n_elements(block) GT 0 then block(*) = 0 endif offset = offset + pointer pointer = 0L endif ;; Write the variable data if it exists if vdata AND NOT keyword_set(nodata) AND n_elements(data) GT 0 then begin cmsv_wdata, block, pointer, data, unit=unit, $ status=status, errmsg=errmsg, _EXTRA=extra if status EQ 0 then return if n_elements(unit1) GT 0 then $ point_lun, -unit1, offset endif ;; Rewrite the record header using the new header. if pointer NE p1 AND n_elements(np) EQ 0 then begin rechead(1) = offset + pointer if n_elements(unit1) GT 0 then begin ;; Be careful: we have already written the record header to ;; disk, so we need to seek backwards, write the new header, ;; and then seek forwards again. point_lun, -unit1, offset2 cmsv_wraw, /long, block1, 0L, rechead, $ status=status, errmsg=errmsg if status EQ 0 then return point_lun, unit1, offset1+p0 writeu, unit1, block1(0:15) point_lun, unit1, offset2 endif else begin ;; It's easy if the data has not been written yet cmsv_wraw, /long, block, (p0+0), rechead, $ status=status, errmsg=errmsg if status EQ 0 then return endelse endif status = 1 return end