d PROGRAM ACA PARAMETER VERSION=2.0 ,C PROGRAM FOR ANALYZING ACCOUNTING RECORDS C C PROMPT 'ACA>' XC C OPERATION CONTROLLED RESPONSE TO PROMPT OF THE FORM C ACA>command operand C ARGEMENTS WHERE USED ARE DENOTED BY (ARG). C LC COMMAND FUNCTION C Help LIST FUNCTIONS AVAILABLE C Find FIND NEXT RECORD FOR (USERNAME) xC Next DISPLAY NEXT SEQUENTIAL RECORD C Backspace DISPLAY PREVIOUS SEQUENTIAL RECORD @C List LIST (COPY) DISPLAY TO (FILE) C Exit EXIT PROGRAM C lC IF A BLANK LINE IS ENTERED, , THE LAST CORRECT FUNCTION C OTHER THAN LIST OR HELP IS REPEATED. 4C C C TABLE OF CONTENTS FOR ACA.FOR (SOURCE FILE) ` C PAGE CONTENTS C 1 DESCRIPTIVE COMMENTS ( C 2 STORAGE ALLOCATION AND DEFINATIONS C 3 INITALIZATION, COMMAND PARSER, AND MAIN LOOP C 4 OUTPUT OPERATIONS T C 5 EXIT AND ERROR EXITS C 6 SUBROUTINE MY$GET_INPUT  C 7 SUBROUTINE MY$ASCTIM C 8 SUBROUTINES MY$LOCC & MY$SKPCC C H C IMPROVEMENTS IN VERSION 2.0 C C 1) NULL FUNCTION NOT CHANGED AFTER A LIST FUNCTION (BUG FIXED) tC 2) SETUP VERSION NUMBER AND PROGRAM IDENTIFICATION C 3) SETUP TO LET NORMAL FORTRAN EXIT HANDLER CLOSING FILES <C 4) SETUP GOOD PROMPT USING LIB$GET_INPUT ROUTINE C 5) SETUP NEW, HOPEFULLY IMPROVED, OUTPUT FORMAT C 6) SETUP NEW -- SMARTER-- COMMAND PARSER dC C STORAGE ALLOCATION AND DEFINATIONS ,C C  INCLUDE 'CYC$LIBRARY:ACCDEF.FOR/NOLIST' & INCLUDE 'CYC$LIBRARY:SSDEF.FOR/NOLIST' X CHARACTER*30 ACCT_FILE C  PARAMETER L$_INPUT_STRING=50  CHARACTER*50 INPUT_STRING, OLD_STRING, ARG_STRING  DATA OLD_STRING /'Next'/ L CHARACTER*1 COMMAND, CC  CHARACTER*1 TAB  DATA TAB /'9'X/ xC  CHARACTER*12 USERNAME_TEST @C  INTEGER*4 SYS$GETMSG, STATUS  INTEGER*2 MESG_LENGTH l CHARACTER*25 TEXT_FINALSTS  DATA TEXT_FINALSTS(1:1)/'('/ ` C CHARACTER*24 IN_TIME_BUF, OUT_TIME_BUF ( CHARACTER*16 ELAPSD_TIME_BUF INTEGER*4 ELAPSED_TIME(2) C T LOGICAL*1 DAT_FILE_OPEN DATA DAT_FILE_OPEN/.FALSE./  C CHARACTER*4 ERASE_SCREEN DATA ERASE_SCREEN(1:1)/'1B'X/, !HJ H 1 ERASE_SCREEN(2:2)/'H'/, 2 ERASE_SCREEN(3:3)/'1B'X/,  3 ERASE_SCREEN(4:4)/'J'/ dC C INITALIZATION, COMMAND PARSER, AND MAIN LOOP ,C C C INSURE UNIT 6 IS SYS$OUTPUT X OPEN (UNIT=6,NAME='SYS$OUTPUT') C C IDENTIFY SELF  WRITE (6,10000) VERSION 10000 FORMAT ('1ACCOUNTING FILE ANALYSIS PROGRAM - VERSION 'F5.1) LC C GET ACCOUNTING FILE TO PROCESS  CALL MY$GET_INPUT (ACCT_FILE,'ENTER ACCOUNTING FILE NAME: ') x IF (ACCT_FILE.EQ.' ') ACCT_FILE='DB0:[SYSMGR]ACCOUNTNG.OLD'  OPEN (UNIT=10,NAME=ACCT_FILE,TYPE='OLD',READONLY) @C C PROMPT FOR NEW COMMAND 1 CONTINUE l WRITE (6,10010) 10010 FORMAT ('0') 4 CALL MY$GET_INPUT (INPUT_STRING,'ACA>') C C PARSE COMMAND ` IF (INPUT_STRING(1:1) .EQ. ' ') !TEST FOR NULL 1 INPUT_STRING = OLD_STRING !MEANING REPEAT ( COMMAND = INPUT_STRING(1:1) !GET COMMAND CHAR. IPTR = MIN0( MY$LOCC( ' ', INPUT_STRING), !LOCATE FIRST 1 MY$LOCC( TAB, INPUT_STRING)) !SPACE OR TAB T ARG_STRING = ' ' !BLANK OUT ARG_STRING 23 CONTINUE !SKIP SPACES AND TABS  CC = INPUT_STRING(IPTR:IPTR) !GET CHAR. AT IPTR IF (CC.NE.' '.AND.CC.NE.TAB) GO TO 27 !IF NOT S.OR.T DONE IF (CC.EQ.' ') THEN !IF SPACE H I = MY$SKPC( ' ', !THEN SKIP SPACES 1 INPUT_STRING(IPTR+1:L$_INPUT_STRING))  ELSE !IF TAB t I = MY$SKPC( TAB, !THEN SKIP TABS  1 INPUT_STRING(IPTR+1:L$_INPUT_STRING)) < ENDIF  IPTR=IPTR+I !MOVE TO NEW CHAR.  GO TO 23 !AND LOOP TO RETEST h27 ARG_STRING = INPUT_STRING(IPTR:L$_INPUT_STRING) !SETUP ARG.  !STRING AND DO COMD. 0C C DECODE COMMAND 50 CONTINUE \ IF (COMMAND.EQ.'H') GO TO 100  IF (COMMAND.EQ.'F') GO TO 200 $ IF (COMMAND.EQ.'N') GO TO 300  IF (COMMAND.EQ.'B') GO TO 400  IF (COMMAND.EQ.'L') GO TO 500 P IF (COMMAND.EQ.'E') GO TO 9999  WRITE (6,*) 'ILLEGAL FUNCTION TYPE H FOR HELP'  GO TO 1 |C C HELP FUNCTION D100 WRITE (6,10020) 10020 FORMAT ('0FUNCTIONS ARE'/' Help'T16'Print this message'/  1 ' Find USERNAME'T16'Find the next record for user USERNAME'/ p 1 T17'Default USERNAME is SYSTEM'/  2 ' Next'T16'Display next record'/ 8 3 ' Backspace'T16'Display previous record'/  4 ' List FILE'T16'List record crrently displayed in FILE'/  5 T17'If no FILE given current file (default'/ d 6 T17'ACA.DAT) is used'/  7 ' Exit'T16'Exit program'// , 8 ' When no command is entered, , the last command typed'/  9 ' is repeated. The exceptions are "List" and "Help" after'/  1 ' which the next most recent command is repeated.') X GO TO 1 C C FIND FUNCTION 200 CONTINUE  USERNAME_TEST = ARG_STRING(1:12) L IF (USERNAME_TEST.EQ.' ') USERNAME_TEST='SYSTEM'  READ (10,10200,ERR=9901,END=9902) ACC_RECORD 10200 FORMAT (164A1) x IF (ACC_T_USERNAME.EQ.USERNAME_TEST) GO TO 2000  GO TO 200 @C C NEXT FUNCTION  300 READ (10,10200,ERR=9901,END=9902) ACC_RECORD l GO TO 2000 C 4!C BACKSPACE FUNCTION !400 BACKSPACE 10 ! BACKSPACE 10 `" GO TO 300 "C (#C LIST FUNCTION #500 CONTINUE # IF (ARG_STRING .NE. ' ' .AND. DAT_FILE_OPEN) THEN T$ CLOSE (UNIT=1) $ DAT_FILE_OPEN = .FALSE. % ENDIF % IF (ARG_STRING .EQ. ' ' .AND. .NOT.DAT_FILE_OPEN) % 1 ARG_STRING = 'ACA.DAT' H& IF (.NOT.DAT_FILE_OPEN) THEN & OPEN (UNIT=1, NAME=ARG_STRING) ' DAT_FILE_OPEN = .TRUE. t' ENDIF ' GO TO 2010 dC C OUTPUT OPERATIONS ,C C C TERMINAL OUTPUT ENTRY XC 2000 OLD_STRING = INPUT_STRING !GOOD COMMAND STRING  IOUT_UNIT=6  WRITE (6,20004) ERASE_SCREEN  GO TO 2050 LC C LIST ENTRY C x2010 IOUT_UNIT=1  WRITE (1,20006) !NEW PAGE @C C OUTPUT RECORD TYPE HEADING C l2050 CONTINUE  IF (ACC_W_MSGTYP.EQ.ACC$K_PRCTRM) THEN 4 WRITE (IOUT_UNIT,20100) 'NON-INTERACTIVE PROCESS COMPLETION',  1 ACC_W_MSGTYP, ACC_W_MSGSIZ  GO TO 2060 ` ENDIF IF (ACC_W_MSGTYP.EQ.ACC$K_INTTRM) THEN ( WRITE (IOUT_UNIT,20100) 'INTERACTIVE PROCESS LOGOUT', 1 ACC_W_MSGTYP, ACC_W_MSGSIZ GO TO 2060 T ENDIF IF (ACC_W_MSGTYP.EQ.ACC$K_BATTRM) THEN  WRITE (IOUT_UNIT,20100) 'BATCH JOB COMPLETION', 1 ACC_W_MSGTYP, ACC_W_MSGSIZ GO TO 2060 H ENDIF IF (ACC_W_MSGTYP.EQ.ACC$K_PRTJOB) THEN  WRITE (IOUT_UNIT,20100) 'PRINT JOB', t 1 ACC_W_MSGTYP, ACC_W_MSGSIZ  GO TO 2060 < ENDIF  IF (ACC_W_MSGTYP.EQ.ACC$K_LOGTRM) THEN  WRITE (IOUT_UNIT,20100) 'LOGIN FAILURE', h 1 ACC_W_MSGTYP, ACC_W_MSGSIZ  ACC_W_MSGTYP = ACC$K_INTTRM !PRETEND IT IS LOGOUT 0 GO TO 2060 !AND GIVE FULL OUTPUT  ELSE  WRITE (IOUT_UNIT,20100) 'UNKNOWN ACCOUNTING RECORD TYPE', \ 1 ACC_W_MSGTYP, ACC_W_MSGSIZ  ENDIF $ GO TO 1 2060 CONTINUE C PC OUTPUT USERNAME AND ACCOUNT C  WRITE (IOUT_UNIT,20101) ACC_T_USERNAME, ACC_T_ACCOUNT |C C FOR BATCH OUTPUT QUEUE AND JOB NAMES DC  IF (ACC_W_MSGTYP.EQ.ACC$K_BATTRM) THEN  WRITE (IOUT_UNIT,20201) ACC_T_JOB_QUE, ACC_T_JOB_NAME p ENDIF C 8C FOR PRINT OUTPUT QUEUE AND JOB NAMES C  IF (ACC_W_MSGTYP.EQ.ACC$K_PRTJOB) THEN d WRITE (IOUT_UNIT,20301) ACC_T_PRT_QUE, ACC_T_PRT_NAME  ENDIF ,C C ATTEMPT TO CONVERT FINAL STATUS INTO A MESSAGE (W/O TEXT) C X STATUS = SYS$GETMSG (%VAL(ACC_L_FINALSTS), MESG_LENGTH,  1 TEXT_FINALSTS(2:24), %VAL('E'X), )  INDEX = LIB$MATCH_COND (STATUS, SS$_BUFFEROVF, SS$_MSGNOTFND,  1 SS$_NORMAL)  GO TO (2085,2084,2085,2086),INDEX+1 L2084 TEXT_FINALSTS(2:25)='***********************)' !MESSAGE TOO LONG  MESG_LENGTH = 25  GO TO 2089 x2085 TEXT_FINALSTS(2:2) = ')' !NO MESSAGE OR OTHER ERROR  MESG_LENGTH = 2 @ GO TO 2089 2086 I = MESG_LENGTH+2 !NORMAL SUCCESSFUL COMPLETION  TEXT_FINALSTS(I:I) = ')' l MESG_LENGTH = I 2089 CONTINUE 4!C !C OUTPUT EXIT STATUS (WITH TEXT MESSAGE), PROCESS ID, !C JOB ID, PROCESS ID OF OWNER PROCESS `"C " WRITE (IOUT_UNIT,20105) ACC_L_FINALSTS, (# 1 TEXT_FINALSTS(1:MESG_LENGTH), ACC_L_PID, # 2 ACC_L_JOBID, ACC_L_OWNER #C T$C OUTPUT RESOURCES USED ACCOUNTING INFORMATION $C % IF (ACC_W_MSGTYP.NE.ACC$K_PRTJOB) THEN %C %C FOR BATCH AND OTHER PROCESSES H&C OUTPUT PAGING AND I/O STATISTICS &C ' WRITE (IOUT_UNIT,20110) ACC_L_PAGEFLTS, ACC_L_PGFLPEAK, t' 1 ACC_L_WSPEAK, ACC_L_DIOCNT, ACC_L_VOLUMES, ACC_L_BIOCNT ' ELSE <(C (C FOR PRINT OUTPUT PAGES PRINTED, QIO'S, AND GET'S )C h) WRITE (IOUT_UNIT,20302) ACC_L_QIOCNT, ACC_L_PAGCNT, ) 1 ACC_L_GETCNT 0* ENDIF *C *C CONVERT AND OUTPUT DATE-TIME INFORMATION \+C +C CONVERT TIME FINISHED(LOGOUT) --IT IS THE SAME FOR ALL TYPES-- $,C , CALL MY$ASCTIM (OUT_TIME_BUF, ACC_Q_TERMTIME) , IF (ACC_W_MSGTYP.NE.ACC$K_PRTJOB) THEN P-C -C FOR ALL BUT PRINT JOBS CONVERT TIME PROCESS STARTED .C THEN COMPUTE AND CONVERT ELAPSED TIME |.C . CALL MY$ASCTIM (IN_TIME_BUF, ACC_Q_LOGIN) D/ CALL SUBQUAD (ACC_Q_LOGIN, ACC_Q_TERMTIME, ELAPSED_TIME) / !NB: THE SUBTRACTION IS BACKWARDS TO PRODUCE A DELTA TIME 0 CALL MY$ASCTIM (ELAPSD_TIME_BUF, ELAPSED_TIME) p0 IF (ACC_W_MSGTYP.EQ.ACC$K_INTTRM) THEN 0C 81C OUTPUT INFORMATION WITH INTERACTIVE TYPE LABELS 1C 2 WRITE (IOUT_UNIT,20120) ' LOGOUT TIME', OUT_TIME_BUF, d2 1 ' LOGIN TIME', IN_TIME_BUF, 2 2 'CONNECT TIME', ELAPSD_TIME_BUF ,3 ELSE 3C 3C OUTPUT INFORMATION WITH NON-INTERACTIVE(OR BATCH) LABELS X4C 4 WRITE (IOUT_UNIT,20120) ' STOP TIME', OUT_TIME_BUF, 5 1 ' START TIME', IN_TIME_BUF, 5 2 'ELAPSED TIME', ELAPSD_TIME_BUF 5 ENDIF L6 ELSE 6C 7C FOR PRINT JOBS CONVERT TIME JOB QUEUED x7C THEN COMPUTE AND CONVERT ELAPSED TIME 7C @8 CALL MY$ASCTIM (IN_TIME_BUF, ACC_Q_QUETIME) 8 CALL SUBQUAD (ACC_Q_QUETIME, ACC_Q_TERMTIME, ELAPSED_TIME) 9 !NB: THE SUBTRACTION IS BACKWARDS TO PRODUCE A DELTA TIME l9 CALL MY$ASCTIM (ELAPSD_TIME_BUF, ELAPSED_TIME) 9C 4:C OUTPUT INFORMATION WITH PRINT TYPE LABLES :C : WRITE (IOUT_UNIT,20120) 'TIME FINISHED', OUT_TIME_BUF, `; 1 ' TIME QUEUED', IN_TIME_BUF, ' ELAPSED TIME', ; 2 ELAPSD_TIME_BUF (< ENDIF WRITE (IOUT_UNIT,20130) ACC_L_CPUTIM, SEC >C >C RETURN TO COMMAND LOOP H? GO TO 1 ?C @C FORMATS USED FOR THE ABOVE OUTPUT t@C @20004 FORMAT (' 'A)