         TITLE 'ACM.:WHO name database program'
*++
*
* WHO.NAMES maintenance program.
*
* Well we'll start simple.  Useful features later.
*
* By John Wilson, 06-Sep-87 (beyond the grave).
* johnw%buengf@BU-CS.BU.EDU, JOHNW@AI.AI.MIT.EDU,
* and other even more inaccessible addresses.
*
* Cheapskate manager mode added 04/12/88 by JMBW (I'm back!).
*
* 'Cause we're here in gold, and red and black
* YOU GUESSED IT!  The Fat Boys are BACK!
*
*--
         GBLC  &MAINTID
&MAINTID SETC  'WHO.'             ;nameID of 'WHO Maintenance'
*
         MACRO
&TAG     JSYS  &DEST,&R1LIST      ;Jump to SYStem
&TAG     L     15,=V(&DEST)       ;pt at routine
         AIF   ('&R1LIST' EQ '').NOARGS
         LA    1,&R1LIST          ;pt at args
.NOARGS  BASR  14,15              ;do the call
         MEND
*
BEG      ENTER 12,SA=REGS         ;set up R13 area, base regs
*
GNID1    L     1,=V(LASTJOB)      ;this will usually be X'1000'
         L     1,0(,1)            ;that's us; get our JTBL entry
         L     1,X'60'(,1)        ;and snag our nameID from it
         LTR   1,1                ;is a name $set?
         BNZ   GNID2              ;yes
         JSYS  SERCOM,NONAME      ;no, complain
         JSYS  SERCOM,NONAMB      ;tell them what to do
         JSYS  MTS                ;stop, possibly temporarily
         B     GNID1              ;try again
GNID2    ST    1,NAMEID           ;stash it for now
*
         JSYS  SPRINT,BAN1        ;say hello
         JSYS  SPRINT,BAN2
*
         JSYS  GETFD,WHO#NAMES    ;get an FDUB for the file
         ST    0,WNFD             ;save it
*
         MVI   MANAGE,0           ;assume not managing
         CLC   NAMEID,=C'&MAINTID' ;is it John?
         BNE   NOMAN              ;nope
         MVI   MANAGE,X'FF'       ;yes, obey His commands
         B     MLOOP1             ;PFX is OK on 1st try
MLOOP    JSYS  SETPFX,PFXB        ;reset blank PFX
         JSYS  REWIND,=A(WNFD)    ;rewind WHO.NAMES
MLOOP1   JSYS  SPRINT,MPRMPT      ;prompt for manager
         BAS   10,GETLIN          ;get response
         LTR   15,15              ;PA2?
         BNZ   QUIT               ;die if so
         LTR   1,1                ;blank line?
         BZ    QUIT               ;likewise
         LA    2,NAMEID           ;dest buf
         LA    3,GBUF             ;source buf
         LA    4,4                ;max count
         XR    0,0                ;clear bits 0-23
         MVC   NAMEID,=C'$.$.'    ;pad w/defaults
PNID1    CLI   0(3),C' '          ;blank?
         BE    PNID2              ;yes, ignore
         MVC   0(1,2),0(3)        ;no, copy
         LA    2,1(2)             ;advance dest
         BCT   4,PNID2            ;count it
         B     PNID3              ;got 4 chars, skip
PNID2    LA    3,1(3)             ;advance source
         BCT   1,PNID1            ;loop
PNID3    L     1,=V(CASECONV)     ;pt at table
         TR    NAMEID(4),0(1)     ;convert to UC
         JSYS  SETPFX,PFXB        ;reset blank PFX
NOMAN    ANOP
*
* Find our entry
*
         L     2,NAMEID           ;get nameid
FIND1    JSYS  READ,FNDLST        ;read next line
         LTR   15,15              ;eof?
         BNZ   FIND2              ;yes, skip
         C     2,BUF              ;nameID's match?
         BNZ   FIND1              ;no, loop
*
* Found the entry, decide whether to change it.
*
         JSYS  UNLK,WNFD          ;let go for now
         STCM  2,15,FND1ID        ;poke nameID
         LH    1,LEN              ;get length of line
         LA    0,C'"'             ;load a quote
         STC   0,BUF(1)           ;put it at end
         SH    1,=H'5'            ;correct length
         EX    1,CMVC1            ;copy name into buf
         LA    1,FND1LN+1(,1)     ;add rest of length (+'"')
         STH   1,LFND1            ;save total length
         JSYS  SPRINT,FND1        ;write strings
         JSYS  SPRINT,FND2
         JSYS  SPRINT,FND3
         BAS   10,GETLIN          ;get loser's response
         LA    0,2                ;modifier=@I
         ST    0,MOD              ;save it
         LTR   15,15              ;delete the entry?
         BNZ   DELETE             ;yes, go do it
         LTR   1,1                ;forget it?
         BZ    DONE               ;yes, die
         BCTR  1,0                ;fix for MVC
         EX    1,CMVC3            ;copy name to buffer
         LA    1,5+1(,1)          ;fix from MVC, + nameID
DELETE   STH   1,LEN              ;save it
UPDATE   JSYS  LOCK,LKLIST        ;lock the file again
         JSYS  WRITE,WRLIST       ;write the new record
DONE     CLI   MANAGE,0           ;managing?
         BZ    QUIT               ;no
         JSYS  UNLK,WNFD          ;yes, unlock again
         B     MLOOP              ;prompt again
QUIT     L     0,WNFD             ;get FDUB
         JSYS  FREEFD             ;lose it
         JSYS  EXIT               ;catch you later
*
* Create a new entry.
*
FIND2    JSYS  UNLK,WNFD          ;let go, for now
         STCM  2,15,NTF1ID        ;save ID
         CLI   MANAGE,0           ;are we managing?
         BNZ   NODEF              ;yes, no default name
         JSYS  GUINFO,GNAME       ;get uname
         L     1,NLEN             ;get length
         LA    2,NAME(1)          ;pt at end
         MVI   0(2),C'"'          ;quote
         MVI   1(2),C','          ;comma
         LA    1,1(,1)            ;1+1
         EX    1,CMVC2            ;copy name
         LA    1,NTF2LN+1(,1)     ;add length of rest
         STH   1,LNTFN2           ;save it
         JSYS  SPRINT,NTFND1      ;print msg
         JSYS  SPRINT,NTFND2
         JSYS  SPRINT,NTFND3
         BAS   10,GETLIN          ;get response
         LTR   15,15              ;forget it?
         BNZ   DONE               ;yes, take off
         LTR   1,1                ;use default name?
         BZ    DEFNAM             ;yes, skip
NEWNM1   BCTR  1,0                ;-1 for MVC
         EX    1,CMVC3            ;get it
NEWNM2   LA    1,5+1(,1)          ;1+1, +nameID
         STH   1,LEN              ;save it
         XR    1,1                ;modifier=none
         ST    1,MOD              ;save it
         L     1,NAMEID           ;get nameid
         ST    1,BUF              ;save it
         MVI   BUF+4,C' '         ;blank after nameID
         B     UPDATE             ;write it
*
DEFNAM   L     1,NLEN             ;length of default
         BCTR  1,0                ;-1 for MVC
         EX    1,CMVC4            ;get name
         B     NEWNM2             ;write it
*
* Name not found in manage mode;
* don't offer a default since using our name would be dumb
*
NODEF    JSYS  SPRINT,NTFND1      ;tell them we have nothing
         JSYS  SPRINT,ENTNAM      ;tell them we need a name
         BAS   10,GETLIN          ;read their excuse
         LTR   1,1                ;blank line?
         BZ    MLOOP              ;yeah, reprompt
         LTR   15,15              ;PA2?
         BZ    NEWNM1             ;just add it if not
         B     MLOOP              ;reprompt
*
* Read input from GUSER
* Trim trailing blanks, return length in R1
*
GETLIN   JSYS  SETPFX,PFXC        ;set prefix char
         JSYS  GUSER,GULIST       ;get input
         XR    1,1                ;in case of EOF
         LTR   15,15              ;eof?
         BNZR  10                 ;return if so
         LH    1,GLEN             ;get length read
         LTR   1,1                ;anything?
         BZR   10                 ;no, just return
         XR    0,0                ;0=0
GLIN1    IC    0,GBUF-1(1)        ;get last char
         CH    0,=Y(C' ')         ;trailing blank?
         BNZR  10                 ;return if not
         BCT   1,GLIN1            ;loop if not
         BR    10                 ;return
*
* data area
*
         LTORG
WHO#NAMES DC   C'#HA8G:WHO.NAMES ' ;name of file
* note that ACM5:WHO.NAMES is a $CONTINUE WITH this file
*
BAN1     DC    A(TBAN1,LBAN1,ZERO,ZERO) ;banner
BAN2     DC    A(TBAN2,LBAN2,ZERO,ZERO)
LBAN1    DC    Y(L'TBAN1+L'TBAN1A)
LBAN2    DC    Y(L'TBAN2)
TBAN1    DC    C' ACM.:WHO name database maintenance program'
TBAN1A   DC    C', version: &SYSDATE..'
TBAN2    DC    C' By John Wilson.  Bugs to "WHO Maintenance".'
*
NONAME   DC    A(NONAM1,LNONM,ZERO,DUMMY)
NONAM1   DC    C' You must $SET a name before running WHONAMES.'
LNONM    DC    Y(L'NONAM1)
NONAMB   DC    A(NONAM2,LNONM2,ZERO,DUMMY)
NONAM2   DC    C' Type $RESTART after you have set a name.'
LNONM2   DC    Y(L'NONAM2)
*
MPRMPT   DC    A(MPRM1,LPRM1,ZERO,DUMMY)
MPRM1    DC    C'0Enter nameID to modify'
LPRM1    DC    Y(L'MPRM1)
*
FNDLST   DC    A(BUF,LEN,@MAXLEN,LNUM,WNFD) ;READ arg list
@MAXLEN  DC    X'08000000'        ;@MAXLEN read modifier
LEN      DC    H'0,85,0'          ;length record (max=85)
*
CMVC1    MVC   FND1NM(0),BUF+5
CMVC2    MVC   NTF2NM(0),NAME
CMVC3    MVC   BUF+5(0),GBUF
CMVC4    MVC   BUF+5(0),NAME
FND1     DC    A(TFND1,LFND1,ZERO,DUMMY)
FND2     DC    A(TFND2,LFND2,ZERO,DUMMY)
FND3     DC    A(TFND3,LFND3,ZERO,DUMMY)
LFND1    DS    Y
LFND2    DC    Y(L'TFND2)
LFND3    DC    Y(L'TFND3)
TFND1    DC    C'0Entry for nameID '
FND1ID   DS    4C
         DC    C' is "'
FND1LN   EQU   *-TFND1
FND1NM   DS    81C
TFND2    DC    C' Press ENTER to keep this name,'
TFND3    DC    C' $ENDFILE to delete it, or enter a replacement:'
*
LKLIST   DC    A(WNFD,ZERO,MINUS1) ;LOCKM (indef wait)
ZERO     DC    F'0'
MINUS1   DC    F'-1'
*
WRLIST   DC    A(BUF,LEN,MOD,LNUM,WNFD) ;update or delete
MOD      DS    F
*
GULIST   DC    A(GBUF,GLEN,@MAXLEN,DUMMY)
GLEN     DC    H'0,80,0'
PFXC     DC    A(*+4)
         DC    C'?'
*
PFXB     DC    A(*+4)
         DC    C' '
*
GNAME    DC    A(USERNAME,NBUF)   ;get username into name buf
USERNAME DC    F'298'             ;item number
*
NTFND1   DC    A(TNTF1,LNTFN1,ZERO,DUMMY)
NTFND2   DC    A(TNTF2,LNTFN2,ZERO,DUMMY)
NTFND3   DC    A(TNTF3,LNTFN3,ZERO,DUMMY)
LNTFN1   DC    Y(L'TNTF1+4)
LNTFN2   DS    Y
LNTFN3   DC    Y(L'TNTF3)
TNTF1    DC    C'0No entry for nameID '
NTF1ID   DS    4C
TNTF2    DC    C' Press ENTER to use "'
NTF2LN   EQU   *-TNTF2
NTF2NM   DS    66C                ;name + '",'
TNTF3    DC    C' $ENDFILE to quit, or enter a name:'
ENTNAM   DC    A(TENT,LENT,ZERO,DUMMY)
TENT     DC    C' Enter a name, or a null line to abort:'
LENT     DC    Y(L'TENT)
*
NAMEID   DS    F                  ;nameID for our user
WNFD     DS    F                  ;WHO.NAMES FDUB ptr
*
NBUF     DC    A(64+4+4)          ;length of GUINFO reg
NLEN     DS    F                  ;length of name
NAME     DS    64C                ;name
         DS    2C                 ;'",' after name
*
LNUM     DS    F                  ;length; fullword align BUF
BUF      DS    85C                ;line buffer
*
GBUF     DS    80C                ;GUSER buf
*
MANAGE   DS    X                  ;NZ => manage mode
*
DUMMY    DS    F
*
REGS     DS    18F                ;R13 save area
*
         END   BEG
