STD.SETUP

From Pickwiki
Revision as of 20:11, 9 April 2014 by James (talk)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigationJump to search

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