!***********************************************************************
!*
!* Program to assist in regular runs of housekeeping programs
!*
!* Copyright (C) R.D. Eager University of Kent MCMLXXXIV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constinteger maxintype = 3
conststring (7)array intype(1:maxintype) = "DAILY", "WEEKLY", "MONTHLY"
constbyteintegerarray mdays(1:12) = 31,28,31,30,31,30,31,31,30,31,30,31
conststring (1) snl = "
"
conststring (11)array dayname(1:7) = c
"SUNDAY","MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY"
constbyteintegerarray xfudge(1:12) = c
0,3,3,6,1,4,6,2,5,0,3,5
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
recordformat rf(integer conad,filetype,datastart,dataend)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
systemroutinespec oper(integer operno,string (255) s)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec connect(string (31) file,integer mode,hole,c
prot,record (rf)name r,integername flag)
externalstringfunctionspec date
systemroutinespec define(integer chan,string (31) iden,c
integername afd,flag)
systemstringfunctionspec failuremessage(integer mess)
systemstringfunctionspec itos(integer n)
systemstringfunctionspec nexttemp
systemintegerfunctionspec pstoi(string (63) s)
systemroutinespec setfname(string (63) s)
externalroutinespec set return code(integer i)
systemroutinespec uctranslate(integer ad,len)
externalintegerfunctionspec uinfi(integer entry)
externalstringfunctionspec uinfs(integer entry)
!
externalroutinespec clear(string (255) s)
externalroutinespec detachjob(string (255) s)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
string (255)function specmessage(integer flag,stringname info)
switch mes(1000:1005)
!
-> mes(flag)
!
mes(1000): result = "Invalid interval name ".info
mes(1001): result = "Invalid day name ".info
mes(1002): result = "Invalid day number ".info
mes(1003): result = "Invalid time limit ".info
mes(1004): result = "Missing line in file ".info
mes(1005): result = "Invalid time of day ".info
end ; ! of specmessage
!
!-----------------------------------------------------------------------
!
routine fail(integer flag,string (31) info)
string (255) s
!
if flag < 1000 then start
setfname(info)
s = failuremessage(flag)
finish else start
s = specmessage(flag,info)
finish
!
selectoutput(0)
printstring(snl."HOUSEKEEP fails -".s.snl)
s = " - Auto housekeeping failed"
s = uinfs(1)." job ".uinfs(11).s.tostring(17)
if uinfi(2) = 2 then oper(0,s); ! Batch only
set return code(flag)
stop
end ; ! of fail
!
!-----------------------------------------------------------------------
!
routine readline(stringname s)
integer c
!
on event 9 start ; ! Trap 'Input Ended'
s = ".END" if s = ""
return
finish
!
s = ""
cycle
cycle
readsymbol(c)
exit if c = nl
s <- s.tostring(c)
repeat
exit unless length(s) = 0
repeat
!
while length(s) > 0 and charno(s,length(s)) = ' ' cycle
length(s) = length(s) - 1
repeat
uctranslate(addr(s)+1,length(s))
end ; ! of readline
!
!-----------------------------------------------------------------------
!
routine get date(integername day,month,year)
string (8) today
!
today = date
day = pstoi(substring(today,1,2))
month = pstoi(substring(today,4,5))
year = pstoi(substring(today,7,8))
end ; ! of get date
!
!-----------------------------------------------------------------------
!
string (8)function check tod(string (8) s)
integer hh,mm,ss
!
if length(s) = 5 then s = s.".00"
-> fails unless length(s) = 8
-> fails unless charno(s,3) = '.' = charno(s,6)
hh = pstoi(substring(s,1,2))
mm = pstoi(substring(s,4,5))
ss = pstoi(substring(s,7,8))
-> fails unless 0 <= hh <= 23
-> fails unless 0 <= mm <= 59
-> fails unless 0 <= ss <= 59
result = s
!
fails:
fail(1005,s)
end ; ! of check tod
!
!-----------------------------------------------------------------------
!
integerfunction maxday(integer month,year)
integer leap,i
!
if year//4*4 = year then leap = 1 else leap = 0
!
i = mdays(month)
if month = 2 then i = i + leap
result = i
end ; ! of maxday
!
!-----------------------------------------------------------------------
!
routine next(integername day,month,year)
day = day + 1
if day > maxday(month,year) then start
day = 1
month = month + 1
if month > 12 then start
month = 1
year = year + 1
finish
finish
end ; ! of next
!
!-----------------------------------------------------------------------
!
integerfunction dayno(integer day,month,year)
integer days in month,fudge,leap,i
!
days in month = maxday(month,year)
fudge = xfudge(month)
if year//4*4 = year then leap = 1 else leap = 0
if month = 2 then start
fudge = fudge - leap
finish
if month = 1 then fudge = fudge + 6*leap
i = year + year//4 + day + fudge
i = i - (i//7*7) + 1
result = i
end ; ! of dayno
!
!
!***********************************************************************
!*
!* H O U S E K E E P
!*
!***********************************************************************
!
externalroutine housekeep(string (255) cfile)
integer flag,day,month,year,afd,i
record (rf) rr
string (8) tod
string (31) file,interval,docpars
string (255) s
switch sw(1:maxintype)
!
if cfile = "" then fail(263,cfile); ! Wrong number of parameters
!
tod = "00.00.00"; ! Default time for AFTER parameter
get date(day,month,year)
file = cfile."_INTERVAL"
connect(file,1,0,0,rr,flag)
if flag # 0 then fail(flag,file)
define(1,file,afd,flag)
if flag # 0 then fail(flag,file)
selectinput(1)
!
readline(interval)
cycle i = 1,1,maxintype
if intype(i) = interval then -> sw(i)
repeat
fail(1000,interval); ! Invalid interval name
!
sw(1): ! Daily
readline(s)
if s # ".END" then tod = check tod(s)
next(day,month,year); ! Advance by one day
-> go
!
sw(2): ! Weekly
readline(s)
if s = ".END" then fail(1004,file); ! Missing line
cycle i = 1,1,7
if dayname(i) = s then -> dayok1
repeat
fail(1001,s); ! Invalid day name
!
dayok1:
readline(s)
if s # ".END" then tod = check tod(s)
next(day,month,year) until dayno(day,month,year) = i
-> go
!
sw(3): ! Monthly
day = 100; ! Impossible value - forces month advance
next(day,month,year)
readline(s)
if s = ".END" then fail(1004,file); ! Missing line
i = charno(s,1)
if '0' <= i <= '9' then start
i = pstoi(s)
unless 1 <= i <= maxday(month,year) then fail(1002,s); ! Invalid day number
day = i
finish else start
cycle i = 1,1,7
if dayname(i) = s then -> dayok2
repeat
fail(1001,s); ! Invalid day name
!
dayok2:
day = 1
day = day + 1 while dayno(day,month,year) # i
finish
readline(s)
if s # ".END" then tod = check tod(s)
-> go
!
go:
!
! New date has been set - now detach the job
!
s = itos(month)."/".itos(year)
if length(s) = 4 then s = "0".s
s = itos(day)."/".s
if length(s) = 7 then s = "0".s
s = "AFTER=".s." ".tod
file = cfile."_DOCPARAMS"
connect(file,1,0,0,rr,flag)
if flag # 0 then fail(flag,file)
selectinput(0)
closestream(1)
define(1,file,afd,flag)
if flag # 0 then fail(flag,file)
selectinput(1)
docpars = "T#".nexttemp
define(2,docpars,afd,flag)
if flag # 0 then fail(flag,docpars)
selectoutput(2)
printstring(s.snl)
cycle
readline(s)
printstring(s.snl)
exit if s = ".END"
repeat
selectoutput(0)
closestream(2)
selectinput(0)
closestream(1)
file = cfile."_TIME"
connect(file,1,0,0,rr,flag)
if flag # 0 then fail(flag,file)
define(1,file,afd,flag)
if flag # 0 then fail(flag,file)
selectinput(1)
readline(s)
selectinput(0)
closestream(1)
clear("1,2")
i = pstoi(s)
unless 1 <= i <= 7200 then fail(1003,s); ! Invalid time limit
s = cfile."_COMMANDS"
connect(s,1,0,0,rr,flag)
if flag # 0 then fail(flag,s)
detachjob(s.",".itos(i).",".docpars)
end ; ! of HOUSEKEEP
endoffile