! Simple PURGE utility for old-style Fred-O/S, intended to run against
! the new-style filestores (running it against the old-style filestores
! will be a no-op).

include  "Inc:FS.Imp"

owninteger  n = 0

routine  delete file(string (255) file)
   integer  x
      on  3 start 
         printstring("Delete ");  printstring(file)
         printstring(" failed: ");  printstring(event_message)
         newline
         return 
      finish 
      !! printstring("Delete ");  printstring(file);  newline
      x = fcomm('D' << 8, file)
      n = n + 1
end 

routine  read line(string (*)name  s)
   integer  ch
      s = ""
      cycle 
         read symbol(ch)
         exit  if  ch = NL
         s = s . to string(ch)
      repeat 
end 

begin 
   string (255) directory, file
      on  3, 9 start 
         if  event_event = 3 start 
            printstring("Purge ")
            if  directory = "" then  printstring("current default") c 
                               else  printstring(directory)
            printstring(" fails: ");  printstring(event_message)
            newline
            stop 
         finish 
         write(n, 0);  printstring(" file")
         print symbol('s') if  n # 1
         printstring(" purged");  newline
         stop 
      finish 
      directory = CLI param
      if  directory = "" start 
         open input(3, ".");  select input(3)
      else 
         directory = directory . ":" c 
            unless  charno(directory, length(directory)) = ':'
         open input(3, directory);  select input(3)
      finish 
      cycle 
         read line(file)
         if  file -> file . (":-") start 
            !! printstring("Versions of ");  printstring(file)
            !! printstring(" exist");  newline
            delete file(directory . file . ":-1")
         finish 
      repeat 
end  of  program