1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2005 Ada Core Technologies, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 pragma Style_Checks (All_Checks);
35 -- Turn off alpha ordering check for subprograms, since we cannot
36 -- Put Finalize and Initialize in alpha order (see comments).
40 with Ada.Strings.Unbounded;
41 with Ada.Strings.Fixed;
42 with Ada.Strings.Maps;
43 with Ada.Unchecked_Deallocation;
45 with GNAT.Directory_Operations;
46 with GNAT.Dynamic_Tables;
49 package body GNAT.AWK is
52 use Ada.Strings.Unbounded;
60 type Mode is abstract tagged null record;
61 -- This is the main type which is declared abstract. This type must be
62 -- derived for each split style.
64 type Mode_Access is access Mode'Class;
66 procedure Current_Line (S : Mode; Session : Session_Type)
68 -- Split current line of Session using split mode S
70 ------------------------
71 -- Split on separator --
72 ------------------------
74 type Separator (Size : Positive) is new Mode with record
75 Separators : String (1 .. Size);
78 procedure Current_Line
80 Session : Session_Type);
86 type Column (Size : Positive) is new Mode with record
87 Columns : Widths_Set (1 .. Size);
90 procedure Current_Line (S : Column; Session : Session_Type);
94 procedure Free is new Unchecked_Deallocation
95 (Split.Mode'Class, Split.Mode_Access);
101 type AWK_File is access String;
103 package File_Table is
104 new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
105 -- List of file names associated with a Session
107 procedure Free is new Unchecked_Deallocation (String, AWK_File);
113 type Field_Slice is record
117 -- This is a field slice (First .. Last) in session's current line
119 package Field_Table is
120 new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
121 -- List of fields for the current line
127 -- Define all patterns style: exact string, regular expression, boolean
132 type Pattern is abstract tagged null record;
133 -- This is the main type which is declared abstract. This type must be
134 -- derived for each patterns style.
136 type Pattern_Access is access Pattern'Class;
140 Session : Session_Type) return Boolean
142 -- Returns True if P match for the current session and False otherwise
144 procedure Release (P : in out Pattern);
145 -- Release memory used by the pattern structure
147 --------------------------
148 -- Exact string pattern --
149 --------------------------
151 type String_Pattern is new Pattern with record
152 Str : Unbounded_String;
158 Session : Session_Type) return Boolean;
160 --------------------------------
161 -- Regular expression pattern --
162 --------------------------------
164 type Pattern_Matcher_Access is access Regpat.Pattern_Matcher;
166 type Regexp_Pattern is new Pattern with record
167 Regx : Pattern_Matcher_Access;
173 Session : Session_Type) return Boolean;
175 procedure Release (P : in out Regexp_Pattern);
177 ------------------------------
178 -- Boolean function pattern --
179 ------------------------------
181 type Callback_Pattern is new Pattern with record
182 Pattern : Pattern_Callback;
186 (P : Callback_Pattern;
187 Session : Session_Type) return Boolean;
191 procedure Free is new Unchecked_Deallocation
192 (Patterns.Pattern'Class, Patterns.Pattern_Access);
198 -- Define all action style : simple call, call with matches
202 type Action is abstract tagged null record;
203 -- This is the main type which is declared abstract. This type must be
204 -- derived for each action style.
206 type Action_Access is access Action'Class;
210 Session : Session_Type) is abstract;
211 -- Call action A as required
217 type Simple_Action is new Action with record
218 Proc : Action_Callback;
223 Session : Session_Type);
225 -------------------------
226 -- Action with matches --
227 -------------------------
229 type Match_Action is new Action with record
230 Proc : Match_Action_Callback;
235 Session : Session_Type);
239 procedure Free is new Unchecked_Deallocation
240 (Actions.Action'Class, Actions.Action_Access);
242 --------------------------
243 -- Pattern/Action table --
244 --------------------------
246 type Pattern_Action is record
247 Pattern : Patterns.Pattern_Access; -- If Pattern is True
248 Action : Actions.Action_Access; -- Action will be called
251 package Pattern_Action_Table is
252 new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50);
258 type Session_Data is record
259 Current_File : Text_IO.File_Type;
260 Current_Line : Unbounded_String;
261 Separators : Split.Mode_Access;
262 Files : File_Table.Instance;
263 File_Index : Natural := 0;
264 Fields : Field_Table.Instance;
265 Filters : Pattern_Action_Table.Instance;
268 Matches : Regpat.Match_Array (0 .. 100);
269 -- latest matches for the regexp pattern
273 new Unchecked_Deallocation (Session_Data, Session_Data_Access);
279 procedure Initialize (Session : in out Session_Type) is
281 Session.Data := new Session_Data;
283 -- Initialize separators
285 Session.Data.Separators :=
286 new Split.Separator'(Default_Separators'Length, Default_Separators);
288 -- Initialize all tables
290 File_Table.Init (Session.Data.Files);
291 Field_Table.Init (Session.Data.Fields);
292 Pattern_Action_Table.Init (Session.Data.Filters);
295 -----------------------
296 -- Session Variables --
297 -----------------------
299 -- These must come after the body of Initialize, since they make
300 -- implicit calls to Initialize at elaboration time.
302 Def_Session : Session_Type;
303 Cur_Session : Session_Type;
309 -- Note: Finalize must come after Initialize and the definition
310 -- of the Def_Session and Cur_Session variables, since it references
313 procedure Finalize (Session : in out Session_Type) is
315 -- We release the session data only if it is not the default session
317 if Session.Data /= Def_Session.Data then
320 -- Since we have closed the current session, set it to point now to
321 -- the default session.
323 Cur_Session.Data := Def_Session.Data;
327 ----------------------
328 -- Private Services --
329 ----------------------
331 function Always_True return Boolean;
332 -- A function that always returns True
334 function Apply_Filters
335 (Session : Session_Type := Current_Session) return Boolean;
336 -- Apply any filters for which the Pattern is True for Session. It returns
337 -- True if a least one filters has been applied (i.e. associated action
338 -- callback has been called).
340 procedure Open_Next_File
341 (Session : Session_Type := Current_Session);
342 pragma Inline (Open_Next_File);
343 -- Open next file for Session closing current file if needed. It raises
344 -- End_Error if there is no more file in the table.
346 procedure Raise_With_Info
347 (E : Exceptions.Exception_Id;
349 Session : Session_Type);
350 pragma No_Return (Raise_With_Info);
351 -- Raises exception E with the message prepended with the current line
352 -- number and the filename if possible.
354 procedure Read_Line (Session : Session_Type);
355 -- Read a line for the Session and set Current_Line
357 procedure Split_Line (Session : Session_Type);
358 -- Split session's Current_Line according to the session separators and
359 -- set the Fields table. This procedure can be called at any time.
361 ----------------------
362 -- Private Packages --
363 ----------------------
369 package body Actions is
377 Session : Session_Type)
379 pragma Unreferenced (Session);
391 Session : Session_Type)
394 A.Proc (Session.Data.Matches);
403 package body Patterns is
411 Session : Session_Type) return Boolean
414 return P.Str = Field (P.Rank, Session);
423 Session : Session_Type) return Boolean
425 use type Regpat.Match_Location;
429 (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
430 return Session.Data.Matches (0) /= Regpat.No_Match;
438 (P : Callback_Pattern;
439 Session : Session_Type) return Boolean
441 pragma Unreferenced (Session);
444 return P.Pattern.all;
451 procedure Release (P : in out Pattern) is
452 pragma Unreferenced (P);
462 procedure Release (P : in out Regexp_Pattern) is
463 procedure Free is new Unchecked_Deallocation
464 (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
476 package body Split is
484 procedure Current_Line (S : Separator; Session : Session_Type) is
485 Line : constant String := To_String (Session.Data.Current_Line);
486 Fields : Field_Table.Instance renames Session.Data.Fields;
491 Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators);
494 -- First field start here
498 -- Record the first field start position which is the first character
501 Field_Table.Increment_Last (Fields);
502 Fields.Table (Field_Table.Last (Fields)).First := Start;
505 -- Look for next separator
508 (Source => Line (Start .. Line'Last),
513 Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
515 -- If separators are set to the default (space and tab) we skip
516 -- all spaces and tabs following current field.
518 if S.Separators = Default_Separators then
520 (Line (Stop + 1 .. Line'Last),
521 Maps.To_Set (Default_Separators),
532 -- Record in the field table the start of this new field
534 Field_Table.Increment_Last (Fields);
535 Fields.Table (Field_Table.Last (Fields)).First := Start;
539 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
546 procedure Current_Line (S : Column; Session : Session_Type) is
547 Line : constant String := To_String (Session.Data.Current_Line);
548 Fields : Field_Table.Instance renames Session.Data.Fields;
549 Start : Positive := Line'First;
552 -- Record the first field start position which is the first character
555 for C in 1 .. S.Columns'Length loop
557 Field_Table.Increment_Last (Fields);
559 Fields.Table (Field_Table.Last (Fields)).First := Start;
561 Start := Start + S.Columns (C);
563 Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
567 -- If there is some remaining character on the line, add them in a
570 if Start - 1 < Line'Length then
572 Field_Table.Increment_Last (Fields);
574 Fields.Table (Field_Table.Last (Fields)).First := Start;
576 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
588 Session : Session_Type := Current_Session)
590 Files : File_Table.Instance renames Session.Data.Files;
593 if OS_Lib.Is_Regular_File (Filename) then
594 File_Table.Increment_Last (Files);
595 Files.Table (File_Table.Last (Files)) := new String'(Filename);
598 (File_Error'Identity,
599 "File " & Filename & " not found.",
611 Number_Of_Files_Added : out Natural;
612 Session : Session_Type := Current_Session)
614 use Directory_Operations;
617 Filename : String (1 .. 200);
621 Number_Of_Files_Added := 0;
623 Open (Dir, Directory);
626 Read (Dir, Filename, Last);
629 Add_File (Filename (1 .. Last), Session);
630 Number_Of_Files_Added := Number_Of_Files_Added + 1;
638 (File_Error'Identity,
639 "Error scaning directory " & Directory
640 & " for files " & Filenames & '.',
648 function Always_True return Boolean is
657 function Apply_Filters
658 (Session : Session_Type := Current_Session) return Boolean
660 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
661 Results : Boolean := False;
664 -- Iterate through the filters table, if pattern match call action
666 for F in 1 .. Pattern_Action_Table.Last (Filters) loop
667 if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
669 Actions.Call (Filters.Table (F).Action.all, Session);
680 procedure Close (Session : Session_Type) is
681 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
682 Files : File_Table.Instance renames Session.Data.Files;
685 -- Close current file if needed
687 if Text_IO.Is_Open (Session.Data.Current_File) then
688 Text_IO.Close (Session.Data.Current_File);
691 -- Release separators
693 Free (Session.Data.Separators);
695 -- Release Filters table
697 for F in 1 .. Pattern_Action_Table.Last (Filters) loop
698 Patterns.Release (Filters.Table (F).Pattern.all);
699 Free (Filters.Table (F).Pattern);
700 Free (Filters.Table (F).Action);
703 for F in 1 .. File_Table.Last (Files) loop
704 Free (Files.Table (F));
707 File_Table.Set_Last (Session.Data.Files, 0);
708 Field_Table.Set_Last (Session.Data.Fields, 0);
709 Pattern_Action_Table.Set_Last (Session.Data.Filters, 0);
711 Session.Data.NR := 0;
712 Session.Data.FNR := 0;
713 Session.Data.File_Index := 0;
714 Session.Data.Current_Line := Null_Unbounded_String;
717 ---------------------
718 -- Current_Session --
719 ---------------------
721 function Current_Session return Session_Type is
726 ---------------------
727 -- Default_Session --
728 ---------------------
730 function Default_Session return Session_Type is
739 function Discrete_Field
741 Session : Session_Type := Current_Session) return Discrete
744 return Discrete'Value (Field (Rank, Session));
752 (Session : Session_Type := Current_Session) return Boolean
755 return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
756 and then End_Of_File (Session);
764 (Session : Session_Type := Current_Session) return Boolean
767 return Text_IO.End_Of_File (Session.Data.Current_File);
776 Session : Session_Type := Current_Session) return String
778 Fields : Field_Table.Instance renames Session.Data.Fields;
781 if Rank > Number_Of_Fields (Session) then
783 (Field_Error'Identity,
784 "Field number" & Count'Image (Rank) & " does not exist.",
789 -- Returns the whole line, this is what $0 does under Session_Type
791 return To_String (Session.Data.Current_Line);
794 return Slice (Session.Data.Current_Line,
795 Fields.Table (Positive (Rank)).First,
796 Fields.Table (Positive (Rank)).Last);
802 Session : Session_Type := Current_Session) return Integer
805 return Integer'Value (Field (Rank, Session));
808 when Constraint_Error =>
810 (Field_Error'Identity,
811 "Field number" & Count'Image (Rank)
812 & " cannot be converted to an integer.",
818 Session : Session_Type := Current_Session) return Float
821 return Float'Value (Field (Rank, Session));
824 when Constraint_Error =>
826 (Field_Error'Identity,
827 "Field number" & Count'Image (Rank)
828 & " cannot be converted to a float.",
837 (Session : Session_Type := Current_Session) return String
839 Files : File_Table.Instance renames Session.Data.Files;
842 if Session.Data.File_Index = 0 then
845 return Files.Table (Session.Data.File_Index).all;
853 procedure For_Every_Line
854 (Separators : String := Use_Current;
855 Filename : String := Use_Current;
856 Callbacks : Callback_Mode := None;
857 Session : Session_Type := Current_Session)
862 Open (Separators, Filename, Session);
864 while not End_Of_Data (Session) loop
866 Split_Line (Session);
868 if Callbacks in Only .. Pass_Through then
871 pragma Unreferenced (Discard);
873 Discard := Apply_Filters (Session);
877 if Callbacks /= Only then
892 (Callbacks : Callback_Mode := None;
893 Session : Session_Type := Current_Session)
895 Filter_Active : Boolean;
898 if not Text_IO.Is_Open (Session.Data.Current_File) then
904 Split_Line (Session);
912 Filter_Active := Apply_Filters (Session);
913 exit when not Filter_Active;
916 Filter_Active := Apply_Filters (Session);
923 ----------------------
924 -- Number_Of_Fields --
925 ----------------------
927 function Number_Of_Fields
928 (Session : Session_Type := Current_Session) return Count
931 return Count (Field_Table.Last (Session.Data.Fields));
932 end Number_Of_Fields;
934 --------------------------
935 -- Number_Of_File_Lines --
936 --------------------------
938 function Number_Of_File_Lines
939 (Session : Session_Type := Current_Session) return Count
942 return Count (Session.Data.FNR);
943 end Number_Of_File_Lines;
945 ---------------------
946 -- Number_Of_Files --
947 ---------------------
949 function Number_Of_Files
950 (Session : Session_Type := Current_Session) return Natural
952 Files : File_Table.Instance renames Session.Data.Files;
955 return File_Table.Last (Files);
958 ---------------------
959 -- Number_Of_Lines --
960 ---------------------
962 function Number_Of_Lines
963 (Session : Session_Type := Current_Session) return Count
966 return Count (Session.Data.NR);
974 (Separators : String := Use_Current;
975 Filename : String := Use_Current;
976 Session : Session_Type := Current_Session)
979 if Text_IO.Is_Open (Session.Data.Current_File) then
983 if Filename /= Use_Current then
984 File_Table.Init (Session.Data.Files);
985 Add_File (Filename, Session);
988 if Separators /= Use_Current then
989 Set_Field_Separators (Separators, Session);
992 Open_Next_File (Session);
1000 -- Open_Next_File --
1001 --------------------
1003 procedure Open_Next_File
1004 (Session : Session_Type := Current_Session)
1006 Files : File_Table.Instance renames Session.Data.Files;
1009 if Text_IO.Is_Open (Session.Data.Current_File) then
1010 Text_IO.Close (Session.Data.Current_File);
1013 Session.Data.File_Index := Session.Data.File_Index + 1;
1015 -- If there are no mores file in the table, raise End_Error
1017 if Session.Data.File_Index > File_Table.Last (Files) then
1022 (File => Session.Data.Current_File,
1023 Name => Files.Table (Session.Data.File_Index).all,
1024 Mode => Text_IO.In_File);
1032 (Separators : String := Use_Current;
1033 Filename : String := Use_Current;
1034 Session : Session_Type := Current_Session)
1036 Filter_Active : Boolean;
1037 pragma Unreferenced (Filter_Active);
1040 Open (Separators, Filename, Session);
1042 while not End_Of_Data (Session) loop
1043 Get_Line (None, Session);
1044 Filter_Active := Apply_Filters (Session);
1050 ---------------------
1051 -- Raise_With_Info --
1052 ---------------------
1054 procedure Raise_With_Info
1055 (E : Exceptions.Exception_Id;
1057 Session : Session_Type)
1059 function Filename return String;
1060 -- Returns current filename and "??" if this information is not
1063 function Line return String;
1064 -- Returns current line number without the leading space
1070 function Filename return String is
1071 File : constant String := AWK.File (Session);
1084 function Line return String is
1085 L : constant String := Natural'Image (Session.Data.FNR);
1087 return L (2 .. L'Last);
1090 -- Start of processing for Raise_With_Info
1093 Exceptions.Raise_Exception
1095 '[' & Filename & ':' & Line & "] " & Message);
1096 raise Constraint_Error; -- to please GNAT as this is a No_Return proc
1097 end Raise_With_Info;
1103 procedure Read_Line (Session : Session_Type) is
1105 function Read_Line return String;
1106 -- Read a line in the current file. This implementation is recursive
1107 -- and does not have a limitation on the line length.
1109 NR : Natural renames Session.Data.NR;
1110 FNR : Natural renames Session.Data.FNR;
1116 function Read_Line return String is
1117 Buffer : String (1 .. 1_024);
1121 Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last);
1123 if Last = Buffer'Last then
1124 return Buffer & Read_Line;
1126 return Buffer (1 .. Last);
1130 -- Start of processing for Read_Line
1133 if End_Of_File (Session) then
1134 Open_Next_File (Session);
1138 Session.Data.Current_Line := To_Unbounded_String (Read_Line);
1151 Action : Action_Callback;
1152 Session : Session_Type := Current_Session)
1154 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1155 U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
1158 Pattern_Action_Table.Increment_Last (Filters);
1160 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1161 (Pattern => new Patterns.String_Pattern'(U_Pattern, Field),
1162 Action => new Actions.Simple_Action'(Proc => Action));
1167 Pattern : GNAT.Regpat.Pattern_Matcher;
1168 Action : Action_Callback;
1169 Session : Session_Type := Current_Session)
1171 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1173 A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1174 new Regpat.Pattern_Matcher'(Pattern);
1176 Pattern_Action_Table.Increment_Last (Filters);
1178 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1179 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1180 Action => new Actions.Simple_Action'(Proc => Action));
1185 Pattern : GNAT.Regpat.Pattern_Matcher;
1186 Action : Match_Action_Callback;
1187 Session : Session_Type := Current_Session)
1189 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1191 A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1192 new Regpat.Pattern_Matcher'(Pattern);
1194 Pattern_Action_Table.Increment_Last (Filters);
1196 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1197 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1198 Action => new Actions.Match_Action'(Proc => Action));
1202 (Pattern : Pattern_Callback;
1203 Action : Action_Callback;
1204 Session : Session_Type := Current_Session)
1206 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1209 Pattern_Action_Table.Increment_Last (Filters);
1211 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1212 (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern),
1213 Action => new Actions.Simple_Action'(Proc => Action));
1217 (Action : Action_Callback;
1218 Session : Session_Type := Current_Session)
1221 Register (Always_True'Access, Action, Session);
1228 procedure Set_Current (Session : Session_Type) is
1230 Cur_Session.Data := Session.Data;
1233 --------------------------
1234 -- Set_Field_Separators --
1235 --------------------------
1237 procedure Set_Field_Separators
1238 (Separators : String := Default_Separators;
1239 Session : Session_Type := Current_Session)
1242 Free (Session.Data.Separators);
1244 Session.Data.Separators :=
1245 new Split.Separator'(Separators'Length, Separators);
1247 -- If there is a current line read, split it according to the new
1250 if Session.Data.Current_Line /= Null_Unbounded_String then
1251 Split_Line (Session);
1253 end Set_Field_Separators;
1255 ----------------------
1256 -- Set_Field_Widths --
1257 ----------------------
1259 procedure Set_Field_Widths
1260 (Field_Widths : Widths_Set;
1261 Session : Session_Type := Current_Session) is
1264 Free (Session.Data.Separators);
1266 Session.Data.Separators :=
1267 new Split.Column'(Field_Widths'Length, Field_Widths);
1269 -- If there is a current line read, split it according to
1270 -- the new separators.
1272 if Session.Data.Current_Line /= Null_Unbounded_String then
1273 Split_Line (Session);
1275 end Set_Field_Widths;
1281 procedure Split_Line (Session : Session_Type) is
1282 Fields : Field_Table.Instance renames Session.Data.Fields;
1285 Field_Table.Init (Fields);
1287 Split.Current_Line (Session.Data.Separators.all, Session);
1291 -- We have declared two sessions but both should share the same data.
1292 -- The current session must point to the default session as its initial
1293 -- value. So first we release the session data then we set current
1294 -- session data to point to default session data.
1296 Free (Cur_Session.Data);
1297 Cur_Session.Data := Def_Session.Data;