1 
  2 /****^  HISTORY COMMENTS:
  3   1) change(2021-02-23,GDixon), approve(2021-02-23,MCR10089),
  4      audit(2021-03-31,Swenson), install(2021-03-31,MR12.6g-0053):
  5      Initial version of verify_info command.
  6                                                    END HISTORY COMMENTS */
  7 
  8 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
  9           /*                                                                                                */
 10           /* Name:  verify_info, vi                                                                         */
 11           /*                                                                                                */
 12           /* Function:  verify info segment format.                                                         */
 13           /*                                                                                                */
 14           /* Note:  This program replaces the earlier validate_info_seg (vis) program.                      */
 15           /*                                                                                                */
 16           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 17 
 18 verify_info:
 19 vi:  proc options(variable);
 20 
 21 display_usage:                                              /* Display usage for command.                             */
 22           proc();
 23 
 24           call ssu_$abort_subsystem (C.sciP, 0, "^(^a^)", "
 25 Syntax as a command:  vi INFO_SEGS {-control_args}
 26 
 27 Syntax as an active function:  [vi INFO_SEGS]
 28 ");
 29           end display_usage;
 30 
 31 
 32 
 33   dcl  com_err_ entry() options(variable);
 34   dcl  ioa_ entry() options(variable);
 35 
 36   dcl  info_seg_$append_iFiles entry (ptr, char(*));
 37   dcl  info_seg_$initialize entry (ptr, char(*), char(*), ptr, entry, fixed bin(35));
 38   dcl  info_seg_$terminate entry (ptr);
 39   dcl  info_seg_verify_$display_specifications entry (ptr);
 40   dcl  info_seg_verify_$iFiles entry (ptr);
 41 
 42   dcl  suppress_warning entry variable init(standalone_cleanup_handler);
 43                                                             /* Suppress compiler warning about procedure in           */
 44                                                             /*  ssu_standalone_commmand_.incl.pl1 that is unreferenced*/
 45 
 46   dcl (error_table_$bad_arg,
 47        error_table_$bad_conversion,
 48        error_table_$badopt
 49        ) fixed bin(35) ext static;
 50 
 51   dcl (addr, char, ltrim, null, size, translate, verify) builtin;
 52 %page;
 53 %include verify_info_data;
 54 %page;
 55           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 56           /*                                                                                                */
 57           /* COMMAND:  verify_info, vi                                                                      */
 58           /*                                                                                                */
 59           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 60 
 61 /* ------------------------------------------------------------
 62     Initialize data structure used by verify_info_seg_ routine.
 63    ------------------------------------------------------------ */
 64 
 65   dcl 1 C aligned like verify_info_data;                    /* Data for the info_seg_verify_ subroutine.              */
 66 
 67      C.vid_version = verify_info_data_version_01;           /*  - Use version_01 in verify_info_data_.incl.pl1        */
 68      C.inputs.rules_area = VI_RULE_unset;                   /*  - Setup storage for control arguments.                */
 69 
 70      C.inputs.switches = F;                                 /*  - Control arg switches off by default.                */
 71      C.inputs.naming = VI_NAMING_off;                       /*  - Changing names is off by default.                   */
 72      C.inputs.lines = 0;                                    /*  - info seg line display disabled, by default.         */
 73      C.results = 0;                                         /*  - No files verified as command gets invoked.          */
 74 
 75      C.isd.version = info_seg_data_version_01;              /*  - Initialize substructure used by info_seg_           */
 76      C.isd.standalone_invocationS = F;                      /*  - Initialize data switches.                           */
 77      C.isd.ptrs = null();                                   /*  - Initialize pointers tested by cleanup handler.      */
 78      C.isd.relatives = null();
 79 
 80 /* ------------------------------------------------------------
 81     1) Establish cleanup handler for info_seg_ data.
 82     2) Call info_seg_ to setup its ssu_ standalone invocation
 83        (used throughout verify_info, info_seg_, and info_seg_verify_
 84         to report errors on behalf of the calling command, etc).
 85    ------------------------------------------------------------ */
 86 
 87   dcl  PROC    char(11) internal static options(constant) init("verify_info");
 88   dcl  VERSION char(16) internal static options(constant) init("verify_info__1.0");
 89 
 90                                                             /* Setup cleanup on-unit for:                             */
 91      on cleanup call vi_cleanup_handler( addr(C.isd) );     /*  - the info_seg_ data.  info_seg_$terminate cleans up  */
 92                                                             /*    this struct, and all files initiated via info_seg_. */
 93                                                             /*  - the ssu_ standalone invocation setup by info_seg_   */
 94 
 95      call info_seg_$initialize (addr(C.isd), PROC, VERSION, cu_$arg_list_ptr(), abort_to_EXIT, code);
 96      if  code ^= 0  then do;
 97           call com_err_ (code, PROC, "FATAL ERROR from info_seg_$initialize");
 98           return;
 99           end;
100 
101 /* ------------------------------------------------------------
102     Get our command arguments.
103      - Any file names are stored in an iFile structure chained
104        off the C.files list.
105    ------------------------------------------------------------ */
106 
107      call arg_setup (C.sciP);                               /* Prepare to process arguments.                          */
108 
109      if ^args_remain() then                                 /* If no args given...                                    */
110           call display_usage();                             /*  - command/AF displays usage                           */
111 
112      call controlArgs(C);                                   /* Get arguments.                                         */
113 
114      if  isAF  then do;                                     /* If called as an active function, only return           */
115           C.totalsS = T;                                    /*   highest_severity error number encountered.           */
116           if  C.fileS  |  C.blockS  |  C.sectionS  |
117               C.listS  |  C.briefS  |  C.rules_area ^= VI_RULE_unset  then do;
118                call display_usage();
119                goto EXIT;
120                end;
121           end;
122 
123      if  C.totalsS  &  C.naming > VI_NAMING_off  then       /* -totals inconsistent with renaming operations.         */
124           C.naming = VI_NAMING_off;
125 
126      if  C.totalsS  &  C.briefS  then                       /* -totals inconsistent with -brief display.              */
127           C.briefS = F;
128 
129 /* ------------------------------------------------------------
130     Process incoming command arguments.
131      - Any file names are stored in the C.files sub-structure.
132    ------------------------------------------------------------ */
133 
134      if  C.rules_area ^= VI_RULE_unset  then do;            /* User asked to see guidelines and rules used by vi?     */
135           call info_seg_verify_$display_specifications (addr(C));
136           if  C.files.firstP = null()  then                 /*  - If no files given, just exit after spec display.    */
137                goto EXIT;
138           end;
139 
140 
141      if  C.files.firstP = null()  then                      /* User gave no input file names?  Complain via usage msg */
142           call display_usage();
143 
144      call info_seg_verify_$iFiles (addr(C));                /* info_seg_verify_$iFiles checks format of all input     */
145                                                             /* files.                                                 */
146                                                             /*  - If -totals given, it returns only an error_count    */
147                                                             /*    and highest_severity, instead of printing more      */
148                                                             /*    verbose stuff.  vi command displays those values.   */
149      if  isAF  then do;
150           af_ret = ltrim(char(C.highest_severity));
151           end;
152      else if  C.totalsS  then do;
153           if  C.error_count > 0  then
154                call ioa_("^d error^[s^] found in ^d file^[s^];  highest severity was ^d",
155                     C.error_count, C.error_count ^= 1,
156                     C.segs_processed, C.segs_processed ^= 1,
157                     C.highest_severity);
158           end;
159      else call ioa_("");                                    /* Separate verbose command output from ready line.       */
160 
161 /* ------------------------------------------------------------
162     Exit with cleanup of the info_seg_ data structures.
163      - The abort_to_EXIT subroutine (in ssu_standalone_commmand.incl.pl1)
164        also transfers to this EXIT label to perform an abort
165        of the entire command when needed.
166    ------------------------------------------------------------ */
167 
168 EXIT:                                                       /* Exit command/request with appropriate cleanup          */
169      call vi_cleanup_handler( addr(C.isd) );
170      return;
171 
172 
173 
174 vi_cleanup_handler:                                         /* Cleanup on-unit for vi command, and its supporting     */
175      proc (isdP);                                           /*  info_seg_ data structures and ssu_ invocation.        */
176 
177   dcl  isdP ptr;
178 
179      call info_seg_$terminate (isdP);                       /* Ask info_seg_ to terminate files, cleanup ssu_, etc.   */
180 
181      end vi_cleanup_handler;
182 %page;
183 /* ------------------------------------------------------------
184     Capture INFO_SEG paths, and get -control_arg arguments.
185    ------------------------------------------------------------ */
186 
187 controlArgs:
188      proc (c);
189 
190   dcl 1 c aligned like verify_info_data;                    /*  control arg specification data                   (in) */
191 
192   dcl  DIGITS char(10) int static options(constant) init("0123456789");
193   dcl 1 optS,
194       2 (debug,
195          rules
196          ) bit(1) aligned;
197   dcl  lineRangeP ptr;
198 
199      optS = F;
200      lineRangeP = null();
201 
202 SCAN_ARGS:
203      do while (args_remain());
204           call ssu_$arg_ptr (c.sciP, argI+1, argP, argL);   /* Conditionally read next arg to command/af/request      */
205 
206           if  optS.debug  then do;
207                call get_debug();
208                optS.debug = F;
209                end;
210 
211           else if  lineRangeP ^= null()  then do;
212                call get_line_range( lineRangeP, arg );
213                lineRangeP = null();
214                end;
215 
216           else if  optS.rules  then do;
217                call get_rule_type();
218                optS.rules = F;
219                end;
220 
221           else if isControlArg(arg) then do;
222 
223                if       arg = "-nm"     | arg = "-names"        then c.naming = VI_NAMING_query;
224                else if  arg = "-nnm"    | arg = "-no_names"     then c.naming = VI_NAMING_off;
225                else if  arg = "-fnm"    | arg = "-force_names"  then c.naming = VI_NAMING_force;
226 
227                else if  arg = "-tt"     | arg = "-totals"       then c.totalsS = T;
228 
229                else if  arg = "-lg"     | arg = "-long"         then c.briefS = F;
230                else if  arg = "-bf"     | arg = "-brief"        then c.briefS = T;
231 
232                else if                    arg = "-rules"        then optS.rules = T;
233 
234                else if  arg = "-ln"     | arg = "-lines"        then lineRangeP = addr(c.lines.file);
235                else if  arg = "-bk"     | arg = "-block"        then lineRangeP = addr(c.lines.blok);
236 
237                else if  arg = "-db"     | arg = "-debug"        then optS.debug = T;
238 
239                else call ssu_$print_message (c.sciP, error_table_$badopt,
240                     "Ignoring unsupported control arg: ^a", arg);
241                end;
242 
243           else call info_seg_$append_iFiles (addr(c.isd), arg);
244                                                             /* All non-control arguments are pathnames.               */
245                                                             /*   info_seg_ does all the work on our behalf.           */
246 
247           argI = argI + 1;                                  /* Record that we processed the arg just examined above.  */
248           end SCAN_ARGS;
249 
250      if  lineRangeP ^= null()  then                         /* Handle -lines or -block or -rules  as final argument.  */
251           call get_line_range( lineRangeP, "");
252      if  optS.rules  then
253           c.rules_area = VI_RULE_all_areas;
254 
255      return;
256 %page;
257 
258 get_debug:
259      proc();
260 
261   dcl (i, j) fixed bin;
262 
263      do i = lbound(VI_DEBUG_OPERAND,1) to hbound(VI_DEBUG_OPERAND,1);
264           do j = lbound(VI_DEBUG_OPERAND,2) to hbound(VI_DEBUG_OPERAND,2);
265                if  arg = VI_DEBUG_OPERAND(i,j)  then
266                     goto SET_DB(i);
267                end;
268           end;
269      call ssu_$print_message( c.sciP, error_table_$bad_arg, "-debug ^a", arg);
270      return;
271 
272 SET_DB(VI_DEBUG_file):
273      c.fileS = T;
274      return;
275 
276 SET_DB(VI_DEBUG_block):
277      c.blockS = T;
278      return;
279 
280 SET_DB(VI_DEBUG_section):
281      c.sectionS = T;
282      return;
283 
284 SET_DB(VI_DEBUG_list):
285      c.listS = T;
286      return;
287 
288      end get_debug;
289 
290 /* -----------------------------------------------------------------
291    INTERNAL PROCEDURE:  get_line_range
292 
293    FUNCTION:  Parse operand of -lines or -block into a line range:
294                - count of lines, and
295                - starting line number (optional)
296 
297    Format of a line range:
298      -lines,
299      -lines COUNT,
300      -lines START:{COUNT}
301        displays lines of the info segment.  The optional START line number
302        and COUNT of lines refer to lines within the entire info segment.
303 
304        If START is not given, it defaults to: 1
305 
306        If START is a negative integer, it refers to a line number
307        counting back from the end of the segment: -lines -3: displays the
308        final 3 lines of the segment.
309 
310        If COUNT is not given, it defaults to: 9999
311    ----------------------------------------------------------------- */
312 
313 get_line_range:
314      proc ( AlineRangeP, Aarg );
315 
316   dcl  AlineRangeP ptr;                                     /* Pointer to either c.lines.file or c.lines.blok         */
317   dcl  Aarg char(*);                                        /* Incoming argument (operand of -lines or -block)        */
318                                                             /*  containing the line_range specification.              */
319 
320   dcl  spec char(length(Aarg)) var init(Aarg);              /* Copy arg into varying string to simplify manipulation  */
321 
322   dcl 1 lineRange aligned like verify_info_data.lines.file based( AlineRangeP );
323 
324   dcl  count char(20) var;                                  /* Strings to hold components of line range.              */
325   dcl  start char(8) var;
326 
327   dcl  DIGITS char(10) int static options(constant) init("0123456789");
328   dcl  SIGNED_DIGITS char(12) int static options(constant) init("+-0123456789");
329 
330           count = "9999";
331           start = "1";
332 
333           spec = ltrim(rtrim(spec));
334           if  spec = ""  then
335                goto ASSIGN_RANGE;
336           if  index(spec, COLON) > 1  then do;
337                start = rtrim(before(spec, COLON));
338                count = ltrim( after(spec, COLON));
339                if  count = ""  then
340                     count = "9999";
341                end;
342           else if  index(spec, COLON) = 1  then
343                count = ltrim( after(spec, COLON));
344           else count = spec;
345 
346           if  length(start) = 1  then                       /* Make sure start is at least 2 digits in length.        */
347                start = "0" || start;
348                                                             /*  - start must be an optionally-signed integer string   */
349           if  verify(substr(start,1,1), SIGNED_DIGITS) = 0   &
350               verify(substr(start,2), DIGITS) = 0            &
351               verify(count, DIGITS) = 0  then do;           /*  - count must be an unsigned integer string.           */
352 ASSIGN_RANGE:  lineRange.start = binary(start,17,0);
353                lineRange.count = binary(count,17,0);
354                end;
355           else call ssu_$print_message (c.sciP, error_table_$bad_arg, "^[-lines^;-block^] ^a",
356                lineRangeP = addr(c.lines.file), arg);
357 
358           end get_line_range;
359 
360 
361 get_rule_type:
362      proc();
363 
364   dcl (i, j, k) fixed bin;
365 
366           do i = lbound(VI_RULES_AREA,1) to hbound(VI_RULES_AREA,1);
367                do j = lbound(VI_RULES_AREA,2) to hbound(VI_RULES_AREA,2);
368                     if  VI_RULES_AREA(i,1) = "all_kinds"  then
369                          k = i;                             /* Gather demarcation element for possible error message. */
370                     if  arg = VI_RULES_AREA(i,j)  then do;
371                          c.rules_area = i;
372                          return;
373                          end;
374                     end;
375                end;
376           call ssu_$abort_line( c.sciP, error_table_$bad_arg, "-rules ^a" ||
377                "^/Argument may be:"  ||
378                "^/   ^v(^a, ^a    ^)" ||
379                "^/or a block kind:"  ||
380              "^(^/   ^2(^a, ^a^2-^)^)",
381                arg, k-1, VI_RULES_AREA(*,*) );
382           return;
383 
384           end get_rule_type;
385 
386      end controlArgs;
387 %page;
388 %include ssu_standalone_command_;
389 %page;
390 %include info_seg_dcls_;
391 
392      end verify_info;