aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/atools/tainsert.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/utilities/nttools/atools/tainsert.x')
-rw-r--r--pkg/utilities/nttools/atools/tainsert.x260
1 files changed, 260 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/atools/tainsert.x b/pkg/utilities/nttools/atools/tainsert.x
new file mode 100644
index 00000000..125ed348
--- /dev/null
+++ b/pkg/utilities/nttools/atools/tainsert.x
@@ -0,0 +1,260 @@
+include <tbset.h>
+
+define BUFSIZE 1024 # max number of elements copied at one time
+
+# tainsert -- copy a column from one table to an entry in another
+# This task inserts an array of values into a row for a column that contains
+# array entries. If the output table exists it will be written to in-place;
+# otherwise, it will be created. The same column name is used in both
+# tables. If the row number is less than one, the output row number will be
+# taken from the keyword ORIG_ROW in the input table.
+#
+# Phil Hodge, 28-Jul-1994 Task created.
+# Phil Hodge, 15-Dec-1995 Add nremain, fix while loop on ncopy.
+# Phil Hodge, 4-Apr-1996 Remove slen from calling sequence of tbaptr, etc.,
+# for writing indef to extra elements of array.
+# Phil Hodge, 30-Jan-1998 Add optional parameters to define new column;
+# call tbhgti as a function, not a subroutine.
+# Phil Hodge, 8-Apr-1999 Call tbfpri.
+# Phil Hodge, 13-Apr-2000 Add column name to warning message.
+
+procedure tainsert()
+
+pointer intable
+pointer outtable
+int row # row number at which to insert
+char column[SZ_COLNAME] # name of column to copy
+char outcolumn[SZ_COLNAME] # name to use for column in output table
+int size # length of output array for new column
+char colunits[SZ_COLUNITS] # units for new column
+char colfmt[SZ_COLFMT] # display format for new column
+pointer dtype # data type of new column
+#--
+pointer sp
+pointer x # scratch for array of data
+pointer nbuf # scratch for array of null flags
+pointer itp, otp # pointers to table structs
+pointer icp, ocp # pointers to column structs
+int datatype # data type of column
+char icolname[SZ_COLNAME] # from tbcinf for input table column
+char icolunits[SZ_COLUNITS] # from tbcinf, units for column
+char icolfmt[SZ_COLFMT] # from tbcinf, display format
+int idatatype # from tbcinf, data type of column
+int colnum, lenfmt # output from tbcinf and ignored
+int nrows # number of rows in input table
+int nelem # input number of rows, output length of array
+int nremain # number of elements that remain to be copied
+int ncopy # number of elements to copy at once
+int i # loop index
+int first, last # first and last elements (or rows)
+int slen # length of string to copy
+int phu_copied # set by tbfpri and ignored
+bool inplace # true if output table already exists
+bool newcolumn # true if output column does not already exist
+int delete # should we delete output table if error?
+pointer tbtopn()
+int clgeti(), tbpsta(), tbtacc(), tbcigi(), tbhgti()
+bool isblank()
+
+# INDEF values for use in a calling sequence:
+# (The problem is that INDEFS is an int, not a short; the others may be OK.)
+double undefd
+real undefr
+int undefi
+short undefs
+
+begin
+ call smark (sp)
+ call salloc (intable, SZ_FNAME, TY_CHAR)
+ call salloc (outtable, SZ_FNAME, TY_CHAR)
+ call salloc (dtype, SZ_FNAME, TY_CHAR)
+
+ call clgstr ("intable", Memc[intable], SZ_FNAME)
+ call clgstr ("outtable", Memc[outtable], SZ_FNAME)
+ row = clgeti ("row")
+ call clgstr ("column", column, SZ_COLNAME)
+ call clgstr ("outcolumn", outcolumn, SZ_COLNAME)
+
+ # The input column name is the default for the output.
+ if (isblank (outcolumn))
+ call strcpy (column, outcolumn, SZ_COLNAME)
+
+ # Open input and output tables.
+ itp = tbtopn (Memc[intable], READ_ONLY, NULL)
+ if (tbtacc (Memc[outtable]) == YES) {
+ otp = tbtopn (Memc[outtable], READ_WRITE, NULL)
+ inplace = true
+ } else {
+ call tbfpri (Memc[intable], Memc[outtable], phu_copied)
+ otp = tbtopn (Memc[outtable], NEW_FILE, NULL)
+ inplace = false
+ }
+ if (inplace)
+ delete = NO
+ else
+ delete = YES # delete output table in case of error
+
+ undefd = INDEFD
+ undefr = INDEFR
+ undefi = INDEFI
+ undefs = INDEFS
+
+ if (row < 1 || IS_INDEFI(row)) {
+ iferr (row = tbhgti (itp, "orig_row"))
+ call taex_disaster (itp, otp, NO,
+ "row number not specified, and ORIG_ROW not found in intable")
+ }
+
+ # This will be the number of elements in the output array,
+ # unless the user explicitly specifies a different size.
+ nrows = tbpsta (itp, TBL_NROWS)
+
+ # Find input column.
+ call tbcfnd (itp, column, icp, 1)
+ if (icp == NULL)
+ call taex_disaster (itp, otp, NO, "column not found in input table")
+
+ # Find or create output column. If we're creating a new column,
+ # use the input column as a template, except that the output will be
+ # an array of length 'size', which defaults to nrows but can be
+ # different if the user specifies a value. The name of the output
+ # column can also be different from the input.
+ call tbcfnd (otp, outcolumn, ocp, 1)
+ if (ocp == NULL) {
+ # Column not found in output, so create it.
+ call tbcinf (icp, colnum, icolname, icolunits, icolfmt,
+ idatatype, nelem, lenfmt)
+ if (nelem > 1)
+ call taex_disaster (itp, otp, NO,
+ "column in input table contains arrays")
+ # Get optional parameters if creating new column.
+ size = clgeti ("size")
+ call clgstr ("colunits", colunits, SZ_COLUNITS)
+ call clgstr ("colfmt", colfmt, SZ_COLFMT)
+ call clgstr ("datatype", Memc[dtype], SZ_FNAME)
+ # Assign default values if not specified.
+ if (IS_INDEFI(size) || size < 1)
+ size = nrows
+ if (isblank (colunits))
+ call strcpy (icolunits, colunits, SZ_COLUNITS)
+ if (isblank (colfmt))
+ call strcpy (icolfmt, colfmt, SZ_COLFMT)
+ if (isblank (Memc[dtype])) {
+ datatype = idatatype
+ } else {
+ # convert e.g. "real" to 6
+ call tbbtyp (Memc[dtype], datatype)
+ }
+ call tbcdef (otp, ocp, outcolumn, colunits, colfmt,
+ datatype, size, 1) # an array
+ newcolumn = true
+ } else {
+ newcolumn = false
+ }
+ if (!inplace)
+ call tbtcre (otp)
+
+ # Get number of elements to copy.
+ nelem = tbcigi (ocp, TBL_COL_LENDATA)
+ if (nrows > nelem) {
+ call eprintf (
+"Warning: The number of input rows (%d) in column %s\n")
+ call pargi (nrows)
+ call pargstr (column)
+ call eprintf (
+" is greater than the array size (%d); the extra rows will be ignored.\n")
+ call pargi (nelem)
+ }
+ nremain = min (nrows, nelem) # total number to copy
+ ncopy = min (nremain, BUFSIZE)
+ first = 1
+ last = ncopy
+
+ # Copy the data.
+ datatype = tbcigi (icp, TBL_COL_DATATYPE)
+ call salloc (nbuf, ncopy, TY_BOOL)
+ if (datatype == TY_REAL) {
+ call salloc (x, ncopy, TY_REAL)
+ while (ncopy > 0) {
+ call tbcgtr (itp, icp, Memr[x], Memb[nbuf], first, last)
+ call tbaptr (otp, ocp, row, Memr[x], first, ncopy)
+ call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+ }
+
+ } else if (datatype == TY_DOUBLE) {
+ call salloc (x, ncopy, TY_DOUBLE)
+ while (ncopy > 0) {
+ call tbcgtd (itp, icp, Memd[x], Memb[nbuf], first, last)
+ call tbaptd (otp, ocp, row, Memd[x], first, ncopy)
+ call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+ }
+
+ } else if (datatype == TY_INT) {
+ call salloc (x, ncopy, TY_INT)
+ while (ncopy > 0) {
+ call tbcgti (itp, icp, Memi[x], Memb[nbuf], first, last)
+ call tbapti (otp, ocp, row, Memi[x], first, ncopy)
+ call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+ }
+
+ } else if (datatype == TY_SHORT) {
+ call salloc (x, ncopy, TY_SHORT)
+ while (ncopy > 0) {
+ call tbcgts (itp, icp, Mems[x], Memb[nbuf], first, last)
+ call tbapts (otp, ocp, row, Mems[x], first, ncopy)
+ call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+ }
+
+ } else if (datatype == TY_BOOL) {
+ call salloc (x, ncopy, TY_BOOL)
+ while (ncopy > 0) {
+ call tbcgtb (itp, icp, Memb[x], Memb[nbuf], first, last)
+ call tbaptb (otp, ocp, row, Memb[x], first, ncopy)
+ call taex_incr (nremain, ncopy, first, last, BUFSIZE)
+ }
+
+ } else if (datatype < 0) { # character string
+ slen = -datatype + 3 # a little extra space
+ call salloc (x, slen, TY_CHAR)
+ do i = 1, nelem {
+ call tbegtt (itp, icp, i, Memc[x], slen)
+ call tbaptt (otp, ocp, row, Memc[x], slen, i, 1)
+ }
+
+ } else {
+ call eprintf ("datatype = %d\n")
+ call pargi (datatype)
+ call taex_disaster (itp, otp, delete, "unknown data type")
+ }
+
+ # If we wrote to an existing column in an existing table, and the
+ # output column array has more elements than input rows, then we
+ # should set the remaining elements in this entry to INDEF.
+ if (!newcolumn) {
+ if (datatype == TY_REAL) {
+ do i = nrows+1, nelem
+ call tbaptr (otp, ocp, row, undefr, i, 1)
+ } else if (datatype == TY_DOUBLE) {
+ do i = nrows+1, nelem
+ call tbaptd (otp, ocp, row, undefd, i, 1)
+ } else if (datatype == TY_INT) {
+ do i = nrows+1, nelem
+ call tbapti (otp, ocp, row, undefi, i, 1)
+ } else if (datatype == TY_SHORT) {
+ do i = nrows+1, nelem
+ call tbapts (otp, ocp, row, undefs, i, 1)
+ } else if (datatype == TY_BOOL) {
+ do i = nrows+1, nelem
+ call tbaptb (otp, ocp, row, false, i, 1)
+ } else if (datatype < 0) {
+ slen = -datatype
+ do i = nrows+1, nelem
+ call tbaptt (otp, ocp, row, "", slen, i, 1)
+ }
+ }
+
+ call tbtclo (otp)
+ call tbtclo (itp)
+
+ call sfree (sp)
+end
generated by cgit (git 2.34.1) at 2025-09-20 05:06:24 -0400