Example RPGLE web service program [SOAP] 

 January 20, 2015

By  NickLitten

Here is a quick little example RPGLE web service – it’s written in RPG, the SQLRPGLE flavor and simply reads a file (the System/21 Stockroom master file — INP20) and returns a multi-occurrence data structure (array) of the stockrooms that the user is authorized to use. #hopeithelpssomebody

WEBGETSTR – get all stockrooms for a company code; located in NLITTEN/QRPGLESRC

o H spec defines how the program is running

o Uses SOAP activation group to help identify program

o PGMINFO -defines parameters are in WSDL format

o Inputs – WEGGETSTD

Special Offer for all NICKLITTEN Punters

20% Off with Coupon: NICKLITTEN

In Partnership with SNUG CBD - American readers get 20% off

CBD helps with relaxation, focus and great for pain relief. I highly recommend the SNUG CBD Tincture to help keep you in the zone when programming!

o Return values – Rtn is return value prefix for variable names

o RtnMessage – return message to users

WEBGETSTR – Copybook with input parms

 // ------------------------------------------------------------------------------------------
 // Service Name - WEBGETSTR
 // Function - This interface will be used to return all stockrooms for given company code
 // ------------------------------------------------------------------------------------------
 D Company like(S21Stockroom.CONO20) const
 D User 10a const
 D Stockroom 2a const
 D RtnStatus 1a options(*nopass)
 D RtnMessage 256a options(*nopass)
 D RtnCount 10i 0 options(*nopass)
 D RtnList likeds(RtnArray) dim(999)
 D options(*nopass) 


// ------------------------------------------------------------------------------------------
 // Service Name - WEBGETSTR
 // Function - This interface will be used to return all stockrooms for given company code
 // ------------------------------------------------------------------------------------------
 // WSDL - http://ahptest:10010/web/services/WEBGETSTR?wsdl
 // Author - Nick Litten (Freelance Software Projex - software.projex.com)
 // This is a SOAP web service, called using the HTTP protocol
 // and it accept input data, processes it and returns results.
 // ------------------------------------------------------------------------------------------
 // Web Services Server Information { http://ahptest:2001/HTTPAdmin }
 // Server name: SOAP21
 // Server description: Web services server created by the Create Web Services Server wizard.
 // Internal port range: 10000 - 10009
 // Server root: /www/SOAP21
 // Server URL: http://something.corp.absc.local:10010
 // User ID for server: NLITTEN
 // Context root: /web
 // HTTP Server Information
 // HTTP server name: SOAP21
 // HTTP server description: Web services server
 // Port: 10010
 // Document root: /www/SOAP21/htdocs
 // Server root: /www/SOAP21
 // Server association: SOAP21
 // ------------------------------------------------------------------------------------------
 // Modification History:
 // 2014-01-04 V1 Created
 // 2014-01-12 V1.1 Added Department Code
 // 2014-01-20 V1.2 Added Additional Return Codes
 // ------------------------------------------------------------------------------------------

 ctl-opt option(*srcstmt: *nodebugio) dftactgrp(*no) actgrp('SOAP')
 pgminfo(*pcml:*module) copyright('Version 1.2 January 19th 2015')

 // Define Procedure and Interface parameters
 dcl-pr WEBGETSTR extpgm('WEBGETSTR');
 /copy qcpylesrc,webgetstr
 dcl-pi WEBGETSTR;
 /copy qcpylesrc,webgetstr

 // ---------------------------------------
 // | Include Webservice *SRVPGM prototypes |
 // ---------------------------------------
 /copy qcpylesrc,webservice

 // ---------------------------------------
 // | Include Common Webservice Variables |
 // ---------------------------------------
 /copy qcpylesrc,webvars

 // Use Data Structures to hold SQL file information for easy recognition
 dcl-ds S21Stockroom extname('INP20') qualified end-ds;

 // array to hold data reformatted ready for return
 dcl-ds RtnArray qualified inz;
  RtnStockroom like(s21stockroom.strc20);
  RtnStockName like(s21stockroom.strn20);
  RtnDepartment like(s21stockroom.depc20);
  RtnAllowReceipts like(s21stockroom.rcta20);
  RtnAllowIssues like(s21stockroom.issa20);
  RtnAllowTransfers like(s21stockroom.trna20);
  RtnAllowSupplierOrders like(s21stockroom.spoa20);
  RtnAllowSalesOrders like(s21stockroom.slor20);
  RtnIncludeInStockValution like(s21stockroom.insv20);

 dcl-ds LDA extname('LDA') dtaara(*lda) end-ds;

 // ---------------------------------------
 // | Include Webservice *INIT prototypes |
 // ---------------------------------------
 /copy qcpylesrc,webinit

 // Set SQL option, mainly to force cursor to close at endmodule
 exec sql set option naming = *sys,
   commit = *none,
   usrprf = *user,
   dynusrprf = *user,
   datfmt = *iso,
   closqlcsr = *endmod ;

 rtnCount = 0;
 RtnMessage = *blanks;

 // build conditions for this file access (note: do not qualify the file
 // name with a library. It will be found from the library list defined to
 // the webservice at http://<system>:2001/HTTPAdmin
 exec SQL declare C1 cursor for
   select * from INP20
   where CONO20 = :Company
   for read only;

 exec SQL open C1;

 exec SQL fetch next from C1 into :S21Stockroom ;

 dow sqlstt='00000' or %subst(sqlstt:1:2)='01';

 // Validate stockroom
 If Stockroom = '**' or  #ValidStockroom ( Company : S21Stockroom.STRC20 : User : RtnErrorCode );

 RtnCount += 1;
 RtnArray.RtnStockroom = S21Stockroom.STRC20;
 RtnArray.RtnStockName = S21Stockroom.STRN20;
 RtnArray.RtnDepartment = S21Stockroom.DEPC20;
 RtnArray.RtnAllowReceipts = S21Stockroom.RCTA20;
 RtnArray.RtnAllowIssues = S21Stockroom.ISSA20;
 RtnArray.RtnAllowTransfers = S21Stockroom.TRNA20;
 RtnArray.RtnAllowSupplierOrders = S21Stockroom.SPOA20;
 RtnArray.RtnAllowSalesOrders = S21Stockroom.SLOR20;
 RtnArray.RtnIncludeInStockValution = S21Stockroom.INSV20;
 RtnArray.RtnDepartment = S21Stockroom.DEPC20;

 // Store Datastructure values in next element of 'return array'
 RtnList(RtnCount) = RtnArray;

 // Read next record from Cursor selection
 exec SQL fetch next from C1 into :S21Stockroom ;


 exec SQL close C1;

 // Set Returncode to values requested by calling system ( in this case ACSIS)
 if RtnCount < 1;
   RtnStatus = 'X';
   RtnMessage = 'Error! Company code ' + %trim(Company ) +
   ' has no stockrooms defined in System21! (File:INP20)';
   RtnStatus = 'Y';
   In LDA;
   RtnMessage = 'Print queue for user ' + %trim(L#USER) +
   ' is ' + %trim(L#PRQU) ;

 #Cleanup( 'WEBGETSTR' : RtnErrorCode );

 *inlr = *on; // The END is nigh.... 


IBM i Software Developer, Digital Dad, AS400 Anarchist, RPG Modernizer, Shameless Trekkie, Belligerent Nerd, Englishman Abroad and Passionate Eater of Cheese and Biscuits. Nick Litten Dot Com is a mixture of blog posts that can be sometimes serious, frequently playful and probably down-right pointless all in the space of a day. Enjoy your stay, feel free to comment and remember: If at first you don't succeed then skydiving probably isn't a hobby you should look into.

Nick Litten

related posts:

{"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}
__CONFIG_colors_palette__{"active_palette":0,"config":{"colors":{"cff50":{"name":"Main Accent","parent":-1},"a344d":{"name":"Accent Transparent","parent":"cff50"}},"gradients":[]},"palettes":[{"name":"Default","value":{"colors":{"cff50":{"val":"var(--tcb-skin-color-0)"},"a344d":{"val":"rgba(46, 138, 229, 0.85)","hsl_parent_dependency":{"h":210,"l":0.54,"s":0.78}}},"gradients":[]},"original":{"colors":{"cff50":{"val":"rgb(0, 178, 255)","hsl":{"h":198,"s":1,"l":0.5}},"a344d":{"val":"rgba(0, 178, 255, 0.85)","hsl_parent_dependency":{"h":198,"s":1,"l":0.5}}},"gradients":[]}}]}__CONFIG_colors_palette__

Get In Touch

I’m always looking for awesome input, feedback and critique!