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
|
include <tbset.h>
define USRERR 1
# PUTTABDAT -- Write a value passed as a string into a table element
#
# B.Simon 17-Aug-87 First Code
procedure puttabdat (hd, colname, rownum, value, undef, eltype)
pointer hd # i: Table descriptor
char colname[ARB] # i: Table column name
int rownum # i: Table row number
char value[ARB] # i: Table element value
bool undef # i: Is table element undefined?
int eltype # i: Type of table element
bool bvalue[1]
double dvalue[1]
int ivalue[1]
pointer colptr[1]
real rvalue[1]
int coltype, lendata, ip, junk, maxch
pointer sp, errtxt
string badtyperr "Type mismatch in table column (%s)"
string badnamerr "Column name not found in table (%s)"
int ctod()
int stridx(), strlen(), tbcigi()
begin
# Allocate dynamic memory to hold strings
call smark (sp)
call salloc (errtxt, SZ_LINE, TY_CHAR)
# Get the column pointer from the column name
call tbcfnd (hd, colname, colptr, 1)
# If the pointer is NULL, the column was not found
if (colptr[1] == NULL) {
call sprintf (Memc[errtxt], SZ_LINE, badnamerr)
call pargstr (colname)
call error (USRERR, Memc[errtxt])
}
# Get the column data type. Store in coltype
coltype = tbcigi (colptr[1], TBL_COL_DATATYPE)
if (coltype < 0) {
lendata = - coltype
coltype = TY_CHAR
}
if (undef)
# Set table element to undefined
call tbrudf (hd, colptr, 1, rownum)
else {
# Convert element value to a double
ip = 1
junk = ctod (value, ip, dvalue[1])
# Check for illegal type conversions
if ((coltype == TY_BOOL && eltype != TY_BOOL) ||
(!(coltype == eltype || coltype == TY_CHAR) &&
(eltype == TY_BOOL || eltype == TY_CHAR) ) ) {
call sprintf (Memc[errtxt], SZ_LINE, badtyperr)
call pargstr (colname)
call error (USRERR, Memc[errtxt])
}
# Use the proper procedure to write the new element value
switch (coltype) {
case TY_BOOL :
bvalue[1] = stridx (value[1], "TtYy") > 0
call tbrptb (hd, colptr, bvalue, 1, rownum)
case TY_CHAR :
maxch = strlen (value) + 1
call tbrptt (hd, colptr, value, maxch, 1, rownum)
case TY_SHORT,TY_INT,TY_LONG :
ivalue[1] = int (dvalue[1])
call tbrpti (hd, colptr, ivalue, 1, rownum)
case TY_REAL :
rvalue[1] = real (dvalue[1])
call tbrptr (hd, colptr, rvalue, 1, rownum)
case TY_DOUBLE :
call tbrptd (hd, colptr, dvalue, 1, rownum)
}
}
call sfree (sp)
return
end
|
