JCL to DAG
We are going to convert a JCL step into a configuration file (yaml).
//JOB1 JOB (123),CLASS=C,MSGCLASS=S,MSGLEVEL=(1,1),NOTIFY=&SYSUID
//*
//STEP01 EXEC PGM=BCUOTA
//INFILE DD DSN=DEV.APPL1.TEST,DISP=SHR
//OUTFILE DD DSN=DEV.APPL1.CUOTA,
// DISP=(NEW,CATLG,DELETE),VOLUME=SER=SHARED,
// SPACE=(CYL,(1,1),RLSE),UNIT=SYSDA,
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=800)
//*
Create a step.yaml file and copy and paste the following code into it.
---
stepname: "step1"
exec:
pgm: "bcuota"
dd:
- name: "infile"
dsn: "test.txt"
disp: "shr"
normaldisp: "catlg"
abnormaldisp: "catlg"
- name: "outfile"
dsn: "cuota.txt"
disp: "new"
normaldisp: "catlg"
abnormaldisp: "delete"
Next, using this configuration yaml, we will run a batch file read/write program. The main program bcuota.cbl reads an input file, calls the COBOL routine loancalc.cbl to calculate the loan quota, and writes the result to the output file.
******************************************************************
*
* Loan Calculator Batch
* ==========================
*
*
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. bcuota.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT LOAN ASSIGN TO "infile"
ORGANIZATION IS LINE SEQUENTIAL
ACCESS IS SEQUENTIAL.
SELECT CUOTA ASSIGN TO "outfile"
ORGANIZATION IS LINE SEQUENTIAL
ACCESS IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD LOAN.
01 LOAN-FILE PIC X(26).
FD CUOTA.
01 CUOTA-FILE.
05 CUOTA-ACC PIC X(10).
05 CUOTA-PAY PIC 9(7)V9(2).
WORKING-STORAGE SECTION.
01 WS-LOAN.
05 WS-ACC PIC X(10).
05 FILLER PIC X(1).
05 WS-AMT PIC 9(7).
05 FILLER PIC X(1).
05 WS-INT PIC 9(2)V9(2).
05 FILLER PIC X(1).
05 WS-YEAR PIC 9(2).
01 WS-EOF PIC X(1) VALUE "N".
01 WS-COUNTER PIC 9(9) VALUE ZEROES.
****************************************************************
01 LOAN-PARAMS.
05 INPUT-MSG.
10 PRIN-AMT PIC S9(7) USAGE IS DISPLAY.
10 INT-RATE PIC S9(2)V9(2) USAGE IS DISPLAY.
10 TIMEYR PIC S9(2) USAGE IS DISPLAY.
05 OUTPUT-MSG.
10 PAYMENT PIC S9(7)V9(2) USAGE IS DISPLAY.
10 ERROR-MSG PIC X(20).
PROCEDURE DIVISION.
OPEN INPUT LOAN.
OPEN OUTPUT CUOTA.
PERFORM UNTIL WS-EOF='Y'
READ LOAN INTO WS-LOAN
AT END MOVE 'Y' TO WS-EOF
NOT AT END
MOVE WS-AMT TO PRIN-AMT
MOVE WS-INT TO INT-RATE
MOVE WS-YEAR TO TIMEYR
CALL "loancalc" USING LOAN-PARAMS
ADD 1 TO WS-COUNTER
MOVE WS-ACC TO CUOTA-ACC
MOVE PAYMENT TO CUOTA-PAY
WRITE CUOTA-FILE
END-WRITE
END-READ
END-PERFORM.
CLOSE LOAN.
CLOSE CUOTA.
DISPLAY "TOTAL RECORDS PROCESSED: " WS-COUNTER.
GOBACK.
The loancalc.cbl routine has been modified to avoid writing to the system log.
******************************************************************
*
* Loan Calculator Subroutine
* ==========================
*
* A sample program to demonstrate how to create a gRPC COBOL
* microservice.
*
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. loancalc.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
* Declare program variables
01 WS-MSG.
05 WS-ERROR PIC X(01).
05 WS-MSG00 PIC X(20) VALUE 'OK'.
05 WS-MSG10 PIC X(20) VALUE 'INVALID INT. RATE'.
05 WS-MSG12 PIC X(20) VALUE 'INVALID NUMBER YEARS'.
01 AUX-VARS.
05 MONTHLY-RATE USAGE IS COMP-2.
05 AUX-X USAGE IS COMP-2.
05 AUX-Y USAGE IS COMP-2.
05 AUX-Z USAGE IS COMP-2.
LINKAGE SECTION.
* Data to share with COBOL subroutines
01 LOAN-PARAMS.
05 INPUT-MSG.
10 PRIN-AMT PIC S9(7) USAGE IS DISPLAY.
10 INT-RATE PIC S9(2)V9(2) USAGE IS DISPLAY.
10 TIMEYR PIC S9(2) USAGE IS DISPLAY.
05 OUTPUT-MSG.
10 PAYMENT PIC S9(7)V9(2) USAGE IS DISPLAY.
10 ERROR-MSG PIC X(20).
PROCEDURE DIVISION USING BY REFERENCE LOAN-PARAMS.
* code goes here!
000-MAIN.
MOVE "N" TO WS-ERROR.
* DISPLAY "PRIN-AMT: " PRIN-AMT.
* DISPLAY "INT-RATE: " INT-RATE.
* DISPLAY "TIMEYR: " TIMEYR.
PERFORM 100-INIT.
IF WS-ERROR = 'N'
PERFORM 200-PROCESS
END-IF.
PERFORM 300-WRAPUP.
100-INIT.
IF INT-RATE <= 0
MOVE WS-MSG10 TO ERROR-MSG
MOVE 10 TO RETURN-CODE
MOVE 'Y' TO WS-ERROR
ELSE
IF TIMEYR <= 0
MOVE WS-MSG12 TO ERROR-MSG
MOVE 12 TO RETURN-CODE
MOVE 'Y' TO WS-ERROR
END-IF
END-IF.
200-PROCESS.
INITIALIZE AUX-VARS.
COMPUTE MONTHLY-RATE = (INT-RATE / 12 / 100).
COMPUTE AUX-X = ((1 + MONTHLY-RATE) ** (TIMEYR*12)).
COMPUTE AUX-Y = AUX-X * MONTHLY-RATE.
COMPUTE AUX-Z = (AUX-X - 1) / AUX-Y.
COMPUTE PAYMENT = PRIN-AMT / AUX-Z.
MOVE WS-MSG00 TO ERROR-MSG.
MOVE 0 TO RETURN-CODE.
* DISPLAY "PAYMENT: " PAYMENT.
* DISPLAY "ERROR-MSG: " ERROR-MSG.
300-WRAPUP.
GOBACK.
Compile both programs to create a shared library (*.so, *dylib).
cobc -m bcouta.cbl loancalc.cbl.
The d8parti controller will replace the JES mainframe subsystem, here is a simplified version of this module, create a d8parti.go file and copy the following code.
package main
/*
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <libcob.h>
#cgo CFLAGS: -I/opt/homebrew/Cellar/gnucobol/3.2/include
#cgo LDFLAGS: -L/opt/homebrew/Cellar/gnucobol/3.2/lib -lcob
*/
import "C"
import (
"fmt"
"log"
"os"
"time"
"unsafe"
"github.com/spf13/viper"
)
type step struct {
Stepname string `mapstructure:"stepname"`
Exec exec
Dd []dd
}
type exec struct {
Pgm string `mapstructure:"pgm"`
}
type dd struct {
Name string `mapstructure:"name"`
Dsn string `mapstructure:"dsn"`
Disp string `mapstructure:"disp"`
Normaldisp string `mapstructure:"normaldisp"`
Abnormaldisp string `mapstructure:"abnormaldisp"`
}
var Step *step
func config() error {
// Read yaml config file
viper.SetConfigName("step")
viper.SetConfigType("yaml")
viper.AddConfigPath(".")
if err := viper.ReadInConfig(); err != nil {
return err
}
// Unmarshal yaml config file
if err := viper.Unmarshal(&Step); err != nil {
return err
}
// Create Symlink
for i := 0; i < len(Step.Dd); i++ {
err := os.Symlink(Step.Dd[i].Dsn, Step.Dd[i].Name)
if err != nil {
switch {
case os.IsExist(err):
// DDNAME already exist
log.Printf("INFO: DDNAME=%s already exists. %s", Step.Dd[i].Name, err)
case os.IsNotExist(err):
// DDNAME invalid
log.Printf("ERROR: DDNAME=%s invalid ddname. %s", Step.Dd[i].Name, err)
return err
default:
log.Println(err)
return err
}
}
}
return nil
}
func cobCall(p string) error {
defer delSymlink()
c_progName := C.CString(p)
defer C.free(unsafe.Pointer(c_progName))
n := C.cob_resolve(c_progName)
if n == nil {
return fmt.Errorf("ERROR: Program %s not found", p)
} else {
log.Printf("INFO: PGM=%s started", p)
r := C.cob_call_with_exception_check(c_progName, C.int(0), nil)
rc := int(C.cob_last_exit_code())
err := C.GoString(C.cob_last_runtime_error())
switch int(r) {
case 0:
log.Printf("INFO: program %s exited with return-code: %v", p, rc)
C.cob_tidy()
case 1:
log.Printf("INFO: program %s STOP RUN with return-code: %v", p, rc)
case -1:
return fmt.Errorf("ERROR: program %s exit with return-code: %v and error: %s", p, rc, err)
case -2:
return fmt.Errorf("FATAL: program %s exit with return-code: %v and error: %s", p, rc, err)
case -3:
return fmt.Errorf("ERROR: program %s signal handler exit with signal: %v and error: %s", p, rc, err)
default:
return fmt.Errorf("ERROR: program %s unexpected return exit code: %v and error: %s", p, rc, err)
}
return nil
}
}
func delSymlink() {
for i := 0; i < len(Step.Dd); i++ {
err := os.Remove(Step.Dd[i].Name)
if err != nil {
log.Printf("INFO: DDNAME=%s does not exists. %s", Step.Dd[i].Name, err)
}
}
}
func main() {
start := time.Now()
// Initialize gnucobol
C.cob_init(C.int(0), nil)
log.Println("INFO: gnucobol initialized")
// Load config file
if err := config(); err != nil {
log.Printf("ERROR: reading yaml config file. %s", err)
os.Exit(12)
}
// Call COBOL program -> EXEC PGM defined in JCL
if err := cobCall(Step.Exec.Pgm); err != nil {
log.Println(err)
os.Exit(12)
}
elapsed := time.Since(start)
log.Printf("INFO: %s elapsed time %s", Step.Exec.Pgm, elapsed)
}
How do I create a sample input file (infile)?
The input file format is very simple.
01 WS-LOAN.
05 WS-ACC PIC X(10).
05 FILLER PIC X(1).
05 WS-AMT PIC 9(7).
05 FILLER PIC X(1).
05 WS-INT PIC 9(2)V9(2).
05 FILLER PIC X(1).
05 WS-YEAR PIC 9(2).
An account number (10 bytes), an amount (7 bytes), an interest rate (4 bytes with two decimal places) and a period of time in years (2 bytes). The fields are delimited by a separator (FILLER 1 byte) to make the input file easier to read.
You can use the following example program to create the input file.
package main
import (
"flag"
"fmt"
"math/rand"
"os"
"strconv"
"time"
)
var r1 *rand.Rand
var (
rows = flag.Int("rows", 1000, "number of rows to generate")
)
var (
file = flag.String("file", "test.txt", "input file name")
)
func main() {
flag.Parse()
s1 := rand.NewSource(time.Now().UnixNano())
r1 = rand.New(s1)
f, err := os.Create(*file)
if err != nil {
fmt.Println(err)
return
}
for i := 0; i != *rows; i++ {
output := account(i) + "-" + amount() + "-" + interest() + "-" + yearsPending() + "\n"
_, err := f.WriteString(output)
if err != nil {
fmt.Println(err)
f.Close()
return
}
}
err = f.Close()
if err != nil {
fmt.Println(err)
return
}
}
func account(id int) string {
return "id:" + fmt.Sprintf("%07d", id+1)
}
func amount() string {
min := 1000
max := 1000000
a := strconv.Itoa(r1.Intn(max-min+1) + min)
for i := len(a); i != 7; i++ {
a = "0" + a
}
return a
}
func interest() string {
return "0450"
}
func yearsPending() string {
min := 5
max := 25
y := strconv.Itoa(r1.Intn(max-min+1) + min)
if len(y) < 2 {
y = "0" + y
}
return y
}