1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32 contents:
33 proc options(variable);
34
35 dcl PROC char(8) init("contents");
36
37 dcl ignoreCode fixed bin(35);
38
39
40 dcl expand_pathname_$component entry (char(*), char(*), char(*), char(*), fixed bin(35));
41 dcl initiate_file_$component entry (char(*), char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35));
42 dcl ioa_ entry() options(variable);
43 dcl iox_$put_chars entry (ptr, ptr, fixed bin(21), fixed bin(35));
44 dcl pathname_$component entry (char(*), char(*), char(*)) returns(char(194));
45 dcl requote_string_ entry (char(*)) returns(char(*));
46 dcl search_file_$silent entry (ptr, fixed bin(21), fixed bin(21), ptr, fixed bin(21), fixed bin(21), fixed bin(21),
47 fixed bin(21), fixed bin(35));
48 dcl terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35));
49
50
51 dcl NL char(1) int static options(constant) init("
52 ");
53 dcl SP char(1) int static options(constant) init(" ");
54 dcl SP_HT char(2) int static options(constant) init(" ");
55
56
57
58 dcl iox_$user_output ptr ext static;
59
60 dcl (error_table_$badopt,
61 error_table_$bigarg,
62 error_table_$inconsistent,
63 error_table_$noarg,
64 error_table_$too_many_args
65 ) fixed bin(35) ext static;
66
67 dcl (addr, binary, dimension, length, maxlength, null, rtrim, search, string, verify) builtin;
68 %page;
69
70
71
72 %include ssu_standalone_command_;
73 %page;
74
75
76
77
78 dcl 1 BOUND aligned,
79 2 type fixed bin(2),
80 2 lineN fixed bin(21),
81 2 strP ptr,
82 2 strL fixed bin(21);
83
84 dcl (BOUND_type_NUMBER_FOR init(-2),
85 BOUND_type_UNSET init(-1),
86 BOUND_type_NUMBER init( 0),
87 BOUND_type_SIGNED_NUMBER init( 1),
88 BOUND_type_STRING init( 2),
89 BOUND_type_REGEX init( 3)
90 ) fixed bin(2) int static options(constant);
91
92 dcl 1 FILTER aligned,
93 2 mode fixed bin(2),
94 2 type fixed bin(2),
95 2 strP ptr,
96 2 strL fixed bin(21);
97
98 dcl (FILTER_mode_UNSET init(0),
99 FILTER_mode_MATCH init(1),
100 FILTER_mode_EXCLUDE init(2),
101
102 FILTER_type_UNSET init(0),
103 FILTER_type_STRING init(1),
104 FILTER_type_REGEX init(2)
105 ) fixed bin(2) int static options(constant);
106 dcl MAX_FILTERS fixed bin init(30) int static options(constant);
107
108 dcl 1 SPEC aligned,
109 2 sciP ptr init( null() ),
110
111 2 entrypoint fixed bin(2),
112
113 2 file,
114 3 path char(194) unal,
115 3 P ptr,
116 3 L fixed bin(21),
117
118 2 S aligned,
119 3 (NL_to_SP,
120 NL_to_QUOTE,
121 errorsS
122
123
124 ) bit(1) unal,
125
126 2 db fixed bin, debug
127
128 2 range aligned,
129 3 (from, to) aligned like BOUND,
130
131 2 filters aligned,
132 3 fN fixed bin,
133 3 fI fixed bin,
134 3 f (MAX_FILTERS) aligned like FILTER;
135
136
137 dcl (EP_contains_cmd init(0),
138 EP_contains_req init(1),
139 EP_contents_cmd init(2),
140 EP_contents_req init(3)
141 ) fixed bin(2) int static options(constant);
142
143 dcl file_str char(SPEC.file.L) based(SPEC.file.P),
144
145 from_str char(SPEC.range.from.strL) based(SPEC.range.from.strP),
146
147 to_str char(SPEC.range.to.strL) based(SPEC.range.to.strP);
148
149
150 dcl filter_mode fixed bin (2) aligned based( addr(SPEC.filters.f(SPEC.filters.fI).mode) );
151
152 dcl filter_str char(SPEC.filters.f(SPEC.filters.fI).strL)
153 based( SPEC.filters.f(SPEC.filters.fI).strP);
154
155 dcl filter_type fixed bin (2) aligned based( addr(SPEC.filters.f(SPEC.filters.fI).type) );
156
157
158 %page;
159
160
161
162
163 SPEC.entrypoint = EP_contents_cmd;
164 goto INITIALIZE_SPEC;
165
166
167 contains:
168 entry() options(variable);
169
170 SPEC.entrypoint = EP_contains_cmd;
171 PROC = "contains";
172 goto INITIALIZE_SPEC;
173
174
175 ssu_contents_request:
176 entry (sci_ptr, data_ptr);
177
178 dcl (sci_ptr,
179 data_ptr
180 ) ptr;
181
182 SPEC.sciP = sci_ptr;
183 SPEC.entrypoint = EP_contents_req;
184
185 goto INITIALIZE_SPEC;
186
187
188 ssu_contains_request:
189 entry (sci_ptr, data_ptr);
190
191 SPEC.sciP = sci_ptr;
192 PROC = "contains";
193 SPEC.entrypoint = EP_contains_req;
194
195 goto INITIALIZE_SPEC;
196
197 %page;
198
199
200
201
202 INITIALIZE_SPEC:
203
204
205
206 SPEC.file.path = "";
207 SPEC.file.P = null();
208 SPEC.file.L = 0;
209
210 SPEC.db = 0; debug
211
212 SPEC.S = F;
213 SPEC.S.errorsS = T;
214 SPEC.S.NL_to_SP = (SPEC.entrypoint = EP_contents_cmd | SPEC.entrypoint = EP_contents_req);
215
216 SPEC.range.from.type = BOUND_type_UNSET;
217 SPEC.range.from.lineN = 0;
218 SPEC.range.from.strP = addr(SP);
219 SPEC.range.from.strL = 0;
220
221 SPEC.range.to.type = BOUND_type_UNSET;
222 SPEC.range.to.lineN = 0;
223 SPEC.range.to.strP = addr(SP);
224 SPEC.range.to.strL = 0;
225
226 SPEC.filters.fN = 0;
227 SPEC.filters.fI = 0;
228 SPEC.filters.f(*).mode = FILTER_mode_UNSET;
229 SPEC.filters.f(*).type = FILTER_type_UNSET;
230 SPEC.filters.f(*).strP = addr(SP);
231 SPEC.filters.f(*).strL = 0;
232 %page;
233
234
235
236
237
238 isStandalone = ( SPEC.sciP = null() );
239
240 on cleanup call CONTENTS_cleanup_handler (addr(SPEC), isStandalone, SPEC.sciP);
241
242 if isStandalone then do;
243
244 dcl CONTENTS_VERSION char(1) int static options(constant) init("2");
245
246 call ssu_$standalone_invocation (SPEC.sciP, PROC, CONTENTS_VERSION, cu_$arg_list_ptr(), abort_to_EXIT, code);
247
248 if code ^= 0 then goto EXIT;
249 end;
250
251 call arg_setup (SPEC.sciP);
252 if args_remain() then
253 call controlArgs ();
254
255 if SPEC.db >= 1 then do; debug
256
257 dcl field char(12) var;
258 call ioa_ ("
259 "^[contains ^[command^;active function^]^;contains ^[request^;active request^]" ||
260 "^;contents ^[command^;active function^]^;contents ^[request^;active request^]^]",
261 SPEC.entrypoint+1, ^isAF);
262 call ioa_ ("^-path:^- ^a", SPEC.file.path);
263 call ioa_ ("^-NL_to_SP:^- ^[T^;F^]^-.NL_to_QUOTE:^- ^[T^;F^]", SPEC.NL_to_SP, SPEC.NL_to_QUOTE);
264 call ioa_ ("^
265 call ioa_ ("^-db:^- ^d", SPEC.db);
266 if SPEC.from.type > BOUND_type_UNSET then do;
267 call ioa_ ("^-from:^- ^[^s^d^2s^;^[+^]^d^2s^;^2s^[""^a""^;^a^]^;^2s^[""/^a/""^;/^a/^]^]",
268 SPEC.range.from.type+1, SPEC.from.lineN>=0, SPEC.from.lineN, search(from_str, SP_HT)>0, from_str);
269 end;
270 if SPEC.to.type = BOUND_type_NUMBER_FOR then
271 call ioa_ ("^-for:^- ^d", SPEC.to.lineN);
272 else if SPEC.to.type > BOUND_type_UNSET then
273 call ioa_ ("^-to:^- ^[^s^d^2s^;^[+^]^d^2s^;^2s^[""^a""^;^a^]^;^2s^[""/^a/""^;/^a/^]^]",
274 SPEC.range.to.type+1, SPEC.to.lineN>=0, SPEC.to.lineN, search(to_str, SP_HT)>0, to_str);
275 field = "filter:";
276 do SPEC.filters.fI = 1 to SPEC.filters.fN;
277 if filter_mode = FILTER_mode_MATCH then
278 call ioa_ ("^-^a^- -match ^[UNSET^2s^;^[""^a""^;^a^]^;^[""/^a/""^;/^a/^]^]",
279 field, filter_type+1, search(filter_str, SP_HT)>0, filter_str);
280 field = "";
281 end;
282 do SPEC.filters.fI = 1 to SPEC.filters.fN;
283 if filter_mode = FILTER_mode_EXCLUDE then
284 call ioa_ ("^-^a^- -exclude ^[UNSET^2s^;^[""^a""^;^a^]^;^[""/^a/""^;/^a/^]^]",
285 field, filter_type+1, search(filter_str, SP_HT)>0, filter_str);
286 field = "";
287 end;
288 end;
289
290 if SPEC.file.path = "" then
291 NOTE
292 call ssu_$abort_line( SPEC.sciP, error_table_$noarg,
293 "^2/^[Syntax as ^[a command^;an active function^]^;Syntax^[^; as an active request^]^]: " ||
294 "^[[ ^]^a PATH ^[{^]-control_args^[}^]^[ ]^]",
295 isStandalone, ^isAF,
296 isAF, PROC, PROC = "contents", PROC = "contents", isAF);
297
298 if PROC = "contains" & SPEC.filters.fN = 0 then
299
300 call ssu_$abort_line( SPEC.sciP, error_table_$inconsistent,
301 "^/^-One or more -match and/or -exclude control arguments are required.");
302 %page;
303
304
305
306
307
308 dcl dir char(168) unal,
309 ent char(32) unal,
310 comp char(32) unal;
311
312 call expand_pathname_$component (SPEC.file.path, dir, ent, comp, code);
313 if code ^= 0 then do;
314 call ssu_$abort_line( SPEC.sciP, code, "^a", SPEC.file.path );
315 return;
316 end;
317
318
319 dcl bit_count fixed bin(24);
320
321 call initiate_file_$component (dir, ent, comp, R_ACCESS, SPEC.file.P, bit_count, code);
322 if SPEC.file.P = null() then
323 call ssu_$abort_line( SPEC.sciP, code, "^a", pathname_$component (dir, ent, comp) );
324
325 SPEC.file.L = divide( (bit_count + BITS_PER_CHAR - 1), BITS_PER_CHAR, 21, 0);
326
327 if SPEC.S.NL_to_SP then
328 SPEC.file.L = length( rtrim( file_str, NL) );
329 %page;
330
331
332
333
334
335
336
337
338 dcl data_selectedS bit(1) aligned init(F);
339 dcl do_output bit(1) aligned int static options(constant) init(T);
340
341
342 if PROC = "contains" then do;
343
344
345 call process_selection( ^do_output, data_selectedS );
346 if isAF then
347 if data_selectedS then
348 af_ret = "true";
349 else af_ret = "false";
350 else call ioa_("^[true^;false^]", data_selectedS);
351 end;
352
353 else do;
354 if SPEC.range.from.type ^= BOUND_type_UNSET |
355 SPEC.range.to.type ^= BOUND_type_UNSET |
356 SPEC.filters.fN > 0 then do;
357 call process_selection( do_output, data_selectedS );
358 end;
359 else call return_entire_segment( data_selectedS );
360 end;
361
362
363
364
365
366 EXIT:
367
368 call CONTENTS_cleanup_handler (addr(SPEC), isStandalone, SPEC.sciP);
369 return;
370
371
372
373
374
375
376
377
378
379 CONTENTS_cleanup_handler:
380 proc (AdataP, AisStandalone, AsciP);
381
382 dcl AdataP ptr,
383 1 d aligned like SPEC based (AdataP);
384 dcl AisStandalone bit(1) aligned;
385 dcl AsciP ptr;
386
387 if d.file.P ^= null() then
388 call terminate_file_ (d.file.P, 0, TERM_FILE_TERM, ignoreCode);
389 if AisStandalone then
390 call standalone_cleanup_handler (AisStandalone, AsciP);
391
392 end CONTENTS_cleanup_handler;
393 %page;
394
395
396
397
398
399
400 return_entire_segment:
401 proc( Adata_selectedS );
402
403 dcl Adata_selectedS bit(1) aligned;
404
405 dcl seg char(segL) based(segP),
406 segL fixed bin(21),
407 segP ptr;
408 dcl seg_arr (segL) char(1) based(segP);
409
410 dcl line char(lineL) based(segP),
411 lineL fixed bin(21);
412
413 if SPEC.S.NL_to_SP | SPEC.S.NL_to_QUOTE then do;
414
415
416
417 segP = addr(file_str);
418 segL = length(file_str);
419
420 do while (length(seg) > 0);
421 lineL = index(seg, NL);
422 if lineL > 0 then
423 lineL = lineL - length(NL);
424 else lineL = length(seg);
425
426 if SPEC.S.NL_to_QUOTE then
427 call output( requote_string_(line), do_output, Adata_selectedS );
428 else call output( line, do_output, Adata_selectedS );
429
430
431 if length(line) + length(NL) >= length(seg) then
432 segL = 0;
433 else do;
434 segP = addr( seg_arr( length(line)+length(NL)+1 ) );
435 segL = segL - ( length(line)+length(NL) );
436 end;
437 end;
438 end;
439 else call output( file_str, do_output, Adata_selectedS );
440
441
442 if ^isAF & do_output then
443
444 call iox_$put_chars (iox_$user_output, addr(NL), length(NL), ignoreCode);
445
446 end return_entire_segment;
447 %page;
448
449
450
451
452
453
454
455
456
457 output:
458 proc( data, actually_outputS, data_was_outputS );
459
460 dcl data char(*);
461
462
463 dcl actually_outputS bit(1) aligned;
464
465 dcl data_was_outputS bit(1) aligned;
466
467 data_was_outputS = T;
468 if ^actually_outputS then return;
469
470
471 dcl new_length fixed bin(21);
472
473 if isAF then do;
474 if length(af_ret) ^= 0 then do;
475 if SPEC.S.NL_to_SP | SPEC.S.NL_to_QUOTE then do;
476 new_length = length(af_ret) + length(SP) + length(data);
477 af_ret = af_ret || SP || data;
478 end;
479 else do;
480
481 new_length = length(af_ret) + length(data);
482 af_ret = af_ret || data;
483 end;
484 end;
485 else do;
486 new_length = length(data);
487 af_ret = data;
488 end;
489
490 if new_length > maxlength(af_ret) & SPEC.errorsS then
491 call ssu_$abort_line( SPEC.sciP, 0, "Return string (^d characters) is too long.", new_length);
492
493 end;
494
495 else do;
496 call iox_$put_chars (iox_$user_output, addr(data), length(data), ignoreCode);
497 if SPEC.S.NL_to_SP | SPEC.S.NL_to_QUOTE then
498 call iox_$put_chars (iox_$user_output, addr(SP), length(SP), ignoreCode);
499 end;
500
501 end output;
502 %page;
503
504
505
506
507
508
509
510
511
512
513 process_selection:
514 proc ( AoutputS, Adata_selectedS );
515
516 dcl AoutputS bit(1) aligned;
517 note
518 dcl Adata_selectedS bit(1) aligned;
519
520 dcl seg char(segL) based(segP),
521 segL fixed bin(21),
522 segP ptr;
523 dcl seg_arr (segL) char(1) based(segP);
524
525 dcl line char(lineL) based(segP),
526 line_with_NL char(lineL+1) based(segP),
527 lineL fixed bin(21);
528
529 dcl line_no fixed bin(21) init(0);
530 dcl line_beyond_end_of_file fixed bin(21);
531
532
533
534
535
536
537 if SPEC.range.from.lineN < 0 | SPEC.range.to.lineN < 0 then do;
538
539
540 segP = addr(file_str);
541 segL = length(file_str);
542
543 do while (length(seg) > 0);
544 lineL = index(seg, NL);
545 if lineL > 0 then
546 lineL = lineL - length(NL);
547 else lineL = length(seg);
548
549 line_no = line_no + 1;
550
551 if length(line) + length(NL) >= length(seg) then
552 segL = 0;
553 else do;
554 segP = addr(seg_arr( length(line)+length(NL)+1 ) );
555 segL = segL - ( length(line)+length(NL) );
556 end;
557 end;
558
559 line_beyond_end_of_file = line_no + 1;
560
561 if SPEC.db >= 2 then
562 call ioa_ ("
563 end;
564 %page;
565
566
567
568
569
570
571 if SPEC.range.from.type = BOUND_type_SIGNED_NUMBER &
572 SPEC.range.from.lineN < 0 then do;
573 SPEC.range.from.lineN = line_beyond_end_of_file + SPEC.range.from.lineN;
574 SPEC.range.from.lineN = max(1, SPEC.range.from.lineN);
575
576 SPEC.range.from.type = BOUND_type_NUMBER;
577
578 if SPEC.db >= 2 & SPEC.from.type > BOUND_type_UNSET then
579 call ioa_ ("
580 SPEC.range.from.type+1, SPEC.from.lineN>0, SPEC.from.lineN, from_str);
581 end;
582
583 if SPEC.range.to.type = BOUND_type_SIGNED_NUMBER &
584 SPEC.range.to.lineN < 0 then do;
585 SPEC.range.to.lineN = line_beyond_end_of_file + SPEC.range.to.lineN;
586 SPEC.range.to.lineN = max(1, SPEC.range.to.lineN);
587
588 SPEC.range.to.type = BOUND_type_NUMBER;
589
590 if SPEC.db >= 2 & SPEC.to.type > BOUND_type_UNSET then
591 call ioa_ ("
592 SPEC.range.to.type+1, SPEC.to.lineN>0, SPEC.to.lineN, to_str);
593 end;
594 %page;
595
596
597
598
599
600 line_no = 0;
601
602 segP = addr(file_str);
603 segL = length(file_str);
604
605 FIND_RANGE_START:
606 do while (length(seg) > 0);
607 lineL = index(seg, NL);
608 if lineL > 0 then
609 lineL = lineL - length(NL);
610 else lineL = length(seg);
611
612 line_no = line_no + 1;
613
614 goto FROM (SPEC.range.from.type);
615
616 FROM (BOUND_type_UNSET):
617 goto RANGE_started;
618
619 FROM (BOUND_type_NUMBER):
620 FROM (BOUND_type_SIGNED_NUMBER):
621 if line_no = SPEC.range.from.lineN then
622 goto RANGE_started;
623 goto FROM_next_line;
624
625 FROM (BOUND_type_STRING):
626 if index(line, from_str) > 0 then
627 goto RANGE_started;
628 goto FROM_next_line;
629
630 FROM (BOUND_type_REGEX):
631 if length(line) < length(seg) then do;
632 if regex_search( "-from", from_str, line_with_NL) then
633 goto RANGE_started;
634 end;
635 else if regex_search( "-from", from_str, line) then
636 goto RANGE_started;
637 goto FROM_next_line;
638
639 FROM_next_line:
640 if length(line) + length(NL) >= length(seg) then
641 segL = 0;
642 else do;
643 segP = addr(seg_arr( length(line)+length(NL)+1 ) );
644 segL = segL - ( length(line)+length(NL) );
645 end;
646 end FIND_RANGE_START;
647
648 if SPEC.errorsS then
649
650 call ssu_$abort_line (SPEC.sciP, 0, "Line not found: " ||
651 "-from ^[^s^d^2s^;^[+^]^d^2s^;^2s^[""^a""^;^a^]^;^2s^[""/^a/""^;/^a/^]^]",
652 SPEC.range.from.type+1, SPEC.from.lineN>=0, SPEC.from.lineN, search(from_str, SP_HT)>0, from_str);
653
654 %page;
655
656
657
658
659
660
661 RANGE_started:
662 if SPEC.range.to.type = BOUND_type_SIGNED_NUMBER &
663 SPEC.range.to.lineN >= 0 then do;
664 SPEC.range.to.lineN = line_no + SPEC.range.to.lineN;
665 SPEC.range.to.type = BOUND_type_NUMBER;
666 end;
667 else if SPEC.range.to.type = BOUND_type_NUMBER_FOR then do;
668
669 SPEC.range.to.lineN = line_no + SPEC.range.to.lineN - 1;
670 SPEC.range.to.type = BOUND_type_NUMBER;
671 end;
672
673
674
675
676
677
678 if SPEC.range.to.type = BOUND_type_NUMBER then
679 SPEC.range.to.lineN = max(line_no, SPEC.range.to.lineN);
680
681 %page;
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709 SCAN_RANGE:
710 do while (length(seg) > 0);
711 if length(line) < length(seg) then do;
712 if line_passes_filters( line_with_NL ) then
713 goto PASS;
714 end;
715 else if line_passes_filters( line ) then do;
716 PASS: if SPEC.S.NL_to_QUOTE then
717 call output( requote_string_(line), AoutputS, Adata_selectedS );
718 else if SPEC.S.NL_to_SP then
719 call output( line, AoutputS, Adata_selectedS );
720 else if length(line) < length(seg) then
721 call output( line_with_NL, AoutputS, Adata_selectedS );
722 else call output( line, AoutputS, Adata_selectedS );
723
724 end;
725
726 goto TO (SPEC.range.to.type);
727
728 TO (BOUND_type_UNSET):
729 goto SCAN_next_line;
730
731 TO (BOUND_type_NUMBER):
732 TO (BOUND_type_SIGNED_NUMBER):
733 TO (BOUND_type_NUMBER_FOR):
734 if line_no = SPEC.range.to.lineN then
735 goto SCAN_ends;
736 goto SCAN_next_line;
737
738 TO (BOUND_type_STRING):
739 if index(line, to_str) > 0 then
740 goto SCAN_ends;
741 goto SCAN_next_line;
742
743 TO (BOUND_type_REGEX):
744 if length(line) < length(seg) then do;
745 if regex_search( "-to", to_str, line_with_NL) then
746 goto SCAN_ends;
747 end;
748 else if regex_search( "-to", to_str, line) then
749 goto SCAN_ends;
750 goto SCAN_next_line;
751
752 SCAN_next_line:
753 if length(line) + length(NL) >= length(seg) then
754 segL = 0;
755 else do;
756 segP = addr( seg_arr( length(line)+length(NL)+1 ) );
757 segL = segL - ( length(line)+length(NL) );
758 end;
759
760 lineL = index(seg, NL);
761 if lineL > 0 then
762 lineL = lineL - length(NL);
763 else lineL = length(seg);
764
765 line_no = line_no + 1;
766
767 end SCAN_RANGE;
768
769 SCAN_ends:
770 if Adata_selectedS & AoutputS & ^isAF then
771
772 call iox_$put_chars (iox_$user_output, addr(NL), length(NL), ignoreCode);
773
774
775 return;
776
777 end process_selection;
778 %page;
779
780
781
782
783
784
785
786
787
788
789
790
791 line_passes_filters:
792 proc (Aline) returns (bit (1) aligned);
793
794 dcl Aline char(*);
795
796 dcl match_test_foundS bit(1) aligned init(F);
797
798 MATCH_TESTS:
799 do SPEC.filters.fI = 1 to SPEC.filters.fN;
800 if filter_mode = FILTER_mode_MATCH then do;
801 goto DO_M (filter_type);
802
803 DO_M (FILTER_type_STRING):
804 match_test_foundS = T;
805 if index(Aline, filter_str) > 0 then
806 goto MATCHED_line_APPLY_EXCLUDES;
807 goto MATCH_next_test;
808
809 DO_M (FILTER_type_REGEX):
810 match_test_foundS = T;
811 if regex_search ("-match", filter_str, Aline) then
812 goto MATCHED_line_APPLY_EXCLUDES;
813 goto MATCH_next_test;
814
815 end;
816
817 DO_M (FILTER_type_UNSET):
818 MATCH_next_test:
819 end MATCH_TESTS;
820
821 if match_test_foundS then
822 return (F);
823
824
825 MATCHED_line_APPLY_EXCLUDES:
826 do SPEC.filters.fI = 1 to SPEC.filters.fN;
827 if filter_mode = FILTER_mode_EXCLUDE then do;
828 goto DO_E (filter_type);
829
830 DO_E (FILTER_type_STRING):
831 if index(Aline, filter_str) > 0 then
832 return (F);
833 goto EXCLUDE_next_test;
834
835 DO_E (FILTER_type_REGEX):
836 if regex_search ("-match", filter_str, Aline) then
837 return (F);
838 goto EXCLUDE_next_test;
839
840 end;
841
842 DO_E (FILTER_type_UNSET):
843 EXCLUDE_next_test:
844 end MATCHED_line_APPLY_EXCLUDES;
845
846 return (T);
847
848 end line_passes_filters;
849 %page;
850
851
852
853
854 regex_search:
855 proc (Acontrol, Aregexp, Aline) returns (bit (1) aligned);
856
857 dcl Acontrol char(*) unal;
858 dcl Aregexp char (*) unal;
859 dcl Aline char(*) unal;
860 NOTE
861
862 dcl code fixed bin(35);
863 dcl error_table_$nomatch fixed bin (35) ext static;
864
865 call search_file_$silent (addr(Aregexp), 1, length(Aregexp), addr(Aline), 1, length(Aline), (0), (0), code);
866 if code = 0 then
867 return (T);
868 else if code = error_table_$nomatch then;
869 else if code ^= 0 then do;
870 if code = 2 then
871 call ssu_$abort_line( SPEC.sciP, 0, "Illegal regular expression: ^a /^a/", Acontrol, Aregexp);
872
873 else call ssu_$abort_line( SPEC.sciP, code, "Searching for: ^a /^a/", Acontrol, Aregexp);
874 end;
875 return (F);
876 end regex_search;
877 %page;
878
879
880
881
882 controlArgs:
883 proc ();
884
885 dcl DIGITS char(10) int static options(constant) init("0123456789");
886 dcl 1 OPERAND aligned,
887 2 (from, NOTE
888 to,
889 for,
890 match,
891 exclude,
892 debug
893 ) bit(1) unal;
894 string(OPERAND) = F;
895
896 ARGUMENT_LOOP:
897 do while (args_remain());
898 call ssu_$arg_ptr (SPEC.sciP, argI+1, argP, argL);
899
900 if OPERAND.from then call set_range_bound( OPERAND.from, "-from", arg, SPEC.from );
901 else if OPERAND.to then call set_range_bound( OPERAND.to, "-to", arg, SPEC.to );
902 else if OPERAND.for then call set_range_bound( OPERAND.for, "-for", arg, SPEC.to );
903 else if OPERAND.match then call set_filter ( OPERAND.match, FILTER_mode_MATCH, arg, SPEC.filters );
904 else if OPERAND.exclude then call set_filter ( OPERAND.exclude, FILTER_mode_EXCLUDE, arg, SPEC.filters );
905
906 else if OPERAND.debug then do;
907 OPERAND.debug = F;
908 if verify(arg, DIGITS) = 0 then
909 SPEC.db = binary(arg, 17, 0);
910 else call ssu_$print_message (SPEC.sciP, error_table_$badopt, "-debug ^a", arg);
911 end;
912
913 else if isControlArg(arg) & SPEC.entrypoint >= EP_contents_cmd then do;
914
915
916 if arg = "-nl" | arg = "-newline" then do; SPEC.S.NL_to_SP = F;
917 SPEC.S.NL_to_QUOTE = F; end;
918 else if arg = "-nnl" | arg = "-no_newline" then do; SPEC.S.NL_to_SP = T;
919 SPEC.S.NL_to_QUOTE = F; end;
920 else if arg = "-rql" | arg = "-requote_line" then do; SPEC.S.NL_to_SP = F;
921 SPEC.S.NL_to_QUOTE = T; end;
922
923 else if arg = "-fm" | arg = "-from" then OPERAND.from = T;
924 else if arg = "-to" then OPERAND.to = T;
925 else if arg = "-for" then OPERAND.for = T;
926
927 else if arg = "-match" then OPERAND.match = T;
928 else if arg = "-ex" | arg = "-exclude" then OPERAND.exclude = T;
929
930 else if arg = "-err" | arg = "-errors" then SPEC.errorsS = T;
931 else if arg = "-nerr" | arg = "-no_errors" then SPEC.errorsS = F;
932
933 else if arg = "-db" | arg = "-debug" then OPERAND.debug = T;
934
935 else call ssu_$print_message (SPEC.sciP, error_table_$badopt,
936 "Ignoring unsupported control arg: ^a", arg);
937 end;
938
939 else if isControlArg(arg) & SPEC.entrypoint <= EP_contains_req then do;
940
941
942 if arg = "-fm" | arg = "-from" then OPERAND.from = T;
943 else if arg = "-to" then OPERAND.to = T;
944 else if arg = "-for" then OPERAND.for = T;
945
946 else if arg = "-match" then OPERAND.match = T;
947 else if arg = "-ex" | arg = "-exclude" then OPERAND.exclude = T;
948
949 else if arg = "-err" | arg = "-errors" then SPEC.errorsS = T;
950 else if arg = "-nerr" | arg = "-no_errors" then SPEC.errorsS = F;
951
952 else if arg = "-db" | arg = "-debug" then OPERAND.debug = T;
953
954 else call ssu_$print_message (SPEC.sciP, error_table_$badopt,
955 "Ignoring unsupported control arg: ^a", arg);
956 end;
957
958 else if SPEC.file.path = "" then do;
959 if length(arg) > maxlength(SPEC.file.path) then
960 call ssu_$abort_line (SPEC.sciP, error_table_$bigarg,
961 "PATH argument is longer than ^d characters: ^a",
962 maxlength(SPEC.file.path), arg);
963 SPEC.file.path = arg;
964 end;
965
966 else do;
967 call ssu_$print_message (SPEC.sciP, error_table_$badopt,
968 "Ignoring unsupported operand: ^a", arg);
969 end;
970
971 argI = argI + 1;
972 end ARGUMENT_LOOP;
973 %page;
974 call check_missing_operand( OPERAND.from, "-from" );
975 call check_missing_operand( OPERAND.to, "-to" );
976 call check_missing_operand( OPERAND.for, "-for" );
977 call check_missing_operand( OPERAND.match, "-match" );
978 call check_missing_operand( OPERAND.exclude, "-exclude" );
979 call check_missing_operand( OPERAND.debug, "-debug" );
980
981 return;
982
983 check_missing_operand:
984 proc (OPERAND_flag, CONTROL_arg);
985
986 dcl OPERAND_flag bit(1) unal;
987 dcl CONTROL_arg char(*) unal;
988
989 if OPERAND_flag then
990 call ssu_$abort_line( SPEC.sciP, error_table_$noarg, "Operand of: ^a", CONTROL_arg);
991
992 end check_missing_operand;
993 %page;
994
995 set_range_bound:
996 proc (OPERAND_flag, CONTROL_arg, Aarg, Abound);
997
998 dcl OPERAND_flag bit(1) unal; xxx
999 dcl CONTROL_arg char(*) unal;
1000 dcl Aarg char(*) unal;
1001 dcl 1 Abound aligned like BOUND;
1002
1003 dcl 1 arg_struc unal based(addr(Aarg)),
1004 2 sign char(1),
1005 2 rest char(length(Aarg)-1);
1006 dcl arg_arr (length(Aarg)) char(1) unal based(addr(Aarg));
1007
1008 dcl bound_str char(Abound.strL) based(Abound.strP);
1009
1010 dcl ignore_regex_resultS bit(1) aligned;
1011
1012 dcl SIGNS char( 2) int static options(constant) init("+-");
1013 dcl SLASH char( 1) int static options(constant) init("/");
1014 dcl TEST_LINE char(19) int static options(constant) init("CONTENTS TEST LINE
1015 ");
1016
1017 if Abound.type ^= BOUND_type_UNSET then do;
1018 call ssu_$print_message( SPEC.sciP, error_table_$inconsistent,
1019 "Only one ^[^a^;^s-to or -for^] control_arg is allowed.", CONTROL_arg = "-from", CONTROL_arg);
1020 goto EXIT_bound;
1021 end;
1022
1023 if length(Aarg) > 0 then
1024 if verify(Aarg, DIGITS) = 0 then do;
1025 if CONTROL_arg = "-for" then
1026 Abound.type = BOUND_type_NUMBER_FOR;
1027 else Abound.type = BOUND_type_NUMBER;
1028 Abound.lineN = bin(Aarg, 21, 0);
1029 if Abound.lineN = 0 then goto BAD_bound;
1030 goto EXIT_bound;
1031 end;
1032
1033 if CONTROL_arg = "-for" then goto BAD_bound;
1034
1035
1036 if length(Aarg) > 1 then
1037 if verify(arg_struc.sign, SIGNS) = 0 then
1038 if verify(arg_struc.rest, DIGITS) = 0 then do;
1039 Abound.type = BOUND_type_SIGNED_NUMBER;
1040 Abound.lineN = bin(Aarg, 21, 0);
1041 if Abound.lineN = 0 then do;
1042 if CONTROL_arg = "-to" & arg_struc.sign = "+" then;
1043
1044
1045
1046 else goto BAD_bound;
1047 end;
1048 goto EXIT_bound;
1049 end;
1050
1051 if length(Aarg) > 2 then
1052 if arg_arr(1) = SLASH then
1053 if arg_arr(length(Aarg)) = SLASH then do;
1054 Abound.type = BOUND_type_REGEX;
1055 Abound.strP = addr(arg_arr(2));
1056 Abound.strL = dimension(arg_arr,1) - 2;
1057 if Abound.strL = 0 then
1058 goto BAD_bound;
1059 ignore_regex_resultS = regex_search( CONTROL_arg, bound_str, TEST_LINE );
1060
1061
1062 goto EXIT_bound;
1063 end;
1064
1065 if length(Aarg) > 0 then do;
1066 Abound.type = BOUND_type_STRING;
1067 Abound.strP = addr(Aarg);
1068 Abound.strL = length(Aarg);
1069 goto EXIT_bound;
1070 end;
1071
1072 BAD_bound:
1073 call ssu_$abort_line( SPEC.sciP, error_table_$badopt, "^a ^[^a^;""^a""^]", CONTROL_arg,
1074 search(Aarg, SP_HT)=0, Aarg );
1075
1076 EXIT_bound:
1077 OPERAND_flag = F;
1078 return;
1079 %page;
1080
1081 set_filter:
1082 entry (OPERAND_flag, FILTER_mode, Aarg, Afilters);
1083
1084 dcl FILTER_mode fixed bin(2);
1085 dcl 1 Afilters aligned,
1086 2 fN fixed bin,
1087 2 fI fixed bin,
1088 2 f (*) aligned like FILTER;
1089
1090 dcl fI fixed bin;
1091
1092 dcl FILTER_arg char(8);
1093
1094 if Afilters.fN >= dimension(Afilters.f,1) then
1095 call ssu_$abort_line( SPEC.sciP, error_table_$too_many_args,
1096 "Up to ^d -match and/or -exclude control arguments may be used.", dimension(Afilters.f,1) );
1097
1098
1099 if FILTER_mode = FILTER_mode_EXCLUDE then
1100 FILTER_arg = "-exclude";
1101 else FILTER_arg = "-match";
1102
1103 Afilters.fN, Afilters.fI, fI = Afilters.fN + 1;
1104 Afilters.f(fI).mode = FILTER_mode;
1105
1106 if length(Aarg) > 2 then
1107 if arg_arr(1) = SLASH then
1108 if arg_arr(length(Aarg)) = SLASH then do;
1109 Afilters.f(fI).type = FILTER_type_REGEX;
1110 Afilters.f(fI).strP = addr(arg_arr(2));
1111 Afilters.f(fI).strL = dimension(arg_arr,1) - 2;
1112 if Afilters.f(fI).strL = 0 then
1113 goto BAD_filter;
1114 ignore_regex_resultS = regex_search( FILTER_arg, filter_str, TEST_LINE );
1115
1116
1117 goto EXIT_filter;
1118 end;
1119
1120 Afilters.f(fI).type = FILTER_type_STRING;
1121 Afilters.f(fI).strP = addr(Aarg);
1122 Afilters.f(fI).strL = length(Aarg);
1123 if Afilters.f(fI).strL = 0 then
1124 goto BAD_filter;
1125 goto EXIT_filter;
1126
1127 BAD_filter:
1128 call ssu_$abort_line( SPEC.sciP, error_table_$badopt, "^a ""^a"" ", CONTROL_arg, Aarg);
1129
1130 EXIT_filter:
1131 OPERAND_flag = F;
1132 return;
1133
1134 end set_range_bound;
1135
1136 end controlArgs;
1137 %page;
1138 %include system_constants;
1139 %page;
1140 %include terminate_file;
1141 %include access_mode_values;
1142
1143 end contents;