| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- G N A T . A W K -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2000-2014, AdaCore -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Exceptions; |
| with Ada.Text_IO; |
| with Ada.Strings.Unbounded; |
| with Ada.Strings.Fixed; |
| with Ada.Strings.Maps; |
| with Ada.Unchecked_Deallocation; |
| |
| with GNAT.Directory_Operations; |
| with GNAT.Dynamic_Tables; |
| with GNAT.OS_Lib; |
| |
| package body GNAT.AWK is |
| |
| use Ada; |
| use Ada.Strings.Unbounded; |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| -- The following two subprograms provide a functional interface to the |
| -- two special session variables, that are manipulated explicitly by |
| -- Finalize, but must be declared after Finalize to prevent static |
| -- elaboration warnings. |
| |
| function Get_Def return Session_Data_Access; |
| procedure Set_Cur; |
| |
| ---------------- |
| -- Split mode -- |
| ---------------- |
| |
| package Split is |
| |
| type Mode is abstract tagged null record; |
| -- This is the main type which is declared abstract. This type must be |
| -- derived for each split style. |
| |
| type Mode_Access is access Mode'Class; |
| |
| procedure Current_Line (S : Mode; Session : Session_Type) |
| is abstract; |
| -- Split current line of Session using split mode S |
| |
| ------------------------ |
| -- Split on separator -- |
| ------------------------ |
| |
| type Separator (Size : Positive) is new Mode with record |
| Separators : String (1 .. Size); |
| end record; |
| |
| procedure Current_Line |
| (S : Separator; |
| Session : Session_Type); |
| |
| --------------------- |
| -- Split on column -- |
| --------------------- |
| |
| type Column (Size : Positive) is new Mode with record |
| Columns : Widths_Set (1 .. Size); |
| end record; |
| |
| procedure Current_Line (S : Column; Session : Session_Type); |
| |
| end Split; |
| |
| procedure Free is new Unchecked_Deallocation |
| (Split.Mode'Class, Split.Mode_Access); |
| |
| ---------------- |
| -- File_Table -- |
| ---------------- |
| |
| type AWK_File is access String; |
| |
| package File_Table is |
| new Dynamic_Tables (AWK_File, Natural, 1, 5, 50); |
| -- List of file names associated with a Session |
| |
| procedure Free is new Unchecked_Deallocation (String, AWK_File); |
| |
| ----------------- |
| -- Field_Table -- |
| ----------------- |
| |
| type Field_Slice is record |
| First : Positive; |
| Last : Natural; |
| end record; |
| -- This is a field slice (First .. Last) in session's current line |
| |
| package Field_Table is |
| new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100); |
| -- List of fields for the current line |
| |
| -------------- |
| -- Patterns -- |
| -------------- |
| |
| -- Define all patterns style: exact string, regular expression, boolean |
| -- function. |
| |
| package Patterns is |
| |
| type Pattern is abstract tagged null record; |
| -- This is the main type which is declared abstract. This type must be |
| -- derived for each patterns style. |
| |
| type Pattern_Access is access Pattern'Class; |
| |
| function Match |
| (P : Pattern; |
| Session : Session_Type) return Boolean |
| is abstract; |
| -- Returns True if P match for the current session and False otherwise |
| |
| procedure Release (P : in out Pattern); |
| -- Release memory used by the pattern structure |
| |
| -------------------------- |
| -- Exact string pattern -- |
| -------------------------- |
| |
| type String_Pattern is new Pattern with record |
| Str : Unbounded_String; |
| Rank : Count; |
| end record; |
| |
| function Match |
| (P : String_Pattern; |
| Session : Session_Type) return Boolean; |
| |
| -------------------------------- |
| -- Regular expression pattern -- |
| -------------------------------- |
| |
| type Pattern_Matcher_Access is access Regpat.Pattern_Matcher; |
| |
| type Regexp_Pattern is new Pattern with record |
| Regx : Pattern_Matcher_Access; |
| Rank : Count; |
| end record; |
| |
| function Match |
| (P : Regexp_Pattern; |
| Session : Session_Type) return Boolean; |
| |
| procedure Release (P : in out Regexp_Pattern); |
| |
| ------------------------------ |
| -- Boolean function pattern -- |
| ------------------------------ |
| |
| type Callback_Pattern is new Pattern with record |
| Pattern : Pattern_Callback; |
| end record; |
| |
| function Match |
| (P : Callback_Pattern; |
| Session : Session_Type) return Boolean; |
| |
| end Patterns; |
| |
| procedure Free is new Unchecked_Deallocation |
| (Patterns.Pattern'Class, Patterns.Pattern_Access); |
| |
| ------------- |
| -- Actions -- |
| ------------- |
| |
| -- Define all action style : simple call, call with matches |
| |
| package Actions is |
| |
| type Action is abstract tagged null record; |
| -- This is the main type which is declared abstract. This type must be |
| -- derived for each action style. |
| |
| type Action_Access is access Action'Class; |
| |
| procedure Call |
| (A : Action; |
| Session : Session_Type) is abstract; |
| -- Call action A as required |
| |
| ------------------- |
| -- Simple action -- |
| ------------------- |
| |
| type Simple_Action is new Action with record |
| Proc : Action_Callback; |
| end record; |
| |
| procedure Call |
| (A : Simple_Action; |
| Session : Session_Type); |
| |
| ------------------------- |
| -- Action with matches -- |
| ------------------------- |
| |
| type Match_Action is new Action with record |
| Proc : Match_Action_Callback; |
| end record; |
| |
| procedure Call |
| (A : Match_Action; |
| Session : Session_Type); |
| |
| end Actions; |
| |
| procedure Free is new Unchecked_Deallocation |
| (Actions.Action'Class, Actions.Action_Access); |
| |
| -------------------------- |
| -- Pattern/Action table -- |
| -------------------------- |
| |
| type Pattern_Action is record |
| Pattern : Patterns.Pattern_Access; -- If Pattern is True |
| Action : Actions.Action_Access; -- Action will be called |
| end record; |
| |
| package Pattern_Action_Table is |
| new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50); |
| |
| ------------------ |
| -- Session Data -- |
| ------------------ |
| |
| type Session_Data is record |
| Current_File : Text_IO.File_Type; |
| Current_Line : Unbounded_String; |
| Separators : Split.Mode_Access; |
| Files : File_Table.Instance; |
| File_Index : Natural := 0; |
| Fields : Field_Table.Instance; |
| Filters : Pattern_Action_Table.Instance; |
| NR : Natural := 0; |
| FNR : Natural := 0; |
| Matches : Regpat.Match_Array (0 .. 100); |
| -- Latest matches for the regexp pattern |
| end record; |
| |
| procedure Free is |
| new Unchecked_Deallocation (Session_Data, Session_Data_Access); |
| |
| -------------- |
| -- Finalize -- |
| -------------- |
| |
| procedure Finalize (Session : in out Session_Type) is |
| begin |
| -- We release the session data only if it is not the default session |
| |
| if Session.Data /= Get_Def then |
| -- Release separators |
| |
| Free (Session.Data.Separators); |
| |
| Free (Session.Data); |
| |
| -- Since we have closed the current session, set it to point now to |
| -- the default session. |
| |
| Set_Cur; |
| end if; |
| end Finalize; |
| |
| ---------------- |
| -- Initialize -- |
| ---------------- |
| |
| procedure Initialize (Session : in out Session_Type) is |
| begin |
| Session.Data := new Session_Data; |
| |
| -- Initialize separators |
| |
| Session.Data.Separators := |
| new Split.Separator'(Default_Separators'Length, Default_Separators); |
| |
| -- Initialize all tables |
| |
| File_Table.Init (Session.Data.Files); |
| Field_Table.Init (Session.Data.Fields); |
| Pattern_Action_Table.Init (Session.Data.Filters); |
| end Initialize; |
| |
| ----------------------- |
| -- Session Variables -- |
| ----------------------- |
| |
| Def_Session : Session_Type; |
| Cur_Session : Session_Type; |
| |
| ---------------------- |
| -- Private Services -- |
| ---------------------- |
| |
| function Always_True return Boolean; |
| -- A function that always returns True |
| |
| function Apply_Filters |
| (Session : Session_Type) return Boolean; |
| -- Apply any filters for which the Pattern is True for Session. It returns |
| -- True if a least one filters has been applied (i.e. associated action |
| -- callback has been called). |
| |
| procedure Open_Next_File |
| (Session : Session_Type); |
| pragma Inline (Open_Next_File); |
| -- Open next file for Session closing current file if needed. It raises |
| -- End_Error if there is no more file in the table. |
| |
| procedure Raise_With_Info |
| (E : Exceptions.Exception_Id; |
| Message : String; |
| Session : Session_Type); |
| pragma No_Return (Raise_With_Info); |
| -- Raises exception E with the message prepended with the current line |
| -- number and the filename if possible. |
| |
| procedure Read_Line (Session : Session_Type); |
| -- Read a line for the Session and set Current_Line |
| |
| procedure Split_Line (Session : Session_Type); |
| -- Split session's Current_Line according to the session separators and |
| -- set the Fields table. This procedure can be called at any time. |
| |
| ---------------------- |
| -- Private Packages -- |
| ---------------------- |
| |
| ------------- |
| -- Actions -- |
| ------------- |
| |
| package body Actions is |
| |
| ---------- |
| -- Call -- |
| ---------- |
| |
| procedure Call |
| (A : Simple_Action; |
| Session : Session_Type) |
| is |
| pragma Unreferenced (Session); |
| begin |
| A.Proc.all; |
| end Call; |
| |
| ---------- |
| -- Call -- |
| ---------- |
| |
| procedure Call |
| (A : Match_Action; |
| Session : Session_Type) |
| is |
| begin |
| A.Proc (Session.Data.Matches); |
| end Call; |
| |
| end Actions; |
| |
| -------------- |
| -- Patterns -- |
| -------------- |
| |
| package body Patterns is |
| |
| ----------- |
| -- Match -- |
| ----------- |
| |
| function Match |
| (P : String_Pattern; |
| Session : Session_Type) return Boolean |
| is |
| begin |
| return P.Str = Field (P.Rank, Session); |
| end Match; |
| |
| ----------- |
| -- Match -- |
| ----------- |
| |
| function Match |
| (P : Regexp_Pattern; |
| Session : Session_Type) return Boolean |
| is |
| use type Regpat.Match_Location; |
| begin |
| Regpat.Match |
| (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches); |
| return Session.Data.Matches (0) /= Regpat.No_Match; |
| end Match; |
| |
| ----------- |
| -- Match -- |
| ----------- |
| |
| function Match |
| (P : Callback_Pattern; |
| Session : Session_Type) return Boolean |
| is |
| pragma Unreferenced (Session); |
| begin |
| return P.Pattern.all; |
| end Match; |
| |
| ------------- |
| -- Release -- |
| ------------- |
| |
| procedure Release (P : in out Pattern) is |
| pragma Unreferenced (P); |
| begin |
| null; |
| end Release; |
| |
| ------------- |
| -- Release -- |
| ------------- |
| |
| procedure Release (P : in out Regexp_Pattern) is |
| procedure Free is new Unchecked_Deallocation |
| (Regpat.Pattern_Matcher, Pattern_Matcher_Access); |
| begin |
| Free (P.Regx); |
| end Release; |
| |
| end Patterns; |
| |
| ----------- |
| -- Split -- |
| ----------- |
| |
| package body Split is |
| |
| use Ada.Strings; |
| |
| ------------------ |
| -- Current_Line -- |
| ------------------ |
| |
| procedure Current_Line (S : Separator; Session : Session_Type) is |
| Line : constant String := To_String (Session.Data.Current_Line); |
| Fields : Field_Table.Instance renames Session.Data.Fields; |
| Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators); |
| |
| Start : Natural; |
| Stop : Natural; |
| |
| begin |
| -- First field start here |
| |
| Start := Line'First; |
| |
| -- Record the first field start position which is the first character |
| -- in the line. |
| |
| Field_Table.Increment_Last (Fields); |
| Fields.Table (Field_Table.Last (Fields)).First := Start; |
| |
| loop |
| -- Look for next separator |
| |
| Stop := Fixed.Index |
| (Source => Line (Start .. Line'Last), |
| Set => Seps); |
| |
| exit when Stop = 0; |
| |
| Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1; |
| |
| -- If separators are set to the default (space and tab) we skip |
| -- all spaces and tabs following current field. |
| |
| if S.Separators = Default_Separators then |
| Start := Fixed.Index |
| (Line (Stop + 1 .. Line'Last), |
| Maps.To_Set (Default_Separators), |
| Outside, |
| Strings.Forward); |
| |
| if Start = 0 then |
| Start := Stop + 1; |
| end if; |
| |
| else |
| Start := Stop + 1; |
| end if; |
| |
| -- Record in the field table the start of this new field |
| |
| Field_Table.Increment_Last (Fields); |
| Fields.Table (Field_Table.Last (Fields)).First := Start; |
| |
| end loop; |
| |
| Fields.Table (Field_Table.Last (Fields)).Last := Line'Last; |
| end Current_Line; |
| |
| ------------------ |
| -- Current_Line -- |
| ------------------ |
| |
| procedure Current_Line (S : Column; Session : Session_Type) is |
| Line : constant String := To_String (Session.Data.Current_Line); |
| Fields : Field_Table.Instance renames Session.Data.Fields; |
| Start : Positive := Line'First; |
| |
| begin |
| -- Record the first field start position which is the first character |
| -- in the line. |
| |
| for C in 1 .. S.Columns'Length loop |
| |
| Field_Table.Increment_Last (Fields); |
| |
| Fields.Table (Field_Table.Last (Fields)).First := Start; |
| |
| Start := Start + S.Columns (C); |
| |
| Fields.Table (Field_Table.Last (Fields)).Last := Start - 1; |
| |
| end loop; |
| |
| -- If there is some remaining character on the line, add them in a |
| -- new field. |
| |
| if Start - 1 < Line'Length then |
| |
| Field_Table.Increment_Last (Fields); |
| |
| Fields.Table (Field_Table.Last (Fields)).First := Start; |
| |
| Fields.Table (Field_Table.Last (Fields)).Last := Line'Last; |
| end if; |
| end Current_Line; |
| |
| end Split; |
| |
| -------------- |
| -- Add_File -- |
| -------------- |
| |
| procedure Add_File |
| (Filename : String; |
| Session : Session_Type) |
| is |
| Files : File_Table.Instance renames Session.Data.Files; |
| |
| begin |
| if OS_Lib.Is_Regular_File (Filename) then |
| File_Table.Increment_Last (Files); |
| Files.Table (File_Table.Last (Files)) := new String'(Filename); |
| else |
| Raise_With_Info |
| (File_Error'Identity, |
| "File " & Filename & " not found.", |
| Session); |
| end if; |
| end Add_File; |
| |
| procedure Add_File |
| (Filename : String) |
| is |
| |
| begin |
| Add_File (Filename, Cur_Session); |
| end Add_File; |
| |
| --------------- |
| -- Add_Files -- |
| --------------- |
| |
| procedure Add_Files |
| (Directory : String; |
| Filenames : String; |
| Number_Of_Files_Added : out Natural; |
| Session : Session_Type) |
| is |
| use Directory_Operations; |
| |
| Dir : Dir_Type; |
| Filename : String (1 .. 200); |
| Last : Natural; |
| |
| begin |
| Number_Of_Files_Added := 0; |
| |
| Open (Dir, Directory); |
| |
| loop |
| Read (Dir, Filename, Last); |
| exit when Last = 0; |
| |
| Add_File (Filename (1 .. Last), Session); |
| Number_Of_Files_Added := Number_Of_Files_Added + 1; |
| end loop; |
| |
| Close (Dir); |
| |
| exception |
| when others => |
| Raise_With_Info |
| (File_Error'Identity, |
| "Error scanning directory " & Directory |
| & " for files " & Filenames & '.', |
| Session); |
| end Add_Files; |
| |
| procedure Add_Files |
| (Directory : String; |
| Filenames : String; |
| Number_Of_Files_Added : out Natural) |
| is |
| |
| begin |
| Add_Files (Directory, Filenames, Number_Of_Files_Added, Cur_Session); |
| end Add_Files; |
| |
| ----------------- |
| -- Always_True -- |
| ----------------- |
| |
| function Always_True return Boolean is |
| begin |
| return True; |
| end Always_True; |
| |
| ------------------- |
| -- Apply_Filters -- |
| ------------------- |
| |
| function Apply_Filters |
| (Session : Session_Type) return Boolean |
| is |
| Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; |
| Results : Boolean := False; |
| |
| begin |
| -- Iterate through the filters table, if pattern match call action |
| |
| for F in 1 .. Pattern_Action_Table.Last (Filters) loop |
| if Patterns.Match (Filters.Table (F).Pattern.all, Session) then |
| Results := True; |
| Actions.Call (Filters.Table (F).Action.all, Session); |
| end if; |
| end loop; |
| |
| return Results; |
| end Apply_Filters; |
| |
| ----------- |
| -- Close -- |
| ----------- |
| |
| procedure Close (Session : Session_Type) is |
| Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; |
| Files : File_Table.Instance renames Session.Data.Files; |
| |
| begin |
| -- Close current file if needed |
| |
| if Text_IO.Is_Open (Session.Data.Current_File) then |
| Text_IO.Close (Session.Data.Current_File); |
| end if; |
| |
| -- Release Filters table |
| |
| for F in 1 .. Pattern_Action_Table.Last (Filters) loop |
| Patterns.Release (Filters.Table (F).Pattern.all); |
| Free (Filters.Table (F).Pattern); |
| Free (Filters.Table (F).Action); |
| end loop; |
| |
| for F in 1 .. File_Table.Last (Files) loop |
| Free (Files.Table (F)); |
| end loop; |
| |
| File_Table.Set_Last (Session.Data.Files, 0); |
| Field_Table.Set_Last (Session.Data.Fields, 0); |
| Pattern_Action_Table.Set_Last (Session.Data.Filters, 0); |
| |
| Session.Data.NR := 0; |
| Session.Data.FNR := 0; |
| Session.Data.File_Index := 0; |
| Session.Data.Current_Line := Null_Unbounded_String; |
| end Close; |
| |
| --------------------- |
| -- Current_Session -- |
| --------------------- |
| |
| function Current_Session return not null access Session_Type is |
| begin |
| return Cur_Session.Self; |
| end Current_Session; |
| |
| --------------------- |
| -- Default_Session -- |
| --------------------- |
| |
| function Default_Session return not null access Session_Type is |
| begin |
| return Def_Session.Self; |
| end Default_Session; |
| |
| -------------------- |
| -- Discrete_Field -- |
| -------------------- |
| |
| function Discrete_Field |
| (Rank : Count; |
| Session : Session_Type) return Discrete |
| is |
| begin |
| return Discrete'Value (Field (Rank, Session)); |
| end Discrete_Field; |
| |
| function Discrete_Field_Current_Session |
| (Rank : Count) return Discrete is |
| function Do_It is new Discrete_Field (Discrete); |
| begin |
| return Do_It (Rank, Cur_Session); |
| end Discrete_Field_Current_Session; |
| |
| ----------------- |
| -- End_Of_Data -- |
| ----------------- |
| |
| function End_Of_Data |
| (Session : Session_Type) return Boolean |
| is |
| begin |
| return Session.Data.File_Index = File_Table.Last (Session.Data.Files) |
| and then End_Of_File (Session); |
| end End_Of_Data; |
| |
| function End_Of_Data |
| return Boolean |
| is |
| begin |
| return End_Of_Data (Cur_Session); |
| end End_Of_Data; |
| |
| ----------------- |
| -- End_Of_File -- |
| ----------------- |
| |
| function End_Of_File |
| (Session : Session_Type) return Boolean |
| is |
| begin |
| return Text_IO.End_Of_File (Session.Data.Current_File); |
| end End_Of_File; |
| |
| function End_Of_File |
| return Boolean |
| is |
| begin |
| return End_Of_File (Cur_Session); |
| end End_Of_File; |
| |
| ----------- |
| -- Field -- |
| ----------- |
| |
| function Field |
| (Rank : Count; |
| Session : Session_Type) return String |
| is |
| Fields : Field_Table.Instance renames Session.Data.Fields; |
| |
| begin |
| if Rank > Number_Of_Fields (Session) then |
| Raise_With_Info |
| (Field_Error'Identity, |
| "Field number" & Count'Image (Rank) & " does not exist.", |
| Session); |
| |
| elsif Rank = 0 then |
| |
| -- Returns the whole line, this is what $0 does under Session_Type |
| |
| return To_String (Session.Data.Current_Line); |
| |
| else |
| return Slice (Session.Data.Current_Line, |
| Fields.Table (Positive (Rank)).First, |
| Fields.Table (Positive (Rank)).Last); |
| end if; |
| end Field; |
| |
| function Field |
| (Rank : Count) return String |
| is |
| begin |
| return Field (Rank, Cur_Session); |
| end Field; |
| |
| function Field |
| (Rank : Count; |
| Session : Session_Type) return Integer |
| is |
| begin |
| return Integer'Value (Field (Rank, Session)); |
| |
| exception |
| when Constraint_Error => |
| Raise_With_Info |
| (Field_Error'Identity, |
| "Field number" & Count'Image (Rank) |
| & " cannot be converted to an integer.", |
| Session); |
| end Field; |
| |
| function Field |
| (Rank : Count) return Integer |
| is |
| begin |
| return Field (Rank, Cur_Session); |
| end Field; |
| |
| function Field |
| (Rank : Count; |
| Session : Session_Type) return Float |
| is |
| begin |
| return Float'Value (Field (Rank, Session)); |
| |
| exception |
| when Constraint_Error => |
| Raise_With_Info |
| (Field_Error'Identity, |
| "Field number" & Count'Image (Rank) |
| & " cannot be converted to a float.", |
| Session); |
| end Field; |
| |
| function Field |
| (Rank : Count) return Float |
| is |
| begin |
| return Field (Rank, Cur_Session); |
| end Field; |
| |
| ---------- |
| -- File -- |
| ---------- |
| |
| function File |
| (Session : Session_Type) return String |
| is |
| Files : File_Table.Instance renames Session.Data.Files; |
| |
| begin |
| if Session.Data.File_Index = 0 then |
| return "??"; |
| else |
| return Files.Table (Session.Data.File_Index).all; |
| end if; |
| end File; |
| |
| function File |
| return String |
| is |
| begin |
| return File (Cur_Session); |
| end File; |
| |
| -------------------- |
| -- For_Every_Line -- |
| -------------------- |
| |
| procedure For_Every_Line |
| (Separators : String := Use_Current; |
| Filename : String := Use_Current; |
| Callbacks : Callback_Mode := None; |
| Session : Session_Type) |
| is |
| Quit : Boolean; |
| |
| begin |
| Open (Separators, Filename, Session); |
| |
| while not End_Of_Data (Session) loop |
| Read_Line (Session); |
| Split_Line (Session); |
| |
| if Callbacks in Only .. Pass_Through then |
| declare |
| Discard : Boolean; |
| begin |
| Discard := Apply_Filters (Session); |
| end; |
| end if; |
| |
| if Callbacks /= Only then |
| Quit := False; |
| Action (Quit); |
| exit when Quit; |
| end if; |
| end loop; |
| |
| Close (Session); |
| end For_Every_Line; |
| |
| procedure For_Every_Line_Current_Session |
| (Separators : String := Use_Current; |
| Filename : String := Use_Current; |
| Callbacks : Callback_Mode := None) |
| is |
| procedure Do_It is new For_Every_Line (Action); |
| begin |
| Do_It (Separators, Filename, Callbacks, Cur_Session); |
| end For_Every_Line_Current_Session; |
| |
| -------------- |
| -- Get_Line -- |
| -------------- |
| |
| procedure Get_Line |
| (Callbacks : Callback_Mode := None; |
| Session : Session_Type) |
| is |
| Filter_Active : Boolean; |
| |
| begin |
| if not Text_IO.Is_Open (Session.Data.Current_File) then |
| raise File_Error; |
| end if; |
| |
| loop |
| Read_Line (Session); |
| Split_Line (Session); |
| |
| case Callbacks is |
| |
| when None => |
| exit; |
| |
| when Only => |
| Filter_Active := Apply_Filters (Session); |
| exit when not Filter_Active; |
| |
| when Pass_Through => |
| Filter_Active := Apply_Filters (Session); |
| exit; |
| |
| end case; |
| end loop; |
| end Get_Line; |
| |
| procedure Get_Line |
| (Callbacks : Callback_Mode := None) |
| is |
| begin |
| Get_Line (Callbacks, Cur_Session); |
| end Get_Line; |
| |
| ---------------------- |
| -- Number_Of_Fields -- |
| ---------------------- |
| |
| function Number_Of_Fields |
| (Session : Session_Type) return Count |
| is |
| begin |
| return Count (Field_Table.Last (Session.Data.Fields)); |
| end Number_Of_Fields; |
| |
| function Number_Of_Fields |
| return Count |
| is |
| begin |
| return Number_Of_Fields (Cur_Session); |
| end Number_Of_Fields; |
| |
| -------------------------- |
| -- Number_Of_File_Lines -- |
| -------------------------- |
| |
| function Number_Of_File_Lines |
| (Session : Session_Type) return Count |
| is |
| begin |
| return Count (Session.Data.FNR); |
| end Number_Of_File_Lines; |
| |
| function Number_Of_File_Lines |
| return Count |
| is |
| begin |
| return Number_Of_File_Lines (Cur_Session); |
| end Number_Of_File_Lines; |
| |
| --------------------- |
| -- Number_Of_Files -- |
| --------------------- |
| |
| function Number_Of_Files |
| (Session : Session_Type) return Natural |
| is |
| Files : File_Table.Instance renames Session.Data.Files; |
| begin |
| return File_Table.Last (Files); |
| end Number_Of_Files; |
| |
| function Number_Of_Files |
| return Natural |
| is |
| begin |
| return Number_Of_Files (Cur_Session); |
| end Number_Of_Files; |
| |
| --------------------- |
| -- Number_Of_Lines -- |
| --------------------- |
| |
| function Number_Of_Lines |
| (Session : Session_Type) return Count |
| is |
| begin |
| return Count (Session.Data.NR); |
| end Number_Of_Lines; |
| |
| function Number_Of_Lines |
| return Count |
| is |
| begin |
| return Number_Of_Lines (Cur_Session); |
| end Number_Of_Lines; |
| |
| ---------- |
| -- Open -- |
| ---------- |
| |
| procedure Open |
| (Separators : String := Use_Current; |
| Filename : String := Use_Current; |
| Session : Session_Type) |
| is |
| begin |
| if Text_IO.Is_Open (Session.Data.Current_File) then |
| raise Session_Error; |
| end if; |
| |
| if Filename /= Use_Current then |
| File_Table.Init (Session.Data.Files); |
| Add_File (Filename, Session); |
| end if; |
| |
| if Separators /= Use_Current then |
| Set_Field_Separators (Separators, Session); |
| end if; |
| |
| Open_Next_File (Session); |
| |
| exception |
| when End_Error => |
| raise File_Error; |
| end Open; |
| |
| procedure Open |
| (Separators : String := Use_Current; |
| Filename : String := Use_Current) |
| is |
| begin |
| Open (Separators, Filename, Cur_Session); |
| end Open; |
| |
| -------------------- |
| -- Open_Next_File -- |
| -------------------- |
| |
| procedure Open_Next_File |
| (Session : Session_Type) |
| is |
| Files : File_Table.Instance renames Session.Data.Files; |
| |
| begin |
| if Text_IO.Is_Open (Session.Data.Current_File) then |
| Text_IO.Close (Session.Data.Current_File); |
| end if; |
| |
| Session.Data.File_Index := Session.Data.File_Index + 1; |
| |
| -- If there are no mores file in the table, raise End_Error |
| |
| if Session.Data.File_Index > File_Table.Last (Files) then |
| raise End_Error; |
| end if; |
| |
| Text_IO.Open |
| (File => Session.Data.Current_File, |
| Name => Files.Table (Session.Data.File_Index).all, |
| Mode => Text_IO.In_File); |
| end Open_Next_File; |
| |
| ----------- |
| -- Parse -- |
| ----------- |
| |
| procedure Parse |
| (Separators : String := Use_Current; |
| Filename : String := Use_Current; |
| Session : Session_Type) |
| is |
| Filter_Active : Boolean; |
| pragma Unreferenced (Filter_Active); |
| |
| begin |
| Open (Separators, Filename, Session); |
| |
| while not End_Of_Data (Session) loop |
| Get_Line (None, Session); |
| Filter_Active := Apply_Filters (Session); |
| end loop; |
| |
| Close (Session); |
| end Parse; |
| |
| procedure Parse |
| (Separators : String := Use_Current; |
| Filename : String := Use_Current) |
| is |
| begin |
| Parse (Separators, Filename, Cur_Session); |
| end Parse; |
| |
| --------------------- |
| -- Raise_With_Info -- |
| --------------------- |
| |
| procedure Raise_With_Info |
| (E : Exceptions.Exception_Id; |
| Message : String; |
| Session : Session_Type) |
| is |
| function Filename return String; |
| -- Returns current filename and "??" if this information is not |
| -- available. |
| |
| function Line return String; |
| -- Returns current line number without the leading space |
| |
| -------------- |
| -- Filename -- |
| -------------- |
| |
| function Filename return String is |
| File : constant String := AWK.File (Session); |
| begin |
| if File = "" then |
| return "??"; |
| else |
| return File; |
| end if; |
| end Filename; |
| |
| ---------- |
| -- Line -- |
| ---------- |
| |
| function Line return String is |
| L : constant String := Natural'Image (Session.Data.FNR); |
| begin |
| return L (2 .. L'Last); |
| end Line; |
| |
| -- Start of processing for Raise_With_Info |
| |
| begin |
| Exceptions.Raise_Exception |
| (E, |
| '[' & Filename & ':' & Line & "] " & Message); |
| raise Constraint_Error; -- to please GNAT as this is a No_Return proc |
| end Raise_With_Info; |
| |
| --------------- |
| -- Read_Line -- |
| --------------- |
| |
| procedure Read_Line (Session : Session_Type) is |
| |
| function Read_Line return String; |
| -- Read a line in the current file. This implementation is recursive |
| -- and does not have a limitation on the line length. |
| |
| NR : Natural renames Session.Data.NR; |
| FNR : Natural renames Session.Data.FNR; |
| |
| --------------- |
| -- Read_Line -- |
| --------------- |
| |
| function Read_Line return String is |
| Buffer : String (1 .. 1_024); |
| Last : Natural; |
| |
| begin |
| Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last); |
| |
| if Last = Buffer'Last then |
| return Buffer & Read_Line; |
| else |
| return Buffer (1 .. Last); |
| end if; |
| end Read_Line; |
| |
| -- Start of processing for Read_Line |
| |
| begin |
| if End_Of_File (Session) then |
| Open_Next_File (Session); |
| FNR := 0; |
| end if; |
| |
| Session.Data.Current_Line := To_Unbounded_String (Read_Line); |
| |
| NR := NR + 1; |
| FNR := FNR + 1; |
| end Read_Line; |
| |
| -------------- |
| -- Register -- |
| -------------- |
| |
| procedure Register |
| (Field : Count; |
| Pattern : String; |
| Action : Action_Callback; |
| Session : Session_Type) |
| is |
| Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; |
| U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern); |
| |
| begin |
| Pattern_Action_Table.Increment_Last (Filters); |
| |
| Filters.Table (Pattern_Action_Table.Last (Filters)) := |
| (Pattern => new Patterns.String_Pattern'(U_Pattern, Field), |
| Action => new Actions.Simple_Action'(Proc => Action)); |
| end Register; |
| |
| procedure Register |
| (Field : Count; |
| Pattern : String; |
| Action : Action_Callback) |
| is |
| begin |
| Register (Field, Pattern, Action, Cur_Session); |
| end Register; |
| |
| procedure Register |
| (Field : Count; |
| Pattern : GNAT.Regpat.Pattern_Matcher; |
| Action : Action_Callback; |
| Session : Session_Type) |
| is |
| Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; |
| |
| A_Pattern : constant Patterns.Pattern_Matcher_Access := |
| new Regpat.Pattern_Matcher'(Pattern); |
| begin |
| Pattern_Action_Table.Increment_Last (Filters); |
| |
| Filters.Table (Pattern_Action_Table.Last (Filters)) := |
| (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field), |
| Action => new Actions.Simple_Action'(Proc => Action)); |
| end Register; |
| |
| procedure Register |
| (Field : Count; |
| Pattern : GNAT.Regpat.Pattern_Matcher; |
| Action : Action_Callback) |
| is |
| begin |
| Register (Field, Pattern, Action, Cur_Session); |
| end Register; |
| |
| procedure Register |
| (Field : Count; |
| Pattern : GNAT.Regpat.Pattern_Matcher; |
| Action : Match_Action_Callback; |
| Session : Session_Type) |
| is |
| Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; |
| |
| A_Pattern : constant Patterns.Pattern_Matcher_Access := |
| new Regpat.Pattern_Matcher'(Pattern); |
| begin |
| Pattern_Action_Table.Increment_Last (Filters); |
| |
| Filters.Table (Pattern_Action_Table.Last (Filters)) := |
| (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field), |
| Action => new Actions.Match_Action'(Proc => Action)); |
| end Register; |
| |
| procedure Register |
| (Field : Count; |
| Pattern : GNAT.Regpat.Pattern_Matcher; |
| Action : Match_Action_Callback) |
| is |
| begin |
| Register (Field, Pattern, Action, Cur_Session); |
| end Register; |
| |
| procedure Register |
| (Pattern : Pattern_Callback; |
| Action : Action_Callback; |
| Session : Session_Type) |
| is |
| Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; |
| |
| begin |
| Pattern_Action_Table.Increment_Last (Filters); |
| |
| Filters.Table (Pattern_Action_Table.Last (Filters)) := |
| (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern), |
| Action => new Actions.Simple_Action'(Proc => Action)); |
| end Register; |
| |
| procedure Register |
| (Pattern : Pattern_Callback; |
| Action : Action_Callback) |
| is |
| begin |
| Register (Pattern, Action, Cur_Session); |
| end Register; |
| |
| procedure Register |
| (Action : Action_Callback; |
| Session : Session_Type) |
| is |
| begin |
| Register (Always_True'Access, Action, Session); |
| end Register; |
| |
| procedure Register |
| (Action : Action_Callback) |
| is |
| begin |
| Register (Action, Cur_Session); |
| end Register; |
| |
| ----------------- |
| -- Set_Current -- |
| ----------------- |
| |
| procedure Set_Current (Session : Session_Type) is |
| begin |
| Cur_Session.Data := Session.Data; |
| end Set_Current; |
| |
| -------------------------- |
| -- Set_Field_Separators -- |
| -------------------------- |
| |
| procedure Set_Field_Separators |
| (Separators : String := Default_Separators; |
| Session : Session_Type) |
| is |
| begin |
| Free (Session.Data.Separators); |
| |
| Session.Data.Separators := |
| new Split.Separator'(Separators'Length, Separators); |
| |
| -- If there is a current line read, split it according to the new |
| -- separators. |
| |
| if Session.Data.Current_Line /= Null_Unbounded_String then |
| Split_Line (Session); |
| end if; |
| end Set_Field_Separators; |
| |
| procedure Set_Field_Separators |
| (Separators : String := Default_Separators) |
| is |
| begin |
| Set_Field_Separators (Separators, Cur_Session); |
| end Set_Field_Separators; |
| |
| ---------------------- |
| -- Set_Field_Widths -- |
| ---------------------- |
| |
| procedure Set_Field_Widths |
| (Field_Widths : Widths_Set; |
| Session : Session_Type) |
| is |
| begin |
| Free (Session.Data.Separators); |
| |
| Session.Data.Separators := |
| new Split.Column'(Field_Widths'Length, Field_Widths); |
| |
| -- If there is a current line read, split it according to |
| -- the new separators. |
| |
| if Session.Data.Current_Line /= Null_Unbounded_String then |
| Split_Line (Session); |
| end if; |
| end Set_Field_Widths; |
| |
| procedure Set_Field_Widths |
| (Field_Widths : Widths_Set) |
| is |
| begin |
| Set_Field_Widths (Field_Widths, Cur_Session); |
| end Set_Field_Widths; |
| |
| ---------------- |
| -- Split_Line -- |
| ---------------- |
| |
| procedure Split_Line (Session : Session_Type) is |
| Fields : Field_Table.Instance renames Session.Data.Fields; |
| begin |
| Field_Table.Init (Fields); |
| Split.Current_Line (Session.Data.Separators.all, Session); |
| end Split_Line; |
| |
| ------------- |
| -- Get_Def -- |
| ------------- |
| |
| function Get_Def return Session_Data_Access is |
| begin |
| return Def_Session.Data; |
| end Get_Def; |
| |
| ------------- |
| -- Set_Cur -- |
| ------------- |
| |
| procedure Set_Cur is |
| begin |
| Cur_Session.Data := Def_Session.Data; |
| end Set_Cur; |
| |
| begin |
| -- We have declared two sessions but both should share the same data. |
| -- The current session must point to the default session as its initial |
| -- value. So first we release the session data then we set current |
| -- session data to point to default session data. |
| |
| Free (Cur_Session.Data); |
| Cur_Session.Data := Def_Session.Data; |
| end GNAT.AWK; |
