home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol079 / eraq.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  4.2 KB  |  174 lines
  1. /* eraq - conditional file erase program (with query)
  2.     The default fcb (from the command line) is used to search for
  3.     matching files and each match is printed on the console for 
  4.     delete confirmation.  A table is built of files to be deleted
  5.     so as to not lose the search position in the directory.
  6.     The maximum number of fcbs in the table is given by LIST_LNGTH
  7.     below, if this number is exceeded or free space exhausted the
  8.     table entries are deleted and the search restarted. */
  9.  
  10.     eraq: procedure options(main);
  11.     %replace
  12.        TRUE           by '1'b,
  13.        FALSE          by '0'b,
  14.        VERSION        by 'ERAQ 1.0',
  15.        VERDATE        by '02/05/81',
  16.        HELP_CMD       by 'HELP    ',
  17.        EOF            by '^Z',
  18.        INTRRPT        by '^C',
  19.        LIST_LNGTH     by 512;
  20.  
  21.     %include 'diomod.dcl';
  22.  
  23.     declare
  24.        version_date   char(8) external static init(VERDATE);
  25.     
  26.  
  27.     declare
  28.        1 default1      based(dfcb0()),
  29.          3 space       fixed(7),
  30.          3 command     char(8);
  31.  
  32.     declare
  33.        fcbp            pointer,
  34.        1 dir_fcb       based(fcbp),
  35.          3 drive       fixed(7),
  36.          3 fname       char(8),
  37.          3 ftype       char(3),
  38.          3 fext        fixed(7);
  39.  
  40.     declare
  41.        1 del_fcb       based,
  42.          3 dr          fixed(7),
  43.          3 fn          char(8),
  44.          3 ft          char(3),
  45.          3 fe          fixed(7);
  46.  
  47.     declare
  48.        1 default_fcb   based(dfcb0()),
  49.          3 spacer      bit(8),
  50.          3 name        char(11);
  51.  
  52.     declare
  53.        delp(LIST_LNGTH) pointer,
  54.        drv              bin fixed(7) based(dfcb0()),
  55.        dir_mask(0:127)  bit(8) based(dbuff()),
  56.        (i,n)            bin fixed static init(0);
  57.  
  58.     on error(7) begin;
  59.        n = n - 1;
  60.        put skip list('List space exhausted');
  61.        call delete_list;
  62.           do i = 1 to n;
  63.           free delp(i)->del_fcb;
  64.           end;
  65.        n = 0;
  66.        go to redo;
  67.        end;
  68.  
  69.     put list(VERSION);
  70.     if command = HELP_CMD then do;
  71.         put skip list('ERAQ - Erase with Query');
  72.         put skip(2) list('Command line:');
  73.         put list('        ERAQ <ambiguous filename>');
  74.         put skip(2);
  75.         call reboot();
  76.         end;
  77.  
  78. redo:
  79.     PUT SKIP;
  80.     if index(default_fcb.name,'?') = 0 then do;
  81.        call delete(dfcb0());
  82.        end;
  83.     else do;
  84.        call setdma(dbuff());
  85.        i = sear(dfcb0());
  86.        if i > -1 then do;
  87.              do while(i > -1);
  88.              unspec(i) = unspec(i) & '00000011'b;  /* for CP/M 1.4 */
  89.              fcbp = addr(dir_mask(i * 32));
  90.              if drive = user() then do;
  91.                 drive = drv;
  92.                 if query() then
  93.                    call add_to_list;
  94.                 i = searn();
  95.                 end;
  96.              end;
  97.           call delete_list;
  98.           end;
  99.        else
  100.           put skip list('File not found');
  101.        end;
  102.     call reboot();
  103.  
  104. /* user - procedure to get user number if version > = cp/m 2.0 */
  105.     user: procedure returns(fixed(7));
  106.  
  107.     if vers() = '0000'b4 then
  108.        return(0);
  109.     else
  110.        return(getusr());
  111.     end user;
  112.  
  113. /* add_to_list - add fcb to delete list */
  114.     add_to_list: procedure;
  115.  
  116.     n = n + 1;
  117.     if n > LIST_LNGTH then
  118.        signal error(7);
  119.     allocate del_fcb set(delp(n));
  120.     delp(n)->del_fcb = dir_fcb;
  121.     end add_to_list;
  122.  
  123.  
  124. /* delete_list - delete fcbs in delete list */
  125.     delete_list: procedure;
  126.  
  127.     put skip list('Deleting: ');
  128.        do i = 1 to n;
  129.        put list('.');
  130.        call delete(delp(i));
  131.        call abort_test;
  132.        end;
  133.     put skip list(n,'file(s) deleted');
  134.     end delete_list;
  135.  
  136. /* query - query and delete if response is 'y'es */
  137.     query: procedure returns(bit(1));
  138.     declare
  139.        c              char(1);
  140.  
  141.     put skip;
  142.     if drive > 0 then
  143.        put list(ascii(64+drive)||':');
  144.     put list(fname||'.'||ftype,'?');
  145.     c = rdcon();
  146.     if c = EOF then do;
  147.        call delete_list;
  148.        call reboot();
  149.        end;
  150.     else if c = INTRRPT then
  151.        call reboot();
  152.     else if translate(c,'Y','y') = 'Y' then
  153.        return(TRUE);
  154.     else
  155.        return(FALSE);
  156.     end query;
  157.  
  158. /* abort_test - abort if console character */
  159.     abort_test: procedure;
  160.     dcl c char(1);
  161.  
  162.                 if break() then do;
  163.            c = rdcon();
  164.            put skip list('Abort (Y/N)? ');
  165.            c = rdcon();
  166.            if c = 'Y' | c ='y' then do;
  167.                        put skip list('Aborted');
  168.                        call reboot();
  169.                end;    
  170.                    end;
  171.     end abort_test;
  172.         
  173.     end eraq;
  174.