Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
292
Task/HTTP/COBOL/http-1.cobol
Normal file
292
Task/HTTP/COBOL/http-1.cobol
Normal file
|
|
@ -0,0 +1,292 @@
|
|||
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.
|
||||
Loading…
Add table
Add a link
Reference in a new issue