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