|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 8261 (0x2045)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Debug_Tools;
with Misc_String_Utilities;
package body Fields is
Is_Done : exception;
function Is_Null (This_Iterator : in Iterator) return Boolean is
begin
return (This_Iterator.The_Fields.all = "");
end Is_Null;
procedure Advance_Field_In (This_Iterator : in out Iterator) is
begin
This_Iterator.Characters_In_Current_Field := 0;
This_Iterator.Current_Field_Number :=
This_Iterator.Current_Field_Number + 1;
if (This_Iterator.Trailing_Separator_Position >
This_Iterator.The_Fields'Last) then
This_Iterator.Done := True;
end if;
loop
exit when (This_Iterator.Done);
This_Iterator.Trailing_Separator_Position :=
This_Iterator.Trailing_Separator_Position + 1;
exit when (This_Iterator.Trailing_Separator_Position >
This_Iterator.The_Fields'Last);
exit when (Is_Separator
(This_Iterator.The_Fields
(This_Iterator.Trailing_Separator_Position)));
This_Iterator.Characters_In_Current_Field :=
This_Iterator.Characters_In_Current_Field + 1;
end loop;
end Advance_Field_In;
procedure Set_State (This_Iterator : in out Iterator) is
begin
if (not Is_Null (This_Iterator)) then
This_Iterator.Trailing_Separator_Position :=
This_Iterator.The_Fields'First - 1;
This_Iterator.Characters_In_Current_Field := 0;
This_Iterator.Current_Field_Number := 0;
This_Iterator.Done := False;
Advance_Field_In (This_Iterator);
end if;
end Set_State;
function Create (From_String : in String) return Iterator is
--
New_Iterator : Iterator;
--
The_String : constant String (1 .. From_String'Length) := From_String;
--
begin
New_Iterator.The_Fields := new String'(The_String);
Set_State (New_Iterator);
return (New_Iterator);
end Create;
procedure Assert_Is_Initialized (This_Iterator : in Iterator) is
begin
if (This_Iterator.The_Fields = null) then
raise Not_Initialized;
end if;
end Assert_Is_Initialized;
function Done (This_Iterator : in Iterator) return Boolean is
begin
Assert_Is_Initialized (This_Iterator);
return (This_Iterator.Done);
end Done;
procedure Reset (This_Iterator : in out Iterator) is
begin
Assert_Is_Initialized (This_Iterator);
Set_State (This_Iterator);
end Reset;
procedure Assert_Not_Done (This_Iterator : in Iterator) is
begin
if (Done (This_Iterator)) then
raise Is_Done;
end if;
end Assert_Not_Done;
function Current_Field_Start (This_Iterator : in Iterator) return Natural is
begin
return (This_Iterator.Trailing_Separator_Position -
This_Iterator.Characters_In_Current_Field);
end Current_Field_Start;
function Current_Field_End (This_Iterator : in Iterator) return Natural is
begin
return (This_Iterator.Trailing_Separator_Position - 1);
end Current_Field_End;
function Current (This_Iterator : in Iterator) return Field is
begin
Assert_Not_Done (This_Iterator);
declare
The_Current_Field_Raw : constant String :=
This_Iterator.The_Fields (Current_Field_Start (This_Iterator) ..
Current_Field_End (This_Iterator));
The_Current_Field_Normalized :
constant String (1 .. The_Current_Field_Raw'Length) :=
The_Current_Field_Raw;
begin
return (The_Current_Field_Normalized);
end;
--
exception
when Is_Done =>
raise No_Current_Field;
end Current;
procedure Assert_Field_Valid (This_Field : in Field) is
begin
for Index in This_Field'Range loop
if (Is_Separator (This_Field (Index))) then
raise Parse_Failure;
end if;
end loop;
end Assert_Field_Valid;
procedure Modify (This_Iterator : in out Iterator; New_Field : in Field) is
--
Original_Position : constant Positive := Position (This_Iterator);
--
begin
Assert_Not_Done (This_Iterator);
Assert_Field_Valid (New_Field);
declare
New_Fields : constant String :=
Misc_String_Utilities.Replace
(From_Here => Current_Field_Start (This_Iterator),
To_Here => Current_Field_End (This_Iterator),
With_Substring => New_Field,
In_String => This_Iterator.The_Fields.all);
begin
This_Iterator.The_Fields.all := New_Fields;
end;
Set (This_Iterator, Original_Position);
--
exception
when Is_Done =>
raise No_Current_Field;
end Modify;
procedure Next (This_Iterator : in out Iterator) is
begin
Assert_Not_Done (This_Iterator);
Advance_Field_In (This_Iterator);
--
exception
when Is_Done =>
raise No_Next_Field;
end Next;
function Position (In_Iterator : in Iterator) return Field_Number is
begin
Assert_Not_Done (In_Iterator);
return (In_Iterator.Current_Field_Number);
end Position;
procedure Set (This_Iterator : in out Iterator;
To_Field : in Field_Number) is
begin
Reset (This_Iterator);
for Counter in 1 .. (To_Field - 1) loop
Next (This_Iterator);
end loop;
--
exception
when No_Next_Field =>
raise Out_Of_Range;
end Set;
function Field_At
(This_Position : in Field_Number; In_Iterator : in Iterator)
return Field is
--
The_Iterator : Iterator := In_Iterator;
--
Original_Position : Positive := Position (In_Iterator);
--
begin
Set (The_Iterator, This_Position);
declare
The_Field : constant String := Current (The_Iterator);
begin
Set (The_Iterator, Original_Position);
return (The_Field);
end;
end Field_At;
function Is_Empty (This_Iterator : in Iterator) return Boolean is
begin
Assert_Is_Initialized (This_Iterator);
return (Is_Null (This_Iterator));
end Is_Empty;
function Fields_In (This_Iterator : in Iterator) return Natural is
--
The_Iterator : Iterator := This_Iterator;
--
Original_Position : Positive := Position (The_Iterator);
--
begin
Assert_Is_Initialized (The_Iterator);
Reset (The_Iterator);
for Counter in 0 .. Integer'Last loop
if (Done (The_Iterator)) then
return (Counter);
end if;
Next (The_Iterator);
end loop;
end Fields_In;
-- ***** REGISTRATION OF TYPE IMAGES
function Fields_Image (These_Fields : in Iterator;
Level : in Natural;
Prefix : in String;
Expand_Pointers : in Boolean) return String is
begin
if (These_Fields.The_Fields = null) then
return ("<NOT INITIALIZED>");
else
return ("""" & These_Fields.The_Fields.all & """" &
Ascii.Lf & Prefix & " CURRENT FIELD NUMBER => " &
Natural'Image (These_Fields.Current_Field_Number) &
Ascii.Lf & Prefix & " CHARACTERS IN CURRENT FIELD => " &
Natural'Image (These_Fields.Characters_In_Current_Field) &
Ascii.Lf & Prefix & " TRAILING SEPARATOR POSITION => " &
Natural'Image (These_Fields.Trailing_Separator_Position) &
Ascii.Lf & Prefix & " DONE => " &
Boolean'Image (These_Fields.Done));
end if;
end Fields_Image;
procedure Register_Fields is
new Debug_Tools.Register (Iterator, Fields_Image);
begin
Register_Fields;
end Fields;