Original post is here: eklausmeier.goip.de
Task at hand: Convert IMS/DC MFS to PHP code. This is vaguely similar to the task that the MFS language utility DFSUPAA0 does. IMS/DC is a mainframe based transaction manager. MFS is an Assembler like description of the message format used in IMS/DC.
Parse MFS using Perl:
- Screen layout is delimited by
FMT
andFMTEND
- Expect one single
FMT
per file - Message format used by COBOL programs is delimited by
MSG
andMSGEND
- Expect two
MSGEND
: one for input, one for output, i.e., two message formats per file - Each labeled field in FMT-specification will be stored in key of a hash. Value of hash contains:
- X position
- Y position
- Length of field
ATTR
attributes in a bit-field. Attributes are:- 0x01: Protected or non-protected
- 0x02: Numeric or alpha
- 0x04: Highlighted or not
- 0x08: Displayable or not
- Unlabeled fields are grouped in hash starting with
__1
,__2
,__3
, etc. Value of hash same as for labeled fields.
EATTR
attributes are ignored. So are NODET, DET, IDET.
[mermaid] erDiagram hash { int x int y int len int attr } [/mermaid]
MFS files with only one MSGEND, this is mostly print output, are ignored for the moment.
Generate PHP file using Perl:
- In head: CSS code for each field, e.g.,
#TXCODE {width:6.0em}
- In head: PHP functions for packing and unpacking the message format as parsed above
- PHP function call for each field on the screen, e.g.:
<input class=X type=text maxlength=1 id=X name=X value=<?=$P["X"]?>>
For the hash $P
see below -- pack()
and unpack()
.
Packing is: Maps PHP variables to message format according input message (MSG TYPE=INPUT
). In PHP we use pack()
for this.
Unpacking is: Maps message format to PHP variables according output message (MSG TYPE=OUTPUT
).
In PHP we use unpack()
for this.
Result is in $P
.
IMS emulation layer, which is part of the head of the generated PHP file, written in either PHP or C (PHP extension):
- Creates and maintains IPC shared memory. This shared memory is also accessed via
CBLTDLI
calls from COBOL. - Maintains mapping between transaction code and COBOL program
- Packing PHP variables
$_POST[]
into message format, as usually we are called as HTTP POST. Pushing message viaCBLTDLI('ISRT',...)
. - Calls COBOL program which corresponds to the transaction; PHP would call FFI here
- COBOL program calls CBLTDLI to get message and insert new message.
- Fetching message via
CBLTDLI('GU',...)
. Unpacking message format to PHP variables, which are then actually shown on web-page. [mermaid] flowchart LR a([HTTP POST]) --> b(Pack PHP into IN-message\nISRT via CBLTDLI) --> c{{COBOL}} --> d(GU via CBLTDLI\nUnpack OUT-message into PHP) [/mermaid]
For packing and unpacking we need either the COBOL copybook or the above message format, which contains information on:
- Fieldname
- Length of field
- Start position in message
Perl script is here: ims2php
, helper PHP script is here: ims2php.php
.
The CBLTDLI
routine, called from COBOL and PHP, is a tailor-made routine in C which responds to message types AUTH, GU, GHU, GN, GHN, INIT, ISRT, ROLB, and PPS. Below given routine is a proof-of-concept demonstration.
1int CBLTDLI (const char fct[], struct IO_PCB *iopcb, char *msg, char *mfsmodn, void *nullp) {
2 int size;
3 char *pcb = NULL, *pcbname = "unknown";
4 static int sizeErr = -20; // that many non-positive sizes are o.k., thereafter exit
5 static int runaway = -20; // limit calls to CBLTDLI() to this many
6 assert(mainp != NULL);
7 assert(outmsg != NULL);
8 if (++runaway > 0) exit(21);
9
10 if (strncmp(fct,"AUTH",4) == 0) {
11 puts("CBLTDLI: AUTH");
12 } else if (strncmp(fct,"GU ",4) == 0 || strncmp(fct,"GHU ",4) == 0
13 || strncmp(fct,"GN ",4) == 0 || strncmp(fct,"GHN ",4) == 0) {
14 assert(msg != NULL);
15 size = 0;
16 if (iopcb == &global_iopcb) {
17 pcb = mainp;
18 pcbname = "IO-PCB";
19 if (iopcb->io_segnr == 0) {
20 iopcb->io_status[0] = ' ';
21 iopcb->io_status[1] = ' ';
22 } else {
23 iopcb->io_status[0] = 'Q';
24 iopcb->io_status[1] = 'C';
25 }
26 iopcb->io_segnr += 1; // increment segment number
27 } else if ((char*)iopcb == spa_pcb) {
28 size = 4000;
29 printf("CBLTDLI: %4.4s SPA-PCB %p.\n",fct,iopcb);
30 pcb = (char*) shmp;
31 pcbname = "SPA-PCB";
32 } else if ((struct ALT_PCB *)iopcb == &global_altpcb) {
33 printf("CBLTDLI: %4.4s ALT-PCB.\n",fct);
34 } else {
35 printf("CBLTDLI: %4.4s unknown IO-PCB %p\n", fct, iopcb);
36 }
37 if (size == 0) size = 256 * (unsigned char)(pcb[0]) + (unsigned char)(pcb[1]);
38 printf("CBLTDLI: fct=%4.4s, segnr=%d, LENGTH(msg)=%d, %s=%p%s\n",
39 fct, iopcb->io_segnr, size, pcbname,
40 iopcb, size < 0 ? " ERROR" : "");
41 if (size > 0) memcpy(msg, pcb, size);
42 else if (++sizeErr > 0) exit(21);
43 dbgputs(pcb,size);
44 } else if (strncmp(fct,"INIT",4) == 0) {
45 size = 256 * (unsigned char)(msg[0]) + (unsigned char)(msg[1]);
46 printf("CBLTDLI: fct=%4.4s, segnr=%d, LENGTH(msg)=%d, %s=%p\n",
47 fct, iopcb->io_segnr, size, "unused", iopcb);
48 } else if (strncmp(fct,"ISRT",4) == 0) {
49 assert(msg != NULL);
50 size = 0;
51 if (iopcb == &global_iopcb) {
52 pcb = outmsg;
53 pcbname = "IO-PCB";
54 iopcb->io_status[0] = ' ';
55 iopcb->io_status[1] = ' ';
56 } else if ((char*)iopcb == spa_pcb) {
57 size = 4000;
58 printf("CBLTDLI: %4.4s SPA-PCB %p.\n",fct,iopcb);
59 pcb = (char*) shmp;
60 pcbname = "SPA-PCB";
61 } else if ((struct ALT_PCB *)iopcb == &global_altpcb) {
62 printf("CBLTDLI: %4.4s ALT-PCB.\n",fct);
63 } else {
64 printf("CBLTDLI: %4.4s unknown IO-PCB %p\n", fct, iopcb);
65 }
66 if (size == 0) size = 256 * (unsigned char)(msg[0]) + (unsigned char)(msg[1]);
67 printf("CBLTDLI: fct=%4.4s, segnr=%d, LENGTH(msg)=%d, %s=%p%s\n",
68 fct, iopcb->io_segnr, size, pcbname,
69 iopcb, size < 0 ? " ERROR" : "");
70 if (size > 0) memcpy(pcb, msg, size);
71 else if (++sizeErr > 0) exit(21);
72 dbgputs(msg,size);
73 } else if (strncmp(fct,"ROLB",4) == 0) {
74 if (iopcb == &global_iopcb) {
75 if (iopcb->io_segnr > 0) iopcb->io_segnr -= 1; // "roll back" segment number
76 else puts("segnr already <= 0");
77 }
78 printf("CBLTDLI: fct=%4.4s, segnr=%d, iopcb=%p\n", fct, iopcb->io_segnr, iopcb);
79 } else if (strncmp(fct,"CHKP",4) == 0) {
80 printf("CBLTDLI(): Ignoring checkpointing, function fct=%c%c%c%c\n",fct[0],fct[1],fct[2],fct[3]);
81 } else if (strncmp(fct,"PPS ",4) == 0) {
82 pcb = (char*) shmp;
83 pcbname = "SPA-PCB-special";
84 size = 4000; //256 * (unsigned char)(pcb[0]) + (unsigned char)(pcb[1]);
85 printf("CBLTDLI(): fct=%s, size=%d, %s=%p%s\n",
86 fct, size, pcbname, pcb, size < 0 ? " ERROR" : "");
87 if (size > 0) memcpy(pcb+5000, msg, size);
88 else if (++sizeErr > 0) exit(21);
89 dbgputs(msg,size);
90 } else {
91 printf("CBLTDLI(): Unknown function fct=%c%c%c%c\n",fct[0],fct[1],fct[2],fct[3]);
92 exit(21);
93 }
94
95 return 0;
96}