SIMPLE2 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108
  1. * Curl simple URL request (free-format RPG)
  2. *
  3. ctl-opt dftactgrp(*NO) actgrp(*NEW)
  4. option(*NOSHOWCPY)
  5. bnddir('CURL');
  6. *
  7. **************************************************************************
  8. * _ _ ____ _
  9. * Project ___| | | | _ \| |
  10. * / __| | | | |_) | |
  11. * | (__| |_| | _ <| |___
  12. * \___|\___/|_| \_\_____|
  13. *
  14. * Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
  15. *
  16. * This software is licensed as described in the file COPYING, which
  17. * you should have received as part of this distribution. The terms
  18. * are also available at https://curl.se/docs/copyright.html.
  19. *
  20. * You may opt to use, copy, modify, merge, publish, distribute and/or sell
  21. * copies of the Software, and permit persons to whom the Software is
  22. * furnished to do so, under the terms of the COPYING file.
  23. *
  24. * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF
  25. * ANY KIND, either express or implied.
  26. *
  27. * SPDX-License-Identifier: curl
  28. *
  29. **************************************************************************
  30. /include H,CURL.INC
  31. * Simple free-format RPG program to request the URL given as command line
  32. * parameter and output its response.
  33. dcl-pi *N;
  34. url char(120);
  35. end-pi;
  36. dcl-s urllen int(10); // URL length
  37. **************************************************************************
  38. urllen = trimmed_length(url: %len(url));
  39. // Do the curl stuff.
  40. curl_global_init(CURL_GLOBAL_ALL);
  41. main();
  42. curl_global_cleanup();
  43. *inlr = *on; // Exit
  44. **************************************************************************
  45. * Main procedure: do the curl job.
  46. **************************************************************************
  47. dcl-proc main;
  48. dcl-pi *N end-pi;
  49. dcl-s h pointer; // Easy handle
  50. dcl-s result like(CURLcode) inz(CURLE_OUT_OF_MEMORY); // Curl return code
  51. dcl-s errmsgp pointer; // Error string pointer
  52. dcl-s response char(52); // For error display
  53. // Create and fill curl handle.
  54. h = curl_easy_init();
  55. if h <> *NULL;
  56. curl_easy_setopt_ccsid(h: CURLOPT_URL: %subst(url: 1: urllen):
  57. 0);
  58. curl_easy_setopt(h: CURLOPT_FOLLOWLOCATION: 1);
  59. // Perform the request.
  60. result = curl_easy_perform(h);
  61. curl_easy_cleanup(h); // Release handle
  62. endif;
  63. // Check for error and report if some.
  64. if result <> CURLE_OK;
  65. errmsgp = curl_easy_strerror_ccsid(result: 0);
  66. response = %str(errmsgp);
  67. dsply '' '*EXT' response;
  68. endif;
  69. end-proc;
  70. *
  71. **************************************************************************
  72. * Get the length of right-trimmed string
  73. **************************************************************************
  74. *
  75. dcl-proc trimmed_length;
  76. dcl-pi *N uns(10);
  77. string char(9999999) const options(*varsize);
  78. length uns(10) value;
  79. end-pi;
  80. dcl-s len uns(10);
  81. len = %scan(X'00': string: 1: length); // Limit to zero-terminated string
  82. if len = 0;
  83. len = length + 1;
  84. endif;
  85. if len <= 1;
  86. return 0;
  87. endif;
  88. return %checkr(' ': string: len - 1); // Trim right
  89. end-proc;