CONFIGURATION SECTION. REPOSITORY. class http-client as "com.iscobol.rts.HTTPClient" class http-params as "com.iscobol.rts.HTTPData.Params" . WORKING-STORAGE SECTION. 77 http object reference http-client. 77 parms object reference http-params. |
set parms = http-params:>new :>add ("grant_type", "client_credentials") set http = http-client:>new. http:>setAuth ("<Consumer-key-by-Twitter>" "<Consumer-secret-by-Twitter>"). try http:>doPost ( "https://api.twitter.com/oauth2/token" parms) http:>getResponseCode (response-code) |
{"errors":[ {"label":"authenticity_token_error","code":99,"message": "Unable to verify your credentials"}]} |
{"token_type":"bearer","access_token": "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2FAAAAAAAAAAAAAAAAAAAA3DAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAA"} |
01 twitter-auth identified by "". 03 identified by "token_type". 05 token-type pic x any length. 03 identified by "access_token". 05 access-token pic x any length. |
if response-code = 200 http:>getResponseJSON (twitter-auth) |
if token-type = "bearer" http:>setAuth (access-token) set parms = http-params:>new :>add ("count", "20") :>add ("screen_name", "VeryantCOBOL");; http:>doGet ("https://api.twitter.com/1.1/statuses/user_timeline.json" parms) |
01 twitter identified by space. 03 array identified by space occurs dynamic capacity cnt. 05 identified by "text". 07 twittext pic x any length. 05 identified by "user". 07 identified by "screen_name". 09 screen-name pic x any length. |
PROGRAM-ID. tweet. CONFIGURATION SECTION. REPOSITORY. class http-client as "com.iscobol.rts.HTTPClient" class http-params as "com.iscobol.rts.HTTPData.Params" . WORKING-STORAGE SECTION. 77 http object reference http-client. 77 parms object reference http-params. 77 i int. 77 some-text pic x any length. 77 response-code pic 999. 77 api-key pic x any length. 77 api-secret pic x any length. 01 twitter-auth identified by "". 03 identified by "token_type". 05 token-type pic x any length. 03 identified by "access_token". 05 access-token pic x any length. 01 twitter identified by space. 03 array identified by space occurs dynamic capacity cnt. 05 identified by "text". 07 twittext pic x any length. 05 identified by "user". 07 identified by "screen_name". 09 screen-name pic x any length. PROCEDURE DIVISION. MAIN. accept api-key from environment "api_key" accept api-secret from environment "api_secret" set parms = http-params:>new :>add ("grant_type", "client_credentials") |
set http = http-client:>new. http:>setAuth (api-key api-secret) try http:>doPost ( "https://api.twitter.com/oauth2/token" parms) http:>getResponseCode (response-code) if response-code = 200 http:>getResponseJSON (twitter-auth) if token-type = "bearer" http:>setAuth (access-token) set parms = http-params:>new :>add ("count", "20") :>add ("screen_name", "VeryantCOBOL");; http:>doGet ("https://api.twitter.com/1.1"- "/statuses/user_timeline.json" parms) if response-code = 200 display "Connection OK Response code=" response-code;; http:>getResponseJSON (twitter) perform show-results else display "Response code=" response-code;; http:>getResponsePlain (some-text) display some-text goback end-if else display "wrong token-type=" token-type end-if else display "Connection problem. Response code=" response-code;; http:>getResponsePlain (some-text) display some-text goback end-if catch exception display exception-object:>toString goback end-try. goback. show-results. display "Total number of Tweets [" cnt "]" perform varying i from 1 by 1 until i > cnt display "Tweet " i display "@" screen_name(i) ": " twittext (i) end-perform. |