File : strings-fields.adb
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Text_IO; use Text_IO;
package body Strings.Fields is
--------------
-- Is_Space --
--------------
function Is_Space (Item : Character) return Boolean is
begin
return Item = ' ' or else Item = Ascii.HT;
end;
------------------
-- Select_Field --
------------------
-- Returns a string that represents the nth string in the field.
-- The 'first of the return string is always set to one
--
function Select_Field (
Item : String;
Field_No : Integer;
Field_Separator : Character) return String
is
First : constant Integer := Item'first;
Last : constant Integer := Item'Last;
Start : Natural;
Finish : Natural;
Field : Natural := 1;
----------------------
-- Search_Backwards --
----------------------
procedure Search_Backwards (
Start : in out Natural;
Finish : in out Natural;
Field_No : in Natural)
is
Field : Natural := 1;
begin
-- find the start of the field
-- Post condition : Start points at the char following
-- the n-1th sep. char, or past the last char in the string
loop
exit when Finish < First or else Field = Field_No;
if Item (Finish) = Field_Separator then
Field := Field + 1;
end if;
Finish := Finish - 1;
end loop;
-- Find the end of the field
-- Finish points at the end of the appropriate bit
Start := Finish;
loop
exit when Start < First or else
Item (Start) = Field_Separator;
Start := Start - 1;
end loop;
Start := Start + 1;
end Search_Backwards;
---------------------
-- Search_Forwards --
---------------------
procedure Search_Forwards (
Start : in out Natural;
Finish : in out Natural;
Field_No : in Natural)
is
Field : Natural := 1;
begin
-- find the start of the field
-- Post condition : Start points at the char following
-- the n-1th sep. char, or past the last char in the string
loop
exit when Start > Last or else Field = Field_No;
if Item (Start) = Field_Separator then
Field := Field + 1;
end if;
Start := Start + 1;
end loop;
-- Find the end of the field
-- Start points at the start of the appropriate bit
Finish := Start;
loop
exit when Finish > Last or else
Item (Finish) = Field_Separator;
Finish := Finish + 1;
end loop;
Finish := Finish - 1;
end Search_Forwards;
begin
if Field_No > 0 then
Start := First;
Finish := First;
Search_Forwards (Start, Finish, Field_No);
elsif Field_No < 0 then
Start := Last;
Finish := Last;
Search_Backwards (Start, Finish, abs Field_No);
else
raise Constraint_Error;
end if;
-- Make a subtype conversion to a string with diff.
-- bounds. Forces the 'first to be 1, which makes life
-- simipler for the caller
declare
subtype Slide is String (1..Finish - Start + 1);
begin
return Slide (Item (Start..Finish));
end;
end Select_Field;
------------------
-- Count_Fields --
------------------
function Count_Fields (
Item : String;
Field_Separator : Character) return Natural
is
Count : Positive;
begin
if Item'Length = 0 then
return 0;
else
Count := 1;
for i in Item'Range loop
if Item (i) = Field_Separator then
Count := Count + 1;
end if;
end loop;
end if;
return Count;
end Count_Fields;
------------------
-- Select_Field --
------------------
function Select_Field (
Item : String;
Field_No : Integer) return String
is
First : constant Integer := Item'first;
Last : constant Integer := Item'Last;
Start : Natural;
Finish : Natural;
--------------------
-- Search_Forward --
--------------------
procedure Search_Forwards (
Start : in out Natural;
Finish : in out Natural;
Field_No : in Positive)
is
Field : Natural := 0;
----------------
-- Skip_Space --
----------------
-- Postcondition : Ptr points at a non space char, or beyond the
-- end of the array
procedure Skip_Space (Ptr : in out Positive) is
begin
while (Ptr <= Last) and then (Is_Space (Item (Ptr))) loop
Ptr := Ptr + 1;
end loop;
end;
pragma Inline (Skip_Space);
--------------------
-- Skip_Non_Space --
--------------------
procedure Skip_Non_Space (Ptr : in out Positive) is
begin
while Ptr <= Last and then not Is_Space (Item (Ptr)) loop
Ptr := Ptr + 1;
end loop;
end;
pragma Inline (Skip_Non_Space);
begin
loop
Skip_Space (Start);
Field := Field + 1;
exit when Start > Last or else Field = Field_No;
Skip_Non_Space (Start);
end loop;
Finish := Start;
Skip_Non_Space (Finish);
-- Finish will point one beyond the end, or at the end of
-- the list. (how can we tell!)
Finish := Finish - 1;
end Search_Forwards;
----------------------
-- Search_Backwards --
----------------------
procedure Search_Backwards (
Start : in out Natural;
Finish : in out Natural;
Field_No : in Positive)
is
Field : Natural := 0;
----------------
-- Skip_Space --
----------------
-- Postcondition : Ptr points at a non space char, or before the
-- start of the array
procedure Skip_Space (Ptr : in out Natural) is
begin
while (Ptr >= First) and then (Is_Space (Item (Ptr))) loop
Ptr := Ptr - 1;
end loop;
end;
pragma Inline (Skip_Space);
--------------------
-- Skip_Non_Space --
--------------------
procedure Skip_Non_Space (Ptr : in out Natural) is
begin
while Ptr >= First and then not Is_Space (Item (Ptr)) loop
Ptr := Ptr - 1;
end loop;
end;
pragma Inline (Skip_Non_Space);
begin
loop
Skip_Space (Finish);
Field := Field + 1;
exit when Finish < First or else Field = Field_No;
Skip_Non_Space (Finish);
end loop;
Start := Finish;
Skip_Non_Space (Start);
-- Start will point one before the start
Start := Start + 1;
end Search_Backwards;
begin
if Field_No > 0 then
Start := First;
Finish := First;
Search_Forwards (Start, Finish, Field_No);
elsif Field_No < 0 then
Start := Last;
Finish := Last;
Search_Backwards (Start, Finish, abs Field_No);
else
raise Constraint_Error;
end if;
-- Make a subtype conversion to a string with diff.
-- bounds. Forces the 'first to be 1, which makes life
-- simipler for the caller
declare
subtype Slide is String (1..Finish - Start + 1);
begin
return Slide (Item (Start..Finish));
end;
end Select_Field;
-------------------
-- Select_Fields --
-------------------
function Select_Fields (
Line : String;
Format : String) return String is
Result : Unbounded_String;
Count : Positive := 1;
begin
-- extract each number from the format string.
-- then use that to build up a the resulting string
loop
declare
Selected_Field_String : constant String := Select_Field (Format, Count);
Selected_Field : Positive;
-- if this raises a constraint error, then the user has to
-- deal with it.
begin
-- we have run out of format numbers, so our job is done
exit when Selected_Field_String = "";
Selected_Field := Integer'Value (Selected_Field_String);
-- if this raises a constraint error, then the user has to
-- deal with it.
if Count /= 1 then
Append (Result, ' ');
end if;
Append (Result, Select_Field (Line, Selected_Field));
Count := Count + 1;
end;
end loop;
return To_String (Result);
end Select_Fields;
------------------
-- Build_String --
------------------
-- Format effector allows for $1, $2..$n to select a field.
-- $* represents all the fields.
-- $$ represents the characer '$'
-- Other characters in the format string are copied verbatim into
-- the output string
-- E.g.
-- Build_String ("cat mouse dog", "The $1 ate the $2")
-- would result in the string..
-- "The cat ate the mouse"
--
-- Written with global variables and pragma Inline to ensure
-- that the code is as fast as it can get. As this routine
-- is likely to sit inside loops (typically through processing
-- a file) this is quite important.
Format_Char : constant Character := '$';
Entire_Line : constant Character := '*';
function Build_String (
Line : String;
Format : String) return String
is
First : constant Natural := Format'First;
Last : constant Natural := Format'Last;
Result : Unbounded_String;
Start : Positive := First;
Count : Positive := Start;
----------------
-- Skip_Chars --
----------------
procedure Skip_Chars is
begin
loop
exit when Count > Last
or else Format (Count) = Format_Char;
Count := Count + 1;
end loop;
end Skip_Chars;
pragma Inline (Skip_Chars);
--------------
-- Optional --
--------------
procedure Optional (Char : Character) is
begin
if Format (Count) = Char then
Count := Count + 1;
end if;
end;
pragma Inline (Optional);
-----------
-- Digit --
-----------
procedure Digit (Ok : out Boolean) is
begin
Ok := Format (Count) in '0'..'9';
if Ok then
Count := Count + 1;
end if;
end Digit;
pragma Inline (Digit);
---------
-- Int --
---------
procedure Int (Ok : out Boolean) is
Digit_Char_Found : Boolean;
begin
Optional ('-');
Digit (Ok);
loop
exit when Count > Last;
Digit (Digit_Char_Found);
exit when not Digit_Char_Found;
end loop;
end;
pragma Inline (Int);
begin
loop
-- Grab characters up to the first format character
Start := Count;
Skip_Chars;
Append (Result, Format (Start..Count - 1));
-- either we are at the end of the line, or we
-- have found a Format_Char
exit when Count > Last;
if Count = Last then
raise Format_Error;
else
-- Consume the Format_Char
Count := Count + 1;
case Format (Count) is
when Format_Char =>
-- $$, append the '$'
Append (Result, Format_Char);
Count := Count + 1;
when Entire_Line =>
Append (Result, Line);
-- consume the '*' character
Count := Count + 1;
when others =>
-- should be a number. Won't _just_ check for a positive,
-- as we expect to eventually have -ve values as well
-- (which will represent fields counted from the right
-- of the string
declare
Selected_Field : Integer;
Ok : Boolean;
begin
Start := Count;
Int (Ok);
if not Ok then
raise Format_Error;
end if;
Selected_Field := Integer'Value (Format (Start..Count - 1));
-- Although the digits were checked (int (ok)), a large
-- # will still result in o/flow.
Append (Result, Select_Field (Line, Selected_Field));
exception
when others =>
raise Format_Error;
end;
end case;
end if;
end loop;
return To_String (Result);
end Build_String;
end Strings.Fields;