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
|
include <tbset.h>
#* HISTORY *
#* B.Simon 07-Nov-1994 original
# Phil Hodge 8-Apr-1999 call tbfpri
# TCPYONE -- Copy a single table to the output table
procedure tcpyone (input, output)
char input[ARB] # i: input table name
char output[ARB] # i: output table name
#--
int numrow, numcol, numptr, type, iptr, irow, jrow
int colnum, datatype, lendata, lenfmt
int phu_copied # returned by tbfpri and ignored
pointer sp, root, extend, rowselect, colselect, colname, colunits, colfmt
pointer errmsg, icp, ocp, itp, otp, colptr, newcol, pcode
string nosect "Sections not permitted on output table name (%s)"
string nocols "Column names not found (%s)"
errchk tbfpri, tbtopn, tctexp, tbracket, trsopen, trseval
bool trseval(), streq()
int tbpsta(), tcs_totsize()
pointer tbtopn(), tcs_column, trsopen()
begin
# Allocate memory for temporary strings
call smark (sp)
call salloc (root, SZ_FNAME, TY_CHAR)
call salloc (extend, SZ_FNAME, TY_CHAR)
call salloc (rowselect, SZ_FNAME, TY_CHAR)
call salloc (colselect, SZ_FNAME, TY_CHAR)
call salloc (colname, SZ_COLNAME, TY_CHAR)
call salloc (colunits, SZ_COLUNITS, TY_CHAR)
call salloc (colfmt, SZ_COLFMT, TY_CHAR)
call salloc (errmsg, SZ_LINE, TY_CHAR)
# Check output table name for sections
# call getsects (output, Memc[root], Memc[extend], Memc[rowselect],
# Memc[colselect], SZ_FNAME)
call rdselect (output, Memc[root], Memc[rowselect], Memc[colselect], SZ_FNAME)
if (Memc[rowselect] != EOS || Memc[colselect] != EOS) {
call sprintf (Memc[errmsg], SZ_LINE, nosect)
call pargstr (output)
call error (1, Memc[errmsg])
}
# Break input file names into bracketed sections
# call getsects (input, Memc[root], Memc[extend], Memc[rowselect],
# Memc[colselect], SZ_FNAME)
call rdselect (input, Memc[root], Memc[rowselect], Memc[colselect], SZ_FNAME)
if (Memc[rowselect] == EOS && Memc[colselect] == EOS) {
# Perform straight file copy if no sections on input name
call tbfpri (input, output, phu_copied)
call tbtcpy (input, output)
} else {
# Open the tables and set output table type
# call strcat (Memc[extend], Memc[root], SZ_FNAME)
itp = tbtopn (Memc[root], READ_ONLY, NULL)
call tbfpri (Memc[root], output, phu_copied)
otp = tbtopn (output, NEW_FILE, NULL)
type = tbpsta (itp, TBL_WHTYPE)
# Support for ASCII output (11/20/96, IB)
if (streq (output, "STDOUT"))
type = TBL_TYPE_TEXT
call tbpset (otp, TBL_WHTYPE, type)
# Create an array of column pointers from the column template
numrow = tbpsta (itp, TBL_NROWS)
numcol = tbpsta (itp, TBL_NCOLS)
call salloc (colptr, numcol, TY_INT)
call salloc (newcol, numcol, TY_INT)
call tcs_open (itp, Memc[colselect], Memi[colptr], numptr, numcol)
# Take an error exit if no columns were matched
if (numptr == 0) {
call sprintf (Memc[errmsg], SZ_LINE, nocols)
call pargstr (input)
call error (1, Memc[errmsg])
}
# Copy column information from the input table to the output table
do iptr = 1, numptr {
icp = tcs_column (Memi[colptr+iptr-1])
call tbcinf (icp, colnum, Memc[colname], Memc[colunits],
Memc[colfmt], datatype, lendata, lenfmt)
if (lendata > 1)
lendata = tcs_totsize (Memi[colptr+iptr-1])
call tbcdef (otp, ocp, Memc[colname], Memc[colunits],
Memc[colfmt], datatype, lendata, 1)
Memi[newcol+iptr-1] = ocp
}
# Copy header keywords
call tbtcre (otp)
call tbhcal (itp, otp)
# Copy selected rows from input to output table
jrow = 1
pcode = trsopen (itp, Memc[rowselect])
do irow = 1, numrow {
if (trseval (itp, irow, pcode)) {
call tcpyrow (itp, otp, Memi[colptr], Memi[newcol],
irow, jrow, numptr)
jrow = jrow + 1
}
}
call trsclose (pcode)
call tcs_close (Memi[colptr], numptr)
call tbtclo (itp)
call tbtclo (otp)
}
call sfree (sp)
end
|
