001000* DEMO-SERVER
001010*
001020* Copyright 1998-2000 LegacyJ Corporation.  All Rights Reserved.
001030*
001040* Written by Brian Sullivan.
001050*
001060* This is an example program providing time of day services
001070* along with a banner message to a client machine connecting
001080* via either another PERCobol program or TELNET.
001090*
001100* This example should be used for writing COBOL server programs.
001110*
001120* This demo uses the SCREEN SECTION to provide a visual status
001130* of 14 socket connections (those which fit on a screen); more
001140* connections are allowed, but will not be shown.
001150*
001160* It also includes a clock which is updated once per second.
001170* It includes a date, which is updated only once per execution.
001180* (Add the date display into the clock-display for constant
001190*  date updates.)
001200*
001210* It also includes an advertising banner for PERCobol near the
001220* bottom of the screen.
001230*
001240
001250 IDENTIFICATION DIVISION.
001260 PROGRAM-ID.
001270     DEMO-SERVER.
001280
001290 ENVIRONMENT DIVISION.
001300 CONFIGURATION SECTION.
001310*
001320* The REPOSITORY is a COBOL 2000 feature implemented in
001330* PERCobol V2.0+.  It provides a listing of all classes
001340* to be used by this program.  PERCobol has direct access
001350* using the COBOL 2000 features to Java, for Java objects
001360* and Java Beans.
001370
001380 REPOSITORY.
001390     CLASS JAVA-LANG-THREAD IS "java.lang.Thread"
001400	    CLASS JAVA-NET-SOCKET IS "java.net.Socket"
001410     .
001420
001430	INPUT-OUTPUT SECTION.
001440 FILE-CONTROL.
001450
001460* The file selection and usage is standard, but the device it
001470* is assigned to exists only with PERCobol.  The server:
001480* device opens a TCP/IP server port at the given port number
001490* and then waits for connections whenever opened; when
001500* opened, the file automatically becomes a standard TCP/IP
001510* socket to a client for that thread.  Open the server from 
001520* another thread, get another client socket.
001530
001540 SELECT TCP-FILE ASSIGN TO "server:3456"
001550 ORGANIZATION LINE SEQUENTIAL
001560 .
001570
001580 DATA DIVISION.
001590 FILE SECTION.
001600*
001610* The template for the record to be sent to the client.
001620*
001630 FD  TCP-FILE.
001640 01  PRINT-REC.
001650     05 PRINT-REC-TN PIC XX.
001660     05 FILLER PIC X VALUE SPACES.
001670     05 PRINT-REC-TOD PIC X(22).
001680	    05 FILLER PIC X VALUE SPACES.
001690	    05 BANNER-F PIC X(56).
001700
001710* PERCobol 2.0+ supports the X/Open Screen Section for
001720* GUI's AND for dumb terminals!  PERCobol is the ONLY
001730* Java product which supports full screen control of
001740* dumb terminals.
001750
001760 SCREEN SECTION.
001770 01 STATUS-SCREEN.
001780   05 STATUS-BLANK
001775      BACKGROUND-COLOR WHITE 
001776      FOREGROUND-COLOR BLACK
001777      BLANK SCREEN.
001790	    10 VALUE "PERCobol Time Of Day Server"
001800	       LINE 1 COLUMN 27 BLINK HIGHLIGHT.
001810	    10 VALUE "PERCobol and Time Of Day Server " &
001820              "Copyright 1998-2000 LegacyJ Corporation"
001830              LINE 2 COLUMN 5 HIGHLIGHT.
001840	    10 VALUE "Thread"
001850	       COLUMN 1 LINE 4 UNDERLINE.
001860	    10 VALUE "Status"
001870	       COLUMN 8 LINE 4 UNDERLINE.
001880	    10 VALUE 
001890	       "Socket                            "
001900	       & "                               "
001910	       COLUMN 15 LINE 4 UNDERLINE.
001920	    10 CLOCK-DATE PIC X(9) COLUMN 60 LINE 22 HIGHLIGHT.
001930	    10 CLOCK-TIME PIC X(8) COLUMN 70 LINE 22 HIGHLIGHT.
001940	    10 VALUE "Port 3456" COLUMN 1 LINE 22 HIGHLIGHT UNDERLINE.
001950
001960	    10 BANNER PIC X(80) COLUMN 1 LINE 20 HIGHLIGHT VALUE SPACES.
001970* 
001980* LOCAL-STORAGE is a PERCobol extension also found in a few
001990* other COBOL vendors.  Every instance of a PERCobol program
002000* and every thread of a PERCobol program has its own
002010* local storage.  In this example, the LOCAL STORAGE is used
002020* so that each thread of the server does not interfere with
002030* another thread of the server.
002040*
002050 LOCAL-STORAGE SECTION.
002060 01 TCP-DATA.
002070   05 TCP-THREAD PIC 99.
002080   05 FILLER PIC X VALUE SPACES.
002090   05 TCP-DATA-INNER PIC X(22).
002100	  05 FILLER PIC X VALUE SPACES.
002110	  05 BANNER-F PIC X(56) VALUE 
002120	    "LegacyJ PERCobol 2.3 888-796-5766 www.legacyj.com".
002130
002140 01 CURRENT-SOCKET OBJECT REFERENCE JAVA-NET-SOCKET.
002150 01 ACTIVE-LINE PIC 99.
002160 01 SOCKET-LINE PIC X(65).
002170
002180 PROCEDURE DIVISION.
002190* 
002200* The first paragraph performs some setup operations, including
002210* setting the initial date and time, and displaying the screen.
002220*
002230 GREETING.
002240     MOVE CURRENT-DATE TO CLOCK-DATE
002250	    MOVE CURRENT-TIME TO CLOCK-TIME
002260	    DISPLAY STATUS-SCREEN
002270* Start the clock update thread and continue onwards (#2)
002280     THREAD CLOCK-UPDATE
002290* Start the banner update (#3)
002300     THREAD BANNER-UPDATE
002310* Start the server (#4)
002320	    THREAD OPEN-FILE
002330* End this thread (#1)
002340	    EXIT PROGRAM
002350	    .
002360
002370 OPEN-FILE.
002380*
002390* Wait for a connection; server: connections wait for a
002400* client connection, and then are treated as normal
002410* socket connections.  They may be reopened for another
002420* client safely from another thread.
002430*
002440
002450     OPEN OUTPUT TCP-FILE
002460
002470*	   
002480* Start a new thread of execution with OPEN-FILE and continue.
002490*
002500     THREAD OPEN-FILE
002510	    .
002520*
002530* The program falls through to here in one thread of execution.
002540*
002550
002560 SET-THREAD-NUMBER.
002570
002580* We want to know which thread we are.
002590     SET TCP-THREAD TO CURRENT-THREAD
002600* Adjust for the extra threads we created
002610     SUBTRACT 2 FROM TCP-THREAD
002620
002630*
002640* Obtain the Java Object for the TCP/IP Socket we have.
002650* This is not necessary to use the Socket, but it allows
002660* us to display a nice representation of the Socket
002670* on the screen.  INVOKE'ing methods on the returned
002680* object allows us to find out where the Socket is coming
002690* from, etc.
002700*
002710
002720     SET CURRENT-SOCKET TO FUNCTION NATIVE(TCP-FILE)
002730
002740*
002750* Set the display line
002760*
002770     ADD 4 TO TCP-THREAD GIVING ACTIVE-LINE
002780
002790*
002800* Only show the status until it fills the screen  
002810*
002820	    IF ACTIVE-LINE < 19 THEN
002830*
002840* Set an alpanumeric to an object to obtain a readable version
002850* of its contents.  We could have displayed the object directly
002860* but then it could have overflowed the right bounds of the
002870* screen on occasion.  This way we know that the resulting
002880* text will fit on the screen.
002890*
002900
002910         SET SOCKET-LINE TO CURRENT-SOCKET
002920	        DISPLAY TCP-THREAD  AT COLUMN 1  LINE ACTIVE-LINE
002930	        DISPLAY "Active"    AT COLUMN 8  LINE ACTIVE-LINE
002940	                            HIGHLIGHT
002950	        DISPLAY SOCKET-LINE AT COLUMN 15 LINE ACTIVE-LINE
002960	    END-IF
002970	    .
002980
002990* Write the data to the client.
003000
003010 WRITE-TO-CLIENT.
003020
003030* Move the current date to local storage for the file.
003040
003050     MOVE FUNCTION CURRENT-DATE TO TCP-DATA-INNER
003060
003070* For each client to have different data, the data must
003080* be in local storage, and that means writing from
003090* and reading into separate buffers.  The (RE)WRITE FROM
003100* and READ INTO verbs are safely synchronized for the file.
003110*
003120* Do NOT use the FILE STATUS from multi-threaded programs
003130* as FILE STATUS cannot currently be in LOCAL-STORAGE;
003140* if the network connection is closed from the other
003150* side, EOF will be set for READ's, and WRITE's can
003160* check INVALID KEY for this.
003170*
003180* If a program gives NullPointerException's when multi-
003190* threaded, there's a good chance the program didn't
003200* use LOCAL-STORAGE where necessary.  If one thread is
003210* manipulating a value while another is also trying
003220* to manipulate it, data can be lost; this will not
003230* occur with LOCAL-STORAGE.
003240
003250     WRITE PRINT-REC FROM TCP-DATA AFTER ADVANCING 1 LINE
003260	    INVALID KEY
003270*
003280* Only show the status until it fills the screen  
003290*
003300         IF ACTIVE-LINE < 19 THEN
003310	            SET SOCKET-LINE TO CURRENT-SOCKET
003320	            DISPLAY "  "        AT COLUMN 1 LINE ACTIVE-LINE
003330	            DISPLAY "------"    AT COLUMN 8 LINE ACTIVE-LINE
003340	            DISPLAY SOCKET-LINE AT COLUMN 15 LINE ACTIVE-LINE
003350         END-IF
003360*
003370*     This close affects only the current client.  To have the
003380*     close affect the server socket itself, CLOSE WITH LOCK.
003390*
003400	        CLOSE TCP-FILE
003410*
003420*     Actually, this exits only the current thread.  This program
003430*     must be stopped by a CTRL-C or kill command from the OS
003440*     as it is a server meant to run continuously.  (If running
003450*     this on a GUI, closing the display console also works.)
003460*
003470	        EXIT PROGRAM
003480	    END-WRITE
003490*
003500* Update the client once per second
003510*
003520	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 1000
003530
003540	    GO TO WRITE-TO-CLIENT
003550	    .
003560
003570 DONE-WRITING.
003580*
003590* Close port to end connection from this side.
003600*
003610	    CLOSE TCP-FILE. 
003620*
003630* Exit this thread.
003640*
003650	    EXIT PROGRAM.
003660
003670*
003680* Update the visible clock once per second.
003690*	   
003700 CLOCK-UPDATE.
003710     MOVE CURRENT-TIME TO CLOCK-TIME
003720	    DISPLAY CLOCK-TIME
003730	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 1000
003740	    GO TO CLOCK-UPDATE
003750	    .
003760
003770*
003780* An advertising banner for PERCobol across the bottom of
003790* the screen.  It displays a message and then waits a
003800* number of seconds before displaying another message.
003810* It repeats after showing all banner messages.
003820* 
003830 BANNER-UPDATE.
003840     MOVE "LegacyJ PERCobol " TO BANNER
003860	    DISPLAY BANNER
003870	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 8000
003880
003890     MOVE "LegacyJ and MicroFocus file support." TO BANNER
003910     DISPLAY BANNER
003920     INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 8000
003930
003940	    MOVE "X/Open SCREEN SECTION for Terminals and GUI's"
003950	         TO BANNER
003960	    DISPLAY BANNER
003970	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 4000
003980
003990	    MOVE "Multithreading using THREAD, PERFORM THREAD,"
003995              & " CALL THREAD statement" TO BANNER
004000	    DISPLAY BANNER
004010	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 4000
004020
004030     MOVE "TCP/IP control using file statements, " 
004040     & "BOTH client and server!" TO BANNER
004050	    DISPLAY BANNER
004060	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 4000
004070
004080	    MOVE "This demonstration in COBOL using SCREEN SECTION, "
004090	         & "THREAD, and SERVER: files!" TO BANNER
004100	    DISPLAY BANNER
004110	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 4000
004120
004130	    MOVE "Common IBM, HP, AcuCOBOL, X/Open, MicroFocus " 
004135           & "extensions!  "
004140	         TO BANNER
004150	    DISPLAY BANNER
004160	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 4000
004170
004180	    MOVE "INVOKE and OBJECT REFERENCES to access Java API's!"
004190	         TO BANNER
004200	    DISPLAY BANNER
004210	    INVOKE JAVA-LANG-THREAD "sleep" USING BY VALUE 4000
004220
004230     GO TO BANNER-UPDATE
004240	    .
004250