/* eraq - conditional file erase program (with query)
       The default fcb (from the command line) is used to search for
       matching files and each match is printed on the console for
       delete confirmation.  A table is built of files to be deleted
       so as to not lose the search position in the directory.
       The maximum number of fcbs in the table is given by LIST_LNGTH
       below, if this number is exceeded or free space exhausted the
       table entries are deleted and the search restarted. */

       eraq: procedure options(main);
       %replace
          TRUE           by '1'b,
          FALSE          by '0'b,
          VERSION        by 'ERAQ 1.0',
          VERDATE        by '02/05/81',
          HELP_CMD       by 'HELP    ',
          EOF            by '^Z',
          INTRRPT        by '^C',
          LIST_LNGTH     by 512;

       %include 'diomod.dcl';

       declare
          version_date   char(8) external static init(VERDATE);


       declare
          1 default1      based(dfcb0()),
            3 space       fixed(7),
            3 command     char(8);

       declare
          fcbp            pointer,
          1 dir_fcb       based(fcbp),
            3 drive       fixed(7),
            3 fname       char(8),
            3 ftype       char(3),
            3 fext        fixed(7);

       declare
          1 del_fcb       based,
            3 dr          fixed(7),
            3 fn          char(8),
            3 ft          char(3),
            3 fe          fixed(7);

       declare
          1 default_fcb   based(dfcb0()),
            3 spacer      bit(8),
            3 name        char(11);

       declare
          delp(LIST_LNGTH) pointer,
          drv              bin fixed(7) based(dfcb0()),
          dir_mask(0:127)  bit(8) based(dbuff()),
          (i,n)            bin fixed static init(0);

       on error(7) begin;
          n = n - 1;
          put skip list('List space exhausted');
          call delete_list;
             do i = 1 to n;
             free delp(i)->del_fcb;
             end;
          n = 0;
          go to redo;
          end;

       put list(VERSION);
       if command = HELP_CMD then do;
           put skip list('ERAQ - Erase with Query');
           put skip(2) list('Command line:');
           put list('          ERAQ <ambiguous filename>');
           put skip(2);
           call reboot();
           end;

redo:
       PUT SKIP;
       if index(default_fcb.name,'?') = 0 then do;
          call delete(dfcb0());
          end;
       else do;
          call setdma(dbuff());
          i = sear(dfcb0());
          if i > -1 then do;
                do while(i > -1);
                unspec(i) = unspec(i) & '00000011'b;  /* for CP/M 1.4 */
                fcbp = addr(dir_mask(i * 32));
                if drive = user() then do;
                   drive = drv;
                   if query() then
                      call add_to_list;
                   i = searn();
                   end;
                end;
             call delete_list;
             end;
          else
             put skip list('File not found');
          end;
       call reboot();

/* user - procedure to get user number if version > = cp/m 2.0 */
       user: procedure returns(fixed(7));

       if vers() = '0000'b4 then
          return(0);
       else
          return(getusr());
       end user;

/* add_to_list - add fcb to delete list */
       add_to_list: procedure;

       n = n + 1;
       if n > LIST_LNGTH then
          signal error(7);
       allocate del_fcb set(delp(n));
       delp(n)->del_fcb = dir_fcb;
       end add_to_list;


/* delete_list - delete fcbs in delete list */
       delete_list: procedure;

       put skip list('Deleting: ');
          do i = 1 to n;
          put list('.');
          call delete(delp(i));
          call abort_test;
          end;
       put skip list(n,'file(s) deleted');
       end delete_list;

/* query - query and delete if response is 'y'es */
       query: procedure returns(bit(1));
       declare
          c              char(1);

       put skip;
       if drive > 0 then
          put list(ascii(64+drive)||':');
       put list(fname||'.'||ftype,'?');
       c = rdcon();
       if c = EOF then do;
          call delete_list;
          call reboot();
          end;
       else if c = INTRRPT then
          call reboot();
       else if translate(c,'Y','y') = 'Y' then
          return(TRUE);
       else
          return(FALSE);
       end query;

/* abort_test - abort if console character */
       abort_test: procedure;
       dcl c char(1);

               if break() then do;
                  c = rdcon();
                  put skip list('Abort (Y/N)? ');
                  c = rdcon();
                  if c = 'Y' | c ='y' then do;
                      put skip list('Aborted');
                      call reboot();
                      end;
                  end;
       end abort_test;

       end eraq;