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
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
include <ctype.h>
include <error.h>
include <evexpr.h>
include "../../lib/ptkeysdef.h"
define LEN_LONGLINE 10
# PT_XCALC -- Edit a field in a record using a value expression and a
# a selection expression.
int procedure pt_xcalc (tp_in, tp_out, field, value, expr)
int tp_in # the input text file descriptor
int tp_out # the output text file descriptor
char field[ARB] # field to be edited
char value[ARB] # the new value expression
char expr[ARB] # the expression to be evaluated
bool oexpr
int first_rec, nunique, uunique, funique, fieldno, fieldtype, fieldlen
int elem, record, editall, ncontinue, recptr, nchars, buflen, lenrecord
int offset, fieldptr
pointer key, lline, o, v, sp, line, name, newvalue, fmtstr
bool streq()
extern pt_getop()
int getline(), strncmp(), pt_kstati(), pt_fmkrec()
pointer evexpr(), locpr()
errchk evexpr(), locpr(), pt_getop()
begin
# Get some working space.
call smark (sp)
call salloc (line, SZ_LINE, TY_CHAR)
call salloc (name, SZ_FNAME, TY_CHAR)
call salloc (newvalue, SZ_FNAME, TY_CHAR)
call salloc (fmtstr, SZ_FNAME, TY_CHAR)
# Initialize keyword structure.
call pt_kyinit (key)
# Initialize the file read.
first_rec = YES
nunique = 0
uunique = 0
funique = 0
record = 0
# Initialize the buffers.
buflen = LEN_LONGLINE * SZ_LINE
call malloc (lline, buflen, TY_CHAR)
# Initilize the record read.
ncontinue = 0
recptr = 1
fieldptr = 0
# Initialize the expression decoding.
o = NULL
if (streq (expr, "yes") || streq (expr, "YES"))
editall = YES
else
editall = NO
v = NULL
# Loop over the text file records.
repeat {
# Read in a line of the text file.
nchars = getline (tp_in, Memc[line])
if (nchars == EOF)
break
# Determine the type of record.
if (Memc[line] == KY_CHAR_POUND) {
if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) == 0) {
call pt_kyadd (key, Memc[line], nchars)
call putline (tp_out, Memc[line])
} else if (strncmp (Memc[line], KY_CHAR_NAME,
KY_LEN_STR) == 0) {
nunique = nunique + 1
call pt_kname (key, Memc[line], nchars, nunique)
call putline (tp_out, Memc[line])
} else if (strncmp (Memc[line], KY_CHAR_UNITS,
KY_LEN_STR) == 0) {
uunique = uunique + 1
call pt_knunits (key, Memc[line], nchars, uunique)
call putline (tp_out, Memc[line])
} else if (strncmp (Memc[line], KY_CHAR_FORMAT,
KY_LEN_STR) == 0) {
funique = funique + 1
call pt_knformats (key, Memc[line], nchars, funique)
call putline (tp_out, Memc[line])
} else {
# skip lines beginning with # sign
call putline (tp_out, Memc[line])
}
} else if (Memc[line] == KY_CHAR_NEWLINE) {
# skip blank lines
call putline (tp_out, Memc[line])
} else {
# Set the record size and set the column to be altered.
if (recptr == 1) {
lenrecord = nchars
if (first_rec == YES) {
call pt_kid (field, Memc[name], elem)
fieldno = pt_kstati (key, Memc[name], KY_INDEX)
if (fieldno <= 0) {
call eprintf (
"Cannot find field %s in input file\n")
call pargstr (Memc[name])
break
}
fieldtype = pt_kstati (key, Memc[name], KY_DATATYPE)
if (fieldtype != TY_INT && fieldtype != TY_REAL) {
call eprintf ("Field %s is not numeric\n")
call pargstr (Memc[name])
break
}
fieldlen = pt_kstati (key, Memc[name], KY_LENGTH)
call pt_kstats (key, Memc[name], KY_FMTSTR,
Memc[fmtstr], SZ_FNAME)
}
} else
lenrecord = lenrecord + nchars
# Build the record.
offset = pt_fmkrec (key, fieldno, elem, Memc[line],
nchars, first_rec, recptr, ncontinue)
if (offset > 0)
fieldptr = lenrecord - nchars + offset
# Reallocate the temporary record space if necessary.
if (lenrecord > buflen) {
buflen = buflen + SZ_LINE
call realloc (lline, buflen, TY_CHAR)
}
# Store the record.
call amovc (Memc[line], Memc[lline+lenrecord-nchars], nchars)
Memc[lline+lenrecord] = EOS
# Do the record bookkeeping.
if (Memc[line+nchars-2] != KY_CHAR_CONT) {
# Evaluate the value and selection expression.
iferr {
if (editall == NO) {
call pt_apset (key)
o = evexpr (expr, locpr (pt_getop), 0)
if (O_TYPE(o) != TY_BOOL)
call error (0,
"Selection expression must be a boolean")
oexpr = O_VALB(o)
} else
oexpr = true
if (oexpr) {
call pt_apset (key)
v = evexpr (value, locpr (pt_getop), 0)
switch (fieldtype) {
case TY_BOOL:
if (O_TYPE(v) != TY_BOOL) {
call error (0,
"Value must be a boolean expression")
} else if (fieldptr > 0) {
call sprintf (Memc[newvalue], fieldlen,
Memc[fmtstr])
call pargb (O_VALB(v))
call amovc (Memc[newvalue],
Memc[lline+fieldptr-1], fieldlen)
}
case TY_INT:
if (O_TYPE(v) != TY_INT) {
call error (0,
"Value must be an integer expression")
} else if (fieldptr > 0) {
call sprintf (Memc[newvalue], fieldlen,
Memc[fmtstr])
call pargi (O_VALI(v))
call amovc (Memc[newvalue],
Memc[lline+fieldptr-1], fieldlen)
}
case TY_REAL:
if (O_TYPE(v) != TY_REAL) {
call error (0,
"Value must be a real expression")
} else if (fieldptr > 0) {
call sprintf (Memc[newvalue], fieldlen,
Memc[fmtstr])
call pargr (O_VALR(v))
call amovc (Memc[newvalue],
Memc[lline+fieldptr-1], fieldlen)
}
case TY_CHAR:
if (O_TYPE(v) != TY_CHAR) {
call error (0,
"Value must be a string expression")
} else if (fieldptr > 0) {
call sprintf (Memc[newvalue], fieldlen,
Memc[fmtstr])
call pargstr (O_VALC(v))
call amovc (Memc[newvalue],
Memc[lline+fieldptr-1], fieldlen)
}
default:
call error (0,
"Value expression is undefined")
}
}
} then {
call erract (EA_WARN)
call error (0,
"Error evaluating the value expression")
}
# Write out the record.
call putline (tp_out, Memc[lline])
# Increment the record counter.
record = record + 1
first_rec = NO
# Reinitialize the record read.
ncontinue = 0
recptr = 1
fieldptr = 0
if (o != NULL) {
call xev_freeop (o)
call mfree (o, TY_STRUCT)
}
o = NULL
if (v != NULL) {
call xev_freeop (v)
call mfree (v, TY_STRUCT)
}
v = NULL
}
}
}
# Cleanup.
call mfree (lline, TY_CHAR)
call sfree (sp)
call pt_kyfree (key)
return (record)
end
|
