!  File  MOUSE:SSILIB

! SSI-like utility routines

%option "-low-nons-nocheck-nodiag"

%recordformat fs fm (%integer s,m,r,%bytename sb,rb)

%externalroutinespec FILE LOGOUT (%string(255)fs)
%externalroutinespec FILE LOGIN (%string(*)%name fsu,p)
%externalroutinespec FILE QUOTE PASSWORD (%string(*)%name fs,p)
%externalroutinespec FILE CHANGE PASSWORD (%string(*)%name fs,p)
%externalroutinespec FILE CREATE DIRECTORY (%string(255)f)
%externalroutinespec FILE DELETE (%string(255)f)
%externalroutinespec FILE INFO (%string(*)%name f,info)
%externalroutinespec FILE RENAME (%string(*)%name old,new)
%externalroutinespec FILE COPY (%string(*)%name old,new)
%externalroutinespec FILE PERMIT (%string(*)%name f,p)
%externalroutinespec FILE CHANGE DATE (%string(*)%name f,d)
%externalroutinespec FILE GET DATE (%string(*)%name fs,d)
%externalroutinespec FILE SPECIAL (%string(*)%name fs,%record(fs fm)%name r)
%externalroutinespec FILE OLDFINFO(%string(*)%name f,info)

%externalroutinespec toupper(%string(*)%name s)
%externalroutinespec standardise filename(%string(*)%name f)
%externalroutinespec define logical name(%string(255)s,t)
%externalroutinespec set directory(%string(255)s)
%externalstring(255)%fnspec current filestore
%externalstring(255)%fnspec current directory
%externalstring(255)%fnspec translatelogicalname(%string(255)s)

%externalroutine quote(%string(255)password)
%string(255)s="."
  filequotepassword(s,password)
%end

%externalroutine password(%string(255)password)
%string(255)s="."
  filechangepassword(s,password)
%end

%externalroutine create directory(%string(255)file)
  filecreatedirectory(file)
%end

%externalroutine delete(%string(255)file)
  filedelete(file)
%end

%externalroutine rename(%string(255)from,to)
  filerename(from,to)
%end

%externalroutine copy(%string(255)from,to)
  filecopy(from,to)
%end

%externalroutine permit(%string(255)file,perms)
  filepermit(file,perms)
%end

%externalroutine stamp(%string(255)file,date)
  filechangedate(file,date)
%end

%externalstring(255)%fn ninfo(%string(255)f)
%string(255)i
  file info(f,i)
  %result = i
%end

%externalstring(255)%fn finfo(%string(255)d,%integer n)
%string(255)i
  d = "^".d.","
  d = d.tostring(n>>4+'0')
  d = d.tostring(n&15+'0')
  file oldfinfo(d,i)
  %result = i
%end

%externalroutine logout
  filelogout(current filestore)
  set directory("^")
  define logical name("current_user","")
%end

%externalroutine login(%string(255)user,password)
%record(fs fm)r
%string(255)full,dev="",dir
%bytename b
%integer i,j
  toupper(user)
  %if user -> dev.("::").user %start
    user -> dev.(":").user %if dev=""
  %elseif user -> dev.(":").user
    user -> dev.(":").user %if dev=""
  %finish
  %if dev="" %then dev = currentfilestore %else dev = ":F:".dev.":"
  logout %if dev=currentfilestore
  full = dev.user
  filelogin(full,password)
  define logical name("current_user",user)
  define logical name("current_filestore",dev)
  dir = user.":"
  define logical name("current_directory",dir)
  dir = finfo("",0)
  dir -> dir.(" ")
  b == length(dir)
  %if b>=5 %and b[b]='*' %start {Vax: U:[D.D]*.*;* -> U:[D.D]}
    b = b-5
  %else
    b = b+1 %and b[b] = ':' %unless b[b]=':'
  %finish
  define logical name("default_directory",dir)
  set directory("")
%end

%externalintegerfn wildness(%string(*)%name s)
%integer k,i,w=0
  %for i=1,1,length(s) %cycle
    k = charno(s,i); w = w+1 %if k='*' %or k='%'
  %repeat
  %result = w
%end

%externalpredicate Matches(%string (*) %name s, p)
! S=Subject, P=Pattern. Pattern is the one with the stars in it.
   %integer slen = 0, plen = 0

   %predicate m (%integer spos,ppos)
      %integer psym = 0,ssym = 0

      %cycle
         %if ppos=plen %start
            %true %if spos=slen
            %false
         %finish
         ppos = ppos+1; psym = charno(p,ppos)
         %exitif psym='*'
         %falseif spos=slen
         spos = spos+1; ssym = charno(s,spos)
         psym = ssym %if ssym!32=psym!32 %and 'a'<=psym!32<='z'
         %unless ssym=psym %start
            %falseunless psym='%'
         %finish
      %repeat

      %cycle
         %trueif m(spos,ppos)
         %exitif spos=slen
         spos = spos+1; ssym = charno(s,spos)
      %repeat
      %false
   %end

   slen = length(s)
   plen = length(p)
   %true %if m(0,0)
   %false
%end

%externalstring(255)%fn current user
  %result = translate logical name("current_user")
%end

%systemintegerfn CPUTYPE
  %result = integer(16_1200)
%end

%systemintegerfn CPUTIME
  %result = integer(16_11E4)
%end

%constinteger base {1/1/80} = 29161

%externalstring(19)%fn DECODE DATE AND TIME (%integer code)
%integer d,m,y,hh,mm,ss
%string(19)r="dd/mm/yy  hh.mm.ss"
%bytename b

  %routine p2(%integer n,%bytename b)
    b[1] = rem(n,10)+'0'
    b = rem(n//10,10)+'0'
  %end

  d = (code//(24*60*60)+base)<<2-1
  y = d//1461+1
  d = ((rem(d,1461)+4)>>2)*5-3
  m = d//153-9
  %if m<=0 %start
    m = m+12;  y = y-1
  %finish
  d = (rem(d,153)+5)//5
  b == charno(r,1)
  p2(d,b; m,b[3]; y,b[6])
  ss = rem(code,60); code = code//60
  mm = rem(code,60); hh = rem(code//60,24)
  b == b[10]
  p2(hh,b; mm,b[3]; ss,b[6])
  %result = r
%end

%externalintegerfn ENCODE DATE AND TIME (%string(255)s)
%integer d=0,m=0,y=0,hh=0,mm=0,ss=0
%bytename b,end

  %integerfn num
  %integer n=0
    %result = n %if b==end
    b == b[1]
    %cycle
      %result = n %if b==end
      %if b=' ' %start
        %result = n %unless n=0
      %else
        %result = n %unless '0'<=b<='9'
        n = n*10+b-'0'
      %finish
      b == b[1]
    %repeat
  %end

  b == length(s); end == b[b+1]
  d = num; m = num; y = num; hh = num; mm = num; ss = num
  m = m - 3
  m = m + 12 %and y = y - 1 %if m < 0
  %result = (((((y*1461)>>2+(m*153+2)//5+d-base))*24+hh)*60+mm)*60+ss
%end

%recordformat finfof(%string(23)name,%string(5)perms,%string(9)date,time,
                     %integer blocks,extents)

%externalroutine unpack finfo(%string(127)s,%record(finfof)%name r)
%integer pos=1
  %routine scan
    pos = pos+1 %while pos<=length(s) %and charno(s,pos)=' '
  %end
  %integerfn d
  %integer n=0,k
    scan
    %cycle
      %result = n %if pos>length(s); pos = pos+1; k = charno(s,pos-1)-'0'
      %result = n %if k<0 %or k>9; n = n*10+k
    %repeat
  %end
  %routine w(%string(*)%name t,%integer max)
  %integer k
    scan; t = ""
    %cycle
      %returnif pos>length(s) %or max<=0
      k = charno(s,pos); pos = pos+1; max = max-1
      %returnif k=' '
      t = t.tostring(k)
    %repeat
  %end
  r = 0
  w(r_name,23); w(r_perms,5); w(r_date,9); w(r_time,9)
  r_blocks = d; r_extents = d
%end