1491 lines
38 KiB
Ada
1491 lines
38 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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;
|