! 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