/*

To: q-lang-users@lists.sourceforge.net
From: Tim Haynes <q@stirfried.vegetable.org.uk>
Subject: [q-lang-users] sharing CGI library, potential for inclusion in Q
Date: Mon, 20 Sep 2004 22:10:47 +0100

Hi,

I thought I'd share my Q module for CGI programming. It's probably pretty
crude, but it responds to POST or GET data (fail-over from former to
latter), decodes CGI strings correctly, and allows access to any/all
key/value parameters passed to a script.

Optional things: the sqlXML function requires ODBC. If you don't have it,
remove the module from the import line and don't call sqlXML. Otherwise, it
takes a handle and a query-string (assumes no parameters). 

Function description: 

public 	condstr S,      // conditionally wraps expression with `str'
	starttag T,     // makes a start-tag,  "<T>"
	endtag T,       // makes an end-taag,  "</T>"
	cgipairs,       // hash of all CGI pairs
	tag T C,        // puts content C in start/end tags T
	tagify,         // legacy name for tag
	test,           // use for debugging installation
	xmlify A B,     // builds XML from pair-list B, using A as nodenames
	cgivar S,       // returns value of CGI parameter named S
        sqlXML H Q;     // takes handle, SQL; returns XML for later XSLT


Examples:

a) testing
    #!/usr/bin/env q
    #! -cmain ARGS || quit

    import cgi;

    main = cgi::test;

this dumps a minimal HTML page with title, showing the keys found - so
invoke it as index.q?foo=bar.

b) building XML from a SQL query for later transformation - note this
should be rewritten for Q 5.4 since it has its own XML and XSLT functions
now:

    #!/usr/bin/env q
    #! -cmain ARGS || quit

    import cgi, odbc;

    def H=odbc_connect "DSN=someODBCdsn";

    main = writes (sqlXML H "select * from sometable;");

Please consider it released under the terms of the GPL, for inclusion in
some form in future versions of Q if you wish.

Cheers,

~Tim

Subject: Re: [q-lang-users] cgi.q (was: Q 6.2 is out)
From: Tim Haynes <q@stirfried.vegetable.org.uk>
Date: 19 May 2006 18:08:08 +0100
To: q-lang-users@lists.sourceforge.net

[...]

OK, I'm attaching the latest version I have in use here.

Changes: 

   * A `matches' function (equivalent of perl's "if foo=~/bar/" construct);
   * A `strictatoi' function (a wrapper around val that only works if the
string is a number - saves a risk of Q-injection! - also uses `matches')

*/

// library of useful CGI / XML functions //

// (C) Tim Haynes <q@stirfried.vegetable.org.uk> 2004
//
// Released under the terms of the GNU Public License
// see <http://www.gnu.org/licenses/gpl.txt> for more
//
//

import hdict, system, curl, odbc;

public 	qs,
	condstr S, 
	starttag T, 
	endtag T, 
	cgipairs, 
	tag,
	tagify,
	test, 
	xmlify,
	cgivar,
	cgivarstring,
        sqlXML Q,
        lines, words,
        unlines, unwords,
        pathi, strictatoi,
        stripchars,
        searchWords,
        matches;

private	
	cgis, 
        cgifmt Ls,
        fixspaces S;

//return a stringified version only if it wasn't already a string
condstr S = S if (isstr S);
	  = str S otherwise;

lines = split "\n\r";
words = split " \t";
unlines = join "\n";
unwords = join " ";

stripchars S = filter isalpha S;

//return start- and end-tags of a given name
starttag T = strcat ["<", condstr T, ">"];
endtag T   = strcat ["</", condstr T, ">"];
//taggify some content, simply
tag T C = strcat [starttag T, condstr C, endtag T, "\n"];
tagify=tag;

// read in all of stdin
readIn = "" if eof;
       = reads ++ readIn otherwise;

//get the query-string variable
qs  = S if S<>"" where S=condstr (getenv "QUERY_STRING");
    = S where S=readIn;
    = "" otherwise;

//split qs into individual CGI k/v pairs
def QS=fixspaces qs;
cgis =  split "&" QS;
cgis S =  split "&" S;
cgipartparts S=(A,B)
		where A=hd Ps,
		      B=join "=" (tl Ps)
		      where Ps=split "=" S;
cgiparts = map cgipartparts cgis;
cgipairs = map (tuple.(map curl_unescape).list) cgiparts;

//format a list of CGI (k,v) pairs in html
cgifmt Ls = strcat (map (sprintf "<div>%s => %s</div>\n") Ls);

//Retrieve a specific CGI variable
cgivar N = condstr (HD!N)
	     if any (=N) (keys HD)
	       where HD=hdict cgipairs;
	 = "" otherwise;

cgivarstring N "" = cgivar N;
cgivarstring N QS = setenv "QUERY_STRING" QS || 
              fst (cgivar N, setenv "QUERY_STRING" OLDQS)
                where OLDQS=getenv "QUERY_STRING";

searchWords = words WS ++ ["."]
              where WS=cgivarstring "q" S
              where S=(join "".(drop 1).chars.hd) 
                        (regex "" "^http://[^?]+\\?(.*)$" HR (reg 1) )
                where HR=condstr (getenv "HTTP_REFERER");

//internal testing variables
def MimeType = "Content-Type: text/html\n";
def Head="<html><head>CGI testing</head>\n";
def Head=tag "head" (tag "title" "CGI testing");
def Body=(tag "body" 
           (strcat [tag "p" "CGI pairs found:", 
             (xmlify ["div","div"] cgipairs)]));
def Page=MimeType ++ "\n"++ (tag "html" (Head ++ Body));

//a module-testing routing
test = writes Page;

//XMLify a list of tuples given a list of node-names for each nested level
xmlify [] A = fixangles A;
xmlify _ [] = "";
xmlify _ "" = "";
xmlify N D = xmlify [N] D
		if not islist N;
xmlify [N|Ns] D = "\n" ++ xmlify N (strcat (map (xmlify Ns) D)) ++ "\n"
			if islist D;
		= strcat ["<",N," id=\"",fst D,"\">", snd D, "</",N,">\n"] if istuple D;
		= strcat ["<",N,">", condstr D, "</",N,">\n"] otherwise;

//zipLots [L|Ls]= map (\N.zip (list L) (list N)) Ls;
zipLots [L|Ls] = map (zip (list L).list) Ls;

//if you don't have ODBC, remove or recode this function
sqlXML H Q = xmlify ["xml", "row", "field"] 
               (zipLots (odbc::sql H Q () ));

//sanitization routines
fixleftangle S = join "&lt;" (split "<" S);
fixrightangle S = join "&gt;" (split ">" S);
fixangles= fixleftangle.fixrightangle;
fixspaces S=join " " (split "+" S);

pathi = (tl.(split "/")) S if S<>"getenv \"PATH_INFO\""
        where S=condstr (getenv "PATH_INFO");
      = "" otherwise;

strictatoi S:String= val N if isstr N
                        where N=hd (regex "" "[0-9]+" S (reg 0));
                   = 0 otherwise;

matches R S = #(regex "" R S (true))>0;
