
/* $Id: curltest.q,v 1.6 2007/09/29 08:50:07 agraef Exp $

   curltest.q: Some simple examples showing how to use curl to perform basic
   URL transfer operations. These are just more or less literal translations
   of some of the sample C programs on the libcurl website. */

import curl, system;

/* Define a simple error handler which just aborts with an error message. */

curl_error CODE MSG
= fprintf ERROR "curl returned error code %d%s\n"
  (CODE,ifelse (null MSG) "" (sprintf ": %s" MSG)) || fflush ERROR || halt;

/* For production code you'd probably prefer something like the following,
   which throws an exception instead. */

curl_error CODE MSG = throw '(curl_error CODE MSG);

/* Example #1. Go get a web page, print it on stdout. */

httptest
= curl_setopt CURL CURLOPT_URL "curl.haxx.se" || curl_perform CURL
    where CURL = curl_init;

/* Example #2. Same as above, but return the web page as a string. We use our
   own CURLOPT_WRITEFUNCTION callback here which stores the result in a byte
   string passed as a reference. */

httpmem
= curl_setopt CURL CURLOPT_URL "curl.haxx.se" ||
  curl_setopt CURL CURLOPT_WRITEFUNCTION (accum MEM) ||
  curl_perform CURL || bstr (get MEM)
    where CURL = curl_init, MEM = ref (bytestr "");

/* Our callback just appends the received data to the byte string and returns
   the number of bytes "written". */

accum MEM DATA
= put MEM (get MEM++DATA) || #DATA;

/* Example #3. Download a file via ftp. Here we employ the CURLOPT_WRITE-
   FUNCTION callback to save the result to a file. You might wish to uncomment
   the line with the CURLOPT_NOPROGRESS option to enable libcurl's builtin
   progress meter. (This requires that output goes to a terminal, otherwise
   it's better to leave this line commented out.) */

ftptest
= curl_setopt CURL CURLOPT_URL URL ||
  curl_setopt CURL CURLOPT_WRITEFUNCTION (bwrite F) ||
  // curl_setopt CURL CURLOPT_NOPROGRESS false ||
  curl_perform CURL
    where CURL = curl_init,
      URL = "ftp://ftp.sunet.se/pub/www/utilities/curl/curl-7.9.2.tar.gz",
      NAME = last (split "/" URL), F = fopen NAME "wb";

/* Example #4. Use HTTP PUT to upload a file to a given URL. NAME is the name
   of the source file to be uploaded, URL the target URL. The CURLOPT_READ-
   FUNCTION callback is used to transfer the file. This example also shows the
   use of the standard library `do' function as a convenient means to set
   multiple options collected in a list. */

httpput NAME URL
= do (uncurry (curl_setopt CURL))
  [(CURLOPT_READFUNCTION,bread F), (CURLOPT_UPLOAD,true), (CURLOPT_PUT,true),
   (CURLOPT_URL,URL), (CURLOPT_INFILESIZE,st_size (stat NAME))] ||
  curl_perform CURL
    where CURL:Curl = curl_init, F:File = fopen NAME "rb";

/* Example #5. Build a RFC1867-style form post and send it to a HTTP server.
   NAME is the name of a file to be sent, URL the target URL to post to
   (presumably the location of a cgi script which handles the request). */

httppost NAME URL
= curl_setopt CURL CURLOPT_URL URL ||
  // uncomment the following to state that Expect: 100-continue is not wanted
  // curl_setopt CURL CURLOPT_HTTPHEADER ["Expect:"] ||
  curl_setopt CURL CURLOPT_HTTPPOST
  [("sendfile", CURLFORM_FILE, NAME),
   ("filename", CURLFORM_CONTENT, NAME),
   ("submit", CURLFORM_CONTENT, "send")] ||
  curl_perform CURL
    where CURL = curl_init;

/* Example #6. Multithreaded URL fetches. Get multiple URLs at once, running
   multiple instances of CURL in different threads, one for each URL to be
   retrieved. The result is returned as a list of byte strings. */

def URLS = ["http://curl.haxx.se/",
	    "ftp://cool.haxx.se/",
	    "http://www.contactor.se/",
	    "www.haxx.se",
	    "http://q-lang.sourceforge.net/"];

multitest
= // wait until all threads are finished and return the results
  map result THREADS
    where THREADS = map (thread.fetch) URLS;

fetch URL
= curl_setopt CURL CURLOPT_URL URL ||
  curl_setopt CURL CURLOPT_WRITEFUNCTION (accum MEM) ||
  printf "started  download %s\n" URL || flush ||
  curl_perform CURL ||
  printf "finished download %s\n" URL || flush ||
  get MEM
    where CURL = curl_init, MEM = ref (bytestr "");
