external routine spec call(string (31) cmd, string (255) par)
external routine spec prompt(string (255) s)
external routine spec list(string (255) s)
external routine spec nrstrg(string name s)
external string fn spec ucstring(string (255) s)
system string fn spec itos(integer i)
system integer fn spec current packed dt
system integer fn spec pack date and time(string (8) date, time)
system string fn spec unpack date(integer i)
system string fn spec unpack time(integer i)
external routine spec read profile(string (11) key, name info, integer name version, uflag)
external routine spec write profile(string (11) key, name info, integer name version, uflag)
const integer max profile entries=10
const string (7) browse file="T#DOCX", docfile="T#DOC"
const integer yes=1, no=0
const string (9) unused="Unused", deleted="Deleted", completed="Completed",
after="After", null="Null", current="Queued",
running="Running", sending="Sending"
external routine spec documents(string (255) s)
external routine spec despace(string name s)
external integer fn spec outpos
external routine spec define(string (255) s)
external routine spec clear(string (255) s)
external routine spec rstrg(string name s)
external integer fn spec bin(string (255) s)
external routine browsedocs(string (255) s)
record format docf(integer dtword, string (15) file, string (7) docno, queue,
string (9) state)
record format drf(integer max, point, n, string (31) editor,
record (docf) array doc(1:max profile entries))
routine spec brhelp
routine spec print entry(record (docf) r)
routine spec get doc info
routine spec sort2(record (docf) array name p, integer array name x, integer num)
integer vsn, flag, j, point, max, k, no of cur docs, inserted, updated, hit
integer do documents, do display, ch, dtw
record (drf) r, tempr
record (docf) name ss
string (9) new state, queue, date1, time1
string (31) editor
string (127) a, b, file, docno
integer array x(1:max profile entries)
const integer max new docs=20
record (docf) array curdocs(1:max new docs)
on event 9 start
->eof
finish
vsn=1
max=max profile entries
editor="LIST"
updated=no
! Get profile information
read profile("Docs", r, vsn, flag)
if flag=2 {profile entry wrong size} or flag=3 {profile not exist} or c
flag=4 {keyword not found} start
! Initialise profile array
r=0
r_max=max; r_point=1; r_editor=editor
for j=1, 1, max cycle
r_doc(j)_state=unused
repeat
updated=yes
if flag=2 then vsn=-1 {delete existing entry}
finish else if flag=0 start
max=r_max
editor=r_editor
finish else start
printstring("Read profile fails"); write(flag, 1)
newline
return {bad failure}
finish
do documents=yes
do display=no
! Analyse parameters
if s="?" start
brhelp
return
finish else if s="*" start
newline
printstring("Give maximum number of entries to be held (max ".itos(max profile entries). c
", currently ".itos(max))
printstring(")
or CR to leave unchanged")
newlines(2)
prompt("No of entries: ")
cycle
nrstrg(s)
if s="" then exit
j=bin(s)
if 0<j<=max profile entries start
if j#max then vsn=-1
{different from existing value, so delete profile entry and make new}
r_max=j
updated=yes
exit
finish
repeat
printstring("Give entry point name to be used for displaying Documents")
printstring(" (currently ".r_editor.")
or CR to leave unchanged")
newlines(2)
prompt("Entry point: ")
cycle
nrstrg(s)
s=ucstring(s)
if length(s)<=31 start
if s#"" start
r_editor=s
editor=s
updated=yes
finish
exit
finish
repeat
finish else if s="LIST" or s="SHOW" or s="LOOK" start
editor=s
do documents=no
do display=yes
finish else if s#"" start
hit=0 {set one if non-alpha-num found}
for j=1, 1, length(s) cycle
ch=charno(s, j)
unless 'A'<=ch<='Z' or '0'<=ch<='9' then hit=1
repeat
if hit=0 start
editor=s
do display=yes
finish else start
printstring("Invalid parameter")
newline
return
finish
finish
no of cur docs=0
if do documents=yes start
printstring("Documents()"); newline
define("9,".docfile)
select output(9)
documents("")
select output(0)
close stream(9)
select input(9)
no of cur docs=0
cycle
rstrg(s)
if s->a.("Queue").b and a="" start
despace(b)
queue=b
finish
if length(s)>47 start
docno=substring(s, 25, 29) {doc ident position}
despace(docno)
j=bin(docno)
if 0<j<=9999 start
! Assume decent document number
no of cur docs=no of cur docs+1
if no of cur docs>max new docs start
printstring("Too many new documents!!")
newline
return
finish
file=substring(s, 1, 15); despace(file)
date1=substring(s, 31, 38)
time1=substring(s, 40, 47)
curdocs(no of cur docs)_docno=docno
curdocs(no of cur docs)_dtword=pack date and time(date1, time1)
curdocs(no of cur docs)_queue=queue
curdocs(no of cur docs)_file=file
curdocs(no of cur docs)_state=current
! print entry(curdocs(no of cur docs))
finish
finish
repeat
eof:
select input(0)
close stream(9)
clear("9")
list(docfile)
finish {do documents=yes}
!----------------------------------------------------------------------------
! R is now set up.
point=r_point
for k=1, 1, no of cur docs cycle
inserted=no
hit=0
j=point
cycle
ss==r_doc(j)
if ss_docno=curdocs(k)_docno then hit=1
j=j+1; j=1 if j>max
repeat until j=point
if hit#0 then continue
! Then new, so insert
cycle
ss==r_doc(j)
if ss_state=unused start
ss=curdocs(k)
r_n=r_n+1 if r_n<max
inserted=yes
updated=yes
exit
finish
j=j+1; j=1 if j>max
repeat until j=point
if inserted=no start
! Array is full. Use oldest entry. Point points to the oldest.
! "Point+1", "Point+2", ... get newer and newer. "Point-1" is newest
r_doc(point)=curdocs(k)
point=point+1
point=1 if point>max
r_n=r_n+1 if r_n<max
updated=yes
finish
repeat
!----------------------------------------------------------------------------
! Now look for profile entries which are Queued, but no longer "current"
define("10,".browse file)
j=point
cycle
hit=0
ss==r_doc(j)
if ss_state=after then dtw=ss_dtword else dtw=0
if ss_state=current or ss_state=running or ss_state=sending or c
dtw<<1>>1>=current packed dt<<1>>1 start
for k=1, 1, no of cur docs cycle
if curdocs(k)_docno=ss_docno then hit=1
repeat
if hit=0 and do documents=yes start
printstring("Documents(".ss_docno.")"); newline
get doc info
if new state#null start
ss_state=new state
ss_dtword=pack date and time(date1, time1)
updated=yes
finish else printstring("? Not Deleted/Completed?") and newline
finish
finish
j=j+1; j=1 if j>max
repeat until j=point
! Sort entries on dtword
sort2(r_doc, x, r_n)
tempr=r
hit=no {Array altered by sort?}
for j=1, 1, r_n cycle
if x(j)#j then hit=yes
r_doc(j)=tempr_doc(x(j))
repeat
point=1 {always, now}
if hit=yes then updated=yes
! Update the PROFILE file
if updated=yes start
r_point=point
cycle
write profile("Docs", r, vsn, flag)
if flag#0 start
printstring("Write profile flag"); write(flag, 1)
newline
finish
exit if vsn>0
vsn=1
repeat
finish
return if do display=no
! Now report all entries.
printstring("Recorded status")
printstring(" [Max entries:"); write(max, 1)
printstring(" No used:"); write(r_n, 1)
printstring("]")
newline
if do display=yes then select output(10)
j=point
cycle
ss==r_doc(j)
print entry(ss) if ss_state#unused
j=j+1; j=1 if j>max
repeat until j=point
if do display=yes start
select output(0)
close stream(10)
finish
clear("10")
if do display=yes then call(editor, browse file)
!----------------------------------end body-------------------------------------
string fn day of week(integer dtword)
const string (3) array ww(0:6)="Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"
integer day
day=dtword<<1>>1
day=day//86400 {days since 1st Jan 1970}
day=day-(day//7)*7 {day in week}
result =ww(day)
end {day of week}
routine print entry(record (docf) tt)
const integer dtab=16, {tab for docno}
qtab=dtab+4, {tab for queuename}
stab=qtab+8, {tab for state}
ntab=stab+11, {tab for dayname}
ttab=ntab+4, {tab for date}
itab=ttab+9 {tab for time}
string (8) date, time, dayname
date=unpack date(tt_dtword)
time=unpack time(tt_dtword)
dayname=day of week(tt_dtword)
printstring(tt_file); spaces(dtab-outpos)
printstring(tt_docno); spaces(qtab-outpos)
printstring(tt_queue); spaces(stab-outpos)
printstring(tt_state)
spaces(ntab-outpos); printstring(dayname)
spaces(ttab-outpos); printstring(date)
spaces(itab-outpos); printstring(time)
newline
end {print entry}
!-------------------------------------------------------------------------------
routine get doc info
string (255) s, aa, bb, cc, after found
on event 9 start
->eof2
finish
select output(10)
documents(ss_docno)
select output(0)
close stream(10)
select input(10)
new state=null
after found=null
cycle
rstrg(s)
!printstring("++".s)
!newline
if s->aa.("Completed at ").bb then new state=completed else if c
s->aa.("Deleted at ").bb then new state=deleted
if s->aa.("after=").cc then after found=after
repeat
eof2:
cycle
if new state#null start
date1=substring(bb, 1, 8)
time1=substring(bb, 10, 17)
finish
if after found=null then exit else if c
new state#completed and new state#deleted and new state#running start
after found=null
new state=after
bb=cc
finish else exit
repeat
select input(0)
close stream(10)
end {get doc info}
routine brhelp
printstring("BROWSEDOCS is used to record and display a history of documents submitted to the
")
printstring("Spooling system. It can LIST or SHOW or LOOK at the stored history. The
")
printstring("following table gives the various actions.
"); printstring("
"); printstring("Parameter Calls DOCUMENTS? Inspects stored Using command:
")
printstring(" history?
"); printstring("
"); printstring("none(null) Yes Yes stored in PROFILE
")
printstring("
"); printstring("DOC Yes No -
")
printstring("
"); printstring("LIST,SHOW,LOOK No Yes LIST,SHOW,LOOK
")
printstring("
"); printstring("Other alphnumeric No Yes parameter given
")
printstring("
"); printstring("* Yes Yes stored in PROFILE.
")
printstring("
"); printstring("Additionally, ""*"" allows the default max no(10) of stored entries and the
")
printstring("default display command(LIST) to be altered.
"); printstring("
"); printstring("The action will usually be quicker if DOCUMENTS is not called, but it's
")
printstring("necessary to have DOCUMENTS called once while a document is queued (e.g.
")
printstring("immediately after a LIST or DETACH command) in order to get its details
")
printstring("recorded.
");
end {brhelp}
routine sort2(record (docf) array name p, integer array name x, integer num)
! DECLARE INTEGER ARRAY X, BOUNDS 1:NUM, IN CALLING ROUTINE
integer i, j, hit, n
cycle i=1, 1, num
x(i)=i
repeat
cycle i=num-1, -1, 1
hit=0
cycle n=1, 1, i
if p(x(n))_dtword<<1>>1>p(x(n+1))_dtword<<1>>1 start
j=x(n)
x(n)=x(n+1)
x(n+1)=j
hit=1
finish
repeat
if hit=0 then exit
repeat
end {sort2}
end {browsedocs}
end of file