!***********************************************************************
!*
!*      Program to check if a character file has a VIEW directory
!*
!*       Copyright (C) R.D. Eager   University of Kent   MCMLXXXV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
constantinteger  sscharfiletype = 3;    ! Subsystem file type
constantinteger  sspdfiletype = 6;      ! Subsystem file type
!
!
!***********************************************************************
!*
!*          Record formats
!*
!***********************************************************************
!
recordformat  hf(integer  dataend,datastart,filesize,filetype,sum,
                 datetime,
                 (integer  spare1,spare2 or  c      { Character file }
                 integer  format,records or  c      { Data file }
                 integer  adir,count or  c          { Pdfile }
                 integer  pstart,spare3 or  c       { Old directory file }
                 integer  spare4,controlmode or  c  { Background control file }
                 integer  lda,ofm))                 { Object file }
recordformat  rf(integer  conad,filetype,datastart,dataend)
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
systemroutinespec  connect(string (31) file,integer  mode,hole,
                           prot,record (rf)name  r,integername  flag)
systemintegerfunctionspec  dtword(integer  n)
systemstringfunctionspec  failuremessage(integer  mess)
systemintegerfunctionspec  parmap
systemroutinespec  setfname(string (63) s)
systemroutinespec  setpar(string (255) s)
externalroutinespec  set return code(integer  i)
systemstringfunctionspec  spar(integer  n)
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
integerfunction  diff(integer  time1,time2)
! Yields  the absolute difference in seconds between the two time stamps
! 'time1' and 'time2'.
result  = imod(dtword(time1)-dtword(time2))
end ;   ! of diff
!
!
!***********************************************************************
!*
!*          V I E W C H E C K
!*
!***********************************************************************
!
externalroutine  viewcheck(string (255) parms)
integer  flag
string (31) file
record (rf) rr
record (hf)name  h,mh
!
set return code(1000)
!
setpar(parms)
if  parmap # 1 then  start 
   flag = 263;                          ! Wrong number of parameters
   -> err
finish 
!
if  spar(1) = "?" then  start 
   printstring("There is only one parameter - the name of the file to be checked")
   newline
   printstring("It must be a character file or a partitioned file")
   newline
   set return code(0)
   return 
finish 
!
file = spar(1)
connect(file,0,0,0,rr,flag)
-> err if  flag # 0
h == record(rr_conad)
!
if  h_filetype = sscharfiletype then  start 
   if  h_spare2 = 2 then  flag = 0 else  flag = 1
finish  else  c 
if  h_filetype = sspdfiletype then  start 
   connect(file."_VIEWKEYS",0,0,0,rr,flag)
   if  flag = 0 then  start ;           ! Key member exists
      connect(file."_VIEWDIR2",0,0,0,rr,flag)
      if  flag = 0 then  start ;        ! Directory member exists
         mh == record(rr_conad)
         if  diff(h_datetime,mh_datetime) > 5 then  flag = 2 else  flag = 0
      finish  else  flag = 1
   finish  else  flag = 1
else 
   setfname(file)
   flag = 267;                          ! Invalid filetype
   -> err
finish 
!
if  flag = 0 then  start 
   printstring("File directory is up to date")
finish  else  c 
if  flag = 1 then  start 
   printstring("File has no directory")
else 
   printstring("File directory is out of date")
finish 
newline
!
set return code(flag)
return 
!
err:
newline
printstring("VIEWCHECK fails -".failuremessage(flag))
set return code(flag)
return 
end ;   ! of VIEWCHECK
endoffile