Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- /*define $Version 1.1.1 */
- /*:C#Update Q's via AUTHOR. */
- /* ========================= Program History ========================= */
- /* What Who When Why */
- /* ------------------------------------------------------------------- */
- /* Org - P Foster - 15/01/90 *
- * Mod - */
- /* =================================================================== */
- /* */
- parse arg Task Rest;
- GoodTask=0;
- if Task ^= '' then Upper Task;
- if abbrev('ADD',Task,1) then do;
- GoodTask=1;
- Task='ADD';
- end
- if abbrev('LIST',Task,1) then do;
- GoodTask=1;
- Task='LIST';
- end
- if abbrev('QLIST',Task,1) then do;
- GoodTask=1;
- Task='QLIST';
- end
- if abbrev('DELETE',Task,1) then do;
- GoodTask=1;
- Task='DELETE';
- end
- if abbrev('UPDATE',Task,1) then do;
- GoodTask=1;
- Task='UPDATE';
- end
- Call AccessDisks;
- Call Initialise;
- CanAdd=0;
- CanDel=0;
- Call AuthChk 'A' 'D'
- do forever;
- if ^GoodTask then Task=GetTask(); /* Get a task if necessary. */
- select;
- when Task='ADD' & CanAdd then Call Add;
- when Task='DELETE' & CanDel then Call Delete;
- when Task='UPDATE' & CanAdd & CanDel then Call Update;
- when Task='LIST' then Call List;
- when Task='QLIST' then Call QList;
- otherwise nop;
- end;
- GoodTask=0; /* Force point & grunt menu. */
- end;
- exit;
- Add:
- /* Add a new queue */
- if ^CanAdd then return 4;
- Call LockFile; /* Lock the file. */
- if Result ^= 0 then return;
- address PinExec 'EXEC STORIT 16';
- address command 'DIMAN QADD PINFORM';
- Src=Rc
- Call UnLockFile;
- if Src^=0 then return 4;
- address PinExec 'Refresh';
- if Src=0 then Call Respond 'added';
- Return;
- Delete:
- if ^CanDel then return 4;
- Call GetQName 'D' /* Get the Queue name from billy*/
- if Result ^= 0 then return;
- address PinExec 'Command $LOG Field2Id Qt Queued to';
- address PinExec 'Command $LOG Field2Id Id Status';
- address PinExec 'Command Open LG';
- address PinExec "Command Search ('"Qt]]QName"')" Id]]'OP-';
- address PinExec 'Command Extract TotHits';
- if TotHits.1 ^= 0 then do;
- if TotHits.1=1 then ss='';
- else ss='s';
- 'WClear';
- 'WToggle';
- 'WPut Unable to delete "'strip(QName)'".'
- 'WPut This queue has 'TotHits.1' open log'ss' queued to it.';
- 'WToggle';
- 'WPut ';
- 'WPut Press Enter to continue.';
- 'WWait';
- address PinExec 'Return';
- return;
- end;
- Call LockFile; /* Lock the file. */
- if Result ^= 0 then return;
- Call DeleteQ; /* Get rid of the queue. */
- if Result ^= 0 then return;
- Call UnLockFile; /* Unlock the file. */
- Call Respond 'deleted';
- return
- Update:
- address command 'QERASE $$NEWQ TEMPWORK A';
- address command 'QERASE $$QCAT TEMPWORK A';
- address command 'QERASE $$QUPD TEMPWORK A';
- address command 'QERASE $$QINF TEMPWORK A';
- Call GetQName 'U' /* Get the Queue name from billy*/
- if Result ^= 0 then return; /* this returns the q in RCD. */
- Call FindRecord QName; /* Get the statement number. */
- if Result ^= 0 then return;
- Call LockFile; /* Lock the sucker. */
- if Result ^= 0 then return;
- address command 'GLOBALV SELECT QUPD SET STATEMENT 'Statement;
- do i=1 to Rcd.0 /* Split up the q details. */
- Parse value Rcd.i with . '"'Content'"' Rest;
- address command 'EXECIO 1 DISKW $$NEWQ TEMPWORK A (STR 'Content;
- select
- when i=3 then do until words(Rest)=0; /* If more than one rcd, */
- Parse var Rest '"'Content'"' Rest; /* put 'em in a workfile. */
- if strip(Content)^='' then,
- address command 'EXECIO 1 DISKW $$QCAT TEMPWORK A (STR 'Content;
- end
- when i=4 then do until words(Rest)=0;
- Parse var Rest '"'Content'"' Rest;
- if strip(Content)^='' then,
- address command 'EXECIO 1 DISKW $$QUPD TEMPWORK A (STR 'Content;
- end
- when i=5 then do until words(Rest)=0;
- Parse var Rest '"'Content'"' Rest;
- if strip(Content)^='' then,
- address command 'EXECIO 1 DISKW $$QINF TEMPWORK A (STR 'Content;
- end
- otherwise nop
- end;
- end;
- address command 'FINIS * TEMPWORK A';
- address PinExec 'EXEC STORIT 16'
- address command 'DIMAN QUPD PINFORM';
- Src=Rc
- Call UnLockFile;
- if Src^=0 then return 4;
- Call Respond 'updated';
- return
- QList:
- do forever
- Call GetQName 'L'; /* Get the Queue name from billy*/
- if Result ^= 0 then return;
- end;
- return;
- List:
- Fm = substr(LqFm,1,1);
- address command 'SET CMSTYPE HT';
- address command 'CONDACC 'Fm;
- address command 'SET CMSTYPE RT';
- address command 'EXECIO * DISKR LOGQ NAMES (FINIS STEM LQUEUE.';
- if Rc ^= 0 then do
- 'WClear';
- 'WPut Error 4:'Rc' during list queues.'
- 'WPut Contact support.';
- exit;
- end;
- c=0;
- do i=1 to LQueue.0
- Msg='search $authfile(logq) qname('''APost(LQueue.i)''') manager(?)';
- Call AuthCom Msg;
- Reply = translate(AuthCom_Reply,']"',d2c(1)d2c(2));
- Reply = substr(Reply,2,length(Reply)-1); /* remove ] */
- c=c+1
- parse var Reply x ']' Reply; /* get pair */
- parse var x y '"' x
- DLine.c=left(LQueue.i,21)]]x
- end;
- DLine.0=c
- X='DLine';
- Y='List of queues.';
- Z='Queue Name Manager';
- Call WindMan X , Y , Z;
- return;
- /* */
- /* Give the punter a list of options to choose from. */
- /* */
- GetTask: Procedure Expose CanAdd CanDel;
- n=0
- do i=1 to 5;
- if i=1 & CanAdd then do;
- n=n+1;
- Page.n='Add a queue.';
- Command.n='ADD';
- end;
- if i=2 & CanDel then do;
- n=n+1;
- Page.n='Delete a queue.';
- Command.n='DELETE';
- end
- if i=3 & CanDel & CanAdd then do;
- n=n+1;
- Page.n='Update a queue.';
- Command.n='UPDATE';
- end
- if i=4 then do;
- n=n+1;
- Page.n='List all the queues.';
- Command.n='LIST';
- end;
- if i=5 then do;
- n=n+1;
- Page.n='List the contents of a queue.';
- Command.n='QLIST';
- end;
- end;
- Page.0=n;
- Page_Title = 'Queue Maintenance.';
- Page_Name = 'an option';
- address command 'PAGE';
- if Rc^=0 then do;
- address command 'QERASE $$NEWQ TEMPWORK A';
- address command 'QERASE $$QCAT TEMPWORK A';
- address command 'QERASE $$QUPD TEMPWORK A';
- address command 'QERASE $$QINF TEMPWORK A';
- exit;
- end;
- Return Command.Page_LineNo;
- AccessDisks: Procedure;
- /* */
- /* Ensure that we have access to the latest version of the necessary */
- /* minidisks. */
- /* */
- address command 'CONDACC E'
- address command 'CONDACC M';
- Return;
- Initialise: Procedure Expose ServerId LqFm;
- /* Get necessary disks. */
- /* */
- address command 'EXEC ACE'; /* need access to parm file */
- address command 'EXEC GETC Q'; /* cos its written in C */
- address command 'GETPARM AUTHOR AUTHOR_ID'; /* get user id */
- if Rc^=0 then Do
- 'WPut Unable to access AUTHOR PARMFILE.';
- Call ErrorExit;
- end;
- pull ServerId; /* save auth user id */
- address command 'QSTATE LOGQ NAMES *';
- if Rc ^= 0 then do;
- address command 'GETFMADR'
- if Rc ^= 0 then do
- 'WClear';
- 'WPut Error 1:'Rc' during initialisation.'
- 'WPut Contact support.';
- exit;
- end;
- pull . LqFm Cuu;
- address command 'QCP LINK 'ServerId' 400 'Cuu' RR ALL';
- if Rc ^= 0 then do
- 'WClear';
- 'WPut Error 2:'Rc' during initialisation.'
- 'WPut Contact support.';
- exit;
- end;
- address command 'SET CMSTYPE HT';
- address command 'ACCESS 'Cuu LqFm;
- SRc = Rc;
- address command 'SET CMSTYPE RT';
- if SRc ^= 0 then do
- 'WClear';
- 'WPut Error 3:'Rc' during initialisation.'
- 'WPut Contact support.';
- exit;
- end;
- end;
- else do
- address command 'FEXTRACT LOGQ NAMES *'
- LqFm=substr(Fextract_FileMode,1,1)
- end;
- return;
- AuthCom: Procedure Expose ServerId AuthCom_Reply
- /*----------------------------------------------------------------*
- * Function - Communicate with AUTHOR machine. *
- * Input Parameters: *
- * Command line is passed to AUTHOR. *
- * AUTHOR_REPLY is set to reply. *
- * Exits *
- * rc=0 Normal Return *
- * rc>0 Error communicating with AUTHOR. *
- *P Foster 02/04/90: Change call for Rename to NewName. *
- *----------------------------------------------------------------*/
- parse arg Msg;
- address command 'AUTHCOM 'ServerId Msg;
- if Rc^=0 then Do
- 'WClear';
- 'WPut Error communicating with the 'ServerId' server.';
- Call ErrorExit;
- end;
- return Rc;
- AuthChk: Procedure Expose ServerId CanAdd CanDel;
- arg List , Opt;
- ACnt=words(List)
- Error=0
- do while words(List) ^= 0
- parse var List Type List
- select
- when Type = 'A' then Word = 'add'
- when Type = 'D' then Word = 'delete'
- when Type = 'U' then Word = 'update'
- otherwise Word = 'list';
- end;
- select
- when Type = 'A' then Msg = 'qadd $filename(logq)'
- when Type = 'D' then Msg = 'qdelete $filename(logq)'
- otherwise Msg = 'list';
- end;
- Call AuthCom Msg /* see if authorised */
- if Authcom_Reply = 'Not authorised' then do;
- 'WClear';
- 'WPut You are not authorised to 'Word' queues.'
- 'WPut Press Enter to continue.';
- Error=1;
- end;
- else do
- select
- when Type='A' then CanAdd=1;
- when Type='D' then CanDel=1;
- otherwise nop
- end;
- end;
- 'WClear';
- end;
- if Error then return 4;
- return 0;
- /*----------------------------------------------------------------*
- * Lock file. *
- *----------------------------------------------------------------*/
- LockFile: Procedure Expose ServerId AuthCom_Reply;
- Call AuthCom 'lock $authfile(logq)';
- if Authcom_Reply ^= 'OK' then do;
- 'WClear';
- 'WToggle';
- 'WPut Unable to lock Log Queue file.';
- 'WToggle';
- 'WPut 'AuthCom_Reply;
- 'WToggle';
- 'WPut Press Enter to continue.';
- 'WWait';
- 'WClear';
- Return 4;
- End;
- 'WClear';
- Return 0;
- GetQName: Procedure Expose Statement Rcd. ServerId,
- AuthCom_Reply QName LorD;
- arg LorD;
- ErrorMsg='';
- do forever;
- 'WClear';
- if ErrorMsg^='' then 'WPut 'ErrorMsg; /* Display error, if necessary*/
- ErrorMsg='';
- 'WToggle';
- 'WPut Enter the name of the queue. ';
- 'WPut Press PF3 to quit.';
- 'WRead';
- 'WClear';
- if Window_Key = 'PF03' then return 4;
- if Window_Line= '' then ErrorMsg='You didn''t enter a queue name!';
- else do;
- QName = APost(Window_Line);
- Msg = 'search $authfile(logq) qname('''QName''') manager(?)';
- Call AuthCom Msg
- if strip(AuthCom_Reply) = 'Not found' then,
- ErrorMsg='Queue "'space(Window_Line,1)'" does not exist!';
- else do;
- Call Detail QName;
- LorD='';
- return Result
- end
- end
- End;
- Apost: Procedure;
- /*Strip " from string and convert ' to '' */
- Parse Arg String;
- String = Space(Translate(String,' ','_'),1);
- NewString='';
- do i=1 to length(String)
- c=substr(String,i,1); /* Isolate character */
- if c^='"' then NewString=NewString]]c; /* Strip " as C don't like */
- if c = "'" then NewString = NewString ]] "'"; /* Double up quotes. */
- end;
- return space(NewString,1);
- /*----------------------------------------------------------------*
- * Find the stmt number of the queue record. *
- *----------------------------------------------------------------*/
- FindRecord: Procedure Expose QName ServerId AuthCom_Reply Statement;
- parse arg QName;
- Msg = 'search $authfile(logq) qname('''QName''') $stmt_no(?)';
- Call AuthCom Msg;
- if substr(Authcom_Reply ,2, 8) ^= '$STMT_NO' then do;
- Call AuthCom 'unlock $authfile(logq)'; /* unlock file */
- 'WClear';
- 'WToggle';
- 'WPut Unable to find queue "'QName'".';
- 'WPut Press Enter to continue.';
- 'WWait';
- 'WClear';
- Return 4;
- End;
- 'WClear';
- Statement = substr(Authcom_Reply,11,4)+0; /* get statement number */
- Return 0;
- /*----------------------------------------------------------------*
- * Now delete statement. *
- *----------------------------------------------------------------*/
- DeleteQ: Procedure Expose QName Statement ServerId AuthCom_Reply;
- Call FindRecord QName;
- if result ^= 0 then return 4;
- Call AuthCom 'delete $authfile(logq) $stmt_number(' Statement ')';
- if AuthCom_Reply ^= 'OK' then do;
- Call AuthCom 'unlock $authfile(logq)'; /* unlock file */
- 'WClear';
- 'WToggle';
- 'WPut Unable to delete "'QName'".';
- 'WPut Please call the helpdesk.';
- 'WPut Press Enter to continue.';
- 'WWait';
- 'WClear';
- Return 4;
- End;
- 'WClear';
- return 0;
- /*----------------------------------------------------------------*
- * unlock the logq file. *
- *----------------------------------------------------------------*/
- UnLockFile: Procedure Expose AuthCom_Reply ServerId;
- Call AuthCom 'unlock $authfile(logq)'; /* unlock file */
- if AuthCom_Reply ^= 'OK' then do;
- 'WClear';
- 'WToggle';
- 'WPut Unable to unlock the Log Queue file.';
- 'WPut Please inform the helpdesk.';
- 'WPut Press Enter to continue.';
- 'WWait';
- 'WClear';
- Return 4;
- End;
- 'WClear';
- return 0;
- /* window manager */
- WindMan:
- parse arg VN , Title , Title2;
- interpret 'Lines='VN'.0' ;
- /* Find longest line */
- TL = 0 ; /* window width */
- SC = 1 ; /* start column */
- Do I = 1 to Lines ;
- interpret 'Text='VN'.'I ;
- If Length(Text) > TL then TL = Length(Text) ;
- End ;
- If Lines > 13 then WL = 13 ;
- Else Wl = Lines ; /* Window length */
- if Title2^='' then Wl=Wl-1;
- If TL > 56 then WW = 56 ;
- Else WW = TL ; /* Window width */
- If WW < 38 then WW=38; /* ensure room for PFKs */
- Topline = 1 ; /* first line to display */
- TTl=Right(Title,Length(Title)%2+(WW%2)) ; /* Centre title */
- Bar=Copies('-',WW) ; /* build line of dashes */
- Do forever ;
- 'WCLEAR' ; /* ensure new window */
- 'WPUT' TTl ; /* put title */
- if Title2^='' then 'WPut 'Title2;
- 'WPUT' Bar ; /* put title */
- 'WTOGGLE' ; /* toggle to dim */
- Do I = 1 to WL ; /* Do each line */
- J = TopLine+I-1 ; /* text line number */
- If J > Lines then Text = '' ; /* pad window at botom of win */
- Else interpret 'Text='VN'.'J ; /* Get text of line */
- Text=SubStr(Text,SC) ; /* get right part of text */
- Text=left(Text,WW) ; /* trunc if necessary */
- 'WPUT' Text ; /* Put text in window */
- End ;
- If Lines < 14 & TL ^> WW then Return ; /* one panel holds all */
- PFLine = 'PF3=End' ;
- If SC=1 & TL > 54 then PFLine=PFLine 'PF4=Right' ; /* allow right */
- Else if SC>1 then PFLine=PFLine 'PF4=Left' ; /* allow left */
- If Topline > 1 then PFLine=PFLine 'PF7=Prev' ; /* allow prev */
- If TopLine+14 ^> Lines then PFLine = PFLine 'PF8=Next' ; /* allow ne */
- PFLine = 'PF2=Detail ']] PFLine;
- 'WTOGGLE' ; /* Bright */
- 'WPUT' Bar ; /* a bar */
- 'WPUT' PFLine ; /* put PFK line */
- 'WWAIT' ; /* Wait for Billy */
- Select ;
- When Window_Key = 'PF03' then Leave ; /* PF3 */
- When Window_Key = 'PF04' then Call RightLeft ; /* Right/Left */
- When Window_Key = 'PF07' then TopLine=TopLine-13 ; /* prev */
- When Window_Key = 'PF08' then TopLine=TopLine+13 ; /* next */
- When Window_Key = 'PF02' then do;
- Call GetWinQ;
- if result=0 then Call Detail QName;
- end;
- Otherwise 'WBeep';
- End ;
- If TopLine < 1 then TopLine = 1 ;
- If TopLine > Lines then TopLine = TopLine-13 ;
- End ;
- 'WCLEAR' ;
- return ;
- RightLeft:
- /*----------------------------------------------------------------*
- * Right/Left * ;
- *----------------------------------------------------------------*/ ;
- If TL<55 then Return ; /* all text shown */
- If SC=1 then SC=TL-54+1 ; /* show right */
- Else SC=1 ; /* Show left */
- Return ;
- Respond: Procedure;
- parse arg What;
- 'WSelect 2';
- 'WClear';
- 'WToggle';
- 'WPut The queue has been successfully 'What'.';
- 'WPut Press Enter to continue.';
- 'WWait';
- 'WClear';
- 'WSelect 1';
- return
- /* Come here to exit after an error. */
- ErrorExit:
- 'WPut Please notify the helpdesk.';
- 'WPut Press Enter to continue.';
- 'WWait';
- exit;
- Detail:
- parse arg QName;
- c=0;
- /* First get the QName as it exists on AUTHOR. */
- Msg = 'search $authfile(logq) qname('''QName''') $STMT_NO(?)'
- Call AuthCom Msg
- if rc=0 then do;
- AuthCom_Reply = strip(AuthCom_Reply);
- if AuthCom_Reply ^='' & AuthCom_Reply ^= 'Not_found' then do;
- parse var AuthCom_Reply '01'x . '02'x Sn;
- Msg = 'search $authfile(logq) $stmt_no('Sn') qname(?)'
- Call AuthCom Msg
- if rc=0 then do;
- AuthCom_Reply = strip(AuthCom_Reply);
- if AuthCom_Reply ^='' & AuthCom_Reply ^= 'Not found' then,
- parse var AuthCom_Reply '01'x . '02'x QName;
- end;
- end;
- end;
- do p=1 to 5 /* Get the components of the Q */
- Msg = 'search $authfile(logq) qname('''QName''') '
- select
- when p=1 then Msg=Msg 'manager(?)'
- when p=2 then Msg=Msg 'queuers(?)'
- when p=3 then Msg=Msg 'updaters(?)'
- when p=4 then Msg=Msg 'inform(?)'
- when p=5 then Msg=Msg 'comment(?)'
- otherwise nop;
- end;
- Call AuthCom Msg
- if strip(AuthCom_Reply)='' then do;
- if p=5 then AuthCom_Reply = '01'x 'comment' '02'x ' '
- end;
- if strip(AuthCom_Reply)='Not found' then iterate p;
- Reply = translate(AuthCom_Reply,']"',d2c(1)d2c(2));
- Reply = substr(Reply,2,length(Reply)-1); /* remove ] */
- do while words(Reply) > 0;
- parse var Reply x ']' Reply; /* get pair */
- parse var x y '"' x
- y=strip(y);
- c=c+1;
- Line.c=left(y ]] ':',9);
- do while words(x) > 0;
- parse var x y '"' x;
- y='"' ]] strip(y) ]] '"';
- if length(Line.c) + (length(y)+2) <= 53 then,
- Line.c = Line.c y;
- else do;
- c=c+1;
- Line.c = left(' ',9) y;
- end;
- end;
- end;
- end;
- 'WClear'
- if LorD='U' then do; /* Update - populate Rcd. */
- q=1
- Rcd.q='qname "'QName'"';
- do v=1 to c;
- if strip(substr(Line.v,1,10))='' then Rcd.q=Rcd.q Line.v
- else do
- q=q+1;
- Rcd.q=Line.v;
- end;
- end;
- Rcd.0=q;
- return 0;
- end;
- if LorD='D' then,
- 'WPut 'centre('Delete the "'QName'" queue?',52);
- else,
- 'WPut 'centre('Settings of "'QName'" queue.',52);
- 'WToggle';
- 'WPut ----------------------------------------------------';
- do i=1 to c;
- 'WPut 'Line.i
- end;
- 'WPut ----------------------------------------------------';
- 'WToggle';
- if LorD='D' then,
- 'WPut Enter Y to delete this queue, anything else to quit.';
- else do
- 'WPut Press Enter to quit.';
- 'WWait';
- return 0;
- end;
- 'WRead';
- if Window_Key='PF03' then return 4
- Ans=Window_Line;
- upper Ans
- if abbrev('YES',strip(Ans),1) then return 0;
- Return 4;
- GetWinQ: Procedure Expose QName Window_Cursor;
- LineNum=strip(SubWord(Window_Cursor,1,1),'L','0');
- if LineNum < 4 ] LineNum > 15 then do
- Call NoQueue;
- return 4;
- end;
- 'Extract Window';
- QName = strip(substr(Window.LineNum,1,21));
- if QName ^= '' then return 0;
- Call NoQueue;
- return 4;
- NoQueue:
- 'WSelect 2'
- 'WClear';
- 'WPut Put the cursor on a queue, then press PF12.';
- 'WPut Press Enter to continue.';
- 'WWait'
- 'WClear';
- 'WSelect 1';
- return;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement