From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/utilities/nttools/tquery/doquery.x | 72 +++++++++++++++++++++ pkg/utilities/nttools/tquery/mkpkg | 13 ++++ pkg/utilities/nttools/tquery/tquery.x | 113 +++++++++++++++++++++++++++++++++ pkg/utilities/nttools/tquery/wquery.x | 50 +++++++++++++++ 4 files changed, 248 insertions(+) create mode 100644 pkg/utilities/nttools/tquery/doquery.x create mode 100644 pkg/utilities/nttools/tquery/mkpkg create mode 100644 pkg/utilities/nttools/tquery/tquery.x create mode 100644 pkg/utilities/nttools/tquery/wquery.x (limited to 'pkg/utilities/nttools/tquery') diff --git a/pkg/utilities/nttools/tquery/doquery.x b/pkg/utilities/nttools/tquery/doquery.x new file mode 100644 index 00000000..8dfc4cd4 --- /dev/null +++ b/pkg/utilities/nttools/tquery/doquery.x @@ -0,0 +1,72 @@ +define SYNTAX 1 + +# DOQUERY -- Perform a query on a table and return row and column arrays +# +# B.Simon 18-Dec-1987 First Code +# B.Simon 10-Aug-1992 Fixed calling sequence to tbl_sort +# Phil Hodge 18-Aug-2003 Call select before calling unique. + +procedure doquery (tp, expr, columns, sort, uniq, ascend, casesens, + numcol, colptr, nindex, index) + +int tp # i: Input table descriptor +char expr[ARB] # i: Expression used to select rows +char columns[ARB] # i: Table column template +char sort[ARB] # i: Sort columns template +bool uniq # i: Should output rows be unique? +bool ascend # i: Ascending sort flag +bool casesens # i: Case sensitivity flag +int numcol # io: Number of column pointers +pointer colptr[ARB] # io: Array of column pointers +int nindex # io: Number of row indices +int index[ARB] # io: Array of row indices +#-- +int numptr, numsort +pointer sortptr + +string nocolumn "Column names not found in table" +string nosort "Sort column not found in table" + +bool isblank() + +begin + + # Create an array of column pointers from the column template + + call tctexp (tp, columns, numcol, numptr, colptr) + + if (numptr == 0) + call error (SYNTAX, nocolumn) + + # Select rows according to expression + + if (! isblank(expr)) { + call select (tp, expr, nindex, index) + } + + # Remove duplicate rows from table + + if (uniq) + call unique (tp, numptr, colptr, nindex, index) + + # Sort the array of indices + + if (! isblank(sort)) { + + # Create an array of sort column pointers from the sort template + + call malloc (sortptr, numcol, TY_INT) + call tctexp (tp, sort, numcol, numsort, Memi[sortptr]) + + if (numsort == 0) + call error (SYNTAX, nosort) + + call tbl_sort (ascend, casesens, tp, numsort, Memi[sortptr], + nindex, index) + + call mfree (sortptr, TY_INT) + } + + numcol = numptr + +end diff --git a/pkg/utilities/nttools/tquery/mkpkg b/pkg/utilities/nttools/tquery/mkpkg new file mode 100644 index 00000000..ca5773d7 --- /dev/null +++ b/pkg/utilities/nttools/tquery/mkpkg @@ -0,0 +1,13 @@ +# Update the tquery application code in the ttools package library +# Author: B.Simon, 21-DEC-87 + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + doquery.x + tquery.x + wquery.x + ; diff --git a/pkg/utilities/nttools/tquery/tquery.x b/pkg/utilities/nttools/tquery/tquery.x new file mode 100644 index 00000000..b7fc91b4 --- /dev/null +++ b/pkg/utilities/nttools/tquery/tquery.x @@ -0,0 +1,113 @@ +include # to check for I/O redirection +include + +define SYNTAX 1 + +# TQUERY -- Create a new table from selected rows and columns of an old table +# +# B.Simon 18-Dec-1987 First Code +# Phil Hodge 07-Sep-1988 Change parameter names for tables. +# B.Simon 31-Mar-1992 Set output table type from input table +# Phil Hodge 4-Oct-1995 Use table name template routines tbnopenp, etc. +# Phil Hodge 8-Apr-1999 Call tbfpri. +# Phil Hodge 9-Jun-1999 Set input/output to STDIN/STDOUT if redirected. + +procedure t_tquery() + +pointer ilist # Input table name template +pointer olist # Output table name template +pointer expr # Expression used to select rows +pointer columns # Table column template +pointer sort # Sort columns template +bool uniq # Should output rows be unique? +bool ascend # Ascending sort flag +bool casesens # Case sensitivity flag +#-- +int junk, nindex, numcol, type +int phu_copied # set by tbfpri and ignored +pointer sp, itp, otp, intable, outtable, index, colptr + +string nomatch "Number of input tables must match output tables" + +bool clgetb() +int fstati() +int tbnget(), tbnlen(), tbpsta() +pointer tbtopn(), tbnopenp(), tbnopen() + +begin + # Allocate stack memory for strings + + call smark (sp) + call salloc (intable, SZ_FNAME, TY_CHAR) + call salloc (outtable, SZ_FNAME, TY_CHAR) + call salloc (expr, SZ_LINE, TY_CHAR) + call salloc (columns, SZ_LINE, TY_CHAR) + call salloc (sort, SZ_LINE, TY_CHAR) + + # Read the task parameters + + if (fstati (STDIN, F_REDIR) == YES) + ilist = tbnopen ("STDIN") + else + ilist = tbnopenp ("intable") + + if (fstati (STDOUT, F_REDIR) == YES) + olist = tbnopen ("STDOUT") + else + olist = tbnopenp ("outtable") + + call clgstr ("expr", Memc[expr], SZ_LINE) + call clgstr ("columns", Memc[columns], SZ_LINE) + call clgstr ("sort", Memc[sort], SZ_LINE) + uniq = clgetb ("uniq") + ascend = clgetb ("ascend") + casesens = clgetb ("casesens") + + # Loop over all table names in the input file name template + + if (tbnlen (ilist) != tbnlen (olist)) + call error (SYNTAX, nomatch) + + while (tbnget (ilist, Memc[intable], SZ_FNAME) != EOF) { + + junk = tbnget (olist, Memc[outtable], SZ_FNAME) + + # Open the tables and set output table type + + itp = tbtopn (Memc[intable], READ_ONLY, NULL) + call tbfpri (Memc[intable], Memc[outtable], phu_copied) + otp = tbtopn (Memc[outtable], NEW_FILE, NULL) + + type = tbpsta (itp, TBL_WHTYPE) + call tbpset (otp, TBL_WHTYPE, type) + + # Create index arrays + + call allrows (itp, nindex, index) + call allcols (itp, numcol, colptr) + + # Do the query, returning an array of column pointers + # and row indices + + call doquery (itp, Memc[expr], Memc[columns], Memc[sort], + uniq, ascend, casesens, + numcol, Memi[colptr], nindex, Memi[index]) + + # Copy header and selected rows and columns to output table + + call wquery (itp, otp, numcol, Memi[colptr], nindex, Memi[index]) + + # Close the tables and free dynamic memory + + call tbtclo (itp) + call tbtclo (otp) + call mfree (colptr, TY_INT) + call mfree (index, TY_INT) + } + + # Close the filename template lists + + call tbnclose (ilist) + call tbnclose (olist) + call sfree (sp) +end diff --git a/pkg/utilities/nttools/tquery/wquery.x b/pkg/utilities/nttools/tquery/wquery.x new file mode 100644 index 00000000..33cc25ff --- /dev/null +++ b/pkg/utilities/nttools/tquery/wquery.x @@ -0,0 +1,50 @@ +include + +# WQUERY -- Copy selected columns and rows to output table +# +# B.Simon 19-Oct-87 First Code + +procedure wquery (itp, otp, numcol, colptr, nindex, index) + +pointer itp # i: Input table descriptor +pointer otp # i: Output table descriptor +int numcol # i: Number of column pointers +pointer colptr[ARB] # i: Array of column pointers +int nindex # i: Size of index array +int index[ARB] # i: Array of row indices +#-- +int iptr, idx, jdx +int colnum[1], datatype[1], lendata[1], lenfmt[1] +pointer sp, ocp, newcol, colname, colunits, colfmt + +begin + # Set up arrays in dynamic memory + + call smark (sp) + call salloc (newcol, numcol, TY_INT) + call salloc (colname, SZ_COLNAME, TY_CHAR) + call salloc (colunits, SZ_COLUNITS, TY_CHAR) + call salloc (colfmt, SZ_COLFMT, TY_CHAR) + + + # Copy column information from the input table to the output table + + do iptr = 1, numcol { + call tbcinf (colptr[iptr], colnum, Memc[colname], Memc[colunits], + Memc[colfmt], datatype[1], lendata[1], lenfmt[1]) + call tbcdef (otp, ocp, Memc[colname], Memc[colunits], Memc[colfmt], + datatype[1], lendata[1], 1) + Memi[newcol+iptr-1] = ocp + } + + # Copy the table columns a row at a time + + call tbtcre (otp) + call tbhcal (itp, otp) + do idx = 1, nindex { + jdx = index[idx] + call tbrcsc (itp, otp, colptr, Memi[newcol], jdx, idx, numcol) + } + + call sfree (sp) +end -- cgit