cmsvwrite.pro
8 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
;+
; NAME:
; CMSVWRITE
;
; AUTHOR:
; Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
; craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
; Write a single variable to an open SAVE file
;
; CALLING SEQUENCE:
;
; CMSVWRITE, UNIT, DATA [ , NAME=NAME, COMPATIBILITY=COMPAT ]
;
; DESCRIPTION:
;
; CMSVWRITE writes a single IDL variable to an open IDL SAVE file.
; The file should already have been opened for writing as a normal
; file using OPENW or OPENU.
;
; CMSVWRITE is a simplified version of the CMSVLIB package, and as
; such is not capable of writing heap data (pointers) or object
; data, or structures that contain them. Strings, structures, and
; all array types are supported.
;
; 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.
;
; ==================================================================
; 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.
; ==================================================================
;
; INPUTS:
;
; UNIT - the open file unit.
;
; DATA - the data to be written.
;
; KEYWORDS:
;
; NAME - the optional name of the variable to be written (must be a
; valid variable name).
; Default: CMSVWRITE automatically creates a valid name.
;
; 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'
; Note that files written in IDL5 format may still be
; readable by IDL v.4.
; Default: 'IDL5'
;
; NO_END - a save file must terminate with an "end" record. By
; default, CMSVWRITE will append such a record after the
; variable is written, and then rewind the file pointer.
; The end record must be written after the last variable,
; but is optional otherwise. Set this keyword to disable
; writing the end record (for performance reasons).
;
; QUIET - if set, error messages are not printed.
; Default: an error causes errors to be printed with MESSAGE
;
; 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:
;
; Write variables A, B, C and D to a file.
;
; openw, 50, 'test.sav' ;; Add /STREAM under VMS !
; cmsvwrite, 50, a, name='a'
; cmsvwrite, 50, b, name='b'
; cmsvwrite, 50, c, name='c'
; close, 50
;
; SEE ALSO:
;
; CMSVREAD, CMRESTORE, CMSAVE, SAVE, CMSVLIB
;
; MODIFICATION HISTORY:
; Written and documented, 11 Jan 2001, CM
; Make version checks with correct precision, 19 Jul 2001, CM
; Added notification about RSI License, 13 May 2002, CM
; NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsvwrite.pro,v 1.12 2009/11/22 22:50:49 craigm Exp $
;
;-
; Copyright (C) 2001, 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 cmsvwrite, unit0, data, name=name0, compat=compat0, no_end=noend, $
quiet=quiet, status=status, errmsg=errmsg
status = 0
catch, catcherr
if catcherr EQ 0 then lib = cmsvlib(/query) else lib = 0
catch, /cancel
if lib EQ 0 then begin
errmsg = 'ERROR: The CMSVLIB library must be in your IDL path.'
if keyword_set(quiet) then return else message, errmsg
endif
if n_elements(compat0) EQ 0 then compat = 'IDL5' $
else compat = strtrim(compat0,2)
if compat NE 'IDL4' AND compat NE 'IDL5' AND compat NE 'IDL6' AND $
compat NE 'RIVAL1' then begin
errmsg = 'ERROR: unrecognized COMPAT value'
endif
;; Do type checking on the data
if n_elements(data) EQ 0 then begin
errmsg = 'ERROR: DATA must be defined'
if keyword_set(quiet) then return else message, errmsg
endif
if double(!version.release) GT 4D then begin
has_objects = 0
cmsv_ptrsum, null, /null
cmsv_ptrsum, data, pheap, has_objects=has_objects
if n_elements(pheap) GT 1 then goto, PTR_ERROR
if pheap(0) NE null OR has_objects then begin
PTR_ERROR:
errmsg = 'ERROR: CMSVWRITE cannot save pointers or objects'
if keyword_set(quiet) then return else message, errmsg
endif
endif
if n_elements(unit0) EQ 0 then begin
errmsg = 'ERROR: UNIT is not defined'
if keyword_set(quiet) then return else message, errmsg
endif
unit = floor(unit0(0))
stat = fstat(unit)
if stat.write EQ 0 OR stat.open EQ 0 then begin
errmsg = 'ERROR: UNIT is not open for writing'
if keyword_set(quiet) then return else message, errmsg
endif
;; We are at the beginning of the file, make sure this is a proper
;; IDL save file.
if stat.cur_ptr EQ 0 then begin
;; Open the file
cmsv_open, unit, 'FILENAME', off0, access='W', /reopen, $
status=status, errmsg=errmsg
if status EQ 0 then begin
if keyword_set(quiet) then return else message, errmsg
endif
;; Write the opening records which establish the version number
;; and time stamp.
pp = 0L
cmsv_wrec, block, pp, block_name='TIMESTAMP', offset=off0, $
status=status, errmsg=errmsg
if (status NE 0) AND (compat NE 'IDL4') then $
cmsv_wrec, block, pp, block_name='VERSION', offset=off0, $
compat=compat, status=status, errmsg=errmsg
if status EQ 0 then begin
if keyword_set(quiet) then return else message, errmsg
endif
;; Write the block
writeu, unit, block(0:pp-1)
endif
point_lun, -unit, off0
;; Construct a name for this variable, if one wasn't provided
if n_elements(name0) EQ 0 then begin
DEFAULT_NAME:
name = string(off0, format='("CMSV_",Z8.8)')
endif else begin
name = strupcase(strtrim(name0(0),2))
if name EQ '' then goto, DEFAULT_NAME
endelse
pp = 0L
block = 0 & dummy = temporary(block)
;; Make a block and write out the variable type and data. The
;; following procedure is required. First, we create a new block,
;; which establishes the header and record type (VARIABLE). Second
;; we write out the variable type. Finally we write the actual
;; data, and call the "finblock" procedure which rewrites the header
;; record to have the correct "next" pointer.
;;
;; Note that all these procedures write to a block in memory first,
;; and only at the end is the block written to disk.
sz = size(data)
off1 = pp
cmsv_wrec, block, pp, data, name, block_name='VARIABLE', $
/init, offset=off0, $
status=status, errmsg=errmsg
if status EQ 0 then begin
if keyword_set(quiet) then return else message, errmsg
endif
;; Now write out an end marker block, which will serve to terminate
;; the file in case the user closes it. We will rewind to this
;; point in case new writes occur, so they will overwrite the end
;; block.
eoff = off0 + pp
if NOT keyword_set(noend) then begin
cmsv_wrec, block, pp, block_name='END_MARKER', offset=off0, $
status=status, errmsg=errmsg
if status EQ 0 then begin
if keyword_set(quiet) then return else message, errmsg
endif
endif
writeu, unit, block(0:pp-1)
block = 0
;; Now rewind the file pointer so that it points at the end marker.
;; Any new writes will overwrite the marker.
if NOT keyword_set(noend) then point_lun, unit, eoff
status = 1
return
end