1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 disklow: proc;
 12 
 13 /* This program prints out a listing of projects
 14    whose disk usage is near their limits,
 15    from the disk usage figures in "projfile"
 16    which were placed there by "charge_disk".
 17 
 18    It is based on the program print_disk, and it
 19    prints the same information, but only for projects
 20    selected by the arguments (or the defaults).
 21 
 22    The arguments are number_left and percent_full.
 23    The defaults are 20 pages and 90%, respectively.
 24 
 25    THVV 4/70
 26    Modified June 1979 by C. Hornig to make it legal PL/1.
 27    Modified Feb 1980 by M. B. Armstrong to implement multiple rate structures.
 28    */
 29 
 30 dcl (hp, pp) ptr,                                           /* pointer to input */
 31      dummy (0: 7) float bin,
 32      dummy1 float bin,
 33      disk_price (0:9) float bin,
 34      ap pointer,                                            /* argument pointer */
 35      al fixed bin,                                          /* argument length */
 36      bchr char (al) based (ap) unal,
 37      cs char (16) aligned,
 38      tid char (9) aligned,
 39      PERCENT_FULL float bin init (0.90e0),
 40      NUMBER_LEFT fixed bin init (20),
 41      nlow fixed bin init (0),
 42      rs_number fixed bin,
 43      rs_name char (32),
 44      rs_count fixed bin,
 45      temp fixed bin (71),                                   /* temp for disk use */
 46      dols float bin,                                        /* dollar charge */
 47      tdols float bin init (0.0e0),                          /* total charge */
 48      tqta fixed bin (35) init (0),                          /* total quota */
 49      tuse fixed bin (35) init (0),                          /* total use */
 50      qta fixed bin (35),                                    /* project quota */
 51      use fixed bin (35),                                    /* project use */
 52     (i, np) fixed bin;                                      /* misc */
 53 dcl  ec fixed bin (35);
 54 
 55 dcl  system_info_$rs_name entry (fixed bin, char (*), fixed bin (35)),
 56      system_info_$prices_rs entry (fixed bin,
 57     (0: 7) float bin, (0: 7) float bin, (0: 7) float bin, (0: 7) float bin, float bin, float bin),
 58      system_info_$max_rs_number entry (fixed bin),
 59      search_sat_$rs_number entry (char (*), fixed bin, fixed bin (35)),
 60      search_sat_$clean_up entry,
 61      get_wdir_ entry () returns (char (168)),
 62      cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)),
 63      cv_dec_check_ ext entry (char (*), fixed bin (35)) returns (fixed bin (35)),
 64      ioa_ ext entry options (variable),                     /* output printing procedure */
 65      hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin, ptr, fixed bin (35)),
 66      hcs_$terminate_noname entry (ptr, fixed bin (35)),     /* file system */
 67      com_err_ ext entry options (variable);                 /* error reporter */
 68 dcl  error_table_$noentry external fixed bin (35);
 69 
 70 dcl (addr, hbound, null) builtin;
 71 
 72 dcl  format char (24) int static aligned options (constant) init /* output formats */
 73     ("^9a^4x^6d^4x^6d^4x^15.2f");
 74 
 75 %include projfile;
 76 
 77 /* - - - - */
 78 
 79           call system_info_$max_rs_number (rs_count);       /* see if site has multiple rate structures */
 80           ap = addr (ap);                                   /* initialize ap to dummy address */
 81 
 82           call cu_$arg_ptr (1, ap, al, ec);                 /* get arg 1 */
 83           if ec = 0 then do;
 84                i = cv_dec_check_ (bchr, ec);                /* number? */
 85                if ec ^= 0 then do;
 86 dec_err:            call com_err_ (0, "disklow", "^a is non-numeric.", bchr);
 87                     return;
 88                end;
 89                NUMBER_LEFT = i;
 90                call cu_$arg_ptr (2, ap, al, ec);            /* get arg 2 */
 91                if ec = 0 then do;
 92                     i = cv_dec_check_ (bchr, ec);
 93                     if ec ^= 0 then go to dec_err;
 94                     PERCENT_FULL = i/100.0e0;
 95                end;
 96           end;
 97 
 98           cs = "projfile";
 99           call hcs_$initiate ((get_wdir_ ()), cs, "", 0, 1, pp, ec);
100           if pp = null then do;
101 err:           call com_err_ (ec, "disklow", cs);           /* complain */
102                return;
103           end;
104 
105           do rs_number = 0 to hbound (disk_price, 1);       /* get all the prices */
106                call system_info_$rs_name (rs_number, rs_name, ec); /* this is just used to find if the rs exists */
107                if ec ^= 0 then disk_price (rs_number) = disk_price (0); /* assumes default will be defined aok */
108                else call system_info_$prices_rs (rs_number, dummy, dummy, dummy, dummy, disk_price (rs_number), dummy1);
109           end;
110 
111           np = projfile.nproj;                              /* get number of projects */
112 
113           call ioa_ ("Project       quota      used      dollar charge");
114           do i = 1 to np;                                   /* loop on all projects */
115                if id (i) = "" then go to skip;
116                if off (i) ^= 0 then if disk_psec (i) = 0 then go to skip;
117                     else tid = "*" || id (i);
118                else tid = id (i);
119                qta = disk_quota (i);                        /* extract project quota */
120                use = disk_use (i);                          /* use */
121                temp = disk_psec (i);                        /* page-seconds */
122                if rs_count > 0 then do;                     /* only if site has multiple rate structures */
123                     call search_sat_$rs_number ((id (i)), rs_number, ec); /* get rate index */
124                     if ec ^= 0 then
125                          if ec = error_table_$noentry then
126                               call com_err_ (ec, "disklow",
127                               "Trying to locate project ""^a"".  Default rates will be used.",
128                               id (i));
129                          else call com_err_ (ec, "disklow", "Accessing the sat.  Default rates will be used");
130                end;
131                else rs_number = 0;
132                dols = temp * disk_price (rs_number);        /* compute charge */
133                tdols = tdols + dols;                        /* accumulate totals */
134                tqta = tqta + qta;
135                tuse = tuse + use;
136                if use = 0 then go to skip;                  /* should we print record */
137                if qta - use < NUMBER_LEFT then go to p1;
138                if (1.0e0 * use) / qta > PERCENT_FULL then go to p1;
139                go to skip;
140 p1:            call ioa_ (format, tid, qta, use, dols);
141                nlow = nlow + 1;
142 skip:     end;
143           if nlow = 0 then call ioa_ ("All projects OK.");
144           call ioa_ ("");
145           call ioa_ (format, "TOTAL", tqta, tuse, tdols);
146           call hcs_$terminate_noname (pp, ec);              /* terminate input */
147           if rs_count > 0 then call search_sat_$clean_up;   /* tidy up */
148 
149      end disklow;