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/xtools/catquery/cqgfields.x | 483 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 483 insertions(+) create mode 100644 pkg/xtools/catquery/cqgfields.x (limited to 'pkg/xtools/catquery/cqgfields.x') diff --git a/pkg/xtools/catquery/cqgfields.x b/pkg/xtools/catquery/cqgfields.x new file mode 100644 index 00000000..23b94221 --- /dev/null +++ b/pkg/xtools/catquery/cqgfields.x @@ -0,0 +1,483 @@ +include +include "cqdef.h" +include "cq.h" + +# CQ_SETRECORD -- Set the the current record. What action this procedure takes +# depends on the input data type. In the case of text files this task +# sets the current record pointer and figures where in the record each +# column begins. For blocked text files the foffsets determine where each +# record begins. + +int procedure cq_setrecord (res, recptr) + +pointer res #I the results descriptor +int recptr #U the current record pointer + +pointer buf + +begin + # The record is outside the record data range. + if (recptr <= 0) { + CQ_RECPTR(res) = 0 + CQ_FNFIELDS(res) = 0 + call aclri (Memi[CQ_FINDICES(res)], CQ_MAX_NFIELDS + 1) + return (BOF) + } + if (recptr > CQ_RNRECS(res)) + return (EOF) + + CQ_RECPTR(res) = recptr + switch (CQ_RTYPE(res)) { + case CQ_STEXT: + buf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + call cq_find_fields (Memc[buf], Memi[CQ_FINDICES(res)], + CQ_MAX_NFIELDS, CQ_FNFIELDS(res)) + case CQ_BTEXT: + ; + default: + } + + return (recptr) +end + + +# CQ_GVALC -- Fetch a record field as a string value. + +int procedure cq_gvalc (res, recptr, field, str, maxch) + +pointer res #I the results descriptor +int recptr #I the current record pointer +char field[ARB] #I the record field name. +char str[ARB] #O the output string parameter +int maxch #I the maximum number of characters + +pointer fbuf +int fnum, fip, fsize +int cq_fnumber(), cq_setrecord() + +begin + # The record is outside the record data range. + str[1] = EOS + if (recptr <= 0 || recptr > CQ_RNRECS(res)) + return (0) + + # Find the field number. + fnum = cq_fnumber (res, field) + if (fnum <= 0) + return (0) + + # Set the current record if necessary. + if (recptr != CQ_RECPTR(res)) { + if (cq_setrecord (res, recptr) != recptr) + return (0) + } + + # Extract the requested field as a string. If the data is in binary + # internally this will require formatting a string. If the data is + # text this requires extracting the appropriate piece of text. + + switch (CQ_RTYPE(res)) { + + case CQ_STEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fnum = Memi[CQ_FOFFSETS(res)+fnum-1] + fip = Memi[CQ_FINDICES(res)+fnum-1] + fsize = min (maxch, Memi[CQ_FINDICES(res)+fnum] - + Memi[CQ_FINDICES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], str, fsize) + + case CQ_BTEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fip = Memi[CQ_FOFFSETS(res)+fnum-1] + fsize = min (maxch, Memi[CQ_FSIZES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], str, fsize) + + default: + fsize = 0 + + } + + return (fsize) +end + + +# CQ_GVALD -- Return a double precision field value + +int procedure cq_gvald (res, recptr, field, dval) + +pointer res #I the results descriptor +int recptr #I the current record pointer +char field[ARB] #I the record field name. +double dval #O the output double value + +pointer fbuf, sp, line +int fnum, fip, fsize, nchars +int cq_fnumber(), ctod(), cq_setrecord() + +begin + dval = INDEFD + + # The record is outside the record data range. + if (recptr <= 0 || recptr > CQ_RNRECS(res)) + return (0) + + # Find the field number. + fnum = cq_fnumber (res, field) + if (fnum <= 0) + return (0) + + # Set the current record if necessary. + if (recptr != CQ_RECPTR(res)) { + if (cq_setrecord (res, recptr) != recptr) + return (0) + } + + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Extract the requested field as a double precision value. If the data + # is in binary internally this may imply a type conversion. If the data + # is text this requires decoding the string value. + + switch (CQ_RTYPE(res)) { + + case CQ_STEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fnum = Memi[CQ_FOFFSETS(res)+fnum-1] + fip = Memi[CQ_FINDICES(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] - + Memi[CQ_FINDICES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctod (Memc[line], fip, dval) + + case CQ_BTEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fip = Memi[CQ_FOFFSETS(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctod (Memc[line], fip, dval) + + default: + nchars = 0 + + } + + call sfree (sp) + + return (nchars) +end + + +# CQ_GVALR -- Return a real precision field value. + +int procedure cq_gvalr (res, recptr, field, rval) + +pointer res #I the results descriptor +int recptr #I the current record pointer +char field[ARB] #I the record field name. +real rval #O the output real value + +pointer fbuf, sp, line +int fnum, fip, fsize, nchars +int cq_fnumber(), ctor(), cq_setrecord() + +begin + rval = INDEFR + + # The record is outside the record data range. + if (recptr <= 0 || recptr > CQ_RNRECS(res)) + return (0) + + # Find the field number. + fnum = cq_fnumber (res, field) + if (fnum <= 0) + return (0) + + # Set the current record if necessary. + if (recptr != CQ_RECPTR(res)) { + if (cq_setrecord (res, recptr) != recptr) + return (0) + } + + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Extract the requested field as a double precision value. If the data + # is in binary internally this may imply a type conversion. If the data + # is text this requires decoding the string value. + + switch (CQ_RTYPE(res)) { + + case CQ_STEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fnum = Memi[CQ_FOFFSETS(res)+fnum-1] + fip = Memi[CQ_FINDICES(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] - + Memi[CQ_FINDICES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctor (Memc[line], fip, rval) + + case CQ_BTEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fip = Memi[CQ_FOFFSETS(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctor (Memc[line], fip, rval) + + default: + nchars = 0 + + } + + call sfree (sp) + + return (nchars) +end + + +# CQ_GVALL -- Return a long integer field value. + +int procedure cq_gvall (res, recptr, field, lval) + +pointer res #I the results descriptor +int recptr #I the current record pointer +char field[ARB] #I the record field name. +long lval #I the output long value + +pointer fbuf, sp, line +int fnum, fip, fsize, nchars +int cq_fnumber(), ctol(), cq_setrecord() + +begin + lval = INDEFL + + # The record is outside the record data range. + if (recptr <= 0 || recptr > CQ_RNRECS(res)) + return (0) + + # Find the field number. + fnum = cq_fnumber (res, field) + if (fnum <= 0) + return (0) + + # Set the current record if necessary. + if (recptr != CQ_RECPTR(res)) { + if (cq_setrecord (res, recptr) != recptr) + return(0) + } + + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Extract the requested field as a double precision value. If the data + # is in binary internally this may imply a type conversion. If the data + # is text this requires decoding the string value. + + switch (CQ_RTYPE(res)) { + + case CQ_STEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fnum = Memi[CQ_FOFFSETS(res)+fnum-1] + fip = Memi[CQ_FINDICES(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] - + Memi[CQ_FINDICES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctol (Memc[line], fip, lval) + + case CQ_BTEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fip = Memi[CQ_FOFFSETS(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctol (Memc[line], fip, lval) + + default: + nchars = 0 + + } + + call sfree (sp) + + return (nchars) +end + + +# CQ_GVALI -- Return an integer field value + +int procedure cq_gvali (res, recptr, field, ival) + +pointer res #I the results descriptor +int recptr #I the current record pointer +char field[ARB] #I the record field name. +int ival #I the output int value + +pointer fbuf, sp, line +int fnum, fip, fsize, nchars +int cq_fnumber(), ctoi(), cq_setrecord() + +begin + ival = INDEFI + + # The record is outside the record data range. + if (recptr <= 0 || recptr > CQ_RNRECS(res)) + return (0) + + # Find the field number. + fnum = cq_fnumber (res, field) + if (fnum <= 0) + return (0) + + # Set the current record if necessary. + if (recptr != CQ_RECPTR(res)) { + if (cq_setrecord (res, recptr) != recptr) + return (0) + } + + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Extract the requested field as a double precision value. If the data + # is in binary internally this may imply a type conversion. If the data + # is text this requires decoding the string value. + + switch (CQ_RTYPE(res)) { + + case CQ_STEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fnum = Memi[CQ_FOFFSETS(res)+fnum-1] + fip = Memi[CQ_FINDICES(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] - + Memi[CQ_FINDICES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctoi (Memc[line], fip, ival) + + case CQ_BTEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fip = Memi[CQ_FOFFSETS(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctoi (Memc[line], fip, ival) + + default: + nchars = 0 + } + + call sfree (sp) + + return (nchars) +end + + +# CQ_GVALS -- Return a short integer field value + +int procedure cq_gvals (res, recptr, field, sval) + +pointer res #I the results descriptor +int recptr #I the current record pointer +char field[ARB] #I the record field name. +short sval #O the output short value + +pointer fbuf, sp, line +int fnum, fip, fsize, nchars, ival +int cq_fnumber(), ctoi(), cq_setrecord() + +begin + sval = INDEFS + + # The record is outside the record data range. + if (recptr <= 0 || recptr > CQ_RNRECS(res)) + return (0) + + # Find the field number. + fnum = cq_fnumber (res, field) + if (fnum <= 0) + return (0) + + # Set the current record if necessary. + if (recptr != CQ_RECPTR(res)) { + if (cq_setrecord (res, recptr) != recptr) + return (0) + } + + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Extract the requested field as a double precision value. If the data + # is in binary internally this may imply a type conversion. If the data + # is text this requires decoding the string value. + + switch (CQ_RTYPE(res)) { + + case CQ_STEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fnum = Memi[CQ_FOFFSETS(res)+fnum-1] + fip = Memi[CQ_FINDICES(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FINDICES(res)+fnum] - + Memi[CQ_FINDICES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctoi (Memc[line], fip, ival) + if (nchars > 0) + sval = ival + + case CQ_BTEXT: + fbuf = CQ_RBUF(res) + Memi[CQ_RINDEX(res)+recptr-1] - 1 + fip = Memi[CQ_FOFFSETS(res)+fnum-1] + fsize = min (SZ_LINE, Memi[CQ_FSIZES(res)+fnum-1]) + call strcpy (Memc[fbuf+fip-1], Memc[line], fsize) + fip = 1 + nchars = ctoi (Memc[line], fip, ival) + if (nchars > 0) + sval = ival + + default: + nchars = 0 + + } + + call sfree (sp) + + return (nchars) +end + + +# CQ_FIND_FIELDS -- This procedure finds the starting column for each field +# in the input line. These column numbers are returned in the array +# field_pos; the number of fields is also returned. + +procedure cq_find_fields (linebuf, field_pos, max_fields, nfields) + +char linebuf[ARB] #I the input buffer +int field_pos[max_fields] #O the output field positions +int max_fields #I the maximum number of fields +int nfields #O the computed number of fields + +bool in_field +int ip, field_num + +begin + field_num = 1 + field_pos[1] = 1 + in_field = false + + for (ip=1; linebuf[ip] != '\n' && linebuf[ip] != EOS; ip=ip+1) { + if (! IS_WHITE(linebuf[ip])) + in_field = true + else if (in_field) { + in_field = false + field_num = field_num + 1 + field_pos[field_num] = ip + } + } + + field_pos[field_num+1] = ip + nfields = field_num +end -- cgit