HTTP: Difference between revisions

6,009 bytes removed ,  3 years ago
Cleaned up program and made clearer whitespace wise. Removed output as should be the same for all languages. Cleaned up both parts.
(Fixed URL and whitespace.)
(Cleaned up program and made clearer whitespace wise. Removed output as should be the same for all languages. Cleaned up both parts.)
Line 288:
 
=={{header|COBOL}}==
 
Tested with GnuCOBOL
<lang cobol>COBOL
 
identification division.
<lang cobol>COBOL >>SOURCE FORMAT IS FIXED
identification division.
program-id. curl-rosetta.
 
environment division.
configuration section.
repository.
function read-url
function all intrinsic.
 
data division.
working-storage section.
 
copy "gccurlsym.cpy".
 
01 web-page pic x(16777216).
01 curl-status usage binary-long.
 
01 cli pic x(7) external.
88 helping values "-h", "-help", "help", spaces.
88 displaying value "display".
88 summarizing value "summary".
 
*> ***************************************************************
procedure division.
accept cli from command-line
if helping then
display "./curl-rosetta [help|display|summary]"
goback
end-if
 
*>
*> Read a web resource into fixed ram.
*> Caller is in charge of sizing the buffer,
*> (or getting trickier with the write callback)
*> Pass URL and working-storage variable,
*> get back libcURL error code or 0 for success
 
move read-url("http://www.rosettacode.org", web-page)
to curl-status
 
perform check
perform show
 
goback.
*> ***************************************************************
 
*> Now tesing the result, relying on the gccurlsym
*> GnuCOBOL Curl Symbol copy book
check.
if curl-status not equal zero then
display
curl-status " "
CURLEMSG(curl-status) upon syserr
end-if
.
 
*> And display the page
show.
if summarizing then
display "Length: " stored-char-length(web-page)
end-if
if displaying then
display trim(web-page trailing) with no advancing
end-if
.
 
REPLACE ALSO ==:EXCEPTION-HANDLERS:== BY
==
*> informational warnings and abends
soft-exception.
display space upon syserr
display "--Exception Report-- " upon syserr
display "Time of exception: " current-date upon syserr
display "Module: " module-id upon syserr
display "Module-path: " module-path upon syserr
display "Module-source: " module-source upon syserr
display "Exception-file: " exception-file upon syserr
display "Exception-status: " exception-status upon syserr
display "Exception-location: " exception-location upon syserr
display "Exception-statement: " exception-statement upon syserr
.
 
hard-exception.
perform soft-exception
stop run returning 127
.
==.
 
end program curl-rosetta.
*> ***************************************************************
 
*> ***************************************************************
*>
*> The function hiding all the curl details
*>
*> Purpose: Call libcURL and read into memory
*> ***************************************************************
identification division.
function-id. read-url.
 
environment division.
configuration section.
repository.
function all intrinsic.
 
data division.
working-storage section.
 
copy "gccurlsym.cpy".
 
replace also ==:CALL-EXCEPTION:== by
==
on exception
perform hard-exception
==.
 
01 curl-handle usage pointer.
01 callback-handle usage procedure-pointer.
01 memory-block.
05 memory-address usage pointer sync.
05 memory-size usage binary-long sync.
05 running-total usage binary-long sync.
01 curl-result usage binary-long.
 
01 cli pic x(7) external.
88 helping values "-h", "-help", "help", spaces.
88 displaying value "display".
88 summarizing value "summary".
 
linkage section.
01 url pic x any length.
01 buffer pic x any length.
01 curl-status usage binary-long.
 
*> ***************************************************************
procedure division using url buffer returning curl-status.
if displaying or summarizing then
display "Read: " url upon syserr
end-if
 
*> initialize libcurl, hint at missing library if need be
call "curl_global_init" using by value CURL_GLOBAL_ALL
on exception
display
"need libcurl, link with -lcurl" upon syserr
stop run returning 1
end-call
 
*> initialize handle
call "curl_easy_init" returning curl-handle
:CALL-EXCEPTION:
end-call
if curl-handle equal NULL then
display "no curl handle" upon syserr
stop run returning 1
end-if
 
*> Set the URL
call "curl_easy_setopt" using
by value curl-handle
by value CURLOPT_URL
by reference concatenate(trim(url trailing), x"00")
:CALL-EXCEPTION:
end-call
 
*> follow all redirects
call "curl_easy_setopt" using
by value curl-handle
by value CURLOPT_FOLLOWLOCATION
by value 1
:CALL-EXCEPTION:
end-call
 
*> set the call back to write to memory
set callback-handle to address of entry "curl-write-callback"
call "curl_easy_setopt" using
by value curl-handle
by value CURLOPT_WRITEFUNCTION
by value callback-handle
:CALL-EXCEPTION:
end-call
 
*> set the curl handle data handling structure
set memory-address to address of buffer
move length(buffer) to memory-size
move 1 to running-total
 
call "curl_easy_setopt" using
by value curl-handle
by value CURLOPT_WRITEDATA
by value address of memory-block
:CALL-EXCEPTION:
end-call
 
*> some servers demand an agent
call "curl_easy_setopt" using
by value curl-handle
by value CURLOPT_USERAGENT
by reference concatenate("libcurl-agent/1.0", x"00")
:CALL-EXCEPTION:
end-call
 
*> let curl do all the hard work
call "curl_easy_perform" using
by value curl-handle
returning curl-result
:CALL-EXCEPTION:
end-call
 
*> the call back will handle filling ram, return the result code
move curl-result to curl-status
 
*> curl clean up, more important if testing cookies
call "curl_easy_cleanup" using
by value curl-handle
returning omitted
:CALL-EXCEPTION:
end-call
 
goback.
 
:EXCEPTION-HANDLERS:
 
end function read-url.
*> ***************************************************************
 
*> ***************************************************************
*> Supporting libcurl callback
identification division.
program-id. curl-write-callback.
 
environment division.
configuration section.
repository.
function all intrinsic.
 
data division.
working-storage section.
01 real-size usage binary-long.
 
*> libcURL will pass a pointer to this structure in the callback
01 memory-block based.
05 memory-address usage pointer sync.
05 memory-size usage binary-long sync.
05 running-total usage binary-long sync.
 
01 content-buffer pic x(65536) based.
01 web-space pic x(16777216) based.
01 left-over usage binary-long.
 
linkage section.
01 contents usage pointer.
01 element-size usage binary-long.
01 element-count usage binary-long.
01 memory-structure usage pointer.
 
*> ***************************************************************
procedure division
using
by value contents
by value element-size
by value element-count
by value memory-structure
returning real-size.
 
set address of memory-block to memory-structure
compute real-size = element-size * element-count end-compute
 
*> Fence off the end of buffer
compute
left-over = memory-size - running-total
end-compute
if left-over > 0 and < real-size then
move left-over to real-size
end-if
 
*> if there is more buffer, and data not zero length
if (left-over > 0) and (real-size > 1) then
set address of content-buffer to contents
set address of web-space to memory-address
 
move content-buffer(1:real-size)
to web-space(running-total:real-size)
 
add real-size to running-total
else
display "curl buffer sizing problem" upon syserr
end-if
 
goback.
end program curl-write-callback.</lang>
 
and a copybook
 
program-id.
<lang cobol> *> manifest constants for libcurl
curl-write-callback.
*> Usage: COPY occurlsym inside data division
environment division.
*> Taken from include/curl/curl.h 2013-12-19
 
configuration section.
*> Functional enums
repository.
01 CURL_MAX_HTTP_HEADER CONSTANT AS 102400.
function all intrinsic.
 
data division.
78 CURL_GLOBAL_ALL VALUE 3.
 
working-storage section.
78 CURLOPT_FOLLOWLOCATION VALUE 52.
01 real-size usage binary-long.
78 CURLOPT_WRITEDATA VALUE 10001.
01 memory-block based.
78 CURLOPT_URL VALUE 10002.
05 memory-address usage pointer sync.
78 CURLOPT_USERAGENT VALUE 10018.
05 memory-size usage binary-long sync.
78 CURLOPT_WRITEFUNCTION VALUE 20011.
05 running-total usage binary-long sync.
78 CURLOPT_COOKIEFILE VALUE 10031.
01 content-buffer pic x(65536) based.
78 CURLOPT_COOKIEJAR VALUE 10082.
01 web-space pic x(16777216) based.
78 CURLOPT_COOKIELIST VALUE 10135.
01 left-over usage binary-long.
linkage section.
01 contents usage pointer.
01 element-size usage binary-long.
01 element-count usage binary-long.
01 memory-structure usage pointer.
procedure division using
by value contents
by value element-size
by value element-count
by value memory-structure
returning real-size.
set address of memory-block to memory-structure
compute real-size = element-size * element-count
end-compute
compute left-over = memory-size - running-total
end-compute
if left-over > 0 and < real-size then
move left-over to real-size
end-if
if (left-over > 0) and (real-size > 1) then
set address of content-buffer to contents
set address of web-space to memory-address
move content-buffer(1:real-size) to web-space(running-total:real-size)
add real-size to running-total
else
display "curl buffer sizing problem" upon syserr
end-if
goback.
end program curl-write-callback.
 
identification division.
*> Informationals
78 CURLINFO_COOKIELIST VALUE 4194332.
 
function-id.
*> Result codes
read-url.
78 CURLE_OK VALUE 0.
environment division.
*> Error codes
78 CURLE_UNSUPPORTED_PROTOCOL VALUE 1.
78 CURLE_FAILED_INIT VALUE 2.
78 CURLE_URL_MALFORMAT VALUE 3.
78 CURLE_OBSOLETE4 VALUE 4.
78 CURLE_COULDNT_RESOLVE_PROXY VALUE 5.
78 CURLE_COULDNT_RESOLVE_HOST VALUE 6.
78 CURLE_COULDNT_CONNECT VALUE 7.
78 CURLE_FTP_WEIRD_SERVER_REPLY VALUE 8.
78 CURLE_REMOTE_ACCESS_DENIED VALUE 9.
78 CURLE_OBSOLETE10 VALUE 10.
78 CURLE_FTP_WEIRD_PASS_REPLY VALUE 11.
78 CURLE_OBSOLETE12 VALUE 12.
78 CURLE_FTP_WEIRD_PASV_REPLY VALUE 13.
78 CURLE_FTP_WEIRD_227_FORMAT VALUE 14.
78 CURLE_FTP_CANT_GET_HOST VALUE 15.
78 CURLE_OBSOLETE16 VALUE 16.
78 CURLE_FTP_COULDNT_SET_TYPE VALUE 17.
78 CURLE_PARTIAL_FILE VALUE 18.
78 CURLE_FTP_COULDNT_RETR_FILE VALUE 19.
78 CURLE_OBSOLETE20 VALUE 20.
78 CURLE_QUOTE_ERROR VALUE 21.
78 CURLE_HTTP_RETURNED_ERROR VALUE 22.
78 CURLE_WRITE_ERROR VALUE 23.
78 CURLE_OBSOLETE24 VALUE 24.
78 CURLE_UPLOAD_FAILED VALUE 25.
78 CURLE_READ_ERROR VALUE 26.
78 CURLE_OUT_OF_MEMORY VALUE 27.
78 CURLE_OPERATION_TIMEDOUT VALUE 28.
78 CURLE_OBSOLETE29 VALUE 29.
78 CURLE_FTP_PORT_FAILED VALUE 30.
78 CURLE_FTP_COULDNT_USE_REST VALUE 31.
78 CURLE_OBSOLETE32 VALUE 32.
78 CURLE_RANGE_ERROR VALUE 33.
78 CURLE_HTTP_POST_ERROR VALUE 34.
78 CURLE_SSL_CONNECT_ERROR VALUE 35.
78 CURLE_BAD_DOWNLOAD_RESUME VALUE 36.
78 CURLE_FILE_COULDNT_READ_FILE VALUE 37.
78 CURLE_LDAP_CANNOT_BIND VALUE 38.
78 CURLE_LDAP_SEARCH_FAILED VALUE 39.
78 CURLE_OBSOLETE40 VALUE 40.
78 CURLE_FUNCTION_NOT_FOUND VALUE 41.
78 CURLE_ABORTED_BY_CALLBACK VALUE 42.
78 CURLE_BAD_FUNCTION_ARGUMENT VALUE 43.
78 CURLE_OBSOLETE44 VALUE 44.
78 CURLE_INTERFACE_FAILED VALUE 45.
78 CURLE_OBSOLETE46 VALUE 46.
78 CURLE_TOO_MANY_REDIRECTS VALUE 47.
78 CURLE_UNKNOWN_TELNET_OPTION VALUE 48.
78 CURLE_TELNET_OPTION_SYNTAX VALUE 49.
78 CURLE_OBSOLETE50 VALUE 50.
78 CURLE_PEER_FAILED_VERIFICATION VALUE 51.
78 CURLE_GOT_NOTHING VALUE 52.
78 CURLE_SSL_ENGINE_NOTFOUND VALUE 53.
78 CURLE_SSL_ENGINE_SETFAILED VALUE 54.
78 CURLE_SEND_ERROR VALUE 55.
78 CURLE_RECV_ERROR VALUE 56.
78 CURLE_OBSOLETE57 VALUE 57.
78 CURLE_SSL_CERTPROBLEM VALUE 58.
78 CURLE_SSL_CIPHER VALUE 59.
78 CURLE_SSL_CACERT VALUE 60.
78 CURLE_BAD_CONTENT_ENCODING VALUE 61.
78 CURLE_LDAP_INVALID_URL VALUE 62.
78 CURLE_FILESIZE_EXCEEDED VALUE 63.
78 CURLE_USE_SSL_FAILED VALUE 64.
78 CURLE_SEND_FAIL_REWIND VALUE 65.
78 CURLE_SSL_ENGINE_INITFAILED VALUE 66.
78 CURLE_LOGIN_DENIED VALUE 67.
78 CURLE_TFTP_NOTFOUND VALUE 68.
78 CURLE_TFTP_PERM VALUE 69.
78 CURLE_REMOTE_DISK_FULL VALUE 70.
78 CURLE_TFTP_ILLEGAL VALUE 71.
78 CURLE_TFTP_UNKNOWNID VALUE 72.
78 CURLE_REMOTE_FILE_EXISTS VALUE 73.
78 CURLE_TFTP_NOSUCHUSER VALUE 74.
78 CURLE_CONV_FAILED VALUE 75.
78 CURLE_CONV_REQD VALUE 76.
78 CURLE_SSL_CACERT_BADFILE VALUE 77.
78 CURLE_REMOTE_FILE_NOT_FOUND VALUE 78.
78 CURLE_SSH VALUE 79.
78 CURLE_SSL_SHUTDOWN_FAILED VALUE 80.
78 CURLE_AGAIN VALUE 81.
 
configuration section.
*> Error strings
repository.
01 LIBCURL_ERRORS.
function all intrinsic.
02 CURLEVALUES.
03 FILLER PIC X(30) VALUE "CURLE_UNSUPPORTED_PROTOCOL ".
data division.
03 FILLER PIC X(30) VALUE "CURLE_FAILED_INIT ".
03 FILLER PIC X(30) VALUE "CURLE_URL_MALFORMAT ".
working-storage section.
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE4 ".
copy "gccurlsym.cpy".
03 FILLER PIC X(30) VALUE "CURLE_COULDNT_RESOLVE_PROXY ".
replace also ==:CALL-EXCEPTION:== by == on exception perform hard-exception ==.
03 FILLER PIC X(30) VALUE "CURLE_COULDNT_RESOLVE_HOST ".
01 curl-handle usage pointer.
03 FILLER PIC X(30) VALUE "CURLE_COULDNT_CONNECT ".
01 callback-handle usage procedure-pointer.
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_SERVER_REPLY ".
01 memory-block.
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_ACCESS_DENIED ".
05 memory-address usage pointer sync.
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE10 ".
05 memory-size usage binary-long sync.
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_PASS_REPLY ".
05 running-total usage binary-long sync.
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE12 ".
01 curl-result usage binary-long.
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_PASV_REPLY ".
01 cli pic x(7) external.
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_227_FORMAT ".
88 helping values "-h", "-help", "help", spaces.
03 FILLER PIC X(30) VALUE "CURLE_FTP_CANT_GET_HOST ".
88 displaying value 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE16display". ".
88 summarizing value "summary".
03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_SET_TYPE ".
03 FILLER PIC X(30) VALUE "CURLE_PARTIAL_FILE ".
linkage section.
03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_RETR_FILE ".
01 url pic x any length.
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE20 ".
01 buffer pic x any length.
03 FILLER PIC X(30) VALUE "CURLE_QUOTE_ERROR ".
01 curl-status usage binary-long.
03 FILLER PIC X(30) VALUE "CURLE_HTTP_RETURNED_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_WRITE_ERROR ".
procedure division using
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE24 ".
url buffer
03 FILLER PIC X(30) VALUE "CURLE_UPLOAD_FAILED ".
returning curl-status.
03 FILLER PIC X(30) VALUE "CURLE_READ_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_OUT_OF_MEMORY ".
if displaying or summarizing then
03 FILLER PIC X(30) VALUE "CURLE_OPERATION_TIMEDOUT ".
display "Read: " url upon syserr
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE29 ".
end-if
03 FILLER PIC X(30) VALUE "CURLE_FTP_PORT_FAILED ".
call "curl_global_init" using
03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_USE_REST ".
by value CURL_GLOBAL_ALL on exception
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE32 ".
display "need libcurl, link with -lcurl" upon syserr
03 FILLER PIC X(30) VALUE "CURLE_RANGE_ERROR ".
stop run returning 1
03 FILLER PIC X(30) VALUE "CURLE_HTTP_POST_ERROR ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_SSL_CONNECT_ERROR ".
call "curl_easy_init"
03 FILLER PIC X(30) VALUE "CURLE_BAD_DOWNLOAD_RESUME ".
returning curl-handle :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_FILE_COULDNT_READ_FILE ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_LDAP_CANNOT_BIND ".
if curl-handle equal NULL then
03 FILLER PIC X(30) VALUE "CURLE_LDAP_SEARCH_FAILED ".
display "no curl handle" upon syserr
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE40 ".
stop run returning 1
03 FILLER PIC X(30) VALUE "CURLE_FUNCTION_NOT_FOUND ".
end-if
03 FILLER PIC X(30) VALUE "CURLE_ABORTED_BY_CALLBACK ".
call "curl_easy_setopt" using
03 FILLER PIC X(30) VALUE "CURLE_BAD_FUNCTION_ARGUMENT ".
by value curl-handle
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE44 ".
by value CURLOPT_URL
03 FILLER PIC X(30) VALUE "CURLE_INTERFACE_FAILED ".
by reference concatenate(trim(url trailing), x"00") :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE46 ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_TOO_MANY_REDIRECTS ".
call "curl_easy_setopt" using
03 FILLER PIC X(30) VALUE "CURLE_UNKNOWN_TELNET_OPTION ".
by value curl-handle
03 FILLER PIC X(30) VALUE "CURLE_TELNET_OPTION_SYNTAX ".
by value CURLOPT_FOLLOWLOCATION
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE50 ".
by value 1 :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_PEER_FAILED_VERIFICATION".
end-call
03 FILLER PIC X(30) VALUE "CURLE_GOT_NOTHING ".
set callback-handle to address of entry "curl-write-callback"
03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_NOTFOUND ".
call "curl_easy_setopt" using
03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_SETFAILED ".
by value curl-handle
03 FILLER PIC X(30) VALUE "CURLE_SEND_ERROR ".
by value CURLOPT_WRITEFUNCTION
03 FILLER PIC X(30) VALUE "CURLE_RECV_ERROR ".
by value callback-handle :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE57 ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_SSL_CERTPROBLEM ".
set memory-address to address of buffer
03 FILLER PIC X(30) VALUE "CURLE_SSL_CIPHER ".
move length(buffer) to memory-size
03 FILLER PIC X(30) VALUE "CURLE_SSL_CACERT ".
move 1 to running-total
03 FILLER PIC X(30) VALUE "CURLE_BAD_CONTENT_ENCODING ".
call "curl_easy_setopt" using
03 FILLER PIC X(30) VALUE "CURLE_LDAP_INVALID_URL ".
by value curl-handle
03 FILLER PIC X(30) VALUE "CURLE_FILESIZE_EXCEEDED ".
by value CURLOPT_WRITEDATA
03 FILLER PIC X(30) VALUE "CURLE_USE_SSL_FAILED ".
by value address of memory-block :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_SEND_FAIL_REWIND ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_INITFAILED ".
call "curl_easy_setopt" using
03 FILLER PIC X(30) VALUE "CURLE_LOGIN_DENIED ".
by value curl-handle
03 FILLER PIC X(30) VALUE "CURLE_TFTP_NOTFOUND ".
by value CURLOPT_USERAGENT
03 FILLER PIC X(30) VALUE "CURLE_TFTP_PERM ".
by reference concatenate("libcurl-agent/1.0", x"00") :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_DISK_FULL ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_TFTP_ILLEGAL ".
call "curl_easy_perform" using
03 FILLER PIC X(30) VALUE "CURLE_TFTP_UNKNOWNID ".
by value curl-handle
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_FILE_EXISTS ".
returning curl-result :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_TFTP_NOSUCHUSER ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_CONV_FAILED ".
move curl-result to curl-status
03 FILLER PIC X(30) VALUE "CURLE_CONV_REQD ".
call "curl_easy_cleanup" using
03 FILLER PIC X(30) VALUE "CURLE_SSL_CACERT_BADFILE ".
by value curl-handle
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_FILE_NOT_FOUND ".
returning omitted :CALL-EXCEPTION:
03 FILLER PIC X(30) VALUE "CURLE_SSH ".
end-call
03 FILLER PIC X(30) VALUE "CURLE_SSL_SHUTDOWN_FAILED ".
goback.
03 FILLER PIC X(30) VALUE "CURLE_AGAIN ".
:EXCEPTION-HANDLERS:
01 FILLER REDEFINES LIBCURL_ERRORS.
end function read-url.
02 CURLEMSG OCCURS 81 TIMES PIC X(30).</lang>
 
identification division.
{{out}}
<pre>prompt$ ./curl-rosetta summary
Read: http://www.rosettacode.org
Length: 000024043
 
program-id.
prompt$ ./curl-rosetta display
curl-rosetta.
Read: http://www.rosettacode.org
environment division.
<!DOCTYPE html>
<html lang="en" dir="ltr" class="client-nojs">
configuration section.
<head>
repository.
...</pre>
function read-url function all intrinsic.
data division.
working-storage section.
copy "gccurlsym.cpy".
01 web-page pic x(16777216).
01 curl-status usage binary-long.
01 cli pic x(7) external.
88 helping values "-h", "-help", "help", spaces.
88 displaying value "display".
88 summarizing value "summary".
procedure division.
accept cli from command-line
if helping then
display "./curl-rosetta [help|display|summary]" goback
end-if
move read-url("http://www.rosettacode.org", web-page) to curl-status
perform check
perform show goback.
check.
if curl-status not equal zero then
display curl-status " " CURLEMSG(curl-status) upon syserr
end-if.
show.
if summarizing then
display "Length: " stored-char-length(web-page)
end-if
if displaying then
display trim(web-page trailing) with no advancing
end-if.
REPLACE ALSO == :EXCEPTION-HANDLERS: == BY == soft-exception.
display space upon syserr
display "--Exception Report-- " upon syserr
display "Time of exception: " current-date upon syserr
display "Module: " module-id upon syserr
display "Module-path: " module-path upon syserr
display "Module-source: " module-source upon syserr
display "Exception-file: " exception-file upon syserr
display "Exception-status: " exception-status upon syserr
display "Exception-location: " exception-location upon syserr
display "Exception-statement: " exception-statement upon syserr.
hard-exception.
perform soft-exception stop run returning 127.
==.
end program curl-rosetta.</lang>
Copybook :
<lang cobol>01 CURL_MAX_HTTP_HEADER CONSTANT AS 102400.
78 CURL_GLOBAL_ALL VALUE 3.
78 CURLOPT_FOLLOWLOCATION VALUE 52.
78 CURLOPT_WRITEDATA VALUE 10001.
78 CURLOPT_URL VALUE 10002.
78 CURLOPT_USERAGENT VALUE 10018.
78 CURLOPT_WRITEFUNCTION VALUE 20011.
78 CURLOPT_COOKIEFILE VALUE 10031.
78 CURLOPT_COOKIEJAR VALUE 10082.
78 CURLOPT_COOKIELIST VALUE 10135.
78 CURLINFO_COOKIELIST VALUE 4194332.
78 CURLE_OK VALUE 0.
78 CURLE_UNSUPPORTED_PROTOCOL VALUE 1.
78 CURLE_FAILED_INIT VALUE 2.
78 CURLE_URL_MALFORMAT VALUE 3.
78 CURLE_OBSOLETE4 VALUE 4.
78 CURLE_COULDNT_RESOLVE_PROXY VALUE 5.
78 CURLE_COULDNT_RESOLVE_HOST VALUE 6.
78 CURLE_COULDNT_CONNECT VALUE 7.
78 CURLE_FTP_WEIRD_SERVER_REPLY VALUE 8.
78 CURLE_REMOTE_ACCESS_DENIED VALUE 9.
78 CURLE_OBSOLETE10 VALUE 10.
78 CURLE_FTP_WEIRD_PASS_REPLY VALUE 11.
78 CURLE_OBSOLETE12 VALUE 12.
78 CURLE_FTP_WEIRD_PASV_REPLY VALUE 13.
78 CURLE_FTP_WEIRD_227_FORMAT VALUE 14.
78 CURLE_FTP_CANT_GET_HOST VALUE 15.
78 CURLE_OBSOLETE16 VALUE 16.
78 CURLE_FTP_COULDNT_SET_TYPE VALUE 17.
78 CURLE_PARTIAL_FILE VALUE 18.
78 CURLE_FTP_COULDNT_RETR_FILE VALUE 19.
78 CURLE_OBSOLETE20 VALUE 20.
78 CURLE_QUOTE_ERROR VALUE 21.
78 CURLE_HTTP_RETURNED_ERROR VALUE 22.
78 CURLE_WRITE_ERROR VALUE 23.
78 CURLE_OBSOLETE24 VALUE 24.
78 CURLE_UPLOAD_FAILED VALUE 25.
78 CURLE_READ_ERROR VALUE 26.
78 CURLE_OUT_OF_MEMORY VALUE 27.
78 CURLE_OPERATION_TIMEDOUT VALUE 28.
78 CURLE_OBSOLETE29 VALUE 29.
78 CURLE_FTP_PORT_FAILED VALUE 30.
78 CURLE_FTP_COULDNT_USE_REST VALUE 31.
78 CURLE_OBSOLETE32 VALUE 32.
78 CURLE_RANGE_ERROR VALUE 33.
78 CURLE_HTTP_POST_ERROR VALUE 34.
78 CURLE_SSL_CONNECT_ERROR VALUE 35.
78 CURLE_BAD_DOWNLOAD_RESUME VALUE 36.
78 CURLE_FILE_COULDNT_READ_FILE VALUE 37.
78 CURLE_LDAP_CANNOT_BIND VALUE 38.
78 CURLE_LDAP_SEARCH_FAILED VALUE 39.
78 CURLE_OBSOLETE40 VALUE 40.
78 CURLE_FUNCTION_NOT_FOUND VALUE 41.
78 CURLE_ABORTED_BY_CALLBACK VALUE 42.
78 CURLE_BAD_FUNCTION_ARGUMENT VALUE 43.
78 CURLE_OBSOLETE44 VALUE 44.
78 CURLE_INTERFACE_FAILED VALUE 45.
78 CURLE_OBSOLETE46 VALUE 46.
78 CURLE_TOO_MANY_REDIRECTS VALUE 47.
78 CURLE_UNKNOWN_TELNET_OPTION VALUE 48.
78 CURLE_TELNET_OPTION_SYNTAX VALUE 49.
78 CURLE_OBSOLETE50 VALUE 50.
78 CURLE_PEER_FAILED_VERIFICATION VALUE 51.
78 CURLE_GOT_NOTHING VALUE 52.
78 CURLE_SSL_ENGINE_NOTFOUND VALUE 53.
78 CURLE_SSL_ENGINE_SETFAILED VALUE 54.
78 CURLE_SEND_ERROR VALUE 55.
78 CURLE_RECV_ERROR VALUE 56.
78 CURLE_OBSOLETE57 VALUE 57.
78 CURLE_SSL_CERTPROBLEM VALUE 58.
78 CURLE_SSL_CIPHER VALUE 59.
78 CURLE_SSL_CACERT VALUE 60.
78 CURLE_BAD_CONTENT_ENCODING VALUE 61.
78 CURLE_LDAP_INVALID_URL VALUE 62.
78 CURLE_FILESIZE_EXCEEDED VALUE 63.
78 CURLE_USE_SSL_FAILED VALUE 64.
78 CURLE_SEND_FAIL_REWIND VALUE 65.
78 CURLE_SSL_ENGINE_INITFAILED VALUE 66.
78 CURLE_LOGIN_DENIED VALUE 67.
78 CURLE_TFTP_NOTFOUND VALUE 68.
78 CURLE_TFTP_PERM VALUE 69.
78 CURLE_REMOTE_DISK_FULL VALUE 70.
78 CURLE_TFTP_ILLEGAL VALUE 71.
78 CURLE_TFTP_UNKNOWNID VALUE 72.
78 CURLE_REMOTE_FILE_EXISTS VALUE 73.
78 CURLE_TFTP_NOSUCHUSER VALUE 74.
78 CURLE_CONV_FAILED VALUE 75.
78 CURLE_CONV_REQD VALUE 76.
78 CURLE_SSL_CACERT_BADFILE VALUE 77.
78 CURLE_REMOTE_FILE_NOT_FOUND VALUE 78.
78 CURLE_SSH VALUE 79.
78 CURLE_SSL_SHUTDOWN_FAILED VALUE 80.
78 CURLE_AGAIN VALUE 81.
01 LIBCURL_ERRORS.
02 CURLEVALUES.
03 FILLER PIC X(30) VALUE "CURLE_UNSUPPORTED_PROTOCOL ".
03 FILLER PIC X(30) VALUE "CURLE_FAILED_INIT ".
03 FILLER PIC X(30) VALUE "CURLE_URL_MALFORMAT ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE4 ".
03 FILLER PIC X(30) VALUE "CURLE_COULDNT_RESOLVE_PROXY ".
03 FILLER PIC X(30) VALUE "CURLE_COULDNT_RESOLVE_HOST ".
03 FILLER PIC X(30) VALUE "CURLE_COULDNT_CONNECT ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_SERVER_REPLY ".
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_ACCESS_DENIED ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE10 ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_PASS_REPLY ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE12 ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_PASV_REPLY ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_227_FORMAT ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_CANT_GET_HOST ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE16 ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_SET_TYPE ".
03 FILLER PIC X(30) VALUE "CURLE_PARTIAL_FILE ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_RETR_FILE ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE20 ".
03 FILLER PIC X(30) VALUE "CURLE_QUOTE_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_HTTP_RETURNED_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_WRITE_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE24 ".
03 FILLER PIC X(30) VALUE "CURLE_UPLOAD_FAILED ".
03 FILLER PIC X(30) VALUE "CURLE_READ_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_OUT_OF_MEMORY ".
03 FILLER PIC X(30) VALUE "CURLE_OPERATION_TIMEDOUT ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE29 ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_PORT_FAILED ".
03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_USE_REST ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE32 ".
03 FILLER PIC X(30) VALUE "CURLE_RANGE_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_HTTP_POST_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_CONNECT_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_BAD_DOWNLOAD_RESUME ".
03 FILLER PIC X(30) VALUE "CURLE_FILE_COULDNT_READ_FILE ".
03 FILLER PIC X(30) VALUE "CURLE_LDAP_CANNOT_BIND ".
03 FILLER PIC X(30) VALUE "CURLE_LDAP_SEARCH_FAILED ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE40 ".
03 FILLER PIC X(30) VALUE "CURLE_FUNCTION_NOT_FOUND ".
03 FILLER PIC X(30) VALUE "CURLE_ABORTED_BY_CALLBACK ".
03 FILLER PIC X(30) VALUE "CURLE_BAD_FUNCTION_ARGUMENT ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE44 ".
03 FILLER PIC X(30) VALUE "CURLE_INTERFACE_FAILED ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE46 ".
03 FILLER PIC X(30) VALUE "CURLE_TOO_MANY_REDIRECTS ".
03 FILLER PIC X(30) VALUE "CURLE_UNKNOWN_TELNET_OPTION ".
03 FILLER PIC X(30) VALUE "CURLE_TELNET_OPTION_SYNTAX ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE50 ".
03 FILLER PIC X(30) VALUE "CURLE_PEER_FAILED_VERIFICATION".
03 FILLER PIC X(30) VALUE "CURLE_GOT_NOTHING ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_NOTFOUND ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_SETFAILED ".
03 FILLER PIC X(30) VALUE "CURLE_SEND_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_RECV_ERROR ".
03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE57 ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_CERTPROBLEM ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_CIPHER ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_CACERT ".
03 FILLER PIC X(30) VALUE "CURLE_BAD_CONTENT_ENCODING ".
03 FILLER PIC X(30) VALUE "CURLE_LDAP_INVALID_URL ".
03 FILLER PIC X(30) VALUE "CURLE_FILESIZE_EXCEEDED ".
03 FILLER PIC X(30) VALUE "CURLE_USE_SSL_FAILED ".
03 FILLER PIC X(30) VALUE "CURLE_SEND_FAIL_REWIND ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_INITFAILED ".
03 FILLER PIC X(30) VALUE "CURLE_LOGIN_DENIED ".
03 FILLER PIC X(30) VALUE "CURLE_TFTP_NOTFOUND ".
03 FILLER PIC X(30) VALUE "CURLE_TFTP_PERM ".
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_DISK_FULL ".
03 FILLER PIC X(30) VALUE "CURLE_TFTP_ILLEGAL ".
03 FILLER PIC X(30) VALUE "CURLE_TFTP_UNKNOWNID ".
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_FILE_EXISTS ".
03 FILLER PIC X(30) VALUE "CURLE_TFTP_NOSUCHUSER ".
03 FILLER PIC X(30) VALUE "CURLE_CONV_FAILED ".
03 FILLER PIC X(30) VALUE "CURLE_CONV_REQD ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_CACERT_BADFILE ".
03 FILLER PIC X(30) VALUE "CURLE_REMOTE_FILE_NOT_FOUND ".
03 FILLER PIC X(30) VALUE "CURLE_SSH ".
03 FILLER PIC X(30) VALUE "CURLE_SSL_SHUTDOWN_FAILED ".
03 FILLER PIC X(30) VALUE "CURLE_AGAIN ".
01 FILLER REDEFINES LIBCURL_ERRORS.
02 CURLEMSG OCCURS 81 TIMES PIC X(30).</lang>
 
=={{header|ColdFusion}}==