File : g-awk.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T . A W K --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2000-2014, AdaCore --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Exceptions;
33 with Ada.Text_IO;
34 with Ada.Strings.Unbounded;
35 with Ada.Strings.Fixed;
36 with Ada.Strings.Maps;
37 with Ada.Unchecked_Deallocation;
38
39 with GNAT.Directory_Operations;
40 with GNAT.Dynamic_Tables;
41 with GNAT.OS_Lib;
42
43 package body GNAT.AWK is
44
45 use Ada;
46 use Ada.Strings.Unbounded;
47
48 -----------------------
49 -- Local subprograms --
50 -----------------------
51
52 -- The following two subprograms provide a functional interface to the
53 -- two special session variables, that are manipulated explicitly by
54 -- Finalize, but must be declared after Finalize to prevent static
55 -- elaboration warnings.
56
57 function Get_Def return Session_Data_Access;
58 procedure Set_Cur;
59
60 ----------------
61 -- Split mode --
62 ----------------
63
64 package Split is
65
66 type Mode is abstract tagged null record;
67 -- This is the main type which is declared abstract. This type must be
68 -- derived for each split style.
69
70 type Mode_Access is access Mode'Class;
71
72 procedure Current_Line (S : Mode; Session : Session_Type)
73 is abstract;
74 -- Split current line of Session using split mode S
75
76 ------------------------
77 -- Split on separator --
78 ------------------------
79
80 type Separator (Size : Positive) is new Mode with record
81 Separators : String (1 .. Size);
82 end record;
83
84 procedure Current_Line
85 (S : Separator;
86 Session : Session_Type);
87
88 ---------------------
89 -- Split on column --
90 ---------------------
91
92 type Column (Size : Positive) is new Mode with record
93 Columns : Widths_Set (1 .. Size);
94 end record;
95
96 procedure Current_Line (S : Column; Session : Session_Type);
97
98 end Split;
99
100 procedure Free is new Unchecked_Deallocation
101 (Split.Mode'Class, Split.Mode_Access);
102
103 ----------------
104 -- File_Table --
105 ----------------
106
107 type AWK_File is access String;
108
109 package File_Table is
110 new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
111 -- List of file names associated with a Session
112
113 procedure Free is new Unchecked_Deallocation (String, AWK_File);
114
115 -----------------
116 -- Field_Table --
117 -----------------
118
119 type Field_Slice is record
120 First : Positive;
121 Last : Natural;
122 end record;
123 -- This is a field slice (First .. Last) in session's current line
124
125 package Field_Table is
126 new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
127 -- List of fields for the current line
128
129 --------------
130 -- Patterns --
131 --------------
132
133 -- Define all patterns style: exact string, regular expression, boolean
134 -- function.
135
136 package Patterns is
137
138 type Pattern is abstract tagged null record;
139 -- This is the main type which is declared abstract. This type must be
140 -- derived for each patterns style.
141
142 type Pattern_Access is access Pattern'Class;
143
144 function Match
145 (P : Pattern;
146 Session : Session_Type) return Boolean
147 is abstract;
148 -- Returns True if P match for the current session and False otherwise
149
150 procedure Release (P : in out Pattern);
151 -- Release memory used by the pattern structure
152
153 --------------------------
154 -- Exact string pattern --
155 --------------------------
156
157 type String_Pattern is new Pattern with record
158 Str : Unbounded_String;
159 Rank : Count;
160 end record;
161
162 function Match
163 (P : String_Pattern;
164 Session : Session_Type) return Boolean;
165
166 --------------------------------
167 -- Regular expression pattern --
168 --------------------------------
169
170 type Pattern_Matcher_Access is access Regpat.Pattern_Matcher;
171
172 type Regexp_Pattern is new Pattern with record
173 Regx : Pattern_Matcher_Access;
174 Rank : Count;
175 end record;
176
177 function Match
178 (P : Regexp_Pattern;
179 Session : Session_Type) return Boolean;
180
181 procedure Release (P : in out Regexp_Pattern);
182
183 ------------------------------
184 -- Boolean function pattern --
185 ------------------------------
186
187 type Callback_Pattern is new Pattern with record
188 Pattern : Pattern_Callback;
189 end record;
190
191 function Match
192 (P : Callback_Pattern;
193 Session : Session_Type) return Boolean;
194
195 end Patterns;
196
197 procedure Free is new Unchecked_Deallocation
198 (Patterns.Pattern'Class, Patterns.Pattern_Access);
199
200 -------------
201 -- Actions --
202 -------------
203
204 -- Define all action style : simple call, call with matches
205
206 package Actions is
207
208 type Action is abstract tagged null record;
209 -- This is the main type which is declared abstract. This type must be
210 -- derived for each action style.
211
212 type Action_Access is access Action'Class;
213
214 procedure Call
215 (A : Action;
216 Session : Session_Type) is abstract;
217 -- Call action A as required
218
219 -------------------
220 -- Simple action --
221 -------------------
222
223 type Simple_Action is new Action with record
224 Proc : Action_Callback;
225 end record;
226
227 procedure Call
228 (A : Simple_Action;
229 Session : Session_Type);
230
231 -------------------------
232 -- Action with matches --
233 -------------------------
234
235 type Match_Action is new Action with record
236 Proc : Match_Action_Callback;
237 end record;
238
239 procedure Call
240 (A : Match_Action;
241 Session : Session_Type);
242
243 end Actions;
244
245 procedure Free is new Unchecked_Deallocation
246 (Actions.Action'Class, Actions.Action_Access);
247
248 --------------------------
249 -- Pattern/Action table --
250 --------------------------
251
252 type Pattern_Action is record
253 Pattern : Patterns.Pattern_Access; -- If Pattern is True
254 Action : Actions.Action_Access; -- Action will be called
255 end record;
256
257 package Pattern_Action_Table is
258 new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50);
259
260 ------------------
261 -- Session Data --
262 ------------------
263
264 type Session_Data is record
265 Current_File : Text_IO.File_Type;
266 Current_Line : Unbounded_String;
267 Separators : Split.Mode_Access;
268 Files : File_Table.Instance;
269 File_Index : Natural := 0;
270 Fields : Field_Table.Instance;
271 Filters : Pattern_Action_Table.Instance;
272 NR : Natural := 0;
273 FNR : Natural := 0;
274 Matches : Regpat.Match_Array (0 .. 100);
275 -- Latest matches for the regexp pattern
276 end record;
277
278 procedure Free is
279 new Unchecked_Deallocation (Session_Data, Session_Data_Access);
280
281 --------------
282 -- Finalize --
283 --------------
284
285 procedure Finalize (Session : in out Session_Type) is
286 begin
287 -- We release the session data only if it is not the default session
288
289 if Session.Data /= Get_Def then
290 -- Release separators
291
292 Free (Session.Data.Separators);
293
294 Free (Session.Data);
295
296 -- Since we have closed the current session, set it to point now to
297 -- the default session.
298
299 Set_Cur;
300 end if;
301 end Finalize;
302
303 ----------------
304 -- Initialize --
305 ----------------
306
307 procedure Initialize (Session : in out Session_Type) is
308 begin
309 Session.Data := new Session_Data;
310
311 -- Initialize separators
312
313 Session.Data.Separators :=
314 new Split.Separator'(Default_Separators'Length, Default_Separators);
315
316 -- Initialize all tables
317
318 File_Table.Init (Session.Data.Files);
319 Field_Table.Init (Session.Data.Fields);
320 Pattern_Action_Table.Init (Session.Data.Filters);
321 end Initialize;
322
323 -----------------------
324 -- Session Variables --
325 -----------------------
326
327 Def_Session : Session_Type;
328 Cur_Session : Session_Type;
329
330 ----------------------
331 -- Private Services --
332 ----------------------
333
334 function Always_True return Boolean;
335 -- A function that always returns True
336
337 function Apply_Filters
338 (Session : Session_Type) return Boolean;
339 -- Apply any filters for which the Pattern is True for Session. It returns
340 -- True if a least one filters has been applied (i.e. associated action
341 -- callback has been called).
342
343 procedure Open_Next_File
344 (Session : Session_Type);
345 pragma Inline (Open_Next_File);
346 -- Open next file for Session closing current file if needed. It raises
347 -- End_Error if there is no more file in the table.
348
349 procedure Raise_With_Info
350 (E : Exceptions.Exception_Id;
351 Message : String;
352 Session : Session_Type);
353 pragma No_Return (Raise_With_Info);
354 -- Raises exception E with the message prepended with the current line
355 -- number and the filename if possible.
356
357 procedure Read_Line (Session : Session_Type);
358 -- Read a line for the Session and set Current_Line
359
360 procedure Split_Line (Session : Session_Type);
361 -- Split session's Current_Line according to the session separators and
362 -- set the Fields table. This procedure can be called at any time.
363
364 ----------------------
365 -- Private Packages --
366 ----------------------
367
368 -------------
369 -- Actions --
370 -------------
371
372 package body Actions is
373
374 ----------
375 -- Call --
376 ----------
377
378 procedure Call
379 (A : Simple_Action;
380 Session : Session_Type)
381 is
382 pragma Unreferenced (Session);
383 begin
384 A.Proc.all;
385 end Call;
386
387 ----------
388 -- Call --
389 ----------
390
391 procedure Call
392 (A : Match_Action;
393 Session : Session_Type)
394 is
395 begin
396 A.Proc (Session.Data.Matches);
397 end Call;
398
399 end Actions;
400
401 --------------
402 -- Patterns --
403 --------------
404
405 package body Patterns is
406
407 -----------
408 -- Match --
409 -----------
410
411 function Match
412 (P : String_Pattern;
413 Session : Session_Type) return Boolean
414 is
415 begin
416 return P.Str = Field (P.Rank, Session);
417 end Match;
418
419 -----------
420 -- Match --
421 -----------
422
423 function Match
424 (P : Regexp_Pattern;
425 Session : Session_Type) return Boolean
426 is
427 use type Regpat.Match_Location;
428 begin
429 Regpat.Match
430 (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
431 return Session.Data.Matches (0) /= Regpat.No_Match;
432 end Match;
433
434 -----------
435 -- Match --
436 -----------
437
438 function Match
439 (P : Callback_Pattern;
440 Session : Session_Type) return Boolean
441 is
442 pragma Unreferenced (Session);
443 begin
444 return P.Pattern.all;
445 end Match;
446
447 -------------
448 -- Release --
449 -------------
450
451 procedure Release (P : in out Pattern) is
452 pragma Unreferenced (P);
453 begin
454 null;
455 end Release;
456
457 -------------
458 -- Release --
459 -------------
460
461 procedure Release (P : in out Regexp_Pattern) is
462 procedure Free is new Unchecked_Deallocation
463 (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
464 begin
465 Free (P.Regx);
466 end Release;
467
468 end Patterns;
469
470 -----------
471 -- Split --
472 -----------
473
474 package body Split is
475
476 use Ada.Strings;
477
478 ------------------
479 -- Current_Line --
480 ------------------
481
482 procedure Current_Line (S : Separator; Session : Session_Type) is
483 Line : constant String := To_String (Session.Data.Current_Line);
484 Fields : Field_Table.Instance renames Session.Data.Fields;
485 Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators);
486
487 Start : Natural;
488 Stop : Natural;
489
490 begin
491 -- First field start here
492
493 Start := Line'First;
494
495 -- Record the first field start position which is the first character
496 -- in the line.
497
498 Field_Table.Increment_Last (Fields);
499 Fields.Table (Field_Table.Last (Fields)).First := Start;
500
501 loop
502 -- Look for next separator
503
504 Stop := Fixed.Index
505 (Source => Line (Start .. Line'Last),
506 Set => Seps);
507
508 exit when Stop = 0;
509
510 Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
511
512 -- If separators are set to the default (space and tab) we skip
513 -- all spaces and tabs following current field.
514
515 if S.Separators = Default_Separators then
516 Start := Fixed.Index
517 (Line (Stop + 1 .. Line'Last),
518 Maps.To_Set (Default_Separators),
519 Outside,
520 Strings.Forward);
521
522 if Start = 0 then
523 Start := Stop + 1;
524 end if;
525
526 else
527 Start := Stop + 1;
528 end if;
529
530 -- Record in the field table the start of this new field
531
532 Field_Table.Increment_Last (Fields);
533 Fields.Table (Field_Table.Last (Fields)).First := Start;
534
535 end loop;
536
537 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
538 end Current_Line;
539
540 ------------------
541 -- Current_Line --
542 ------------------
543
544 procedure Current_Line (S : Column; Session : Session_Type) is
545 Line : constant String := To_String (Session.Data.Current_Line);
546 Fields : Field_Table.Instance renames Session.Data.Fields;
547 Start : Positive := Line'First;
548
549 begin
550 -- Record the first field start position which is the first character
551 -- in the line.
552
553 for C in 1 .. S.Columns'Length loop
554
555 Field_Table.Increment_Last (Fields);
556
557 Fields.Table (Field_Table.Last (Fields)).First := Start;
558
559 Start := Start + S.Columns (C);
560
561 Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
562
563 end loop;
564
565 -- If there is some remaining character on the line, add them in a
566 -- new field.
567
568 if Start - 1 < Line'Length then
569
570 Field_Table.Increment_Last (Fields);
571
572 Fields.Table (Field_Table.Last (Fields)).First := Start;
573
574 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
575 end if;
576 end Current_Line;
577
578 end Split;
579
580 --------------
581 -- Add_File --
582 --------------
583
584 procedure Add_File
585 (Filename : String;
586 Session : Session_Type)
587 is
588 Files : File_Table.Instance renames Session.Data.Files;
589
590 begin
591 if OS_Lib.Is_Regular_File (Filename) then
592 File_Table.Increment_Last (Files);
593 Files.Table (File_Table.Last (Files)) := new String'(Filename);
594 else
595 Raise_With_Info
596 (File_Error'Identity,
597 "File " & Filename & " not found.",
598 Session);
599 end if;
600 end Add_File;
601
602 procedure Add_File
603 (Filename : String)
604 is
605
606 begin
607 Add_File (Filename, Cur_Session);
608 end Add_File;
609
610 ---------------
611 -- Add_Files --
612 ---------------
613
614 procedure Add_Files
615 (Directory : String;
616 Filenames : String;
617 Number_Of_Files_Added : out Natural;
618 Session : Session_Type)
619 is
620 use Directory_Operations;
621
622 Dir : Dir_Type;
623 Filename : String (1 .. 200);
624 Last : Natural;
625
626 begin
627 Number_Of_Files_Added := 0;
628
629 Open (Dir, Directory);
630
631 loop
632 Read (Dir, Filename, Last);
633 exit when Last = 0;
634
635 Add_File (Filename (1 .. Last), Session);
636 Number_Of_Files_Added := Number_Of_Files_Added + 1;
637 end loop;
638
639 Close (Dir);
640
641 exception
642 when others =>
643 Raise_With_Info
644 (File_Error'Identity,
645 "Error scanning directory " & Directory
646 & " for files " & Filenames & '.',
647 Session);
648 end Add_Files;
649
650 procedure Add_Files
651 (Directory : String;
652 Filenames : String;
653 Number_Of_Files_Added : out Natural)
654 is
655
656 begin
657 Add_Files (Directory, Filenames, Number_Of_Files_Added, Cur_Session);
658 end Add_Files;
659
660 -----------------
661 -- Always_True --
662 -----------------
663
664 function Always_True return Boolean is
665 begin
666 return True;
667 end Always_True;
668
669 -------------------
670 -- Apply_Filters --
671 -------------------
672
673 function Apply_Filters
674 (Session : Session_Type) return Boolean
675 is
676 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
677 Results : Boolean := False;
678
679 begin
680 -- Iterate through the filters table, if pattern match call action
681
682 for F in 1 .. Pattern_Action_Table.Last (Filters) loop
683 if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
684 Results := True;
685 Actions.Call (Filters.Table (F).Action.all, Session);
686 end if;
687 end loop;
688
689 return Results;
690 end Apply_Filters;
691
692 -----------
693 -- Close --
694 -----------
695
696 procedure Close (Session : Session_Type) is
697 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
698 Files : File_Table.Instance renames Session.Data.Files;
699
700 begin
701 -- Close current file if needed
702
703 if Text_IO.Is_Open (Session.Data.Current_File) then
704 Text_IO.Close (Session.Data.Current_File);
705 end if;
706
707 -- Release Filters table
708
709 for F in 1 .. Pattern_Action_Table.Last (Filters) loop
710 Patterns.Release (Filters.Table (F).Pattern.all);
711 Free (Filters.Table (F).Pattern);
712 Free (Filters.Table (F).Action);
713 end loop;
714
715 for F in 1 .. File_Table.Last (Files) loop
716 Free (Files.Table (F));
717 end loop;
718
719 File_Table.Set_Last (Session.Data.Files, 0);
720 Field_Table.Set_Last (Session.Data.Fields, 0);
721 Pattern_Action_Table.Set_Last (Session.Data.Filters, 0);
722
723 Session.Data.NR := 0;
724 Session.Data.FNR := 0;
725 Session.Data.File_Index := 0;
726 Session.Data.Current_Line := Null_Unbounded_String;
727 end Close;
728
729 ---------------------
730 -- Current_Session --
731 ---------------------
732
733 function Current_Session return not null access Session_Type is
734 begin
735 return Cur_Session.Self;
736 end Current_Session;
737
738 ---------------------
739 -- Default_Session --
740 ---------------------
741
742 function Default_Session return not null access Session_Type is
743 begin
744 return Def_Session.Self;
745 end Default_Session;
746
747 --------------------
748 -- Discrete_Field --
749 --------------------
750
751 function Discrete_Field
752 (Rank : Count;
753 Session : Session_Type) return Discrete
754 is
755 begin
756 return Discrete'Value (Field (Rank, Session));
757 end Discrete_Field;
758
759 function Discrete_Field_Current_Session
760 (Rank : Count) return Discrete is
761 function Do_It is new Discrete_Field (Discrete);
762 begin
763 return Do_It (Rank, Cur_Session);
764 end Discrete_Field_Current_Session;
765
766 -----------------
767 -- End_Of_Data --
768 -----------------
769
770 function End_Of_Data
771 (Session : Session_Type) return Boolean
772 is
773 begin
774 return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
775 and then End_Of_File (Session);
776 end End_Of_Data;
777
778 function End_Of_Data
779 return Boolean
780 is
781 begin
782 return End_Of_Data (Cur_Session);
783 end End_Of_Data;
784
785 -----------------
786 -- End_Of_File --
787 -----------------
788
789 function End_Of_File
790 (Session : Session_Type) return Boolean
791 is
792 begin
793 return Text_IO.End_Of_File (Session.Data.Current_File);
794 end End_Of_File;
795
796 function End_Of_File
797 return Boolean
798 is
799 begin
800 return End_Of_File (Cur_Session);
801 end End_Of_File;
802
803 -----------
804 -- Field --
805 -----------
806
807 function Field
808 (Rank : Count;
809 Session : Session_Type) return String
810 is
811 Fields : Field_Table.Instance renames Session.Data.Fields;
812
813 begin
814 if Rank > Number_Of_Fields (Session) then
815 Raise_With_Info
816 (Field_Error'Identity,
817 "Field number" & Count'Image (Rank) & " does not exist.",
818 Session);
819
820 elsif Rank = 0 then
821
822 -- Returns the whole line, this is what $0 does under Session_Type
823
824 return To_String (Session.Data.Current_Line);
825
826 else
827 return Slice (Session.Data.Current_Line,
828 Fields.Table (Positive (Rank)).First,
829 Fields.Table (Positive (Rank)).Last);
830 end if;
831 end Field;
832
833 function Field
834 (Rank : Count) return String
835 is
836 begin
837 return Field (Rank, Cur_Session);
838 end Field;
839
840 function Field
841 (Rank : Count;
842 Session : Session_Type) return Integer
843 is
844 begin
845 return Integer'Value (Field (Rank, Session));
846
847 exception
848 when Constraint_Error =>
849 Raise_With_Info
850 (Field_Error'Identity,
851 "Field number" & Count'Image (Rank)
852 & " cannot be converted to an integer.",
853 Session);
854 end Field;
855
856 function Field
857 (Rank : Count) return Integer
858 is
859 begin
860 return Field (Rank, Cur_Session);
861 end Field;
862
863 function Field
864 (Rank : Count;
865 Session : Session_Type) return Float
866 is
867 begin
868 return Float'Value (Field (Rank, Session));
869
870 exception
871 when Constraint_Error =>
872 Raise_With_Info
873 (Field_Error'Identity,
874 "Field number" & Count'Image (Rank)
875 & " cannot be converted to a float.",
876 Session);
877 end Field;
878
879 function Field
880 (Rank : Count) return Float
881 is
882 begin
883 return Field (Rank, Cur_Session);
884 end Field;
885
886 ----------
887 -- File --
888 ----------
889
890 function File
891 (Session : Session_Type) return String
892 is
893 Files : File_Table.Instance renames Session.Data.Files;
894
895 begin
896 if Session.Data.File_Index = 0 then
897 return "??";
898 else
899 return Files.Table (Session.Data.File_Index).all;
900 end if;
901 end File;
902
903 function File
904 return String
905 is
906 begin
907 return File (Cur_Session);
908 end File;
909
910 --------------------
911 -- For_Every_Line --
912 --------------------
913
914 procedure For_Every_Line
915 (Separators : String := Use_Current;
916 Filename : String := Use_Current;
917 Callbacks : Callback_Mode := None;
918 Session : Session_Type)
919 is
920 Quit : Boolean;
921
922 begin
923 Open (Separators, Filename, Session);
924
925 while not End_Of_Data (Session) loop
926 Read_Line (Session);
927 Split_Line (Session);
928
929 if Callbacks in Only .. Pass_Through then
930 declare
931 Discard : Boolean;
932 begin
933 Discard := Apply_Filters (Session);
934 end;
935 end if;
936
937 if Callbacks /= Only then
938 Quit := False;
939 Action (Quit);
940 exit when Quit;
941 end if;
942 end loop;
943
944 Close (Session);
945 end For_Every_Line;
946
947 procedure For_Every_Line_Current_Session
948 (Separators : String := Use_Current;
949 Filename : String := Use_Current;
950 Callbacks : Callback_Mode := None)
951 is
952 procedure Do_It is new For_Every_Line (Action);
953 begin
954 Do_It (Separators, Filename, Callbacks, Cur_Session);
955 end For_Every_Line_Current_Session;
956
957 --------------
958 -- Get_Line --
959 --------------
960
961 procedure Get_Line
962 (Callbacks : Callback_Mode := None;
963 Session : Session_Type)
964 is
965 Filter_Active : Boolean;
966
967 begin
968 if not Text_IO.Is_Open (Session.Data.Current_File) then
969 raise File_Error;
970 end if;
971
972 loop
973 Read_Line (Session);
974 Split_Line (Session);
975
976 case Callbacks is
977
978 when None =>
979 exit;
980
981 when Only =>
982 Filter_Active := Apply_Filters (Session);
983 exit when not Filter_Active;
984
985 when Pass_Through =>
986 Filter_Active := Apply_Filters (Session);
987 exit;
988
989 end case;
990 end loop;
991 end Get_Line;
992
993 procedure Get_Line
994 (Callbacks : Callback_Mode := None)
995 is
996 begin
997 Get_Line (Callbacks, Cur_Session);
998 end Get_Line;
999
1000 ----------------------
1001 -- Number_Of_Fields --
1002 ----------------------
1003
1004 function Number_Of_Fields
1005 (Session : Session_Type) return Count
1006 is
1007 begin
1008 return Count (Field_Table.Last (Session.Data.Fields));
1009 end Number_Of_Fields;
1010
1011 function Number_Of_Fields
1012 return Count
1013 is
1014 begin
1015 return Number_Of_Fields (Cur_Session);
1016 end Number_Of_Fields;
1017
1018 --------------------------
1019 -- Number_Of_File_Lines --
1020 --------------------------
1021
1022 function Number_Of_File_Lines
1023 (Session : Session_Type) return Count
1024 is
1025 begin
1026 return Count (Session.Data.FNR);
1027 end Number_Of_File_Lines;
1028
1029 function Number_Of_File_Lines
1030 return Count
1031 is
1032 begin
1033 return Number_Of_File_Lines (Cur_Session);
1034 end Number_Of_File_Lines;
1035
1036 ---------------------
1037 -- Number_Of_Files --
1038 ---------------------
1039
1040 function Number_Of_Files
1041 (Session : Session_Type) return Natural
1042 is
1043 Files : File_Table.Instance renames Session.Data.Files;
1044 begin
1045 return File_Table.Last (Files);
1046 end Number_Of_Files;
1047
1048 function Number_Of_Files
1049 return Natural
1050 is
1051 begin
1052 return Number_Of_Files (Cur_Session);
1053 end Number_Of_Files;
1054
1055 ---------------------
1056 -- Number_Of_Lines --
1057 ---------------------
1058
1059 function Number_Of_Lines
1060 (Session : Session_Type) return Count
1061 is
1062 begin
1063 return Count (Session.Data.NR);
1064 end Number_Of_Lines;
1065
1066 function Number_Of_Lines
1067 return Count
1068 is
1069 begin
1070 return Number_Of_Lines (Cur_Session);
1071 end Number_Of_Lines;
1072
1073 ----------
1074 -- Open --
1075 ----------
1076
1077 procedure Open
1078 (Separators : String := Use_Current;
1079 Filename : String := Use_Current;
1080 Session : Session_Type)
1081 is
1082 begin
1083 if Text_IO.Is_Open (Session.Data.Current_File) then
1084 raise Session_Error;
1085 end if;
1086
1087 if Filename /= Use_Current then
1088 File_Table.Init (Session.Data.Files);
1089 Add_File (Filename, Session);
1090 end if;
1091
1092 if Separators /= Use_Current then
1093 Set_Field_Separators (Separators, Session);
1094 end if;
1095
1096 Open_Next_File (Session);
1097
1098 exception
1099 when End_Error =>
1100 raise File_Error;
1101 end Open;
1102
1103 procedure Open
1104 (Separators : String := Use_Current;
1105 Filename : String := Use_Current)
1106 is
1107 begin
1108 Open (Separators, Filename, Cur_Session);
1109 end Open;
1110
1111 --------------------
1112 -- Open_Next_File --
1113 --------------------
1114
1115 procedure Open_Next_File
1116 (Session : Session_Type)
1117 is
1118 Files : File_Table.Instance renames Session.Data.Files;
1119
1120 begin
1121 if Text_IO.Is_Open (Session.Data.Current_File) then
1122 Text_IO.Close (Session.Data.Current_File);
1123 end if;
1124
1125 Session.Data.File_Index := Session.Data.File_Index + 1;
1126
1127 -- If there are no mores file in the table, raise End_Error
1128
1129 if Session.Data.File_Index > File_Table.Last (Files) then
1130 raise End_Error;
1131 end if;
1132
1133 Text_IO.Open
1134 (File => Session.Data.Current_File,
1135 Name => Files.Table (Session.Data.File_Index).all,
1136 Mode => Text_IO.In_File);
1137 end Open_Next_File;
1138
1139 -----------
1140 -- Parse --
1141 -----------
1142
1143 procedure Parse
1144 (Separators : String := Use_Current;
1145 Filename : String := Use_Current;
1146 Session : Session_Type)
1147 is
1148 Filter_Active : Boolean;
1149 pragma Unreferenced (Filter_Active);
1150
1151 begin
1152 Open (Separators, Filename, Session);
1153
1154 while not End_Of_Data (Session) loop
1155 Get_Line (None, Session);
1156 Filter_Active := Apply_Filters (Session);
1157 end loop;
1158
1159 Close (Session);
1160 end Parse;
1161
1162 procedure Parse
1163 (Separators : String := Use_Current;
1164 Filename : String := Use_Current)
1165 is
1166 begin
1167 Parse (Separators, Filename, Cur_Session);
1168 end Parse;
1169
1170 ---------------------
1171 -- Raise_With_Info --
1172 ---------------------
1173
1174 procedure Raise_With_Info
1175 (E : Exceptions.Exception_Id;
1176 Message : String;
1177 Session : Session_Type)
1178 is
1179 function Filename return String;
1180 -- Returns current filename and "??" if this information is not
1181 -- available.
1182
1183 function Line return String;
1184 -- Returns current line number without the leading space
1185
1186 --------------
1187 -- Filename --
1188 --------------
1189
1190 function Filename return String is
1191 File : constant String := AWK.File (Session);
1192 begin
1193 if File = "" then
1194 return "??";
1195 else
1196 return File;
1197 end if;
1198 end Filename;
1199
1200 ----------
1201 -- Line --
1202 ----------
1203
1204 function Line return String is
1205 L : constant String := Natural'Image (Session.Data.FNR);
1206 begin
1207 return L (2 .. L'Last);
1208 end Line;
1209
1210 -- Start of processing for Raise_With_Info
1211
1212 begin
1213 Exceptions.Raise_Exception
1214 (E,
1215 '[' & Filename & ':' & Line & "] " & Message);
1216 raise Constraint_Error; -- to please GNAT as this is a No_Return proc
1217 end Raise_With_Info;
1218
1219 ---------------
1220 -- Read_Line --
1221 ---------------
1222
1223 procedure Read_Line (Session : Session_Type) is
1224
1225 function Read_Line return String;
1226 -- Read a line in the current file. This implementation is recursive
1227 -- and does not have a limitation on the line length.
1228
1229 NR : Natural renames Session.Data.NR;
1230 FNR : Natural renames Session.Data.FNR;
1231
1232 ---------------
1233 -- Read_Line --
1234 ---------------
1235
1236 function Read_Line return String is
1237 Buffer : String (1 .. 1_024);
1238 Last : Natural;
1239
1240 begin
1241 Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last);
1242
1243 if Last = Buffer'Last then
1244 return Buffer & Read_Line;
1245 else
1246 return Buffer (1 .. Last);
1247 end if;
1248 end Read_Line;
1249
1250 -- Start of processing for Read_Line
1251
1252 begin
1253 if End_Of_File (Session) then
1254 Open_Next_File (Session);
1255 FNR := 0;
1256 end if;
1257
1258 Session.Data.Current_Line := To_Unbounded_String (Read_Line);
1259
1260 NR := NR + 1;
1261 FNR := FNR + 1;
1262 end Read_Line;
1263
1264 --------------
1265 -- Register --
1266 --------------
1267
1268 procedure Register
1269 (Field : Count;
1270 Pattern : String;
1271 Action : Action_Callback;
1272 Session : Session_Type)
1273 is
1274 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1275 U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
1276
1277 begin
1278 Pattern_Action_Table.Increment_Last (Filters);
1279
1280 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1281 (Pattern => new Patterns.String_Pattern'(U_Pattern, Field),
1282 Action => new Actions.Simple_Action'(Proc => Action));
1283 end Register;
1284
1285 procedure Register
1286 (Field : Count;
1287 Pattern : String;
1288 Action : Action_Callback)
1289 is
1290 begin
1291 Register (Field, Pattern, Action, Cur_Session);
1292 end Register;
1293
1294 procedure Register
1295 (Field : Count;
1296 Pattern : GNAT.Regpat.Pattern_Matcher;
1297 Action : Action_Callback;
1298 Session : Session_Type)
1299 is
1300 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1301
1302 A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1303 new Regpat.Pattern_Matcher'(Pattern);
1304 begin
1305 Pattern_Action_Table.Increment_Last (Filters);
1306
1307 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1308 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1309 Action => new Actions.Simple_Action'(Proc => Action));
1310 end Register;
1311
1312 procedure Register
1313 (Field : Count;
1314 Pattern : GNAT.Regpat.Pattern_Matcher;
1315 Action : Action_Callback)
1316 is
1317 begin
1318 Register (Field, Pattern, Action, Cur_Session);
1319 end Register;
1320
1321 procedure Register
1322 (Field : Count;
1323 Pattern : GNAT.Regpat.Pattern_Matcher;
1324 Action : Match_Action_Callback;
1325 Session : Session_Type)
1326 is
1327 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1328
1329 A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1330 new Regpat.Pattern_Matcher'(Pattern);
1331 begin
1332 Pattern_Action_Table.Increment_Last (Filters);
1333
1334 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1335 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1336 Action => new Actions.Match_Action'(Proc => Action));
1337 end Register;
1338
1339 procedure Register
1340 (Field : Count;
1341 Pattern : GNAT.Regpat.Pattern_Matcher;
1342 Action : Match_Action_Callback)
1343 is
1344 begin
1345 Register (Field, Pattern, Action, Cur_Session);
1346 end Register;
1347
1348 procedure Register
1349 (Pattern : Pattern_Callback;
1350 Action : Action_Callback;
1351 Session : Session_Type)
1352 is
1353 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1354
1355 begin
1356 Pattern_Action_Table.Increment_Last (Filters);
1357
1358 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1359 (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern),
1360 Action => new Actions.Simple_Action'(Proc => Action));
1361 end Register;
1362
1363 procedure Register
1364 (Pattern : Pattern_Callback;
1365 Action : Action_Callback)
1366 is
1367 begin
1368 Register (Pattern, Action, Cur_Session);
1369 end Register;
1370
1371 procedure Register
1372 (Action : Action_Callback;
1373 Session : Session_Type)
1374 is
1375 begin
1376 Register (Always_True'Access, Action, Session);
1377 end Register;
1378
1379 procedure Register
1380 (Action : Action_Callback)
1381 is
1382 begin
1383 Register (Action, Cur_Session);
1384 end Register;
1385
1386 -----------------
1387 -- Set_Current --
1388 -----------------
1389
1390 procedure Set_Current (Session : Session_Type) is
1391 begin
1392 Cur_Session.Data := Session.Data;
1393 end Set_Current;
1394
1395 --------------------------
1396 -- Set_Field_Separators --
1397 --------------------------
1398
1399 procedure Set_Field_Separators
1400 (Separators : String := Default_Separators;
1401 Session : Session_Type)
1402 is
1403 begin
1404 Free (Session.Data.Separators);
1405
1406 Session.Data.Separators :=
1407 new Split.Separator'(Separators'Length, Separators);
1408
1409 -- If there is a current line read, split it according to the new
1410 -- separators.
1411
1412 if Session.Data.Current_Line /= Null_Unbounded_String then
1413 Split_Line (Session);
1414 end if;
1415 end Set_Field_Separators;
1416
1417 procedure Set_Field_Separators
1418 (Separators : String := Default_Separators)
1419 is
1420 begin
1421 Set_Field_Separators (Separators, Cur_Session);
1422 end Set_Field_Separators;
1423
1424 ----------------------
1425 -- Set_Field_Widths --
1426 ----------------------
1427
1428 procedure Set_Field_Widths
1429 (Field_Widths : Widths_Set;
1430 Session : Session_Type)
1431 is
1432 begin
1433 Free (Session.Data.Separators);
1434
1435 Session.Data.Separators :=
1436 new Split.Column'(Field_Widths'Length, Field_Widths);
1437
1438 -- If there is a current line read, split it according to
1439 -- the new separators.
1440
1441 if Session.Data.Current_Line /= Null_Unbounded_String then
1442 Split_Line (Session);
1443 end if;
1444 end Set_Field_Widths;
1445
1446 procedure Set_Field_Widths
1447 (Field_Widths : Widths_Set)
1448 is
1449 begin
1450 Set_Field_Widths (Field_Widths, Cur_Session);
1451 end Set_Field_Widths;
1452
1453 ----------------
1454 -- Split_Line --
1455 ----------------
1456
1457 procedure Split_Line (Session : Session_Type) is
1458 Fields : Field_Table.Instance renames Session.Data.Fields;
1459 begin
1460 Field_Table.Init (Fields);
1461 Split.Current_Line (Session.Data.Separators.all, Session);
1462 end Split_Line;
1463
1464 -------------
1465 -- Get_Def --
1466 -------------
1467
1468 function Get_Def return Session_Data_Access is
1469 begin
1470 return Def_Session.Data;
1471 end Get_Def;
1472
1473 -------------
1474 -- Set_Cur --
1475 -------------
1476
1477 procedure Set_Cur is
1478 begin
1479 Cur_Session.Data := Def_Session.Data;
1480 end Set_Cur;
1481
1482 begin
1483 -- We have declared two sessions but both should share the same data.
1484 -- The current session must point to the default session as its initial
1485 -- value. So first we release the session data then we set current
1486 -- session data to point to default session data.
1487
1488 Free (Cur_Session.Data);
1489 Cur_Session.Data := Def_Session.Data;
1490 end GNAT.AWK;