SUBROUTINE ERRORBUFFER
* Construct an HTML page, calling a subroutine to fetch some
* data from a Reality file and format it as a table. On return,
* if the RealWeb error buffer contains an error code, suppress
* the error and display an error message.
*
* The name of the file to open is passed in the FILENAME parameter.

* Include the RealWeb definitions

     INCLUDE #RW.INCLUDE.DEFS FROM /SYSFILES/REALWEB,BP


     EQU LF TO CHAR(10)

* Get the URL of the Reality item server.

     ITEMFILE = ""
CALL RW_GET_PARAM("__isurl", ITEMFILE)

     ITEMFILE = ITEMFILE : "/REALWEB-ITEMS/"
* Specify the location of the stylesheet.

     STYLESHEET = ITEMFILE : "styles.css"

* Start the HTML page.
CALL RW_START_HTML_PAGE("Error Buffer Example", "", STYLESHEET, "", "")

* Get the filename parameter.

     FILENAME = ""
CALL RW_GET_PARAM("FILENAME", FILENAME)


     TABLE = ""

     GOSUB GETTABLEDATA

* Get the contents of the error buffer.

     BUF = ""
CALL RWS_GET_BUF(BUF, RWD_ERROR)
* If no error has occurred...

     IF BUF = "" THEN
* Output the table.
CALL RW_PUT(TABLE)

     END ELSE
* Suppress the RealWeb error message.
CALL RW_SET_BUF("", RWD_ERROR)

* Output an error message.

        TEXT = ""
CALL RWA_RULE(TEXT)
CALL RWA_NEWLINES(TEXT, 1)
CALL RWA_IMAGE(TEXT, ITEMFILE : "exclamation.gif", "Exclamation", "")

        TEXT = TEXT : " Error: Cannot open file " : FILENAME
CALL RWA_NEWLINES(TEXT, 1)

        CLASS = 'style="font-family: sans-serif; font-size: 14pt; color: black;"'
CALL RWS_FONT(TEXT, CLASS)
CALL RWA_NEWLINES(TEXT, 1)
CALL RWA_RULE(TEXT)
CALL RWS_PARA(TEXT, "", "")

* Output the HTML.
CALL RW_PUT(TEXT)

     END

* Complete the page.
CALL RW_END_PAGE

RETURN


*********************************************************************
* Subroutine GETTABLEDATA
*
* Reads data from the Reality file specified in the FILENAME variable
* and formats it as an HTML table. On return, the TABLE variable
* contains the table.
* If an error occurs when reading the file, the error code is placed
* in the RealWeb error buffer and TABLE is set to a null string.
*********************************************************************

GETTABLEDATA:

     EQU TAB TO CHAR(9)

     EQU AM TO CHAR(254)

     EQU VM TO CHAR(253)

* Assemble some data to go in the table.
*   Get some data to insert.

     GTD_ERROR = ""

     PERFORM "SORT-SPREAD " : FILENAME : " < '200' " : ...

           "ROOM NAME ADDRESS CITY STATE ZIP ID-SUPP" ...

           CAPTURING GTD_DATA SETTING GTD_ERROR


     IF GTD_ERROR <> "" THEN
CALL RW_PUT_EX(GTD_ERROR, RWD_ERROR)

        GTD_DATA = ""

     END ELSE
*   The headings are in the second attribute.

        DEL GTD_DATA<1>

        GTD_HEADINGS = GTD_DATA<1>
*   SORT-SPREAD returns tab-separated data; we need a dynamic array.

        GTD_HEADINGS = CHANGE(GTD_HEADINGS, TAB, AM)
*   The data is in the third attribute onwards.

        DEL GTD_DATA<1>
*   SORT-SPREAD returns tab-separated data; we need a dynamic array.

        GTD_DATA = CHANGE(GTD_DATA, TAB, VM)

* Right align all the columns.

        GTD_DATAFORMAT = ""

        FOR I = 1 TO DCOUNT(GTD_HEADINGS, AM)

           GTD_DATAFORMAT<I> = VM : "RIGHT"

        NEXT I


        GTD_CLASS = ""

        GTD_CLASS<2> = "border"                        ;* Give the table a border.

        GTD_CLASS<3> = "bgcolor=lightsteelblue"        ;* Set a background colour.

        GTD_CLASS<4> = "cellspacing=0 cellpadding=5"   ;* Add some space around the text.

* Create the table.

        TABLE = ""

        CALL RWA_MAKE_TABLE(TABLE, ...

           GTD_HEADINGS, ...

           GTD_DATA, ...

           GTD_DATAFORMAT, ...

           GTD_CLASS, ...

           RWD_IGNORE_EMPTY_ROWS)

     END

RETURN
ClosedResult
ClosedHTML