tldm-universe/Ardent/UV/APP.PROGS/TL.SFILE.B

441 lines
14 KiB
Plaintext
Raw Normal View History

2024-09-09 21:51:08 +00:00
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
$INCLUDE UNIVERSE.INCLUDE TLOG.H
******************************************************************************
*
* System Admin Transaction Logging - Update Attributes
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description........................................
* 10/14/98 23801 SAP Change copyrights.
* 05/24/95 16198 GMH Allow FULL TAPE to reconfigure
* 05/04/95 16198 GMH Set CHKPOINT OFF if ARCHIVE TAPE
* 04/26/95 16198 GMH Add archive tape support
* 03/09/95 15864 DTM Fixed so it allows initial response to be understood,
* even if arrow keys are used
* 08/22/94 14726 DTM Fixed so it doesn't allow two Off responses
* 05/15/94 13286 DTM Initial programming
*
*******************************************************************************
id = "%W%"
*******************************************************************************
OPEN '&DEVICE&' TO DEVICE.FILE ELSE
PRINT UVREADMSG(1520,"&DEVICE&")
SLEEP 2
STOP
END
OPEN 'DICT',UV.LOGS.FILE.NAME TO DICT.FILE ELSE
PRINT UVREADMSG(1520,"DICT ":UV.LOGS.FILE.NAME)
SLEEP 2
STOP
END
*******************************************************************************
* Call initialization routines
*******************************************************************************
TPRINT @(-1)
temp = NULL
CALL *ISUSER.B(0, temp)
IF temp = 0 THEN
TPRINT UVREADMSG(071000,"")
SLEEP 3
STOP
END
GOSUB init.form
CALL *DRAW.SCRN.B( SFILE.MSG1, 1 )
GOSUB init.menu
CALL *MNU.BAR.PR.B(Menu.Bar,1)
*******************************************************************************
* Begin processing
*******************************************************************************
GOSUB verify.state
CALL *HELP.PRINT.B(UVREADMSG(073009,""),2)
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
help.loop:
CALL *HELP.PRINT.B(form<form.line,4>,1)
input.loop:
TPRINT form<form.line,2>:
temp=temp.form<form.line>
CALL *CINPUT.B(SEC.PRMPT,temp,special,form<form.line,6>,0)
IF special # 0 THEN
BEGIN CASE
CASE special = UP.ARROW
TPRINT form<form.line,2>:PRMPT:
IF temp.form<form.line> # NULL THEN
TPRINT temp.form<form.line>:
TPRINT STR(SPACE,27-len(temp.form<form.line>)):
END
ELSE
TPRINT group.defaults<form.line>:
TPRINT STR(SPACE,27-len(group.defaults<form.line>)):
END
form.line -=1
IF form.line < 1 THEN
form.line = form.size
END
GOTO help.loop
CASE special = DOWN.ARROW
TPRINT form<form.line,2>:PRMPT:
IF temp.form<form.line> # NULL THEN
TPRINT temp.form<form.line>:
TPRINT STR(SPACE,27-LEN(temp.form<form.line>)):
END
ELSE
TPRINT group.defaults<form.line>:
TPRINT STR(SPACE,27-LEN(group.defaults<form.line>)):
END
form.line +=1
IF form.line > form.size THEN
form.line = 1
END
GOTO help.loop
CASE special = F.1
CALL *HELP.PRINT.B(form<1,5>,3)
GOTO input.loop
CASE special = ESCAPE
STOP @(-1)
CASE special = F.10
action.value=1
CALL *DO.MNU.BAR.B(Menu.Bar,action.value,form.size,form,temp.form)
BEGIN CASE
CASE action.value = 1
STOP @(-1)
CASE action.value = 2
STOP @(-1)
CASE action.value = 3
message=SFILE.MSG8
CONVERT @FM TO " " IN message
CALL *HELP.BOX.B(3,10,60,message)
CASE action.value = 4
message=UVREADMSG(076001,"")
CONVERT @FM TO " " IN message
CALL *HELP.BOX.B(3,10,60,message)
CASE action.value = 5
CALL *HELP.BOX.B(3,10,45,UVREADMSG(076000,""))
END CASE
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
CASE 1
GOTO input.loop
END CASE
END
ELSE
BEGIN CASE
* Checkpoint prompt
CASE form.line = 1
* Only allow chkpoint to change if NOT tape
if ArchiveType # "TAPE" then
CheckPointMode = UPCASE( temp )
IF CheckPointMode # "ON" AND CheckPointMode # "OFF" THEN
CALL *HELP.BOX.B( 10, 10, 40, "Must be either ON or OFF" )
temp.form< form.line > = ""
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
GOTO help.loop
END
end
temp.form< form.line > = UPCASE(temp)
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
* Archive Mode prompt
CASE form.line = 2
ArchiveMode = UPCASE(temp)
IF ArchiveMode # "ON" AND ArchiveMode # "OFF" THEN
CALL *HELP.BOX.B( 10, 10, 40, "Must be either ON or OFF" )
temp.form< form.line > = ""
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
GOTO help.loop
END
temp.form< form.line > = UPCASE(temp)
* Check for value of ArchiveMode
IF ArchiveMode = "OFF" THEN
* Display answer
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
* Set Achive Type to N/A
ArchiveType="N/A"
form.line = 3
temp.form<form.line>="N/A"
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
* Set DevicesList to N/A
ArchiveList = ""
form.line = 4
temp.form<form.line>="N/A"
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
END
* Archive Type prompt - only if Archive Mode ON
CASE form.line = 3
ArchiveType = UPCASE( temp )
IF ArchiveType # "DISK" AND ArchiveType # "TAPE" THEN
CALL *HELP.BOX.B( 10, 10, 40, "Must be either DISK or TAPE" )
temp.form< form.line > = ""
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
GOTO help.loop
END
temp.form<form.line> = UPCASE(temp)
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
* Check for DISK
IF ArchiveType = "DISK" THEN
* Set DevicesList to N/A
form.line += 1
temp.form<form.line>="N/A"
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
END ELSE
* Set Checkpoint to OFF
CheckPointMode = "OFF"
temp.form< 1 > = CheckPointMode
TPRINT form<1,2>:PRMPT:temp.form<1>:
TPRINT STR(SPACE,16-LEN(temp.form<1>)):
END
* Archive Devices List - only if Archive Type TAPE
CASE form.line = 4
ArchiveList = convert(" ",@VM,temp)
RESTART:
IF ArchiveList = "" THEN
CALL *HELP.BOX.B( 10, 10, 40, "At least ONE tape device must be defined." )
* Repaint previous line
TPRINT form<form.line-1,2>:PRMPT:temp.form<form.line-1>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line-1>)):
* Repaint current line
temp.form< form.line > = ""
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
GOTO help.loop
END
* Verify Devices List
VAL=0
LOOP
REMOVE CURDEV FROM ArchiveList SETTING MARK
VAL += 1
* Check in device file
READ DEVREC FROM DEVICE.FILE,CURDEV ELSE
CALL *HELP.BOX.B( 10, 10, 40, CURDEV:" is not in &DEVICE& file. Removed from list." )
del ArchiveList<1,VAL>
goto RESTART
END
* Check if tape
IF DEVREC<4> # "DC" AND DEVREC<4> # "DT" THEN
CALL *HELP.BOX.B( 10, 10, 40, CURDEV:" is not a tape device. Removed from list." )
del ArchiveList<1,VAL>
goto RESTART
END
UNTIL MARK = 0 DO REPEAT
temp.form<form.line> = convert(@VM," ",ArchiveList)
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
END CASE
form.line+=1
* more forms to prompt for?
IF form.line <= form.size THEN GOTO help.loop
* Validation
IF ( CheckPointMode = "OFF" ) AND ( ArchiveMode = "OFF" ) THEN
message = "At least one attribute must be on!"
CALL *HELP.BOX.B( 10, 10, 40, message )
temp.form< 1 > = ""
temp.form< 2 > = ""
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
form.line = 1
GOTO help.loop
END
* If TAPE, need to write ArchiveList to DICT UV_LOGS ARCHIVE F3.
IF ArchiveType = "TAPE" THEN
* Check for list
IF ArchiveList = "" THEN
CALL *HELP.BOX.B(10,10,40,"At least ONE tape device must be defined.")
form.line = 4
temp.form< form.line > = ""
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,16-LEN(temp.form<form.line>)):
GOTO help.loop
END
END
* Update
GOSUB set.attributes
END
STOP @(-1)
*************************************************************************
* set.attributes
*************************************************************************
set.attributes:
Exec.Sentence = "SET.LOG.ATTR ARCHIVE ":ArchiveMode
* Check for Type
IF ArchiveType = "TAPE" THEN
Exec.Sentence := " DEVICELIST ":convert(@vm," ",ArchiveList)
END
Exec.Sentence := " CHECKPOINT ":CheckPointMode
EXECUTE Exec.Sentence CAPTURING message
CALL *HELP.BOX.B( 6, 10, 70, message )
RETURN
*************************************************************************
* verify.state
*************************************************************************
verify.state:
;* Return the state of the server
State = ""
Attributes = ""
temp.form<1>="ON"
temp.form<2>="ON"
temp.form<3>="DISK"
temp.form<4>="N/A"
CP = 0
AR = 0
proceed = 0
* Get state of logging system
RECIO( State, FINFO$AI.STATE, RECIO$FINFO )
* Check if FULL TAPE
if State = AI$FULL then
RECIO( AR, FINFO$AI.ARCHIVE.TAPE, RECIO$FINFO )
if AR = 4 then proceed = 1
end
* Only proceed if necessary
IF State = AI$UNINIT OR State = AI$DISABLED OR State = AI$SUSPENDED OR State = AI$INACTIVE OR proceed THEN
RECIO( CP, FINFO$AI.CHECKPOINT, RECIO$FINFO )
IF CP = 0 THEN
temp.form<1> = "OFF"
END
RECIO( AR, FINFO$AI.ARCHIVE, RECIO$FINFO )
IF AR = 0 THEN
temp.form<2> = "OFF"
temp.form<3> = "N/A"
END ELSE
* Check for tape
RECIO( AR, FINFO$AI.ARCHIVE.TAPE, RECIO$FINFO )
IF AR = 4 THEN
temp.form<3> = "TAPE"
* Now get devices
DV = ""
RECIO( DV, 0, RECIO$DEVICELIST )
temp.form<4> = convert(@vm," ",DV)
END
END
END
ELSE
message = "Logging must be either SUSPENDED or SHUTDOWN"
CALL *HELP.BOX.B( 6, 10, 60, message )
STOP @(-1)
END
CheckPointMode = temp.form<1>
ArchiveMode = temp.form<2>
ArchiveType = temp.form<3>
ArchiveList = convert(@vm," ",temp.form<4>)
RETURN
*************************************************************************
* Init.form
* This routine is used TO initialize the form TO be printed on the
* screen for data input. It also sets up the default answers, if
* any
*
*************************************************************************
init.form:
temp.form = NULL
temp.form<1>= "ON"
temp.form<2>= "ON"
temp.form<3>= "DISK"
temp.form<4>= ""
form.size = 4
form.line = 1
form = NULL
* setup Checkpoint Mode
form<1,1> = @(5,6)
form<1,2> = @(40,6)
form<1,3> = SFILE.MSG6
form<1,4> = SFILE.MSG7
form<1,5> = form<1,4>
form<1,6> = 10
* setup Archive Mode
form<2,1> = @(5,8)
form<2,2> = @(40,8)
form<2,3> = SFILE.MSG4
form<2,4> = SFILE.MSG5
form<2,5> = form<2,4>
form<2,6> = 36
* setup Archive Type
form<3,1> = @(5,10)
form<3,2> = @(40,10)
form<3,3> = SFILE.MSG9
form<3,4> = SFILE.MSG10
form<3,5> = form<3,4>
form<3,6> = 10
* setup Archive Tape Devices list
form<4,1> = @(5,12)
form<4,2> = @(40,12)
form<4,3> = SFILE.MSG11
form<4,4> = SFILE.MSG12
form<4,5> = form<4,4>
form<4,6> = 40
* setup defaults
group.defaults = NULL
group.defaults<1> = "ON"
group.defaults<2> = "ON"
group.defaults<3> = "DISK"
group.defaults<4> = "N/A"
RETURN
***************************************************************************
* init.menu - initializes menu bar
***************************************************************************
init.menu:
scratch=UVREADMSG(073087,"")
Menu.Bar = NULL
Menu.Bar<1,1> = 3 ;* Number of Items in Menu.Bar
Menu.Bar<1,2> = 1 ;* Line # on which to print the Menu Bar
* First Item
Menu.Bar<2,1,1>=scratch<1> ;* SubMenu Title
Menu.Bar<2,1,2>=1 ;* # of items in SubMenu
* SubMenu #1
Menu.Bar<2,2,1>=scratch<6> ;* SubMenu Item
Menu.Bar<2,2,2>=1 ;* Action Code (Returned to calling process)
Menu.Bar<2,2,3>=scratch<7>
* Second Item
Menu.Bar<3,1,1>=scratch<8> ;* SubMenu Title
Menu.Bar<3,1,2>=1 ;* # of items in SubMenu
* SubMenu #1
Menu.Bar<3,2,1>=scratch<6> ;* SubMenu Item
Menu.Bar<3,2,2>=2 ;* Action Code
Menu.Bar<3,2,3>=scratch<7>
scratch=UVREADMSG(073089,"")
Menu.Bar<4,1,1>=scratch<1>
Menu.Bar<4,1,2>=3
Menu.Bar<4,2,1>=scratch<2>
Menu.Bar<4,2,2>=3
Menu.Bar<4,2,3>=scratch<3>
Menu.Bar<4,3,1>=scratch<4>
Menu.Bar<4,3,2>=4
Menu.Bar<4,3,3>=scratch<5>
Menu.Bar<4,4,1>=scratch<6>
Menu.Bar<4,4,2>=5
Menu.Bar<4,4,3>=scratch<7>
RETURN
STOP @(-1)
END