You can invoke an ETP program or transactions from a non-transaction COBOL environment. This include a COBOL command line or a job step in an Elastic Batch Platform JCL batch job. The technique is demonstrated in the Call ETP From COBOL sample project available when you create new COBOL projects from the Elastic COBOL IDE. The necessary files and instructions are attached to this article as well.
You can create a new sample project with the New COBOL Project dialog box:
This will create a COBOL project with a COBOL program named ETPCallFromCOBOL.(attached). Since ETP transactions are packaged as an Enterprise Java Bean as a single SYSID (i.e., "CICS region") we must use EJB client protocols to access this transaction. It is the same interface that is used for Distributed Program Link (DPL) between two transactions in different SYSIDs.
IDENTIFICATION DIVISION.
PROGRAM-ID. ETPCallFromCOBOL.
WORKING-STORAGE SECTION.
10 COMMAREA PIC X(60) VALUE 'HELLO FROM ETPCallFromCOBOL'.
10 RETURNMESSAGE PIC X(10).
10 JNDI1 PIC X(81) VALUE 'java.naming.factory.initial=org.apache.
- 'openejb.client.RemoteInitialContextFactory'.
10 JNDI2 PIC X(80) VALUE
'java.naming.provider.url=ejbd://localhost:4201'.
10 JNDI3 PIC X(80) VALUE
'java.naming.security.principal=system'.
10 JNDI4 PIC X(80) VALUE
'java.naming.security.credentials=manager'.
PROCEDURE DIVISION.
CALL 'ETP_LINK' USING 'ETPETRN', 'ETP2', COMMAREA,
JNDI1, JNDI2
* , JNDI3, JNDI4
GIVING RETURNMESSAGE.
The Elastic COBOL Runtime Library routine ETP_LINK makes the necessary connections to the EJB via class lookup (on COBOL Program ID (Java class) ETPETRN. In order to do this it requires the Java Naming protocol information. This may be different for each JEE server you are using. When deploying transactions to ETP running under Geronimo, the OpenEJB set of classes can be use (produced by a factory) to lookup and remotely invoke a method within the remote class. ETP_LINK requires parameters to make this connection in a series of properties consisting of name/value pairs. The parameters to ETP_LINK are:
- Program Name - the program name in the destination system that should be invoked. This is a Program ID and not a 4-character transaction ID
- System ID - the 4 character SYSID defining the ETP or "CICS region" name.
- COMMAREA - an arbitrarily large communications area used to send and receive parameters to the called program. This can be any COBOL structured data and is sent as a byte-array based on the length of the structure.
- JNDI Parameters - A series of parameters indicating connection mechanism and end-points
- java.naming.factory.initial - the class to be use to manufacture the connection to the destination. (Geronimo default: openejb.client.RemoteINitialContextFactory).
- java.naming.proiver.url - the URL indicating the destination JEE server, depending upon the protocol used. (Use EJB Directory Lookup Protocol URL ejbd://host:port).
- java.naming.provider.principal - if the JEE server is running under security, this is the user ID allowing access (optional).
- java.naming.provider.credentials - if the JEE server is running under security, this is the user's password (optional).
The COMMAREA passed to the transaction (and received back from the transaction) using the same structure. The return string of the ETP_LINK is generally not used but will usually be set to 'SUCCESS'.
Each connection library for a JEE server may be different (although most accept OpenEJB protocols) so you must build and package your application with these libraries. When building under Eclipse additional libraries are specified on the Java Build Properties > Libraries dialog box. For projects created in the New COBOL Project dialog box these are set automatically to jar files shipped with the product:
But, you might have libraries other than these. Use the Add JARs or Add External JARs buttons.
When running your program you must also specify these libraries in the CLASSPATH. From the command line,
java -cp openejb-client-4.5.2.jar:javaee-api-6.0-5.jar:myjar.jar etpcallfromcobol
For running under EBP, set the classpath1..9 configurations to these class files as they are not included in the standard ecobol.jar runtime library.
*OpenEJB Server Exceptions*
Not all of the JEE application servers support OpenEJB by default. In such cases, we must change the factory and provider entries to utilize the class and URL required by the application server.
Oracle's WebLogic uses it's own implementation of the RMI specification and favors it's own proprietary protocol known as T3 with the context lookup port 7001.
- java.naming.factory.initial - weblogic.jndi.WLInitialContextFactory.
- java.naming.provider.url - t3://host:port.
Similarly, IBM's WebSphere 8.5 (full profile) utilizes the Internet Intra-ORB Protocol (IIOP) with the context lookup port 2809.
- java.naming.factory.initial - com.ibm.websphere.naming.WsnInitialContextFactory.
- java.naming.provider.url - iiop://host:port.
0 Comments