Now we look at a Web program doing all the 4 basic DML operations - STORE, OBTAIN, MODIFY and ERASE.
It is made up of one Web dialog and a skeleton map.
1. swebex01-head - the skeleton 'html' map stored in IDD
2. Dwebex01 - Web dialog
Execution Sequence: (Self Explanatory)
Similarly the other 3 functions can be exceuted.
Here is the source:
ADD
MODULE NAME IS SWEBEX01-HEAD VERSION IS 1
LANGUAGE IS HTML
MOD SOU FOLLOWS
<HTML><HEAD> <TITLE> DEPARTMENT UPDATE</TITLE> </HEAD> ?_LBR
<STYLE Type="text/css">
h1{ font-family:Bookman Old Style,Arial;color:0000a0}
h3{ font-family:Bookman Old Style,Arial;color:0000a0} </STYLE>
<!-- h1?_LB font-family:Bookman Old Style,Arial;color:0000a0?_RB-->
<!--h3?_LB font-family:Bookman Old Style,Arial;color:0000a0?_RB</STYLE>-->
<BODY BGCOLOR="FFFFF0">?_LBR
<TABLE BORDER="0" WIDTH="100%" BGCOLOR="AC1504">
<TR>
<TD ALIGN="CENTER" WIDTH="100%"><FONT COLOR="FFFF80"
FACE="BOOKMAN OLD STYLE"><STRONG>S212/IDMS - WEB
INTERFACE : SAMPLE</STRONG></FONT></TD>
</TR>
</TABLE>
<FORM
ACTION="DWEBEX01.DIA"
METHOD=GET> <H1 ALIGN=CENTER> Department Maintenance</H1>
<P><B>DEPT-ID:</B>
<INPUT TYPE="TEXT" NAME="DEPTID" SIZE=4
VALUE="?DEPTID(,BS)">
NAME:?_EOL
<INPUT TYPE="TEXT" NAME="DNAME" ?_EOL
VALUE="?DNAME(,BS) " MAXLENGTH=40 SIZE=40>
HEAD: <INPUT TYPE="TEXT" NAME="DHEAD" SIZE=4 VALUE="?DHEAD" MAXLENGTH=4>
<p><br>
<INPUT TYPE="RADIO" NAME="SEX" VALUE="Male">Male <br>
<INPUT TYPE="RADIO" NAME="SEX" VALUE="Female">Female <br>
<br><br><P> <INPUT TYPE="SUBMIT" NAME="SUB" VALUE="DISPLAY">
<INPUT TYPE="SUBMIT" NAME="SUB" VALUE="STORE">
<INPUT TYPE="SUBMIT" NAME="SUB" VALUE="DELETE">
<INPUT TYPE="SUBMIT" NAME="SUB" VALUE="UPDATE">
<INPUT TYPE="RESET" VALUE="RESET">
Also TESTING @ sign $ dollar {}[] #øæåØÆÅ and ü and Ü<br>
<P>?ERRMSG
MSEND.
ADD PROCESS NAME IS PWEBEX01-PM VERSION IS 1
DESCRIPTION IS 'WEB EXAMPLE 02'
MODULE SOURCE FOLLOWS
¤------------------------------------------------------------
¤ INITIAL VALUES TO VARIABLES -
¤------------------------------------------------------------
MOVE 'EMPDEMO' TO DB-NAME.
MOVE SPACE TO DEPT-NAME-0410.
MOVE SPACE DEPT-ID-0410.
MOVE SPACE DEPT-HEAD-ID-0410.
MOVE SPACE WWWWHTML-TXT.
READY USAGE-MODE UPDATE.
¤------------------------------------------------------------
¤ First Check DEPT-ID Field before everything -
¤------------------------------------------------------------
CALL DEPCHECK.
¤------------------------------------------------------------
¤ READ BUTTON VARIABLE SUB -
¤------------------------------------------------------------
MOVE HTTPDVAR(WWWWPTR,'SUB',1,ACTION-FIELD) to ACTION-FIELD.
IF WWWWVIND-OK THEN DO.
IF ACTION-FIELD = 'DISPLAY' THEN
CALL DISPSUB.
ELSE IF ACTION-FIELD = 'STORE' THEN
CALL STORSUB.
ELSE IF ACTION-FIELD = 'DELETE' THEN
CALL DELSUB.
ELSE IF ACTION-FIELD = 'UPDATE' THEN
CALL UPDSUB.
End.
ELSE DO.
MOVE 'Transmisson Error '
TO WWWWHTML-TXT.
CALL SENDMAP.
END.
¤--------------------------------------------------------
DEFINE DEPCHECK.
¤--------------------------------------------------------
MOVE HTTPDVAR(WWWWPTR,'DEPTID',1,DEPT-ID-0410) TO
DEPT-ID-0410.
¤------------------------------------------------------------
¤ CHECK IF QUERY VARIABLE DEPTID IS CORRECT -
¤------------------------------------------------------------
IF NOT WWWWVIND-OK THEN DO.
IF WWWWVIND-TRUNC
MOVE CON('<font color=red size=+1>',
'Dept ID Too Long and is Truncated',
'</font>') TO WWWWHTML-TXT.
ELSE
MOVE CON('<font color=red size=+1>',
'Dept Entered Missing or Transmission Error',
'</font>') TO WWWWHTML-TXT.
CALL SENDMAP.
END.
¤------ More Checks on the Key Field Dept-ID ------------
IF DEPT-ID-0410 = 0 OR
NOT(numeric(DEPT-ID-0410))
DO.
MOVE CON('<font color=red size=+1>',
'Department ID Cannot be 0 or spaces'
'</font>') TO WWWWHTML-TXT.
CALL SENDMAP.
END.
GOBACK.
¤--------------------------------------------------------
DEFINE STORSUB.
¤--------------------------------------------------------
CALL OTHCHECK.
¤ READ department record
¤
IF DEPT-NAME-0410 = SPACES
MOVE 'SPACES ' TO DEPT-NAME-0410.
ELSE IF WS-SEX NE SPACES
MOVE CON (EXT(DEPT-NAME-0410),'(',EXT(WS-SEX),')')
TO DEPT-NAME-0410.
If not(numeric(DEPT-HEAD-ID-0410))
MOVE 0 TO DEPT-head-id-0410.
STORE DEPARTMENT ALLOWING (DB-ANY-ERROR).
IF DB-STATUS-OK THEN
DO.
MOVE CON('<font color=BLUE size=+1>',
'NEW DEPARTMENT IS STORED'
'</font>') TO WWWWHTML-TXT.
END.
ELSE
DO.
IF error-status='1205'
MOVE CON('<font color=red size=+1>',
'Department Already Exists DEPT-ID=',
DEPT-ID-0410, '</font>') TO WWWWHTML-TXT.
ELSE
MOVE CON('ERROR: DEPT store failed', ERROR-STATUS)
TO WWWWHTML-TXT.
END.
CALL SENDMAP.
GOBACK.
¤--------------------------------------------------------
DEFINE DISPSUB.
¤--------------------------------------------------------
OBTAIN CALC DEPARTMENT.
IF DB-REC-NOT-FOUND
MOVE 'Department Does not Exist' TO WWWWHTML-TXT.
ELSE IF DB-STATUS-OK
MOVE 'Here is the Department Information ' TO WWWWHTML-TXT.
ELSE MOVE 'Critical Database Error ' TO WWWWHTML-TXT.
CALL SENDMAP.
GOBACK.
¤--------------------------------------------------------
DEFINE DELSUB.
¤--------------------------------------------------------
OBTAIN CALC DEPARTMENT.
IF DB-REC-NOT-FOUND
MOVE 'Department Does not Exist' TO WWWWHTML-TXT.
ELSE IF DB-ANY-ERROR
MOVE 'Critical Database Error ' TO WWWWHTML-TXT.
ELSE DO.
ERASE DEPARTMENT ALLOWING(DB-ANY-ERROR).
IF DB-STATUS-OK
MOVE CON('<font color=BLUE size=+1>',
'Department has been Erased',
'</font>') TO WWWWHTML-TXT.
ELSE IF ERROR-STATUS ='0230'
MOVE CON('<font color=BLUE size=+1>',
'Department has Employees - Cannot be Erased',
'</font>') TO WWWWHTML-TXT.
ELSE
MOVE CON('Critical Error During Delete, Error Status=',ERROR-STATUS)
TO WWWWHTML-TXT.
END.
CALL SENDMAP.
GOBACK.
¤--------------------------------------------------------
DEFINE UPDSUB.
¤--------------------------------------------------------
OBTAIN CALC DEPARTMENT.
IF DB-REC-NOT-FOUND
MOVE 'Department Does not Exist' TO WWWWHTML-TXT.
ELSE IF DB-ANY-ERROR
MOVE 'Critical Database Error ' TO WWWWHTML-TXT.
ELSE DO.
CALL OTHCHECK.
MODIFY DEPARTMENT ALLOWING(DB-ANY-ERROR).
IF DB-STATUS-OK
MOVE CON('<font color=BLUE size=+1>',
'Department has been Updated',
'</font>') TO WWWWHTML-TXT.
ELSE IF DB-ANY-ERROR
MOVE CON('Critical Error During Update, Error Status=',ERROR-STATUS)
TO WWWWHTML-TXT.
END.
CALL SENDMAP.
GOBACK.
¤--------------------------------------------------------
DEFINE OTHCHECK.
¤--------------------------------------------------------
¤-- Check the Entry of Other 2 fields Name and Head -
MOVE HTTPDVAR(WWWWPTR,'DNAME',1,DEPT-NAME-0410) TO
DEPT-NAME-0410.
IF NOT WWWWVIND-OK THEN
DO.
MOVE CON('<font color=red size=+1>',
'Name Entered Wrong or Too Long or Transmission Error',
'</font>') TO WWWWHTML-TXT.
CALL SENDMAP.
END.
MOVE HTTPDVAR(WWWWPTR,'DHEAD',1,DEPT-HEAD-ID-0410) TO
DEPT-HEAD-ID-0410.
IF NOT WWWWVIND-OK THEN
DO.
MOVE CON('<font color=red size=+1>',
'Head Id Entered Wrong or Too Long or Transmission Error',
'</font>') TO WWWWHTML-TXT.
CALL SENDMAP.
END.
GOBACK.
DEFINE SENDMAP.
¤------------------------------------------------------------
¤ WRITE HTML SENDMAP FROM IDD MODULE PHWEBEX01-HEAD
¤------------------------------------------------------------
MOVE HTMLPAGE(WWWWPTR,'SWEBEX01-HEAD',1,
'DEPTID',DEPT-ID-0410,
'DNAME',DEPT-NAME-0410,
'DHEAD',DEPT-HEAD-ID-0410,
'ERRMSG',WWWWHTML-TXT)
TO WWWWHTTP-STATUS.
IF WWWWHTTP-STATUS = 200 THEN
DO.
¤ WRITE HTML END -
¤------------------------------------------------------------
¤---- BELOW IS THE FOOTER CODE PWEBEX01-FOOT ----------------
MOVE '</FORM> ' TO WWWWHTML-TXT.
CALL WWWSEND.
END.
CALL EPILOG.
RETURN.
¤-------------------------------
DEFINE EPILOG.
¤--------------------------------
MOVE HTMLPAGE(WWWWPTR,'MENUBUTTON',1,
'DUMMY',' ')¤- DUMMY NEEDED FOR EDIT
TO WWWWHTTP-STATUS.
GOBACK.
¤-------------------------------
DEFINE WWWSEND.
¤--------------------------------
MOVE SLEN(EXTRACT(WWWWHTML-TXT)) TO WWWWSLEN.
PUT SCRATCH AREA ID WWWWHTML-SCR FROM WWWWHTML-TXT LENGTH
WWWWSLEN.
GOBACK.
MSEND
.
That's all. We are able to achieve everything from Web within
240 lines of ADS Code.
Can you find a similar compact code doing the same thing on any
other database or platform or langage? Let's
know!!
IDMS/SQL talked to some Unix people who failed to provide similar code doing the same 4 operations against a Unix Database table.
Many admitted that the operations are possible, but the code will not be so compact!!! Also it has to go through a Web Server in another box!!
The code is compiled and executed on mainframe. There is no way for the end user to intefere in this operation.
Though ADS based web dialogs are impressive and serve the purpose in most cases, some sites have problems (not technical, but 'religious') in integrating this setup with other web applications which are traditionally 'Unix Server' based. But such integration is in fact possible even in our case. Webserver/ADS is only an umbrella on top of TCP/IP Socket Interface or Gateway to IDMS, which is the key component. One can program in Java or C and still access a server dialog in IDMS and get information. Instead of Web the output will be directed to the client (Java for example). Then Java front-end can diagnose the output and take appropriate action. Java program itself can run on the Client side or as many people want on the 'Unix/NT based Webserver'. This will be similar to running JSP. A JSP program running on Unix-Webserver will be the server program for the traditional client, but the same JSP will be a client for IDMS/Server.
After the ADS/Web demo programs we will at least demonstrate a simple Java program accessing Server Dialog using http/ip address URL protocol. At the time of this writing, Vegasoft has also come up with a more programmable interface for Java Clients - VG-Java Client. We will have a look at Java Client later in the series.