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
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) WEBGETSTR – core RPGLE
// ------------------------------------------------------------------------------------------
// Service Name - WEBGETSTR
// Function - This interface will be used to return all stockrooms for given company code
// ------------------------------------------------------------------------------------------
// WSDL - http://sysname: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://sysname: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')
bnddir('WEBSERVICE');
// Define Procedure and Interface parameters
dcl-pr WEBGETSTR extpgm('WEBGETSTR');
/copy qcpylesrc,webgetstr
end-pr;
dcl-pi WEBGETSTR;
/copy qcpylesrc,webgetstr
end-pi;
// ---------------------------------------
// | 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);
end-ds;
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;
endif;
// Read next record from Cursor selection
exec SQL fetch next from C1 into :S21Stockroom ;
enddo;
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)';
else;
RtnStatus = 'Y';
In LDA;
RtnMessage = 'Print queue for user ' + %trim(L#USER) +
' is ' + %trim(L#PRQU) ;
endif;
#Cleanup( 'WEBGETSTR' : RtnErrorCode );
*inlr = *on; // The END is nigh.... 