h dftactgrp(*no) actgrp(*new)
     h copyright('Copyright (c) 2009 by Patrick Monnerat and DATASPHERE S.A.')
     h option(*noshowcpy)
     h bnddir('CURL/CURL')
      *
     d/copy curl/h,curl.inc
      *
      **************************************************************************
      *                            Prototypes
      **************************************************************************
      *
      *  Write data callback for libcurl.
      *
     d @remotewrite    pr            10i 0
     d  buf                       65535    options(*varsize)
     d  size                         10u 0 value
     d  nmemb                        10u 0 value
     d  userdata                       *   value
      *
      *  Convert CCSID.
      *
     d @convertA2A     pr         65535    varying
     d  ccsid_to                     10u 0 value
     d  ccsid_from                   10u 0 value
     d  data                      65535    const varying
      *
      *  CCSID conversion system APIs.
      *
     d iconv_t         ds                  qualified based(#####dummyptr#####)
     d  return_value                 10i 0
     d  cd                           10i 0 dim(12)
      *
     d iconv_open      pr                  extproc('iconv_open')
     d                                     likeds(iconv_t)
     d  tocode                         *   value options(*string)               Destination CCSID
     d  fromcode                       *   value options(*string)               Source CCSID
      *
     d iconv           pr            10i 0 extproc('iconv')
     d  cd                                 value likeds(iconv_t)
     d  inbuf                          *
     d  inbytesleft                  10u 0
     d  outbuf                         *
     d  outbytesleft                 10u 0
      *
     d iconv_close     pr            10i 0 extproc('iconv_close')
     d  cd                                 value likeds(iconv_t)
      *
      **************************************************************************
      *                          Global storage
      **************************************************************************
      *
     d buffer          s          65535    varying                              Remote data buffer
     d res             s                   like(CURLcode)                       Libcurl return code
     d hcurl           s               *                                        Curl easy handle
     d dsplybuf        s             34                                         Display buffer
      *
      **************************************************************************
      *                            Main program
      **************************************************************************
      *
      /free
        //      Start libcurl.

B01     if curl_global_init(CURL_GLOBAL_ALL) <> CURLE_OK;
                dsply 'curl_global_init() failed';
X01     else;
                hcurl = curl_easy_init();

B02             if hcurl = *null;
                        dsply 'curl_easy_init() failed';
X02             else;
                        curl_easy_setopt_ccsid(hcurl: CURLOPT_URL:
                            'http://curl.haxx.se/': 0);
                        curl_easy_setopt_function(hcurl: CURLOPT_WRITEFUNCTION:
                            %paddr(@remotewrite));
                        curl_easy_setopt_long(hcurl: CURLOPT_VERBOSE: 1);       // For debug.
                        curl_easy_setopt_object(hcurl: CURLOPT_WRITEDATA:
                            %addr(buffer));
                        buffer = '';

                        res = curl_easy_perform(hcurl);

B03                     if res <> CURLE_OK;
                                dsply 'curl_easy_perform() failed';
                                dsplybuf = %str(curl_easy_strerror_ccsid(res:
                                    0));
                                dsply dsplybuf;
X03                     else;
                                //      Convert data to EBCDIC and display
                                //              first 32 characters.

                                dsplybuf = @convertA2A(0: 819: buffer);
                                dsply dsplybuf;
E03                     endif;
                        curl_easy_cleanup(hcurl);
E02             endif;

                curl_global_cleanup();
E01     endif;

        *inlr = *on;
      /end-free
      /space 3
      *@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
      *  Write data callback for libcurl.
      *@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
      *
____ p @remotewrite    b
      *
     d @remotewrite    pi            10i 0
     d  buf                       65535    options(*varsize)
     d  size                         10u 0 value
     d  nmemb                        10u 0 value
     d  userdata                       *   value
      *
     d  buffer         s          65535    varying based(userdata)
      *
      **************************************************************************
      *                            Local storage
      **************************************************************************
      *
     d i               s             10i 0
      *
      **************************************************************************
      *                           Procedure code
      **************************************************************************
      *
      /free
        nmemb = nmemb * size;           // Compute true data size.
        i = %size(buffer) - %len(buffer);

B01     if nmemb > i;
                nmemb = i;
E01     endif;

B01     if nmemb > 0;
                buffer = buffer + %subst(buf: 1: nmemb);
E01     endif;

        return %div(nmemb: size);
      /end-free
____ p @remotewrite    e
      /space 3
      *@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
      *  Convert CCSID.
      *@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
      *
____ p @convertA2A     b
      *
     d @convertA2A     pi         65535    varying
     d  ccsid_to                     10u 0 value
     d  ccsid_from                   10u 0 value
     d  data                      65535    const varying
      *
      **************************************************************************
      *                            Local storage
      **************************************************************************
      *
     d cd              ds                  likeds(iconv_t)                      Conversion descriptr
     d buffer          s          65535                                         Destination buffer
     d inbuf           s               *                                        Input pointer
     d inbytesleft     s             10u 0                                      Input byte counter
     d outbuf          s               *                                        Output pointer
     d outbytesleft    s             10u 0                                      Output byte counter
      *
      **************************************************************************
      *                           Procedure code
      **************************************************************************
      *
      /free
        cd = iconv_open('IBMCCSID' + %trim(%editw(ccsid_to: '    0     ')) +
            X'00000000000000000000000000000000000000': 'IBMCCSID' +
            %trim(%editw(ccsid_from: '    0     ')) + '0000000' +
            X'000000000000000000000000');

B01     if cd.return_value = -1;
                return '';
E01     endif;

        buffer = data;
        inbuf = %addr(buffer);
        outbuf = %addr(buffer);
        inbytesleft = %len(data);
        outbytesleft = %size(buffer);
        iconv(cd: inbuf: inbytesleft: outbuf: outbytesleft);
        iconv_close(cd);
        return %subst(buffer: 1: %size(buffer) - outbytesleft);
      /end-free
____ p @convertA2A     e