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.  |