1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
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 Session's current line using split mode.
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 filename 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
)
143 -- Returns True if P match for the current session and False otherwise.
145 procedure Release
(P
: in out Pattern
);
146 -- Release memory used by the pattern structure.
148 --------------------------
149 -- Exact string pattern --
150 --------------------------
152 type String_Pattern
is new Pattern
with record
153 Str
: Unbounded_String
;
159 Session
: Session_Type
)
162 --------------------------------
163 -- Regular expression pattern --
164 --------------------------------
166 type Pattern_Matcher_Access
is access Regpat
.Pattern_Matcher
;
168 type Regexp_Pattern
is new Pattern
with record
169 Regx
: Pattern_Matcher_Access
;
175 Session
: Session_Type
)
178 procedure Release
(P
: in out Regexp_Pattern
);
180 ------------------------------
181 -- Boolean function pattern --
182 ------------------------------
184 type Callback_Pattern
is new Pattern
with record
185 Pattern
: Pattern_Callback
;
189 (P
: Callback_Pattern
;
190 Session
: Session_Type
)
195 procedure Free
is new Unchecked_Deallocation
196 (Patterns
.Pattern
'Class, Patterns
.Pattern_Access
);
202 -- Define all action style : simple call, call with matches
206 type Action
is abstract tagged null record;
207 -- This is the main type which is declared abstract. This type must be
208 -- derived for each action style.
210 type Action_Access
is access Action
'Class;
214 Session
: Session_Type
)
216 -- Call action A as required.
222 type Simple_Action
is new Action
with record
223 Proc
: Action_Callback
;
228 Session
: Session_Type
);
230 -------------------------
231 -- Action with matches --
232 -------------------------
234 type Match_Action
is new Action
with record
235 Proc
: Match_Action_Callback
;
240 Session
: Session_Type
);
244 procedure Free
is new Unchecked_Deallocation
245 (Actions
.Action
'Class, Actions
.Action_Access
);
247 --------------------------
248 -- Pattern/Action table --
249 --------------------------
251 type Pattern_Action
is record
252 Pattern
: Patterns
.Pattern_Access
; -- If Pattern is True
253 Action
: Actions
.Action_Access
; -- Action will be called
256 package Pattern_Action_Table
is
257 new Dynamic_Tables
(Pattern_Action
, Natural, 1, 5, 50);
263 type Session_Data
is record
264 Current_File
: Text_IO
.File_Type
;
265 Current_Line
: Unbounded_String
;
266 Separators
: Split
.Mode_Access
;
267 Files
: File_Table
.Instance
;
268 File_Index
: Natural := 0;
269 Fields
: Field_Table
.Instance
;
270 Filters
: Pattern_Action_Table
.Instance
;
273 Matches
: Regpat
.Match_Array
(0 .. 100);
274 -- latest matches for the regexp pattern
278 new Unchecked_Deallocation
(Session_Data
, Session_Data_Access
);
284 procedure Initialize
(Session
: in out Session_Type
) is
286 Session
.Data
:= new Session_Data
;
288 -- Initialize separators
290 Session
.Data
.Separators
:=
291 new Split
.Separator
'(Default_Separators'Length, Default_Separators);
293 -- Initialize all tables
295 File_Table.Init (Session.Data.Files);
296 Field_Table.Init (Session.Data.Fields);
297 Pattern_Action_Table.Init (Session.Data.Filters);
300 -----------------------
301 -- Session Variables --
302 -----------------------
304 -- These must come after the body of Initialize, since they make
305 -- implicit calls to Initialize at elaboration time.
307 Def_Session : Session_Type;
308 Cur_Session : Session_Type;
314 -- Note: Finalize must come after Initialize and the definition
315 -- of the Def_Session and Cur_Session variables, since it references
318 procedure Finalize (Session : in out Session_Type) is
320 -- We release the session data only if it is not the default session.
322 if Session.Data /= Def_Session.Data then
325 -- Since we have closed the current session, set it to point
326 -- now to the default session.
328 Cur_Session.Data := Def_Session.Data;
332 ----------------------
333 -- Private Services --
334 ----------------------
336 function Always_True return Boolean;
337 -- A function that always returns True.
339 function Apply_Filters
340 (Session : Session_Type := Current_Session)
342 -- Apply any filters for which the Pattern is True for Session. It returns
343 -- True if a least one filters has been applied (i.e. associated action
344 -- callback has been called).
346 procedure Open_Next_File
347 (Session : Session_Type := Current_Session);
348 pragma Inline (Open_Next_File);
349 -- Open next file for Session closing current file if needed. It raises
350 -- End_Error if there is no more file in the table.
352 procedure Raise_With_Info
353 (E : Exceptions.Exception_Id;
355 Session : Session_Type);
356 pragma No_Return (Raise_With_Info);
357 -- Raises exception E with the message prepended with the current line
358 -- number and the filename if possible.
360 procedure Read_Line (Session : Session_Type);
361 -- Read a line for the Session and set Current_Line.
363 procedure Split_Line (Session : Session_Type);
364 -- Split session's Current_Line according to the session separators and
365 -- set the Fields table. This procedure can be called at any time.
367 ----------------------
368 -- Private Packages --
369 ----------------------
375 package body Actions is
383 Session : Session_Type)
385 pragma Warnings (Off, Session);
397 Session : Session_Type)
400 A.Proc (Session.Data.Matches);
409 package body Patterns is
417 Session : Session_Type)
421 return P.Str = Field (P.Rank, Session);
430 Session : Session_Type)
433 use type Regpat.Match_Location;
437 (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
438 return Session.Data.Matches (0) /= Regpat.No_Match;
446 (P : Callback_Pattern;
447 Session : Session_Type)
450 pragma Warnings (Off, Session);
453 return P.Pattern.all;
460 procedure Release (P : in out Pattern) is
461 pragma Warnings (Off, P);
471 procedure Release (P : in out Regexp_Pattern) is
472 procedure Free is new Unchecked_Deallocation
473 (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
485 package body Split is
493 procedure Current_Line (S : Separator; Session : Session_Type) is
494 Line : constant String := To_String (Session.Data.Current_Line);
495 Fields : Field_Table.Instance renames Session.Data.Fields;
500 Seps : Maps.Character_Set := Maps.To_Set (S.Separators);
503 -- First field start here
507 -- Record the first field start position which is the first character
510 Field_Table.Increment_Last (Fields);
511 Fields.Table (Field_Table.Last (Fields)).First := Start;
514 -- Look for next separator
517 (Source => Line (Start .. Line'Last),
522 Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
524 -- if separators are set to the default (space and tab) we skip
525 -- all spaces and tabs following current field.
527 if S.Separators = Default_Separators then
529 (Line (Stop + 1 .. Line'Last),
530 Maps.To_Set (Default_Separators),
537 -- Record in the field table the start of this new field
539 Field_Table.Increment_Last (Fields);
540 Fields.Table (Field_Table.Last (Fields)).First := Start;
544 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
551 procedure Current_Line (S : Column; Session : Session_Type) is
552 Line : constant String := To_String (Session.Data.Current_Line);
553 Fields : Field_Table.Instance renames Session.Data.Fields;
554 Start : Positive := Line'First;
557 -- Record the first field start position which is the first character
560 for C in 1 .. S.Columns'Length loop
562 Field_Table.Increment_Last (Fields);
564 Fields.Table (Field_Table.Last (Fields)).First := Start;
566 Start := Start + S.Columns (C);
568 Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
572 -- If there is some remaining character on the line, add them in a
575 if Start - 1 < Line'Length then
577 Field_Table.Increment_Last (Fields);
579 Fields.Table (Field_Table.Last (Fields)).First := Start;
581 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
593 Session : Session_Type := Current_Session)
595 Files : File_Table.Instance renames Session.Data.Files;
598 if OS_Lib.Is_Regular_File (Filename) then
599 File_Table.Increment_Last (Files);
600 Files.Table (File_Table.Last (Files)) := new String'(Filename
);
603 (File_Error
'Identity,
604 "File " & Filename
& " not found.",
616 Number_Of_Files_Added
: out Natural;
617 Session
: Session_Type
:= Current_Session
)
619 use Directory_Operations
;
622 Filename
: String (1 .. 200);
626 Number_Of_Files_Added
:= 0;
628 Open
(Dir
, Directory
);
631 Read
(Dir
, Filename
, Last
);
634 Add_File
(Filename
(1 .. Last
), Session
);
635 Number_Of_Files_Added
:= Number_Of_Files_Added
+ 1;
643 (File_Error
'Identity,
644 "Error scaning directory " & Directory
645 & " for files " & Filenames
& '.',
653 function Always_True
return Boolean is
662 function Apply_Filters
663 (Session
: Session_Type
:= Current_Session
)
666 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
667 Results
: Boolean := False;
670 -- Iterate through the filters table, if pattern match call action.
672 for F
in 1 .. Pattern_Action_Table
.Last
(Filters
) loop
673 if Patterns
.Match
(Filters
.Table
(F
).Pattern
.all, Session
) then
675 Actions
.Call
(Filters
.Table
(F
).Action
.all, Session
);
686 procedure Close
(Session
: Session_Type
) is
687 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
688 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
691 -- Close current file if needed
693 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
694 Text_IO
.Close
(Session
.Data
.Current_File
);
697 -- Release separators
699 Free
(Session
.Data
.Separators
);
701 -- Release Filters table
703 for F
in 1 .. Pattern_Action_Table
.Last
(Filters
) loop
704 Patterns
.Release
(Filters
.Table
(F
).Pattern
.all);
705 Free
(Filters
.Table
(F
).Pattern
);
706 Free
(Filters
.Table
(F
).Action
);
709 for F
in 1 .. File_Table
.Last
(Files
) loop
710 Free
(Files
.Table
(F
));
713 File_Table
.Set_Last
(Session
.Data
.Files
, 0);
714 Field_Table
.Set_Last
(Session
.Data
.Fields
, 0);
715 Pattern_Action_Table
.Set_Last
(Session
.Data
.Filters
, 0);
717 Session
.Data
.NR
:= 0;
718 Session
.Data
.FNR
:= 0;
719 Session
.Data
.File_Index
:= 0;
720 Session
.Data
.Current_Line
:= Null_Unbounded_String
;
723 ---------------------
724 -- Current_Session --
725 ---------------------
727 function Current_Session
return Session_Type
is
732 ---------------------
733 -- Default_Session --
734 ---------------------
736 function Default_Session
return Session_Type
is
745 function Discrete_Field
747 Session
: Session_Type
:= Current_Session
)
751 return Discrete
'Value (Field
(Rank
, Session
));
759 (Session
: Session_Type
:= Current_Session
)
763 return Session
.Data
.File_Index
= File_Table
.Last
(Session
.Data
.Files
)
764 and then End_Of_File
(Session
);
772 (Session
: Session_Type
:= Current_Session
)
776 return Text_IO
.End_Of_File
(Session
.Data
.Current_File
);
785 Session
: Session_Type
:= Current_Session
)
788 Fields
: Field_Table
.Instance
renames Session
.Data
.Fields
;
791 if Rank
> Number_Of_Fields
(Session
) then
793 (Field_Error
'Identity,
794 "Field number" & Count
'Image (Rank
) & " does not exist.",
799 -- Returns the whole line, this is what $0 does under Session_Type.
801 return To_String
(Session
.Data
.Current_Line
);
804 return Slice
(Session
.Data
.Current_Line
,
805 Fields
.Table
(Positive (Rank
)).First
,
806 Fields
.Table
(Positive (Rank
)).Last
);
812 Session
: Session_Type
:= Current_Session
)
816 return Integer'Value (Field
(Rank
, Session
));
819 when Constraint_Error
=>
821 (Field_Error
'Identity,
822 "Field number" & Count
'Image (Rank
)
823 & " cannot be converted to an integer.",
829 Session
: Session_Type
:= Current_Session
)
833 return Float'Value (Field
(Rank
, Session
));
836 when Constraint_Error
=>
838 (Field_Error
'Identity,
839 "Field number" & Count
'Image (Rank
)
840 & " cannot be converted to a float.",
849 (Session
: Session_Type
:= Current_Session
)
852 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
855 if Session
.Data
.File_Index
= 0 then
858 return Files
.Table
(Session
.Data
.File_Index
).all;
866 procedure For_Every_Line
867 (Separators
: String := Use_Current
;
868 Filename
: String := Use_Current
;
869 Callbacks
: Callback_Mode
:= None
;
870 Session
: Session_Type
:= Current_Session
)
872 Filter_Active
: Boolean;
876 Open
(Separators
, Filename
, Session
);
878 while not End_Of_Data
(Session
) loop
880 Split_Line
(Session
);
882 if Callbacks
in Only
.. Pass_Through
then
883 Filter_Active
:= Apply_Filters
(Session
);
886 if Callbacks
/= Only
then
901 (Callbacks
: Callback_Mode
:= None
;
902 Session
: Session_Type
:= Current_Session
)
904 Filter_Active
: Boolean;
907 if not Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
913 Split_Line
(Session
);
921 Filter_Active
:= Apply_Filters
(Session
);
922 exit when not Filter_Active
;
925 Filter_Active
:= Apply_Filters
(Session
);
932 ----------------------
933 -- Number_Of_Fields --
934 ----------------------
936 function Number_Of_Fields
937 (Session
: Session_Type
:= Current_Session
)
941 return Count
(Field_Table
.Last
(Session
.Data
.Fields
));
942 end Number_Of_Fields
;
944 --------------------------
945 -- Number_Of_File_Lines --
946 --------------------------
948 function Number_Of_File_Lines
949 (Session
: Session_Type
:= Current_Session
)
953 return Count
(Session
.Data
.FNR
);
954 end Number_Of_File_Lines
;
956 ---------------------
957 -- Number_Of_Files --
958 ---------------------
960 function Number_Of_Files
961 (Session
: Session_Type
:= Current_Session
)
964 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
967 return File_Table
.Last
(Files
);
970 ---------------------
971 -- Number_Of_Lines --
972 ---------------------
974 function Number_Of_Lines
975 (Session
: Session_Type
:= Current_Session
)
979 return Count
(Session
.Data
.NR
);
987 (Separators
: String := Use_Current
;
988 Filename
: String := Use_Current
;
989 Session
: Session_Type
:= Current_Session
)
992 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
996 if Filename
/= Use_Current
then
997 File_Table
.Init
(Session
.Data
.Files
);
998 Add_File
(Filename
, Session
);
1001 if Separators
/= Use_Current
then
1002 Set_Field_Separators
(Separators
, Session
);
1005 Open_Next_File
(Session
);
1012 --------------------
1013 -- Open_Next_File --
1014 --------------------
1016 procedure Open_Next_File
1017 (Session
: Session_Type
:= Current_Session
)
1019 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
1022 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
1023 Text_IO
.Close
(Session
.Data
.Current_File
);
1026 Session
.Data
.File_Index
:= Session
.Data
.File_Index
+ 1;
1028 -- If there are no mores file in the table, raise End_Error
1030 if Session
.Data
.File_Index
> File_Table
.Last
(Files
) then
1035 (File
=> Session
.Data
.Current_File
,
1036 Name
=> Files
.Table
(Session
.Data
.File_Index
).all,
1037 Mode
=> Text_IO
.In_File
);
1045 (Separators
: String := Use_Current
;
1046 Filename
: String := Use_Current
;
1047 Session
: Session_Type
:= Current_Session
)
1049 Filter_Active
: Boolean;
1051 Open
(Separators
, Filename
, Session
);
1053 while not End_Of_Data
(Session
) loop
1054 Get_Line
(None
, Session
);
1055 Filter_Active
:= Apply_Filters
(Session
);
1061 ---------------------
1062 -- Raise_With_Info --
1063 ---------------------
1065 procedure Raise_With_Info
1066 (E
: Exceptions
.Exception_Id
;
1068 Session
: Session_Type
)
1070 function Filename
return String;
1071 -- Returns current filename and "??" if the informations is not
1074 function Line
return String;
1075 -- Returns current line number without the leading space
1081 function Filename
return String is
1082 File
: constant String := AWK
.File
(Session
);
1096 function Line
return String is
1097 L
: constant String := Natural'Image (Session
.Data
.FNR
);
1100 return L
(2 .. L
'Last);
1103 -- Start of processing for Raise_With_Info
1106 Exceptions
.Raise_Exception
1108 '[' & Filename
& ':' & Line
& "] " & Message
);
1109 raise Constraint_Error
; -- to please GNAT as this is a No_Return proc
1110 end Raise_With_Info
;
1116 procedure Read_Line
(Session
: Session_Type
) is
1118 function Read_Line
return String;
1119 -- Read a line in the current file. This implementation is recursive
1120 -- and does not have a limitation on the line length.
1122 NR
: Natural renames Session
.Data
.NR
;
1123 FNR
: Natural renames Session
.Data
.FNR
;
1125 function Read_Line
return String is
1126 Buffer
: String (1 .. 1_024
);
1130 Text_IO
.Get_Line
(Session
.Data
.Current_File
, Buffer
, Last
);
1132 if Last
= Buffer
'Last then
1133 return Buffer
& Read_Line
;
1135 return Buffer
(1 .. Last
);
1139 -- Start of processing for Read_Line
1142 if End_Of_File
(Session
) then
1143 Open_Next_File
(Session
);
1147 Session
.Data
.Current_Line
:= To_Unbounded_String
(Read_Line
);
1160 Action
: Action_Callback
;
1161 Session
: Session_Type
:= Current_Session
)
1163 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1164 U_Pattern
: constant Unbounded_String
:= To_Unbounded_String
(Pattern
);
1167 Pattern_Action_Table
.Increment_Last
(Filters
);
1169 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1170 (Pattern
=> new Patterns
.String_Pattern
'(U_Pattern, Field),
1171 Action => new Actions.Simple_Action'(Proc
=> Action
));
1176 Pattern
: GNAT
.Regpat
.Pattern_Matcher
;
1177 Action
: Action_Callback
;
1178 Session
: Session_Type
:= Current_Session
)
1180 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1182 A_Pattern
: Patterns
.Pattern_Matcher_Access
:=
1183 new Regpat
.Pattern_Matcher
'(Pattern);
1185 Pattern_Action_Table.Increment_Last (Filters);
1187 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1188 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern
, Field
),
1189 Action
=> new Actions
.Simple_Action
'(Proc => Action));
1194 Pattern : GNAT.Regpat.Pattern_Matcher;
1195 Action : Match_Action_Callback;
1196 Session : Session_Type := Current_Session)
1198 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1200 A_Pattern : Patterns.Pattern_Matcher_Access :=
1201 new Regpat.Pattern_Matcher'(Pattern
);
1203 Pattern_Action_Table
.Increment_Last
(Filters
);
1205 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1206 (Pattern
=> new Patterns
.Regexp_Pattern
'(A_Pattern, Field),
1207 Action => new Actions.Match_Action'(Proc
=> Action
));
1211 (Pattern
: Pattern_Callback
;
1212 Action
: Action_Callback
;
1213 Session
: Session_Type
:= Current_Session
)
1215 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1218 Pattern_Action_Table
.Increment_Last
(Filters
);
1220 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1221 (Pattern
=> new Patterns
.Callback_Pattern
'(Pattern => Pattern),
1222 Action => new Actions.Simple_Action'(Proc
=> Action
));
1226 (Action
: Action_Callback
;
1227 Session
: Session_Type
:= Current_Session
)
1230 Register
(Always_True
'Access, Action
, Session
);
1237 procedure Set_Current
(Session
: Session_Type
) is
1239 Cur_Session
.Data
:= Session
.Data
;
1242 --------------------------
1243 -- Set_Field_Separators --
1244 --------------------------
1246 procedure Set_Field_Separators
1247 (Separators
: String := Default_Separators
;
1248 Session
: Session_Type
:= Current_Session
)
1251 Free
(Session
.Data
.Separators
);
1253 Session
.Data
.Separators
:=
1254 new Split
.Separator
'(Separators'Length, Separators);
1256 -- If there is a current line read, split it according to the new
1259 if Session.Data.Current_Line /= Null_Unbounded_String then
1260 Split_Line (Session);
1262 end Set_Field_Separators;
1264 ----------------------
1265 -- Set_Field_Widths --
1266 ----------------------
1268 procedure Set_Field_Widths
1269 (Field_Widths : Widths_Set;
1270 Session : Session_Type := Current_Session) is
1273 Free (Session.Data.Separators);
1275 Session.Data.Separators :=
1276 new Split.Column'(Field_Widths
'Length, Field_Widths
);
1278 -- If there is a current line read, split it according to
1279 -- the new separators.
1281 if Session
.Data
.Current_Line
/= Null_Unbounded_String
then
1282 Split_Line
(Session
);
1284 end Set_Field_Widths
;
1290 procedure Split_Line
(Session
: Session_Type
) is
1291 Fields
: Field_Table
.Instance
renames Session
.Data
.Fields
;
1294 Field_Table
.Init
(Fields
);
1296 Split
.Current_Line
(Session
.Data
.Separators
.all, Session
);
1300 -- We have declared two sessions but both should share the same data.
1301 -- The current session must point to the default session as its initial
1302 -- value. So first we release the session data then we set current
1303 -- session data to point to default session data.
1305 Free
(Cur_Session
.Data
);
1306 Cur_Session
.Data
:= Def_Session
.Data
;