STD.SETUP
From Pickwiki
HomePage>>SourceCode>>BasicSource>>SvnWrapper>>STD.SETUP
Run this in 'LOGIN' to set up global commons.
subroutine STD.SETUP
* SUB: Standard Setup Module for all RMS programs.
* =======================================================================================
* 28.Mar.2013 james: Add ALL COMMON'S that have DIM's to assure THIS BREAKS: see below.
* 29.Dec.2010 james: Keep RMS$USER.GROUP.S in RMS.COMMON now too
* 12.Jan.2010 james: Reset FORM$NUM.PARAMS and FORM$PARAM.VARS now in FORM.COMMON.
* 07.Jul.2009 james: Reset the DEBUG.ON flag to @FALSE 'just in case'.
* 16.Apr.2009 james: Clear new DC$TEST.FLAGS for HIGH.COST testing
* 27.Mar.2009 james: Call LOAD.ENV.COMMON with EC.RELOAD now in case we LOGTO.
* 04.Feb.2009 jim: Call OPEN.FILE with RESET to clear Open Files Common 'just in case'.
* 15.Aug.2008 jim: Let's try loading ENV.COMMON here now ? It's in SELECT.FORMS anyway.
* 25.Jun.2008 jim: Reset 'EC$IS.LOADED' so it get's re-loaded if this is rerun ( LOGTO ).
* 11.Mar.2008 manoj: Removed open file PROGRAM since we will not rename PLAN file
* 28.Feb.2008 jim: Cache has problems with 'AUTOLOGOUT' ? Just skip it for now for Cache.
* 25.Feb.2008 jim: Initialize DC$TEST.DATE just in case.
* 16.Jan.2008 jim: Open LAST.ID.FILE for INPUT and other misc programs.
* 20.Jun.2007 jim: FKEY.ACTS is obsolete.
* 24.Jan.2007 jim: Add RMS$PID; different method for Cache.
* 13.Sep.2006 jim: Add PLATFORM 'Cache' or '[[UniVerse]]' for Cache migration.
* 29.Mar.2006 precy: Add OPEN and READ new USER file to access USER record.
* 30-Nov-2005 jay: Removed uname -n from being run per execution to only if not exising in CONTROL.LOCAL
* Implemented CONTROL.LOCAL
* 19-Sep-2005 jim: Use SYSTEM(2) and SYSTEM(3) for Screen Width[[/Height]]
* 14-Sep-2005 jim: Remove PRINT statements if TERMINAL and/or USER are not
* found: who cares anymore ?! Phantoms get junk...
* 05-Aug-2005 jay: Removed "uname -s" and hard coded "LINUX" in common var SYSTEM.OS
* 01-Jul-2005 jay: Added REPLICATION.INIT temporarily to avoid having to release
* war's to all the server at once
* 09/12/2002 jay: Added SYSTEM.OS so that we could seperate programs based on os
* Also Made the ttyp fix
* 05/06/1999 jim: Finally use 'uname -n' for SCO to get the right system name !
* 06/08/1988 jim: TYPE 'T' TOP 1, BOT 23 FOR CULVER PLUMBING
* ALSO ADDED 'EJECT' FOR RITEMAN AND ALL PRINTING !
* 09/15/1986 jim: WELL, NOW I KNOW WHY ! RITEMAN GOES INTO GRAPHICS MODE !
* @(-1) CHANGED BACK TO CHAR(12). SHIT
* 07/23/1986 jim: CLR changed to @(-1); was CHAR(12) I know there's a reason ?
* =======================================================================================
* $Id$
* =======================================================================================
deffun GET.PID ;* Method of getting Process ID differs in Cache
deffun OPEN.FILE( FILENAME, FLAGS, FILEVAR, ERR.MSG )
$include RMS.BP INPUT.COMMON ;* LAST.ID.FILE; also includes CURRENT.COMMON
$include RMS.BP ENV.COMMON ;* PWD, etc.
$include RMS.BP FORM.COMMON ;* Includes EQU.PRINTER, EQU.TERMINAL, EQU.LINE
$include DSI.BP DSI.COMMON ;* DSI Standard files and Unused slots
$include DSI.BP TIMING.COMMON ;* Timing Configuration
* ----------------------------------------------------------------------------
* Add ALL COMMON'S that have DIM's to assure THIS BREAKS if any of the DIM's are
* changed! This is so WEBSITE.INIT breaks and does NOT hand over the session to another
* user if programs with changes to Global Commons are compiled while the session is open.
* (I can't see what it could hurt?: most of these will be loaded anyway...).
* (Note that 'DSI' only things like PRICING.COMMON and INVOICE.COMMON are NOT included)
$include DSI.BP APR.COMMON
$include DSI.BP FORM.LIST.COMMON
$include DSI.BP HIGH.COST.COMMON
$include DSI.BP WEB.DOCS.COMMON
$include RMS.BP FILE.CONFIG.COMMON
$include RMS.BP REPLICATION.COMMON
$include DA.BP DA.COMMON ;* This shares CUSTOMER() with INVOICE.COMMON !?
$include DA.BP PROCESS.COMMON
$include WEB.BP WEB.COMMON
* ----------------------------------------------------------------------------
$include RMS.BP EQU.USER
dim USER( USER.C ) ;* Put this back in RMS.COMMON sometime !
* This is too dangerous; it's used in the middle of things.
* BUT call it at all entry points !:
*CALL CLEAR.COMMON ;* 01-Dec-2004 jim: Will this fix strange crashes?
call DEBUG.MSG( '', 'E' )
* Reset stuff in 'CURRENT.COMMON' in case someone uses it prematurely :
CUR.REC = '' ; CUR.ID = '' ; CUR.AMC = 0 ; CUR.CDC = 0 ; CUR.I = ''
TIMING.ENABLED = @FALSE ;* By default disable timing
EC$IS.LOADED = @FALSE ;* If we don't load this; at least make it re-load (for PWD, etc)
* 15.Aug.2008 jim: Let's try loading ENV.COMMON here now ? (it's in SELECT.FORMS anyway
* so it needs to be done every request anyway...)
*
* This used to 'Load only if NOT already loaded'; but now ALWAYS LOAD; since
* this is NOT called everywhere anymore; and it IS called when we 'LOGTO' so
* this MUST be reloaded then:
*
call LOAD.ENV.COMMON( EC.RELOAD )
* ----------------------------------------------------------------------------
* THIS PROGRAM SETS ALL 'RMS' STANDARD COMMONS; Call ONCE upon initial Login.
*
* ----------------------
* COMMON DEFINITIONS
* ----------------------
*
* CLR : CLEAR SCREEN
* EJECT : EJECT A PAGE ON THE PRINTER (DON'T USE 'CLR' !)
* ES : ERASE SCREEN FROM CURRENT POSITION TO END
* BELL : RING THE BELL
* RN : TURN REVERSE VIDEO ON
* RF : TURN REVERSE VIDEO OFF
* EL : ERASE LINE FROM CURRENT POSITION TO END
* TRUE : BOOLEAN TRUE (1)
* FALSE : BOOLEAN FALSE (0)
*
* TERMTYPE : CURRENT TERMINAL TYPE DEFINED IN PICK
* EMBED.ATTR : BOOLEAN, DOES THIS TERMINAL HAVE EMBEDDED ATTRIBUTES?
* TOP.LINE : 0 OR 1, DEPENDING ON TYPE OF TERMINAL (PC MONITOR IS 0)
* Now set from 'TERMINAL' in 'RMS.CONTROL' if it's there
* BOT.LINE : 23 OR 24 USUALLY
*
* HD.CLR : HEADING COLOR (TOP LINE)
* BD.CLR : BORDER COLOR (FOR MENUS, ETC)
* PR.CLR : PROMPT COLOR (IMMEDIATE PROMPT, ETC)
* M1.CLR : MESSAGE COLOR 1 : IMMEDIATE MESSAGES FOR CURRENT INPUT
* M2.CLR : MESSAGE COLOR 2 : LESS IMPORTANT MESSAGES
* BK.CLR : BACKROUND COLOR
* IN.CLR : INPUT COLOR : FOR CURRENT INPUT LINE (USED BY MR.IN)
* ER.CLR : ERROR MESSAGE COLOR (USUALLY RED !)
* SP.CLR : SPECIAL COLOR FOR ANY PURPOSE
*
* USER.NO : CURRENT USER # (USED TO MAKE THINGS UNIQUE)
* SEC.LVL : CURRENT SECURITY LEVEL OF THIS USER..no longer used !?
*
* DEBUG.FLAG : If set, lots of programs will show their stuff
*
* ============================================================================
gosub SET.STANDARD.VARS ;* STANDARD ASSUMPTIONS
gosub SET.TERMINAL.INFO ;* TERMINAL DEPENDANT STUFF
gosub SET.FORM.COMMON
INS.MODE = @FALSE ;* Insert[[/Replace]] mode for INPUT.IN, BOX.ED.
*crt "!": ;* Signal that STD.SETUP was run; is this useful anymore ?
* 01-Jul-2005 jmp: Implemented for replication update to check rep state
* ? Remove when connection pool call this on connection retrieval
* 10.May.2006 jim: Do NOT remove this ! It is now expected to be set by
* REP.WRITE, etc; why not just do it here ?
*
[[REP_FLAGS]] = ''
call REPLICATION.INIT([[REP_FLAGS]], REP.ERR)
* Do something with REP.ERR if it's returned ? What ?
* At least PRINT IT !:
if REP.ERR # '' then print REP.ERR
* (might be 'REP.Q not found', etc ...)
return
SET.STANDARD.VARS: * NOTE THESE MAY GET RE-SET BELOW
AM = char(254) ; VM = char(253) ; SVM = char(252)
TRUE = 1 ; FALSE = 0 ;* Some programs still use these ? (should use @'s)
ILEN = 32767
* We may be just 'STD.SETUP' for some other reason:
if unassigned(DEBUG.FLAG) then DEBUG.FLAG = ''
FKEY.LEVEL = 0 ;* HOPE NOONE ELSE SETS IT !!
* .. THIS STUFF MAY BE TERMINAL DEPENDENT, BUT SET DEFAULTS ANYWAY
CLR = @(-1) ; EJECT = char(12) ;* .. PAGE EJECT FOR RITEMAN !
ES = @(-3) ; EL = @(-4) ; BELL = char(7)
TOP.LINE = 1
* 19-Sep-2005 jim: Use a bigger TERM !
* BOT.LINE = 24
BOT.LINE = SYSTEM(3)
SCREEN.WIDTH = SYSTEM(2) ;* AND a WIDER Term !?
EMBED.ATTR = FALSE
* RN = @(-13) ; RF = @(-14)
* LEAVE COLOR INFORMATION NULL FOR NORMAL TERMINALS:
HD.CLR='' ; BD.CLR='' ; PR.CLR='' ; M1.CLR='' ; M2.CLR=''
BK.CLR='' ; IN.CLR='' ; ER.CLR='' ; SP.CLR=''
OS.VERSION = "UNIX"
dummy = OPEN.FILE( '', "RESET", FILEVAR, ERR.MSG ) ;* RESET flag does not actually 'open'
gosub [[ProcessControlLocal]]
* ---------------------------------------------------------------------------
* These files are used enough to justify always being open: see DSI.COMMON
* ONCE 'OPEN.FILE' IS USED EVERYWHERE, THIS ALL BECOMES OBSOLETE !
if not( OPEN.FILE( "WS", '', WS.FILE, Err ) ) then stopm Err
if not( OPEN.FILE( "PLAN", '', PLAN.FILE, Err ) ) then stopm Err
if not( OPEN.FILE( "LENDER", '', LENDER.FILE, Err ) ) then stopm Err
if not( OPEN.FILE( "CONTROL", '', CONTROL.FILE, Err ) ) then stopm Err
if not( OPEN.FILE( "LAST.USED", '', LAST.USED.FILE, Err ) ) then stopm Err
if not( OPEN.FILE( "LAST.ID", '', LAST.ID.FILE, Err ) ) then stopm Err
* ---------------------------------------------------------------------------
* Local files:
if not( OPEN.FILE( "USER", '', USER.FILE, Err ) ) then stopm Err
if not( OPEN.FILE( "RMS.CONTROL",'', RMS.CONTROL.FILE, Err ) ) then stopm Err
USER.NO = @TTY ;* .. UNIQUE TTY NAME
* 05-Aug-2005 jay: We do not need to get this unless we have different OS Systems
* if we change os, we need to uncomment these two lines
*EXECUTE \SH -c "uname -s"\ CAPTURING SYSTEM.OS
*SYSTEM.OS = UPCASE(SYSTEM.OS<1>)
SYSTEM.OS = "LINUX" ;* Hard coded for performance
if USER.NO # 'phantom' then
if SYSTEM.OS # "LINUX" then
USER.NO = field(USER.NO,"/",3)
end else
USER.NO = "ttyp":field(USER.NO, "/", 4)
end
end
USER.ID = @LOGNAME
if trim(USER.ID) = '' then
mat USER = ''
end else
matread USER from USER.FILE, USER.ID else
mat USER = ''
end
end
if USER(1) = '' then crt ; crt "User ":USER.ID:" was not found in the USER file." ; crt
if USER$TOP.MENU # '' then
write USER$TOP.MENU on LAST.ID.FILE, "MENU.":USER.NO
end
* Cache has problems with this ? Reported to Lee Burstein
* on 28.Feb.2008. The issue is not this command; it is when you
* 'LIST LENDER' and it crashes at the end of the first page.
if USER$OFF.MINUTES # '' and USER$OFF.MINUTES > "0" and PLATFORM # "Cache" then
execute "AUTOLOGOUT ":USER$OFF.MINUTES
end
RMS$USER.GROUP.S = USER$GROUP.S ;* Keep this in RMS.COMMON now too
* Security Level will be set by user id (logon id) if it exists :
SEC.LVL = USER$SEC.LEVEL
if SEC.LVL < 5 then
* This does not work since it executes in a different shell:
* execute "BREAK OFF"
break OFF ;* BUT this works !
crt "#":
end
if USER.NO = '' then
mat LINE.REC = ''
end else
matread LINE.REC from RMS.CONTROL.FILE, "LINE.":USER.NO else
mat LINE.REC = ''
end
end
L.TERM.TYPE = @TERM.TYPE ;* ALWAYS USE UNIVERSE TERM.TYPE
if L.LAST.PRT = '' then L.LAST.PRT = 'T' ;* Default 'T'erminal
matread TERMINAL from RMS.CONTROL.FILE, "TERM.":L.TERM.TYPE else
mat TERMINAL=''
end
if TERM.TRANS.ON = '' then TERM.TRANS.ON = char(19) ;* CTL-S ??
if TERM.TRANS.OFF = '' then TERM.TRANS.OFF = char(20) ;* CTL-T ??
if TERM.WIDTH = '' then TERM.WIDTH = SCREEN.WIDTH
if TERM.TOP # '' then TOP.LINE = TERM.TOP
if TERM.BOT # '' then BOT.LINE = TERM.BOT
RN = TERM.BOLD.ON ; RF = TERM.BOLD.OFF ;* GENERAL HIGHLIGHT
FKEY.LEAD = '' ;* BUILD STRING OF LEAD-IN CHARACTERS
for I = 31 to TERMINAL.C
if len(TERMINAL(I)) > 1 then
LEAD = TERMINAL(I)[1,1]
if index(FKEY.LEAD,LEAD,1) = 0 then FKEY.LEAD = FKEY.LEAD:LEAD
end
next I
* This fixes a problem with LINK MC5/6 and WYSE 150 Terminals with parallel
* ports: if not printer is plugged in, a TRANS.ON[[/TRANS]].OFF sequence locks
* the terminal (even with no data).
if L.TERM.PRT = '' then ;* .. No printer..Clear Trans ON[[/OFF]] for PARALLEL's
TERM.TRANS.ON = ''
TERM.TRANS.OFF = ''
end
PROMPT "" ;* USUALLY NEEDED ANYWAY
* C.R = " Copyright 1986-1990 (c) J.R.Adrig, All Rights Reserved "
* DSI took over rights to this program...
C.R = ''
* obsolete: mat FKEY.ACTS = '' ;* Until otherwise set !
* .. How long to wait to get next char of function key?(loop)(GET.CH):
readv FKEY.DELAY from RMS.CONTROL.FILE,"FKEY.DELAY",1 else FKEY.DELAY = 10
* This gets set in DSI.COMMON from APR.TEST to call historical versions of APR; PMTS, etc:
DC$TEST.DATE = '' ;* Clear it to make sure it's not floating around.
DC$TEST.FLAGS = '' ;* This too
return
* Initialized Global Common stuff in FORM.COMMON 'just in case' (i.e. in case the
* commons don't get reset because of a fatal breakage in a Command / Audit).
SET.FORM.COMMON:
VAR.NAMES = '' ; mat VARS = ''
FORM$SAVE.VARS = @FALSE ;* This is reset at the end of an Audit but not if it fails !
mat FORM$PARAM.VARS = ''
FORM$NUM.PARAMS = 0
return
SET.TERMINAL.INFO: ;* SET TERMINAL DEPENDANT STUFF
TERMTYPE = @TERM.TYPE ;* old: L.TERM.TYPE
begin case ;* ... FOR EVERY TYPE OF TERMINAL !
case TERMTYPE = "F" ;* FUJITSU MONITOR !!!
* ?? GOSUB SET.COLORS
case TERMTYPE = "M" ;* 'GEORGE' USING TVI912 !!!
CLR = char(26)
EL = SPACE(SCREEN.WIDTH - 2) ;* Was 78 ?
case TERMTYPE = "Q" ;* .. QVT102 (RMS)
RN = @(-9):@(-13) ; RF = @(-9):@(-14)
end case
if L.COLOR = "Y" then gosub SET.COLORS
return
* .. NOW SET UP 'COLORS' !
SET.COLORS:
gosub READ.CONTROL.COLORS
HD.CLR = @(-HD.CLR<1>)
BD.CLR = @(-BD.CLR<1>)
PR.CLR = @(-PR.CLR<1>)
M1.CLR = @(-M1.CLR<1>)
M2.CLR = @(-M2.CLR<1>)
BK.CLR = @(-BK.CLR<1>)
IN.CLR = @(-IN.CLR<1>)
ER.CLR = @(-ER.CLR<1>)
SP.CLR = @(-SP.CLR<1>)
return
* FUJITSU:(ALL MINUSS): 5:BLINK,13 RVSE,14 NORM,17 GREY BACK
* 46 BLUE, 47 RED, 48 PURPLE, 49 GREEN, 50 LT.BLUE
* 51 LT. GREEN, 52 WHITE
* BACK: 54 BLUE, 55 RED, 56 PURP, 57 GREEN, 58 BLUE, 59 GREEN, 60 WHITE
READ.CONTROL.COLORS:
read HD.CLR from RMS.CONTROL.FILE,"HEAD.COLOR" else HD.CLR = 39
read BD.CLR from RMS.CONTROL.FILE,"BORD.COLOR" else BD.CLR = 47
read PR.CLR from RMS.CONTROL.FILE,"PROMPT.COLOR" else PR.CLR = 48
read M1.CLR from RMS.CONTROL.FILE,"MSG1.COLOR" else M1.CLR = 46
read M2.CLR from RMS.CONTROL.FILE,"MSG2.COLOR" else M2.CLR = 42
read BK.CLR from RMS.CONTROL.FILE,"BACK.COLOR" else BK.CLR = 33
read IN.CLR from RMS.CONTROL.FILE,"INPUT.COLOR" else IN.CLR = 43
read ER.CLR from RMS.CONTROL.FILE,"ERR.COLOR" else ER.CLR = 44
read SP.CLR from RMS.CONTROL.FILE,"SPEC.COLOR" else SP.CLR = 45
return
* 13.Sep.2006 jim:
*
* This file is in '/u/local' ? It could be used to make datest 'act like' dsi;
* for example. Or is it just to avoid using 'EXECUTE' often ?
* Since most program now do NOT (or SHOULD not !) call STD.SETUP; it's not
* really a concern anymore ?
[[ProcessControlLocal]]:
open "CONTROL.LOCAL" to CONTROL.LOCAL.FILE then [[OpenedControlLocal]] = @TRUE else [[OpenedControlLocal]] = @FALSE
gosub [[SetSystemName]]
return
[[SetSystemName]]:
if index( SYSTEM(41), 'Cache', 1) then
PLATFORM = 'Cache'
end else
PLATFORM = '[[UniVerse]]'
end
SYSTEM.NAME = ""
[[SystemNameRecordID]] = "HOSTNAME"
if [[OpenedControlLocal]] then
readv SYSTEM.NAME from CONTROL.LOCAL.FILE, [[SystemNameRecordID]],1 else
* We need to set up the name
end
end
* We do not have a system name yet; generate it:
if SYSTEM.NAME = "" then
if PLATFORM = 'Cache' then
*
* 19.Feb.2008 jim: During Cache testing with Lee, we found this to error when
* called from Java !? Use Caution ! (Lee is going to check on this).
*
execute "[ write $zu(110)" capturing SYSTEM.NAME
*
end else
execute \SH -c "uname -n"\ capturing SYSTEM.NAME
end
SYSTEM.NAME = SYSTEM.NAME<1>
if [[OpenedControlLocal]] then
writev SYSTEM.NAME to CONTROL.LOCAL.FILE, [[SystemNameRecordID]], 1
end
end
RMS$PID = GET.PID() ;* Cache version is different !
return
