aboutsummaryrefslogtreecommitdiff
path: root/pkg/xtools/catquery/cqquery.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/xtools/catquery/cqquery.x')
-rw-r--r--pkg/xtools/catquery/cqquery.x998
1 files changed, 998 insertions, 0 deletions
diff --git a/pkg/xtools/catquery/cqquery.x b/pkg/xtools/catquery/cqquery.x
new file mode 100644
index 00000000..1806484c
--- /dev/null
+++ b/pkg/xtools/catquery/cqquery.x
@@ -0,0 +1,998 @@
+include <fset.h>
+include <ctype.h>
+include "cqdef.h"
+include "cq.h"
+
+
+define DEF_SZ_INBUF 32768 # the maximum network transfer buffer size
+define DEF_SZ_INDEX 1000 # the record index length increment
+
+# CQ_QUERY -- Send a query and return the data.
+
+pointer procedure cq_query (cq)
+
+pointer cq #I the catalog database descriptor
+
+pointer cc, res, inbuf, line, sp, spfname
+char url[SZ_PATHNAME], addr[SZ_LINE], query[SZ_LINE], buf[SZ_LINE]
+int j, fd, nchars, nlines, nrecs, szindex, ip, op
+bool done
+long note()
+pointer cq_rinit()
+int ndopen(), strlen(), read(), open(), getline(), fstati(), url_get()
+errchk ndopen(), fprintf(), areadb(), awriteb(), open(), read()
+
+begin
+ # Check that the current catalog is defined.
+ if (CQ_CAT(cq) == NULL)
+ return (NULL)
+ if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+ return (NULL)
+ cc = CQ_CAT(cq)
+
+
+ if (0<1&& USE_URLGET) {
+ # Initialize the image results structure.
+ res = cq_rinit (cq)
+
+ call strcpy (CQ_ADDRESS(cc), buf, SZ_LINE)
+ for (ip=1; buf[ip] != ':'; ip=ip+1) ; # skip 'inet:'
+ ip = ip + 1
+ for ( ; buf[ip] != ':'; ip=ip+1) ; # skip '80:'
+ ip = ip + 1
+ for (op=1; buf[ip] != ':'; ip=ip+1) {
+ addr[op] = buf[ip]
+ op = op + 1
+ }
+ addr[op] = EOS
+
+ call strcpy (CQ_RQUERY(res), buf, SZ_LINE)
+ for (op=1; !IS_WHITE(buf[op+4]); op=op+1)
+ query[op] = buf[op+4]
+ query[op] = EOS
+
+ call sprintf (url, SZ_LINE, "http://%s%s")
+ call pargstr (addr)
+ call pargstr (query)
+
+ iferr {
+ call smark (sp)
+ call salloc (spfname, SZ_FNAME, TY_CHAR)
+
+ call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+
+ # Open the output spool file.
+ call mktemp ("query", Memc[spfname], SZ_FNAME)
+
+ if (url_get (url, Memc[spfname], inbuf) < 0)
+ call error (0, "Cannot access url")
+
+ fd = open (Memc[spfname], READ_ONLY, TEXT_FILE)
+ CQ_RFD(res) = open (Memc[spfname], READ_WRITE, SPOOL_FILE)
+ repeat {
+ call aclrc (Memc[inbuf], DEF_SZ_INBUF)
+ nchars = read (fd, Memc[inbuf], DEF_SZ_INBUF)
+ if (nchars > 0) {
+ Memc[inbuf+nchars] = EOS
+ call write (CQ_RFD(res), Memc[inbuf], nchars)
+ done = false
+ } else
+ done = true
+ } until (done)
+ call flush (CQ_RFD(res))
+ call close (fd)
+
+ CQ_RBUF(res) = fstati (CQ_RFD(res), F_BUFPTR)
+ call seek (CQ_RFD(res), BOF)
+
+ call mfree (inbuf, TY_CHAR)
+ call sfree (sp)
+
+ } then {
+ if (res != NULL)
+ call cq_rfree (res)
+ return (NULL)
+ }
+
+ } else {
+
+ # Open the network connection.
+ iferr (fd = ndopen (CQ_ADDRESS(cc), READ_WRITE))
+ return (NULL)
+
+ # Initialize the results structure.
+ res = cq_rinit (cq)
+
+ # Send the query and get back the results.
+ iferr {
+
+ call smark (sp)
+
+ # Formulate the query.
+ switch (CQ_RTYPE(res)) {
+ case CQ_STEXT, CQ_BTEXT:
+ call fprintf (fd, "%s")
+ call pargstr (CQ_RQUERY(res))
+ default:
+ nchars = strlen (CQ_RQUERY(res))
+ call write (fd, CQ_RQUERY(res), nchars)
+ }
+ call flush (fd)
+
+ # Open the output spool file.
+ call salloc (spfname, SZ_FNAME, TY_CHAR)
+ call mktemp ("query", Memc[spfname], SZ_FNAME)
+ CQ_RFD(res) = open (Memc[spfname], READ_WRITE, SPOOL_FILE)
+ call sfree (sp)
+
+ # Get the data.
+ call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+ call fseti (fd, F_CANCEL, OK)
+
+ switch (CQ_HFMT(cc)) {
+ case CQ_HNONE:
+ ;
+ case CQ_HHTTP:
+ repeat {
+ nchars = getline (fd, Memc[inbuf])
+ if (nchars <= 0)
+ break
+ Memc[inbuf+nchars] = EOS
+ } until ((Memc[inbuf] == '\r' && Memc[inbuf+1] == '\n') ||
+ (Memc[inbuf] == '\n'))
+ default:
+ ;
+ }
+
+ repeat {
+ nchars = read (fd, Memc[inbuf], DEF_SZ_INBUF)
+ if (nchars > 0) {
+ Memc[inbuf+nchars] = EOS
+ call write (CQ_RFD(res), Memc[inbuf], nchars)
+ done = false
+ } else {
+ done = true
+ }
+ } until (done)
+
+ # Cleanup.
+ call flush (CQ_RFD(res))
+ call mfree (inbuf, TY_CHAR)
+ CQ_RBUF(res) = fstati (CQ_RFD(res), F_BUFPTR)
+ call seek (CQ_RFD(res), BOF)
+ call close (fd)
+
+ } then {
+ call cq_rfree (res)
+ call close (fd)
+ return (NULL)
+ }
+
+ }
+
+ # Construct the record index.
+ CQ_RNRECS(res) = 0
+ switch (CQ_RTYPE(res)) {
+ case CQ_STEXT, CQ_BTEXT:
+
+ # Initialize.
+ nlines = 0
+ nrecs = 0
+
+ # Iniitialize the index array.
+ szindex = DEF_SZ_INDEX
+ call malloc (line, SZ_LINE, TY_CHAR)
+ call calloc (CQ_RINDEX(res), szindex, TY_LONG)
+
+ # Create the index array.
+ repeat {
+ Meml[CQ_RINDEX(res)+nrecs] = note (CQ_RFD(res))
+ nchars = getline (CQ_RFD(res), Memc[line])
+ if (nchars == EOF)
+ break
+ nlines = nlines + 1
+ if (nlines <= CQ_RHSKIP(res))
+ next
+ if (Memc[line] == '\n')
+ next
+ #if (CQ_RECSIZE(res) > 0 && nchars != CQ_RECSIZE(res))
+ if (CQ_RECSIZE(res) > 0 && nchars > CQ_RECSIZE(res))
+ Meml[CQ_RINDEX(res)+nrecs] = EOF
+ else if (CQ_RTRIML(res) > 0 || CQ_RTRIMR(res) > 0) {
+ inbuf = CQ_RBUF(res) + Meml[CQ_RINDEX(res)+nrecs] - 1
+ do j = 1, min (CQ_RTRIML(res), nchars)
+ Memc[inbuf+j-1] = ' '
+ do j = nchars - CQ_RTRIMR(res), nchars - 1
+ Memc[inbuf+j-1] = ' '
+ }
+ nrecs = nrecs + 1
+ if (nrecs >= szindex) {
+ szindex = szindex + DEF_SZ_INDEX
+ call realloc (CQ_RINDEX(res), szindex, TY_LONG)
+ call aclrl (Meml[CQ_RINDEX(res)+szindex-DEF_SZ_INDEX],
+ DEF_SZ_INDEX)
+ }
+ }
+ call mfree (line, TY_CHAR)
+ CQ_RNRECS(res) = nrecs
+
+ # Remove the incorrectly sized and trailing records.
+ nrecs = 0
+ do j = 0, CQ_RNRECS(res) - CQ_RTSKIP(res) - 1 {
+ if (Meml[CQ_RINDEX(res)+j] == EOF)
+ next
+ Meml[CQ_RINDEX(res)+nrecs] = Meml[CQ_RINDEX(res)+j]
+ nrecs = nrecs + 1
+ }
+ CQ_RNRECS(res) = nrecs
+
+ # Resize the index array.
+ call realloc (CQ_RINDEX(res), max (1, CQ_RNRECS(res) + 1), TY_LONG)
+
+ default:
+ ;
+ }
+
+ # Return the results pointer.
+ return (res)
+end
+
+
+# CQ_FQUERY -- Treat a catalog file file as thought it were the results
+# of a query. The catalog file file name and file description are passed
+# to the routine as arguments.
+
+pointer procedure cq_fquery (cq, catfile, catfmt)
+
+pointer cq #I the catalog database descriptor
+char catfile[ARB] #I the input catalog file
+char catfmt[ARB] #I the input catalog description
+
+pointer res, inbuf, line, sp, spfname
+int j, fd, nchars, nlines, nrecs, szindex
+bool done
+pointer cq_frinit()
+long note()
+int access(), open(), read(), fstati(), getline()
+errchk open(), read()
+
+begin
+ # Check that the current catalog is defined.
+ if (CQ_CAT(cq) == NULL)
+ return (NULL)
+ if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+ return (NULL)
+
+ # Check to see if the catalog file exists.
+ if (access (catfile, 0, 0) == NO)
+ return (NULL)
+
+ # Check to see if the fmt string is defined.
+ if (catfmt[1] == EOS)
+ return (NULL)
+
+ # Open the catalog file.
+ if (access (catfile, READ_ONLY, TEXT_FILE) == YES) {
+ iferr (fd = open (catfile, READ_ONLY, TEXT_FILE))
+ return (NULL)
+ } else {
+ iferr (fd = open (catfile, READ_ONLY, BINARY_FILE))
+ return (NULL)
+ }
+
+ # Initialize the results structure using the file description.
+ res = cq_frinit (cq, catfmt)
+ if (res == NULL)
+ return (NULL)
+
+ # Read in the results.
+ iferr {
+
+ # Open the output spool file.
+ call smark (sp)
+ call salloc (spfname, SZ_FNAME, TY_CHAR)
+ call mktemp ("query", Memc[spfname], SZ_FNAME)
+ #CQ_RFD(res) = open ("dev$null", READ_WRITE, SPOOL_FILE)
+ CQ_RFD(res) = open (Memc[spfname], READ_WRITE, SPOOL_FILE)
+ call sfree (sp)
+
+ # Get the data.
+ call malloc (inbuf, DEF_SZ_INBUF, TY_CHAR)
+ repeat {
+ nchars = read (fd, Memc[inbuf], DEF_SZ_INBUF)
+ if (nchars > 0) {
+ Memc[inbuf+nchars] = EOS
+ call write (CQ_RFD(res), Memc[inbuf], nchars)
+ done = false
+ } else {
+ done = true
+ }
+ } until (done)
+
+ # Cleanup.
+ call flush (CQ_RFD(res))
+ call mfree (inbuf, TY_CHAR)
+ CQ_RBUF(res) = fstati (CQ_RFD(res), F_BUFPTR)
+ call close (fd)
+
+ } then {
+ call cq_rfree (res)
+ call close (fd)
+ return (NULL)
+ }
+
+ # Construct the record index.
+ CQ_RNRECS(res) = 0
+ switch (CQ_RTYPE(res)) {
+ case CQ_STEXT, CQ_BTEXT:
+
+ # Initialize.
+ nlines = 0
+ nrecs = 0
+
+ # Iniitialize the index array.
+ szindex = DEF_SZ_INDEX
+ call malloc (line, SZ_LINE, TY_CHAR)
+ call calloc (CQ_RINDEX(res), szindex, TY_LONG)
+
+ # Create the index array.
+ call seek (CQ_RFD(res), BOF)
+ repeat {
+ Meml[CQ_RINDEX(res)+nrecs] = note (CQ_RFD(res))
+ nchars = getline (CQ_RFD(res), Memc[line])
+ if (nchars == EOF)
+ break
+ nlines = nlines + 1
+ if (nlines <= CQ_RHSKIP(res))
+ next
+ if (Memc[line] == '\n')
+ next
+ if (Memc[line] == '#')
+ next
+ #if (CQ_RECSIZE(res) > 0 && nchars != CQ_RECSIZE(res))
+ if (CQ_RECSIZE(res) > 0 && nchars > CQ_RECSIZE(res))
+ Meml[CQ_RINDEX(res)+nrecs] = EOF
+ else if (CQ_RTRIML(res) > 0 || CQ_RTRIMR(res) > 0) {
+ inbuf = CQ_RBUF(res) + Meml[CQ_RINDEX(res)+nrecs] - 1
+ do j = 1, min (CQ_RTRIML(res), nchars)
+ Memc[inbuf+j-1] = ' '
+ do j = nchars - CQ_RTRIMR(res), nchars - 1
+ Memc[inbuf+j-1] = ' '
+ }
+ nrecs = nrecs + 1
+ if (nrecs >= szindex) {
+ szindex = szindex + DEF_SZ_INDEX
+ call realloc (CQ_RINDEX(res), szindex, TY_LONG)
+ call aclrl (Meml[CQ_RINDEX(res)+szindex-DEF_SZ_INDEX],
+ DEF_SZ_INDEX)
+ }
+ }
+ call mfree (line, TY_CHAR)
+ CQ_RNRECS(res) = nrecs
+
+ # Check for and reject short records and trim trailing records.
+ nrecs = 0
+ do j = 0, CQ_RNRECS(res) - CQ_RTSKIP(res) - 1 {
+ if (Meml[CQ_RINDEX(res)+j] == EOF)
+ next
+ Meml[CQ_RINDEX(res)+nrecs] = Meml[CQ_RINDEX(res)+j]
+ nrecs = nrecs + 1
+ }
+ CQ_RNRECS(res) = nrecs
+
+ # Trim the trailing records.
+ call realloc (CQ_RINDEX(res), max (1, CQ_RNRECS(res) + 1), TY_LONG)
+
+ default:
+ ;
+ }
+
+ return (res)
+end
+
+
+# CQ_RCLOSE -- Close the results structure,
+
+procedure cq_rclose (res)
+
+pointer res #U the results descriptor.
+
+begin
+ call cq_rfree (res)
+end
+
+
+# CQ_RINIT -- Initialize a results descriptor.
+
+pointer procedure cq_rinit (cq)
+
+pointer cq #I the catalog descriptor
+
+pointer cc, res, sp, query, value, kname, fname, funits, ffmt
+int i, ncount, sz1, sz2, sz3, op1, op2, op3, foffset, fsize
+char ftype
+int cq_wrdstr(), strdic(), cq_dgeti(), cq_dscan(), nscan()
+int cq_dtype(), strlen(), gstrcpy()
+errchk cq_dgwrd(), cq_dgeti(), cq_dscan()
+
+begin
+ # Check that the current catalog is defined.
+ if (CQ_CAT(cq) == NULL)
+ return (NULL)
+ if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+ return (NULL)
+ cc = CQ_CAT(cq)
+
+ # Allocate the results structure.
+ call calloc (res, CQ_LEN_RES, TY_STRUCT)
+
+ # Format the query.
+ call smark (sp)
+ call salloc (query, SZ_LINE, TY_CHAR)
+ call salloc (value, CQ_SZ_QPVALUE, TY_CHAR)
+ call sprintf (Memc[query], SZ_LINE, CQ_QUERY(cc))
+ do i = 1, CQ_NQPARS(cc) {
+ if (cq_wrdstr (i, Memc[value], CQ_SZ_QPVALUE,
+ Memc[CQ_PQPVALUES(cc)]) <= 0)
+ next
+ call pargstr (Memc[value])
+ }
+
+ # Save the catalog informaton and query in the results structure.
+ call strcpy (CQ_CATDB(cq), CQ_RCATDB(res), SZ_FNAME)
+ call strcpy (CQ_CATNAME(cq), CQ_RCATNAME(res), SZ_FNAME)
+ call strcpy (CQ_ADDRESS(cc), CQ_RADDRESS(res), SZ_LINE)
+ call strcpy (Memc[query], CQ_RQUERY(res), SZ_LINE)
+
+ # Copy the query parameters to the results descriptor.
+ CQ_RNQPARS(res) = CQ_NQPARS(cc)
+ fsize = strlen (Memc[CQ_PQPNAMES(cc)])
+ call malloc (CQ_RQPNAMES(res), fsize, TY_CHAR)
+ call strcpy (Memc[CQ_PQPNAMES(cc)], Memc[CQ_RQPNAMES(res)], fsize)
+ fsize = strlen (Memc[CQ_PQPVALUES(cc)])
+ call malloc (CQ_RQPVALUES(res), fsize, TY_CHAR)
+ call strcpy (Memc[CQ_PQPVALUES(cc)], Memc[CQ_RQPVALUES(res)], fsize)
+ fsize = strlen (Memc[CQ_PQPUNITS(cc)])
+ call malloc (CQ_RQPUNITS(res), fsize, TY_CHAR)
+ call strcpy (Memc[CQ_PQPUNITS(cc)], Memc[CQ_RQPUNITS(res)], fsize)
+
+ # Get the input data type.
+ iferr {
+ call cq_dgwrd (cq, CQ_CATNO(cq), "type", Memc[value],
+ CQ_SZ_QPVALUE)
+ } then {
+ Memc[value] = EOS
+ CQ_RTYPE(res) = CQ_STEXT
+ } else {
+ CQ_RTYPE(res) = strdic (Memc[value], Memc[value], CQ_SZ_QPVALUE,
+ CQ_RTYPESTR)
+ }
+
+ # Get the number of leading and trailing records to be skipped.
+ iferr (CQ_RHSKIP(res) = cq_dgeti (cq, CQ_CATNO(cq), "hskip"))
+ CQ_RHSKIP(res) = 0
+ iferr (CQ_RTSKIP(res) = cq_dgeti (cq, CQ_CATNO(cq), "tskip"))
+ CQ_RTSKIP(res) = 0
+
+ # Get the record size and trimming parameters.
+ iferr (CQ_RECSIZE(res) = cq_dgeti (cq, CQ_CATNO(cq), "recsize"))
+ CQ_RECSIZE(res) = 0
+ iferr (CQ_RTRIML(res) = cq_dgeti (cq, CQ_CATNO(cq), "triml"))
+ CQ_RTRIML(res) = 0
+ iferr (CQ_RTRIMR(res) = cq_dgeti (cq, CQ_CATNO(cq), "trimr"))
+ CQ_RTRIMR(res) = 0
+
+ iferr (CQ_NHEADER(res) = cq_dgeti (cq, CQ_CATNO(cq), "nheader"))
+ CQ_NHEADER(res) = 0
+
+ # Get the header parameters.
+ call calloc (CQ_HKNAMES(res), SZ_LINE, TY_CHAR)
+ call calloc (CQ_HKVALUES(res), SZ_LINE, TY_CHAR)
+ ncount = 0
+ if (CQ_NHEADER(res) > 0) {
+
+ # Initialize the header parameter keywords and values.
+ sz1 = SZ_LINE; op1 = 2
+ sz2 = SZ_LINE; op2 = 2
+ call strcpy ("|", Memc[CQ_HKNAMES(res)], sz1)
+ call strcpy ("|", Memc[CQ_HKVALUES(res)], sz2)
+
+ call salloc (kname, CQ_SZ_FNAME, TY_CHAR)
+ do i = 1, CQ_NHEADER(res) {
+
+ # Get the keyword and value.
+ if (cq_dscan (cq) == EOF)
+ break
+ call gargwrd (Memc[kname], CQ_SZ_QPNAME)
+ call gargwrd (Memc[query], SZ_LINE)
+ if (nscan() != 2)
+ break
+
+ # Add the keyword name to the list.
+ if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+ sz1 = sz1 + SZ_LINE
+ call realloc (CQ_HKNAMES(res), sz1, TY_CHAR)
+ }
+ op1 = op1 + gstrcpy (Memc[kname], Memc[CQ_HKNAMES(res)+op1-1],
+ sz1 - op1 + 1)
+ op1 = op1 + gstrcpy ("|", Memc[CQ_HKNAMES(res)+op1-1],
+ sz1 - op1 + 1)
+
+ # Add the keyword value to the list.
+ if ((sz2 - op2 + 1) < (CQ_SZ_QPVALUE + 1)) {
+ sz2 = sz2 + SZ_LINE
+ call realloc (CQ_HKVALUES(res), sz2, TY_CHAR)
+ }
+ op2 = op2 + gstrcpy (Memc[query], Memc[CQ_HKVALUES(res)+op2-1],
+ sz2 - op2 + 1)
+ op2 = op2 + gstrcpy ("|", Memc[CQ_HKVALUES(res)+op2-1],
+ sz2 - op2 + 1)
+
+ ncount = ncount + 1
+ }
+ }
+
+ # Resize the header keyword and value arrays.
+ if (ncount != CQ_NHEADER(res)) {
+ CQ_NHEADER(res) = 0
+ call realloc (CQ_HKNAMES(res), 1, TY_CHAR)
+ call realloc (CQ_HKVALUES(res), 1, TY_CHAR)
+ Memc[CQ_HKNAMES(res)] = EOS
+ Memc[CQ_HKVALUES(res)] = EOS
+ } else {
+ call realloc (CQ_HKNAMES(res), op1, TY_CHAR)
+ call realloc (CQ_HKVALUES(res), op2, TY_CHAR)
+ Memc[CQ_HKNAMES(res)+op1] = EOS
+ Memc[CQ_HKVALUES(res)+op2] = EOS
+ }
+
+ iferr (CQ_NFIELDS(res) = cq_dgeti (cq, CQ_CATNO(cq), "nfields"))
+ CQ_NFIELDS(res) = 0
+
+ # Allocate the field description arrays.
+ call calloc (CQ_FNAMES(res), SZ_LINE, TY_CHAR)
+ call calloc (CQ_FOFFSETS(res), CQ_NFIELDS(res), TY_INT)
+ call calloc (CQ_FSIZES(res), CQ_NFIELDS(res), TY_INT)
+ call calloc (CQ_FTYPES(res), CQ_NFIELDS(res), TY_INT)
+ call calloc (CQ_FUNITS(res), SZ_LINE, TY_CHAR)
+ call calloc (CQ_FFMTS(res), SZ_LINE, TY_CHAR)
+
+ # Get the field decoding parameters.
+ ncount = 0
+ if (CQ_NFIELDS(res) > 0) {
+
+ call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+ call salloc (funits, CQ_SZ_FUNITS, TY_CHAR)
+ call salloc (ffmt, CQ_SZ_FFMTS, TY_CHAR)
+
+ # Initialize the name, units, and format string dictionaries.
+ sz1 = SZ_LINE; op1 = 2
+ sz2 = SZ_LINE; op2 = 2
+ sz3 = SZ_LINE; op3 = 2
+ call strcpy ("|", Memc[CQ_FNAMES(res)], sz1)
+ call strcpy ("|", Memc[CQ_FUNITS(res)], sz2)
+ call strcpy ("|", Memc[CQ_FFMTS(res)], sz3)
+
+ do i =1, CQ_NFIELDS(res) {
+
+ # Get the field description.
+ if (cq_dscan (cq) == EOF)
+ break
+ call gargwrd (Memc[fname], CQ_SZ_FNAME)
+ call gargi (foffset)
+ call gargi (fsize)
+ call gargc (ftype)
+ call gargwrd (Memc[funits], CQ_SZ_FUNITS)
+ call gargwrd (Memc[ffmt], CQ_SZ_FFMTS)
+ if (nscan() != 6)
+ break
+
+ # Add the field name to the field name dictionary.
+ if ((sz1 - op1 + 1) < (CQ_SZ_FNAME + 1)) {
+ sz1 = sz1 + SZ_LINE
+ call realloc (CQ_FNAMES(res), sz1, TY_CHAR)
+ }
+ op1 = op1 + gstrcpy (Memc[fname], Memc[CQ_FNAMES(res)+op1-1],
+ sz1 - op1 + 1)
+ op1 = op1 + gstrcpy ("|", Memc[CQ_FNAMES(res)+op1-1],
+ sz1 - op1 + 1)
+
+ # Set the field offset, size, and type.
+ Memi[CQ_FOFFSETS(res)+i-1] = foffset
+ Memi[CQ_FTYPES(res)+i-1] = cq_dtype (ftype)
+ Memi[CQ_FSIZES(res)+i-1] = fsize
+
+ # Add the field units to the field units dictionary.
+ if ((sz2 - op2 + 1) < (CQ_SZ_FUNITS + 1)) {
+ sz2 = sz2 + SZ_LINE
+ call realloc (CQ_FUNITS(res), sz2, TY_CHAR)
+ }
+ op2 = op2 + gstrcpy (Memc[funits], Memc[CQ_FUNITS(res)+op2-1],
+ sz2 - op2 + 1)
+ op2 = op2 + gstrcpy ("|", Memc[CQ_FUNITS(res)+op2-1],
+ sz2 - op2 + 1)
+
+ # Add the field format to the field format dictionary.
+ if ((sz3 - op3 + 1) < (CQ_SZ_FFMTS + 1)) {
+ sz3 = sz3 + SZ_LINE
+ call realloc (CQ_FFMTS(res), sz3, TY_CHAR)
+ }
+ op3 = op3 + gstrcpy (Memc[ffmt], Memc[CQ_FFMTS(res)+op3-1],
+ sz3 - op3 + 1)
+ op3 = op3 + gstrcpy ("|", Memc[CQ_FFMTS(res)+op3-1],
+ sz3 - op3 + 1)
+
+ ncount = ncount + 1
+ }
+ }
+
+ # Adjust the field description size.
+ if (ncount != CQ_NFIELDS(res)) {
+ CQ_NFIELDS(res) = 0
+ call realloc (CQ_FNAMES(res), 1, TY_CHAR)
+ Memc[CQ_FNAMES(res)] = EOS
+ call mfree (CQ_FOFFSETS(res), TY_INT); CQ_FOFFSETS(res) = NULL
+ call mfree (CQ_FSIZES(res), TY_INT); CQ_FSIZES(res) = NULL
+ call mfree (CQ_FTYPES(res), TY_INT); CQ_FTYPES(res) = NULL
+ call realloc (CQ_FUNITS(res), 1, TY_CHAR)
+ Memc[CQ_FUNITS(res)] = EOS
+ call realloc (CQ_FFMTS(res), 1, TY_CHAR)
+ Memc[CQ_FFMTS(res)] = EOS
+ } else {
+ call realloc (CQ_FNAMES(res), op1, TY_CHAR)
+ call realloc (CQ_FUNITS(res), op2, TY_CHAR)
+ call realloc (CQ_FFMTS(res), op3, TY_CHAR)
+ Memc[CQ_FNAMES(res)+op1] = EOS
+ Memc[CQ_FUNITS(res)+op2] = EOS
+ Memc[CQ_FFMTS(res)+op3] = EOS
+ }
+
+ # Allocate space for the simple text field indices array.
+ call calloc (CQ_FINDICES(res), CQ_MAX_NFIELDS + 1, TY_INT)
+
+ # Initilize the records descriptor.
+ CQ_RFD(res) = NULL
+
+ call sfree (sp)
+
+ return (res)
+end
+
+
+# Temporary definitions to get stuff working. Move into header file at some
+# point ?
+
+define DIC_FNAMES "|type|hskip|tskip|recsize|triml|trimr|nheader|nfields|"
+define DIC_TYPE 1
+define DIC_HSKIP 2
+define DIC_TSKIP 3
+define DIC_RECORD 4
+define DIC_TRIML 5
+define DIC_TRIMR 6
+define DIC_NHEADER 7
+define DIC_NFIELDS 8
+
+# CQ_FRINIT -- Initialize a results descriptor from a file description.
+
+pointer procedure cq_frinit (cq, catfmt)
+
+pointer cq #I Initialize the results structure.
+char catfmt[ARB] #I the catalog format desciption
+
+pointer res, sp, fname, funits, ffmt, fvalue
+int i, ncount, sz1, sz2, sz3, op1, op2, op3, fd, foffset, fsize
+int fscan(), nscan(), strdic(), strlen(), cq_dtype(), gstrcpy()
+char ftype
+int stropen()
+
+begin
+ # Check that the current catalog is defined.
+ if (CQ_CAT(cq) == NULL)
+ return (NULL)
+ if (CQ_CATNO(cq) < 1 || CQ_CATNO(cq) > CQ_NRECS(cq))
+ return (NULL)
+
+ # Allocate the structure.
+ call calloc (res, CQ_LEN_RES, TY_STRUCT)
+
+ # Format the catalog information, the address, query, and query
+ # parameters.
+ call strcpy (CQ_CATDB(cq), CQ_RCATDB(res), SZ_LINE)
+ call strcpy (CQ_CATNAME(cq), CQ_RCATNAME(res), SZ_LINE)
+ call strcpy ("", CQ_RADDRESS(res), SZ_LINE)
+ call strcpy ("", CQ_RQUERY(res), SZ_LINE)
+ CQ_RNQPARS(res) = 0
+ call malloc (CQ_RQPNAMES(res), 1, TY_CHAR)
+ call malloc (CQ_RQPVALUES(res), 1, TY_CHAR)
+ call malloc (CQ_RQPUNITS(res), 1, TY_CHAR)
+ Memc[CQ_RQPNAMES(res)] = EOS
+ Memc[CQ_RQPVALUES(res)] = EOS
+ Memc[CQ_RQPUNITS(res)] = EOS
+
+ # Set default file formats.
+ CQ_RTYPE(res) = CQ_STEXT
+ CQ_RHSKIP(res) = 0
+ CQ_RTSKIP(res) = 0
+ CQ_RECSIZE(res) = 0
+ CQ_RTRIML(res) = 0
+ CQ_RTRIMR(res) = 0
+ CQ_NFIELDS(res) = 0
+
+ call smark(sp)
+ call salloc (fname, CQ_SZ_FNAME, TY_CHAR)
+ call salloc (funits, CQ_SZ_FUNITS, TY_CHAR)
+ call salloc (ffmt, CQ_SZ_FFMTS, TY_CHAR)
+ call salloc (fvalue, SZ_LINE, TY_CHAR)
+
+ # Read in the defined file formats.
+ fd = stropen (catfmt, strlen (catfmt), READ_ONLY)
+ while (fscan (fd) != EOF) {
+
+ # Get the field name.
+ call gargwrd (Memc[fname], CQ_SZ_FNAME)
+ if (nscan () < 1 || Memc[fname] == EOS)
+ next
+ i = strdic (Memc[fname], Memc[fname], CQ_SZ_FNAME, DIC_FNAMES)
+
+ # Decode the field.
+ switch (i) {
+
+ case DIC_TYPE:
+ call gargwrd (Memc[fname], CQ_SZ_FNAME)
+ if (nscan () < 2 || Memc[fname] == EOS)
+ CQ_RTYPE(res) = CQ_STEXT
+ else
+ CQ_RTYPE(res) = strdic (Memc[fname], Memc[fname],
+ CQ_SZ_FNAME, CQ_RTYPESTR)
+
+ case DIC_HSKIP:
+ call gargi (CQ_RHSKIP(res))
+ if (nscan() < 2)
+ CQ_RHSKIP(res) = 0
+
+ case DIC_TSKIP:
+ call gargi (CQ_RTSKIP(res))
+ if (nscan() < 2)
+ CQ_RTSKIP(res) = 0
+
+ case DIC_RECORD:
+ call gargi (CQ_RECSIZE(res))
+ if (nscan() < 2)
+ CQ_RECSIZE(res) = 0
+
+ case DIC_TRIML:
+ call gargi (CQ_RTRIML(res))
+ if (nscan() < 2)
+ CQ_RTRIML(res) = 0
+
+ case DIC_TRIMR:
+ call gargi (CQ_RTRIMR(res))
+ if (nscan() < 2)
+ CQ_RTRIMR(res) = 0
+
+ case DIC_NHEADER:
+ call gargi (CQ_NHEADER(res))
+ if (nscan() < 2)
+ CQ_NHEADER(res) = 0
+
+ call calloc (CQ_HKNAMES(res), SZ_LINE, TY_CHAR)
+ call calloc (CQ_HKVALUES(res), SZ_LINE, TY_CHAR)
+
+ ncount = 0
+ if (CQ_NHEADER(res) > 0) {
+
+ # Initialize the header name and value dictionaries.
+ sz1 = SZ_LINE; op1 = 2
+ sz2 = SZ_LINE; op2 = 2
+ call strcpy ("|", Memc[CQ_HKNAMES(res)], sz1)
+ call strcpy ("|", Memc[CQ_HKVALUES(res)], sz2)
+
+ do i = 1, CQ_NHEADER(res) {
+
+ # Get the keyword name and value.
+ if (fscan (fd) == EOF)
+ break
+ call gargwrd (Memc[fname], CQ_SZ_QPNAME)
+ call gargwrd (Memc[fvalue], SZ_LINE)
+ if (nscan() != 2)
+ break
+
+ # Add the keyword name to the keyword dictionary.
+ if ((sz1 - op1 + 1) < (CQ_SZ_QPNAME + 1)) {
+ sz1 = sz1 + SZ_LINE
+ call realloc (CQ_HKNAMES(res), sz1, TY_CHAR)
+ }
+ op1 = op1 + gstrcpy (Memc[fname], Memc[CQ_HKNAMES(res)+
+ op1-1], sz1 - op1 + 1)
+ op1 = op1 + gstrcpy ("|", Memc[CQ_HKNAMES(res)+op1-1],
+ sz1 - op1 + 1)
+
+ # Add the keyword value to the keyword value dictionary.
+ if ((sz2 - op2 + 1) < (CQ_SZ_QPVALUE + 1)) {
+ sz2 = sz2 + SZ_LINE
+ call realloc (CQ_HKVALUES(res), sz2, TY_CHAR)
+ }
+ op2 = op2 + gstrcpy (Memc[fvalue],
+ Memc[CQ_HKVALUES(res)+ op2-1], sz2 - op2 + 1)
+ op2 = op2 + gstrcpy ("|", Memc[CQ_HKVALUES(res)+op2-1],
+ sz2 - op2 + 1)
+
+ ncount = ncount + 1
+ }
+ }
+
+ # Addjust the keyword dictionary sizes.
+ if (ncount != CQ_NHEADER(res)) {
+ CQ_NHEADER(res) = 0
+ call realloc (CQ_HKNAMES(res), 1, TY_CHAR)
+ call realloc (CQ_HKVALUES(res), 1, TY_CHAR)
+ Memc[CQ_HKNAMES(res)] = EOS
+ Memc[CQ_HKVALUES(res)] = EOS
+ } else {
+ call realloc (CQ_HKNAMES(res), op1, TY_CHAR)
+ call realloc (CQ_HKVALUES(res), op2, TY_CHAR)
+ Memc[CQ_HKNAMES(res)+op1] = EOS
+ Memc[CQ_HKVALUES(res)+op2] = EOS
+ }
+
+ case DIC_NFIELDS:
+ call gargi (CQ_NFIELDS(res))
+ if (nscan() < 2)
+ CQ_NFIELDS(res) = 0
+
+ # Allocate space for the field descriptors.
+ call calloc (CQ_FNAMES(res), SZ_LINE, TY_CHAR)
+ call calloc (CQ_FOFFSETS(res), CQ_NFIELDS(res), TY_INT)
+ call calloc (CQ_FSIZES(res), CQ_NFIELDS(res), TY_INT)
+ call calloc (CQ_FTYPES(res), CQ_NFIELDS(res), TY_INT)
+ call calloc (CQ_FUNITS(res), SZ_LINE, TY_CHAR)
+ call calloc (CQ_FFMTS(res), SZ_LINE, TY_CHAR)
+
+ ncount = 0
+ if (CQ_NFIELDS(res) > 0) {
+
+ sz1 = SZ_LINE; op1 = 2
+ sz2 = SZ_LINE; op2 = 2
+ sz3 = SZ_LINE; op3 = 2
+ call strcpy ("|", Memc[CQ_FNAMES(res)], sz1)
+ call strcpy ("|", Memc[CQ_FUNITS(res)], sz2)
+ call strcpy ("|", Memc[CQ_FFMTS(res)], sz3)
+
+ do i = 1, CQ_NFIELDS(res) {
+
+ # Get the field description.
+ if (fscan (fd) == EOF)
+ break
+ call gargwrd (Memc[fname], CQ_SZ_FNAME)
+ call gargi (foffset)
+ call gargi (fsize)
+ call gargc (ftype)
+ call gargwrd (Memc[funits], CQ_SZ_FUNITS)
+ call gargwrd (Memc[ffmt], CQ_SZ_FFMTS)
+ if (nscan() != 6)
+ break
+
+ # Add the field name to the field name dictionary.
+ if ((sz1 - op1 + 1) < (CQ_SZ_FNAME + 1)) {
+ sz1 = sz1 + SZ_LINE
+ call realloc (CQ_FNAMES(res), sz1, TY_CHAR)
+ }
+ op1 = op1 + gstrcpy (Memc[fname], Memc[CQ_FNAMES(res)+
+ op1-1], sz1 - op1 + 1)
+ op1 = op1 + gstrcpy ("|", Memc[CQ_FNAMES(res)+op1-1],
+ sz1 - op1 + 1)
+
+ Memi[CQ_FOFFSETS(res)+i-1] = foffset
+ Memi[CQ_FTYPES(res)+i-1] = cq_dtype (ftype)
+ Memi[CQ_FSIZES(res)+i-1] = fsize
+
+ # Add the field units to the field units dictionary.
+ if ((sz2 - op2 + 1) < (CQ_SZ_FUNITS + 1)) {
+ sz2 = sz2 + SZ_LINE
+ call realloc (CQ_FUNITS(res), sz2, TY_CHAR)
+ }
+ op2 = op2 + gstrcpy (Memc[funits],
+ Memc[CQ_FUNITS(res)+ op2-1], sz2 - op2 + 1)
+ op2 = op2 + gstrcpy ("|", Memc[CQ_FUNITS(res)+op2-1],
+ sz2 - op2 + 1)
+
+ # Add the field format to the field formats dictionary.
+ if ((sz3 - op3 + 1) < (CQ_SZ_FFMTS + 1)) {
+ sz3 = sz3 + SZ_LINE
+ call realloc (CQ_FFMTS(res), sz3, TY_CHAR)
+ }
+ op3 = op3 + gstrcpy (Memc[ffmt],
+ Memc[CQ_FFMTS(res)+ op3 -1], sz3 - op3 + 1)
+ op3 = op3 + gstrcpy ("|", Memc[CQ_FFMTS(res)+op3-1],
+ sz3 - op3 + 1)
+
+ ncount = ncount + 1
+ }
+ }
+ if (ncount != CQ_NFIELDS(res)) {
+ CQ_NFIELDS(res) = 0
+ call realloc (CQ_FNAMES(res), 1, TY_CHAR)
+ Memc[CQ_FNAMES(res]) = EOS
+ call mfree (CQ_FOFFSETS(res), TY_INT)
+ CQ_FOFFSETS(res) = NULL
+ call mfree (CQ_FSIZES(res), TY_INT)
+ CQ_FSIZES(res) = NULL
+ call mfree (CQ_FTYPES(res), TY_INT)
+ CQ_FTYPES(res) = NULL
+ call realloc (CQ_FUNITS(res), 1, TY_CHAR)
+ Memc[CQ_FUNITS(res)] = EOS
+ call realloc (CQ_FFMTS(res), 1, TY_CHAR)
+ Memc[CQ_FFMTS(res)] = EOS
+ } else {
+ call realloc (CQ_FNAMES(res), op1, TY_CHAR)
+ call realloc (CQ_FUNITS(res), op2, TY_CHAR)
+ call realloc (CQ_FFMTS(res), op3, TY_CHAR)
+ Memc[CQ_FNAMES(res]+op1) = EOS
+ Memc[CQ_FUNITS(res)+op2] = EOS
+ Memc[CQ_FFMTS(res)+op3] = EOS
+ }
+ default:
+ ;
+ }
+ }
+ call close (fd)
+ call sfree (sp)
+
+ # Allocate space for the field indices array.
+ call calloc (CQ_FINDICES(res), CQ_MAX_NFIELDS + 1, TY_INT)
+
+ # Initilize the records descriptor.
+ CQ_RFD(res) = NULL
+
+ return (res)
+end
+
+
+# CQ_RFREE -- Free the results structure.
+
+procedure cq_rfree (res)
+
+pointer res #U the results descriptor.
+
+begin
+ # Free the query parameter names, values, and units.
+ if (CQ_RQPNAMES(res) != NULL)
+ call mfree (CQ_RQPNAMES(res), TY_CHAR)
+ if (CQ_RQPVALUES(res) != NULL)
+ call mfree (CQ_RQPVALUES(res), TY_CHAR)
+ if (CQ_RQPUNITS(res) != NULL)
+ call mfree (CQ_RQPUNITS(res), TY_CHAR)
+
+ # Free the header names and values.
+ if (CQ_HKNAMES(res) != NULL)
+ call mfree (CQ_HKNAMES(res), TY_CHAR)
+ if (CQ_HKVALUES(res) != NULL)
+ call mfree (CQ_HKVALUES(res), TY_CHAR)
+
+ # Free the field offsets, sizes, and types.
+ if (CQ_FNAMES(res) != NULL)
+ call mfree (CQ_FNAMES(res), TY_CHAR)
+ if (CQ_FOFFSETS(res) != NULL)
+ call mfree (CQ_FOFFSETS(res), TY_INT)
+ if (CQ_FSIZES(res) != NULL)
+ call mfree (CQ_FSIZES(res), TY_INT)
+ if (CQ_FTYPES(res) != NULL)
+ call mfree (CQ_FTYPES(res), TY_INT)
+ if (CQ_FUNITS(res) != NULL)
+ call mfree (CQ_FUNITS(res), TY_CHAR)
+ if (CQ_FFMTS(res) != NULL)
+ call mfree (CQ_FFMTS(res), TY_CHAR)
+
+ # Free the record description.
+ if (CQ_FINDICES(res) != NULL)
+ call mfree (CQ_FINDICES(res), TY_INT)
+
+ # Free the record buffer.
+ if (CQ_RINDEX(res) != NULL)
+ call mfree (CQ_RINDEX(res), TY_LONG)
+ if (CQ_RFD(res) != NULL)
+ call close (CQ_RFD(res))
+
+ if (res != NULL)
+ call mfree (res, TY_STRUCT)
+end
generated by cgit (git 2.34.1) at 2025-09-20 08:41:54 -0400