Initial commit

1 files changed, 163 insertions, 0 deletions

diff --git a/noao/astcat/src/debug/t_adumpim.x b/noao/astcat/src/debug/t_adumpim.x
new file mode 100644
index 00000000..e214b8fd
--- /dev/null
+++ b/noao/astcat/src/debug/t_adumpim.x
@@ -0,0 +1,163 @@
+include <mach.h>
+include <fset.h>
+include <pkg/cq.h>
+
+define	DEF_SZPARS	15
+define	DEF_SZBUF	28800
+
+# T_ADUMPIM -- Image survey access debugging routines.
+
+procedure t_adumpim()
+
+pointer	sp, imsurvey, output, ra, dec, size, imdb, query, buf, str
+pointer	qpname, qpvalue, qpunits, qpformats, cq
+int	i, fd, ofd, nqpars, parno, nchars
+bool	done
+
+pointer	cq_map()
+int	cq_setcat(), ndopen(), open(), cq_nqpars(), cq_gqparn(), strlen()
+int	getline(), read()
+bool	streq()
+errchk	cq_fgeti()
+
+begin
+	# Allocate some working space.
+	call smark (sp)
+	call salloc (imsurvey, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (imdb, SZ_FNAME, TY_CHAR)
+	call salloc (ra, DEF_SZPARS, TY_CHAR)
+	call salloc (dec, DEF_SZPARS, TY_CHAR)
+	call salloc (size, DEF_SZPARS, TY_CHAR)
+	call salloc (query, SZ_LINE, TY_CHAR)
+	call salloc (qpname, CQ_SZ_QPNAME, TY_CHAR)
+	call salloc (qpvalue, CQ_SZ_QPVALUE, TY_CHAR)
+	call salloc (qpunits, CQ_SZ_QPUNITS, TY_CHAR)
+	call salloc (qpformats, CQ_SZ_QPFMTS, TY_CHAR)
+	call salloc (buf, 2*DEF_SZBUF, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Get the parameters.
+	call clgstr ("imsurvey", Memc[imsurvey], SZ_FNAME)
+	call clgstr ("output", Memc[output], SZ_FNAME)
+	call clgstr ("ra", Memc[ra], DEF_SZPARS)
+	call clgstr ("dec", Memc[dec], DEF_SZPARS)
+	call clgstr ("size", Memc[size], DEF_SZPARS)
+	call clgstr ("imdb", Memc[imdb], SZ_FNAME)
+
+	# Map the image surfvey configuration file.
+	cq = cq_map (Memc[imdb], READ_ONLY)
+	if (cq == NULL) {
+	    call eprintf ("Cannot open image survey configuration file %s\n")
+		call pargstr (Memc[imdb])
+	    call sfree (sp)
+	    return
+	}
+
+	# Locate the image survey record.
+	if (cq_setcat (cq, Memc[imsurvey]) <= 0) {
+	    call eprintf ("Cannot locate image survey record %s\n")
+		call pargstr (Memc[imsurvey])
+	    call cq_unmap (cq)
+	    call sfree (sp)
+	    return
+	}
+
+	# Connect to the HTTP server.
+	call cq_fgwrd (cq, "address", Memc[str], SZ_LINE)
+	iferr (fd = ndopen (Memc[str], READ_WRITE)) {
+	    call eprintf ("Cannot access image server %s at host %s\n")
+		call pargstr (Memc[imsurvey])
+		call pargstr (Memc[str])
+	    call cq_unmap (cq)
+	    call sfree (sp)
+	    return
+	}
+
+	# Open the output file.
+        #ofd = open (Memc[output], NEW_FILE, BINARY_FILE)
+        ofd = open (Memc[output], NEW_FILE, TEXT_FILE)
+
+        # Format the query without worrying about coordinate systems,
+        # or formats. Just assume that the user types in ra, dec, and
+        # size in the form expected by the server.
+
+        call cq_fgstr (cq, "query", Memc[query], SZ_LINE)
+        nqpars = cq_nqpars (cq)
+        call sprintf (Memc[str], SZ_LINE, Memc[query])
+        do i = 1, nqpars {
+
+            # Get description of each query parameter.
+            parno = cq_gqparn (cq, i, Memc[qpname], CQ_SZ_QPNAME,
+                Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpunits], CQ_SZ_QPUNITS,
+                Memc[qpformats], CQ_SZ_QPFMTS)
+
+            # Pass the parameters to the query string.
+            if (streq (Memc[qpname], "ra")) {
+                call pargstr (Memc[ra])
+            } else if (streq (Memc[qpname], "dec")) {
+                call pargstr (Memc[dec])
+            } else if (streq (Memc[qpname], "width")) {
+                call pargstr (Memc[size])
+            } else if (streq (Memc[qpname], "xwidth")) {
+                call pargstr (Memc[size])
+            } else if (streq (Memc[qpname], "ywidth")) {
+                call pargstr (Memc[size])
+            } else if (streq (Memc[qpname], "radius")) {
+                call pargstr (Memc[size])
+            } else {
+                call pargstr (Memc[qpvalue])
+            }
+
+        }
+
+	# Send the query. Note that since the communication mode and output
+	# file type are binary the command must be converted from IRAF chars
+	# type byte chars. Leave as text for now since it works for FITS
+	# files.
+
+        nchars = strlen (Memc[str])
+        #call chrpak (Memc[str], 1, Memc[str], 1, nchars)
+        #call awriteb (fd, Memc[str], nchars, 1)
+        #nread = awaitb (fd)
+	call write (fd, Memc[str], nchars)
+	call flush (fd)
+	call fseti (fd, F_CANCEL, OK)
+
+	# Read the reply. Skip the HTTP header assuming it ends with a \n or
+	# a \r\n.
+        call cq_fgstr (cq, "protocol", Memc[str], SZ_LINE)
+	if (streq (Memc[str], "http")) {
+	    repeat {
+	        nchars = getline (fd, Memc[buf])
+	        if (nchars <= 0)
+		    break
+	        Memc[buf+nchars] = EOS
+	    } until ((Memc[buf] == '\r' && Memc[buf+1] == '\n') ||
+	        (Memc[buf] == '\n'))
+	}
+
+	repeat {
+	    nchars = read (fd, Memc[buf], DEF_SZBUF)
+	    if (nchars > 0) {
+		Memc[buf+nchars] = EOS
+		call write (ofd, Memc[buf], nchars)
+		done = false
+	    } else {
+		done =true
+	    }
+	 } until (done)
+
+	call flush (ofd)
+
+	# Close the output image.
+	call close (ofd)
+
+	# Close the network connection.
+	call close (fd)
+
+	# Unmap the database.
+	call cq_unmap (cq)
+
+	call sfree (sp)
+end