{ ROSSYP.INC - Remote Operating System Sysop Sub-system, purge routines }

overlay procedure purge_files;
{ Purge various system files of extraneous records }
  var
    done: boolean;
    ch_sel: char;
    age, cur_date: real;
    t: tad_array;

  procedure purge_log;
  { Purge the log file of all records }
    begin
      Write(USR, 'Purging the LOG file...');
      Seek(logr_file, 0);
      Read(logr_file, logr_rec);
      Close(logr_file);
      Rewrite(logr_file);
      Write(logr_file, logr_rec);
      Writeln(USR)
    end;

  procedure purge_message;
  { Purge deleted messages }
    const
      col_width = 6;
    var
      i, col_count, col_limit: integer;
      nsum_file : file of summ_list;
      nmsg_file : file of mesg_list;
    begin
      col_limit := max(1, user_rec.columns div col_width);
      Write(USR, 'Purging the MESSAGE files...');
      Assign(nsum_file, summ_name + '.$$$');
      Assign(nmsg_file, mesg_name + '.$$$');
      Rewrite(nsum_file);
      Rewrite(nmsg_file);
      Seek(summ_file, 0);
      Read(summ_file, summ_rec);      { Copy message counter to new file }
      Write(nsum_file, summ_rec);
      col_count := 0;
      while not EOF(summ_file) do
        with summ_rec do
          begin
            Read(summ_file, summ_rec);
            age := cur_date - greg_to_jul(date[3], date[4], date[5]);
            if (status = deleted) or (age > unr_days) or
               ((status = read) and (age > rea_days))
              then
                begin
                  if (0 = col_count mod col_limit)
                    then Writeln(USR);
                  Write(USR, num:col_width);
                  col_count := succ(col_count)
                end
              else
                begin
                  Seek(mesg_file, st_rec);
                  st_rec := filesize(nmsg_file);
                  Write(nsum_file, summ_rec);
                  for i := 1 to size do
                    begin
                      read(mesg_file, mesg_rec);
                      Write(nmsg_file, mesg_rec)
                    end
                end
          end;
      Close(summ_file);
      Close(mesg_file);
      Close(nsum_file);
      Close(nmsg_file);

      Erase(summ_file);
      Erase(mesg_file);
      Rename(nsum_file, summ_name + ext);
      Rename(nmsg_file, mesg_name + ext);

      Reset(summ_file);
      Reset(mesg_file);

      mesg_build_index(AreaSet);
      Writeln(USR)
    end;

  procedure purge_newin;
  { Purge deleted newin records }
    var
      new_nwin_file: file of nwin_list;
    begin
      Write(USR, 'Purging the NEWIN file...');
      Assign(new_nwin_file, nwin_name + '.$$$');
      Rewrite(new_nwin_file);
      Seek(nwin_file, 0);
      repeat
        {$I-} Read(nwin_file, nwin_rec) {$I+};
        if IOresult = 0
          then if nwin_rec.status <> deleted
                 then Write(new_nwin_file, nwin_rec)
      until EOF(nwin_file);
      Close(nwin_file);
      Close(new_nwin_file);

      Erase(nwin_file);
      Rename(new_nwin_file, nwin_name + ext);

      Reset(nwin_file);
      Writeln(USR)
  end;

  procedure purge_user;
  { Purge outdated users }
    var
      i, temp_user_loc: integer;
      str: StrTAD;
      key: StrName;
      temp_user_rec: user_list;
    begin
      Write(USR, 'Purging the USER file...');
      temp_user_loc := 1;
      while (not brk) and (temp_user_loc < FileLen(DatF)) do
        with temp_user_rec do
          begin
            GetRec(DatF, temp_user_loc, temp_user_rec);
            age := cur_date - greg_to_jul(laston[3], laston[4], laston[5]);
            if ((used = 0) and
                (((age > unv_days) and (access < val_acc)) or
                 ((age > val_days) and (access >= val_acc))))
              then
                begin
                  key := pad(ln, len_ln) + pad(fn, len_fn);
                  DeleteKey(IdxF, temp_user_loc, key);
                  if OK
                    then
                      begin
                        DeleteRec(DatF, temp_user_loc);
                        str := FormTAD(laston);
                        Writeln(USR);
                        Write(USR, key, ' ', access, ' ', str);
                        for i := 1 to pred(FileSize(summ_file)) do
                          begin             { Delete messages pertaining to user }
                            seek(summ_file, i);
                            read(summ_file, summ_rec);
                            if ((summ_rec.user_to = temp_user_loc) or (summ_rec.user_from = temp_user_loc))
                              then
                                begin
                                  Writeln(USR);
                                  mesg_delete
                                end
                          end
                      end
                end;
            temp_user_loc := succ(temp_user_loc)
          end;
      Writeln(USR)
    end;

  begin
    GetTAD(t);
    cur_date := greg_to_jul(t[3], t[4], t[5]);
    done := FALSE;
    repeat
      ch_sel := select('File to purge', 'AllLogMessageNewinUserQuit');
      case ch_sel of
        'A': if ask('Do you want to purge ALL files')
             then
               begin
                 purge_log;
                 purge_newin;
                 purge_user;
                 purge_message;
                 done := TRUE
               end;
        'L': if ask('Do you want to purge the LOG file')
               then purge_log;
        'M': if ask('Do you want to purge the MESSAGE files')
               then purge_message;
        'N': if ask('Do you want to purge the NEWIN file')
               then purge_newin;
        'U': if ask('Do you want to purge the USER file')
               then purge_user;
        'Q': done := TRUE;
        '?': Writeln(USR, '<A>ll, <L>og, <M>essage, <N>ewin, <U>ser, <Q>uit')
      end
    until done
  end;