1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
31 ------------------------------------------------------------------------------
33 pragma Style_Checks
(All_Checks
);
34 -- Turn off alpha ordering check for subprograms, since we cannot
35 -- Put Finalize and Initialize in alpha order (see comments).
39 with Ada
.Strings
.Unbounded
;
40 with Ada
.Strings
.Fixed
;
41 with Ada
.Strings
.Maps
;
42 with Ada
.Unchecked_Deallocation
;
44 with GNAT
.Directory_Operations
;
45 with GNAT
.Dynamic_Tables
;
48 package body GNAT
.AWK
is
51 use Ada
.Strings
.Unbounded
;
59 type Mode
is abstract tagged null record;
60 -- This is the main type which is declared abstract. This type must be
61 -- derived for each split style.
63 type Mode_Access
is access Mode
'Class;
65 procedure Current_Line
(S
: Mode
; Session
: Session_Type
)
67 -- Split Session's current line using split mode.
69 ------------------------
70 -- Split on separator --
71 ------------------------
73 type Separator
(Size
: Positive) is new Mode
with record
74 Separators
: String (1 .. Size
);
77 procedure Current_Line
79 Session
: Session_Type
);
85 type Column
(Size
: Positive) is new Mode
with record
86 Columns
: Widths_Set
(1 .. Size
);
89 procedure Current_Line
(S
: Column
; Session
: Session_Type
);
93 procedure Free
is new Unchecked_Deallocation
94 (Split
.Mode
'Class, Split
.Mode_Access
);
100 type AWK_File
is access String;
102 package File_Table
is
103 new Dynamic_Tables
(AWK_File
, Natural, 1, 5, 50);
104 -- List of filename associated with a Session.
106 procedure Free
is new Unchecked_Deallocation
(String, AWK_File
);
112 type Field_Slice
is record
116 -- This is a field slice (First .. Last) in session's current line.
118 package Field_Table
is
119 new Dynamic_Tables
(Field_Slice
, Natural, 1, 10, 100);
120 -- List of fields for the current line.
126 -- Define all patterns style : exact string, regular expression, boolean
131 type Pattern
is abstract tagged null record;
132 -- This is the main type which is declared abstract. This type must be
133 -- derived for each patterns style.
135 type Pattern_Access
is access Pattern
'Class;
139 Session
: Session_Type
)
142 -- Returns True if P match for the current session and False otherwise.
144 procedure Release
(P
: in out Pattern
);
145 -- Release memory used by the pattern structure.
147 --------------------------
148 -- Exact string pattern --
149 --------------------------
151 type String_Pattern
is new Pattern
with record
152 Str
: Unbounded_String
;
158 Session
: Session_Type
)
161 --------------------------------
162 -- Regular expression pattern --
163 --------------------------------
165 type Pattern_Matcher_Access
is access Regpat
.Pattern_Matcher
;
167 type Regexp_Pattern
is new Pattern
with record
168 Regx
: Pattern_Matcher_Access
;
174 Session
: Session_Type
)
177 procedure Release
(P
: in out Regexp_Pattern
);
179 ------------------------------
180 -- Boolean function pattern --
181 ------------------------------
183 type Callback_Pattern
is new Pattern
with record
184 Pattern
: Pattern_Callback
;
188 (P
: Callback_Pattern
;
189 Session
: Session_Type
)
194 procedure Free
is new Unchecked_Deallocation
195 (Patterns
.Pattern
'Class, Patterns
.Pattern_Access
);
201 -- Define all action style : simple call, call with matches
205 type Action
is abstract tagged null record;
206 -- This is the main type which is declared abstract. This type must be
207 -- derived for each action style.
209 type Action_Access
is access Action
'Class;
213 Session
: Session_Type
)
215 -- Call action A as required.
221 type Simple_Action
is new Action
with record
222 Proc
: Action_Callback
;
227 Session
: Session_Type
);
229 -------------------------
230 -- Action with matches --
231 -------------------------
233 type Match_Action
is new Action
with record
234 Proc
: Match_Action_Callback
;
239 Session
: Session_Type
);
243 procedure Free
is new Unchecked_Deallocation
244 (Actions
.Action
'Class, Actions
.Action_Access
);
246 --------------------------
247 -- Pattern/Action table --
248 --------------------------
250 type Pattern_Action
is record
251 Pattern
: Patterns
.Pattern_Access
; -- If Pattern is True
252 Action
: Actions
.Action_Access
; -- Action will be called
255 package Pattern_Action_Table
is
256 new Dynamic_Tables
(Pattern_Action
, Natural, 1, 5, 50);
262 type Session_Data
is record
263 Current_File
: Text_IO
.File_Type
;
264 Current_Line
: Unbounded_String
;
265 Separators
: Split
.Mode_Access
;
266 Files
: File_Table
.Instance
;
267 File_Index
: Natural := 0;
268 Fields
: Field_Table
.Instance
;
269 Filters
: Pattern_Action_Table
.Instance
;
272 Matches
: Regpat
.Match_Array
(0 .. 100);
273 -- latest matches for the regexp pattern
277 new Unchecked_Deallocation
(Session_Data
, Session_Data_Access
);
283 procedure Initialize
(Session
: in out Session_Type
) is
285 Session
.Data
:= new Session_Data
;
287 -- Initialize separators
289 Session
.Data
.Separators
:=
290 new Split
.Separator
'(Default_Separators'Length, Default_Separators);
292 -- Initialize all tables
294 File_Table.Init (Session.Data.Files);
295 Field_Table.Init (Session.Data.Fields);
296 Pattern_Action_Table.Init (Session.Data.Filters);
299 -----------------------
300 -- Session Variables --
301 -----------------------
303 -- These must come after the body of Initialize, since they make
304 -- implicit calls to Initialize at elaboration time.
306 Def_Session : Session_Type;
307 Cur_Session : Session_Type;
313 -- Note: Finalize must come after Initialize and the definition
314 -- of the Def_Session and Cur_Session variables, since it references
317 procedure Finalize (Session : in out Session_Type) is
319 -- We release the session data only if it is not the default session.
321 if Session.Data /= Def_Session.Data then
324 -- Since we have closed the current session, set it to point
325 -- now to the default session.
327 Cur_Session.Data := Def_Session.Data;
331 ----------------------
332 -- Private Services --
333 ----------------------
335 function Always_True return Boolean;
336 -- A function that always returns True.
338 function Apply_Filters
339 (Session : Session_Type := Current_Session)
341 -- Apply any filters for which the Pattern is True for Session. It returns
342 -- True if a least one filters has been applied (i.e. associated action
343 -- callback has been called).
345 procedure Open_Next_File
346 (Session : Session_Type := Current_Session);
347 pragma Inline (Open_Next_File);
348 -- Open next file for Session closing current file if needed. It raises
349 -- End_Error if there is no more file in the table.
351 procedure Raise_With_Info
352 (E : Exceptions.Exception_Id;
354 Session : Session_Type);
355 pragma No_Return (Raise_With_Info);
356 -- Raises exception E with the message prepended with the current line
357 -- number and the filename if possible.
359 procedure Read_Line (Session : Session_Type);
360 -- Read a line for the Session and set Current_Line.
362 procedure Split_Line (Session : Session_Type);
363 -- Split session's Current_Line according to the session separators and
364 -- set the Fields table. This procedure can be called at any time.
366 ----------------------
367 -- Private Packages --
368 ----------------------
374 package body Actions is
382 Session : Session_Type)
384 pragma Warnings (Off, Session);
396 Session : Session_Type)
399 A.Proc (Session.Data.Matches);
408 package body Patterns is
416 Session : Session_Type)
420 return P.Str = Field (P.Rank, Session);
429 Session : Session_Type)
432 use type Regpat.Match_Location;
436 (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
437 return Session.Data.Matches (0) /= Regpat.No_Match;
445 (P : Callback_Pattern;
446 Session : Session_Type)
449 pragma Warnings (Off, Session);
452 return P.Pattern.all;
459 procedure Release (P : in out Pattern) is
460 pragma Warnings (Off, P);
470 procedure Release (P : in out Regexp_Pattern) is
471 procedure Free is new Unchecked_Deallocation
472 (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
484 package body Split is
492 procedure Current_Line (S : Separator; Session : Session_Type) is
493 Line : constant String := To_String (Session.Data.Current_Line);
494 Fields : Field_Table.Instance renames Session.Data.Fields;
499 Seps : Maps.Character_Set := Maps.To_Set (S.Separators);
502 -- First field start here
506 -- Record the first field start position which is the first character
509 Field_Table.Increment_Last (Fields);
510 Fields.Table (Field_Table.Last (Fields)).First := Start;
513 -- Look for next separator
516 (Source => Line (Start .. Line'Last),
521 Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
523 -- if separators are set to the default (space and tab) we skip
524 -- all spaces and tabs following current field.
526 if S.Separators = Default_Separators then
528 (Line (Stop + 1 .. Line'Last),
529 Maps.To_Set (Default_Separators),
536 -- Record in the field table the start of this new field
538 Field_Table.Increment_Last (Fields);
539 Fields.Table (Field_Table.Last (Fields)).First := Start;
543 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
550 procedure Current_Line (S : Column; Session : Session_Type) is
551 Line : constant String := To_String (Session.Data.Current_Line);
552 Fields : Field_Table.Instance renames Session.Data.Fields;
553 Start : Positive := Line'First;
556 -- Record the first field start position which is the first character
559 for C in 1 .. S.Columns'Length loop
561 Field_Table.Increment_Last (Fields);
563 Fields.Table (Field_Table.Last (Fields)).First := Start;
565 Start := Start + S.Columns (C);
567 Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
571 -- If there is some remaining character on the line, add them in a
574 if Start - 1 < Line'Length then
576 Field_Table.Increment_Last (Fields);
578 Fields.Table (Field_Table.Last (Fields)).First := Start;
580 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
592 Session : Session_Type := Current_Session)
594 Files : File_Table.Instance renames Session.Data.Files;
597 if OS_Lib.Is_Regular_File (Filename) then
598 File_Table.Increment_Last (Files);
599 Files.Table (File_Table.Last (Files)) := new String'(Filename
);
602 (File_Error
'Identity,
603 "File " & Filename
& " not found.",
615 Number_Of_Files_Added
: out Natural;
616 Session
: Session_Type
:= Current_Session
)
618 use Directory_Operations
;
621 Filename
: String (1 .. 200);
625 Number_Of_Files_Added
:= 0;
627 Open
(Dir
, Directory
);
630 Read
(Dir
, Filename
, Last
);
633 Add_File
(Filename
(1 .. Last
), Session
);
634 Number_Of_Files_Added
:= Number_Of_Files_Added
+ 1;
642 (File_Error
'Identity,
643 "Error scaning directory " & Directory
644 & " for files " & Filenames
& '.',
652 function Always_True
return Boolean is
661 function Apply_Filters
662 (Session
: Session_Type
:= Current_Session
)
665 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
666 Results
: Boolean := False;
669 -- Iterate through the filters table, if pattern match call action.
671 for F
in 1 .. Pattern_Action_Table
.Last
(Filters
) loop
672 if Patterns
.Match
(Filters
.Table
(F
).Pattern
.all, Session
) then
674 Actions
.Call
(Filters
.Table
(F
).Action
.all, Session
);
685 procedure Close
(Session
: Session_Type
) is
686 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
687 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
690 -- Close current file if needed
692 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
693 Text_IO
.Close
(Session
.Data
.Current_File
);
696 -- Release separators
698 Free
(Session
.Data
.Separators
);
700 -- Release Filters table
702 for F
in 1 .. Pattern_Action_Table
.Last
(Filters
) loop
703 Patterns
.Release
(Filters
.Table
(F
).Pattern
.all);
704 Free
(Filters
.Table
(F
).Pattern
);
705 Free
(Filters
.Table
(F
).Action
);
708 for F
in 1 .. File_Table
.Last
(Files
) loop
709 Free
(Files
.Table
(F
));
712 File_Table
.Set_Last
(Session
.Data
.Files
, 0);
713 Field_Table
.Set_Last
(Session
.Data
.Fields
, 0);
714 Pattern_Action_Table
.Set_Last
(Session
.Data
.Filters
, 0);
716 Session
.Data
.NR
:= 0;
717 Session
.Data
.FNR
:= 0;
718 Session
.Data
.File_Index
:= 0;
719 Session
.Data
.Current_Line
:= Null_Unbounded_String
;
722 ---------------------
723 -- Current_Session --
724 ---------------------
726 function Current_Session
return Session_Type
is
731 ---------------------
732 -- Default_Session --
733 ---------------------
735 function Default_Session
return Session_Type
is
744 function Discrete_Field
746 Session
: Session_Type
:= Current_Session
)
750 return Discrete
'Value (Field
(Rank
, Session
));
758 (Session
: Session_Type
:= Current_Session
)
762 return Session
.Data
.File_Index
= File_Table
.Last
(Session
.Data
.Files
)
763 and then End_Of_File
(Session
);
771 (Session
: Session_Type
:= Current_Session
)
775 return Text_IO
.End_Of_File
(Session
.Data
.Current_File
);
784 Session
: Session_Type
:= Current_Session
)
787 Fields
: Field_Table
.Instance
renames Session
.Data
.Fields
;
790 if Rank
> Number_Of_Fields
(Session
) then
792 (Field_Error
'Identity,
793 "Field number" & Count
'Image (Rank
) & " does not exist.",
798 -- Returns the whole line, this is what $0 does under Session_Type.
800 return To_String
(Session
.Data
.Current_Line
);
803 return Slice
(Session
.Data
.Current_Line
,
804 Fields
.Table
(Positive (Rank
)).First
,
805 Fields
.Table
(Positive (Rank
)).Last
);
811 Session
: Session_Type
:= Current_Session
)
815 return Integer'Value (Field
(Rank
, Session
));
818 when Constraint_Error
=>
820 (Field_Error
'Identity,
821 "Field number" & Count
'Image (Rank
)
822 & " cannot be converted to an integer.",
828 Session
: Session_Type
:= Current_Session
)
832 return Float'Value (Field
(Rank
, Session
));
835 when Constraint_Error
=>
837 (Field_Error
'Identity,
838 "Field number" & Count
'Image (Rank
)
839 & " cannot be converted to a float.",
848 (Session
: Session_Type
:= Current_Session
)
851 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
854 if Session
.Data
.File_Index
= 0 then
857 return Files
.Table
(Session
.Data
.File_Index
).all;
865 procedure For_Every_Line
866 (Separators
: String := Use_Current
;
867 Filename
: String := Use_Current
;
868 Callbacks
: Callback_Mode
:= None
;
869 Session
: Session_Type
:= Current_Session
)
871 Filter_Active
: Boolean;
875 Open
(Separators
, Filename
, Session
);
877 while not End_Of_Data
(Session
) loop
879 Split_Line
(Session
);
881 if Callbacks
in Only
.. Pass_Through
then
882 Filter_Active
:= Apply_Filters
(Session
);
885 if Callbacks
/= Only
then
900 (Callbacks
: Callback_Mode
:= None
;
901 Session
: Session_Type
:= Current_Session
)
903 Filter_Active
: Boolean;
906 if not Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
912 Split_Line
(Session
);
920 Filter_Active
:= Apply_Filters
(Session
);
921 exit when not Filter_Active
;
924 Filter_Active
:= Apply_Filters
(Session
);
931 ----------------------
932 -- Number_Of_Fields --
933 ----------------------
935 function Number_Of_Fields
936 (Session
: Session_Type
:= Current_Session
)
940 return Count
(Field_Table
.Last
(Session
.Data
.Fields
));
941 end Number_Of_Fields
;
943 --------------------------
944 -- Number_Of_File_Lines --
945 --------------------------
947 function Number_Of_File_Lines
948 (Session
: Session_Type
:= Current_Session
)
952 return Count
(Session
.Data
.FNR
);
953 end Number_Of_File_Lines
;
955 ---------------------
956 -- Number_Of_Files --
957 ---------------------
959 function Number_Of_Files
960 (Session
: Session_Type
:= Current_Session
)
963 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
966 return File_Table
.Last
(Files
);
969 ---------------------
970 -- Number_Of_Lines --
971 ---------------------
973 function Number_Of_Lines
974 (Session
: Session_Type
:= Current_Session
)
978 return Count
(Session
.Data
.NR
);
986 (Separators
: String := Use_Current
;
987 Filename
: String := Use_Current
;
988 Session
: Session_Type
:= Current_Session
)
991 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
995 if Filename
/= Use_Current
then
996 File_Table
.Init
(Session
.Data
.Files
);
997 Add_File
(Filename
, Session
);
1000 if Separators
/= Use_Current
then
1001 Set_Field_Separators
(Separators
, Session
);
1004 Open_Next_File
(Session
);
1011 --------------------
1012 -- Open_Next_File --
1013 --------------------
1015 procedure Open_Next_File
1016 (Session
: Session_Type
:= Current_Session
)
1018 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
1021 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
1022 Text_IO
.Close
(Session
.Data
.Current_File
);
1025 Session
.Data
.File_Index
:= Session
.Data
.File_Index
+ 1;
1027 -- If there are no mores file in the table, raise End_Error
1029 if Session
.Data
.File_Index
> File_Table
.Last
(Files
) then
1034 (File
=> Session
.Data
.Current_File
,
1035 Name
=> Files
.Table
(Session
.Data
.File_Index
).all,
1036 Mode
=> Text_IO
.In_File
);
1044 (Separators
: String := Use_Current
;
1045 Filename
: String := Use_Current
;
1046 Session
: Session_Type
:= Current_Session
)
1048 Filter_Active
: Boolean;
1050 Open
(Separators
, Filename
, Session
);
1052 while not End_Of_Data
(Session
) loop
1053 Get_Line
(None
, Session
);
1054 Filter_Active
:= Apply_Filters
(Session
);
1060 ---------------------
1061 -- Raise_With_Info --
1062 ---------------------
1064 procedure Raise_With_Info
1065 (E
: Exceptions
.Exception_Id
;
1067 Session
: Session_Type
)
1069 function Filename
return String;
1070 -- Returns current filename and "??" if the informations is not
1073 function Line
return String;
1074 -- Returns current line number without the leading space
1080 function Filename
return String is
1081 File
: constant String := AWK
.File
(Session
);
1095 function Line
return String is
1096 L
: constant String := Natural'Image (Session
.Data
.FNR
);
1099 return L
(2 .. L
'Last);
1102 -- Start of processing for Raise_With_Info
1105 Exceptions
.Raise_Exception
1107 '[' & Filename
& ':' & Line
& "] " & Message
);
1108 raise Constraint_Error
; -- to please GNAT as this is a No_Return proc
1109 end Raise_With_Info
;
1115 procedure Read_Line
(Session
: Session_Type
) is
1117 function Read_Line
return String;
1118 -- Read a line in the current file. This implementation is recursive
1119 -- and does not have a limitation on the line length.
1121 NR
: Natural renames Session
.Data
.NR
;
1122 FNR
: Natural renames Session
.Data
.FNR
;
1124 function Read_Line
return String is
1125 Buffer
: String (1 .. 1_024
);
1129 Text_IO
.Get_Line
(Session
.Data
.Current_File
, Buffer
, Last
);
1131 if Last
= Buffer
'Last then
1132 return Buffer
& Read_Line
;
1134 return Buffer
(1 .. Last
);
1138 -- Start of processing for Read_Line
1141 if End_Of_File
(Session
) then
1142 Open_Next_File
(Session
);
1146 Session
.Data
.Current_Line
:= To_Unbounded_String
(Read_Line
);
1159 Action
: Action_Callback
;
1160 Session
: Session_Type
:= Current_Session
)
1162 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1163 U_Pattern
: constant Unbounded_String
:= To_Unbounded_String
(Pattern
);
1166 Pattern_Action_Table
.Increment_Last
(Filters
);
1168 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1169 (Pattern
=> new Patterns
.String_Pattern
'(U_Pattern, Field),
1170 Action => new Actions.Simple_Action'(Proc
=> Action
));
1175 Pattern
: GNAT
.Regpat
.Pattern_Matcher
;
1176 Action
: Action_Callback
;
1177 Session
: Session_Type
:= Current_Session
)
1179 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1181 A_Pattern
: Patterns
.Pattern_Matcher_Access
:=
1182 new Regpat
.Pattern_Matcher
'(Pattern);
1184 Pattern_Action_Table.Increment_Last (Filters);
1186 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1187 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern
, Field
),
1188 Action
=> new Actions
.Simple_Action
'(Proc => Action));
1193 Pattern : GNAT.Regpat.Pattern_Matcher;
1194 Action : Match_Action_Callback;
1195 Session : Session_Type := Current_Session)
1197 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1199 A_Pattern : Patterns.Pattern_Matcher_Access :=
1200 new Regpat.Pattern_Matcher'(Pattern
);
1202 Pattern_Action_Table
.Increment_Last
(Filters
);
1204 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1205 (Pattern
=> new Patterns
.Regexp_Pattern
'(A_Pattern, Field),
1206 Action => new Actions.Match_Action'(Proc
=> Action
));
1210 (Pattern
: Pattern_Callback
;
1211 Action
: Action_Callback
;
1212 Session
: Session_Type
:= Current_Session
)
1214 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1217 Pattern_Action_Table
.Increment_Last
(Filters
);
1219 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1220 (Pattern
=> new Patterns
.Callback_Pattern
'(Pattern => Pattern),
1221 Action => new Actions.Simple_Action'(Proc
=> Action
));
1225 (Action
: Action_Callback
;
1226 Session
: Session_Type
:= Current_Session
)
1229 Register
(Always_True
'Access, Action
, Session
);
1236 procedure Set_Current
(Session
: Session_Type
) is
1238 Cur_Session
.Data
:= Session
.Data
;
1241 --------------------------
1242 -- Set_Field_Separators --
1243 --------------------------
1245 procedure Set_Field_Separators
1246 (Separators
: String := Default_Separators
;
1247 Session
: Session_Type
:= Current_Session
)
1250 Free
(Session
.Data
.Separators
);
1252 Session
.Data
.Separators
:=
1253 new Split
.Separator
'(Separators'Length, Separators);
1255 -- If there is a current line read, split it according to the new
1258 if Session.Data.Current_Line /= Null_Unbounded_String then
1259 Split_Line (Session);
1261 end Set_Field_Separators;
1263 ----------------------
1264 -- Set_Field_Widths --
1265 ----------------------
1267 procedure Set_Field_Widths
1268 (Field_Widths : Widths_Set;
1269 Session : Session_Type := Current_Session) is
1272 Free (Session.Data.Separators);
1274 Session.Data.Separators :=
1275 new Split.Column'(Field_Widths
'Length, Field_Widths
);
1277 -- If there is a current line read, split it according to
1278 -- the new separators.
1280 if Session
.Data
.Current_Line
/= Null_Unbounded_String
then
1281 Split_Line
(Session
);
1283 end Set_Field_Widths
;
1289 procedure Split_Line
(Session
: Session_Type
) is
1290 Fields
: Field_Table
.Instance
renames Session
.Data
.Fields
;
1293 Field_Table
.Init
(Fields
);
1295 Split
.Current_Line
(Session
.Data
.Separators
.all, Session
);
1299 -- We have declared two sessions but both should share the same data.
1300 -- The current session must point to the default session as its initial
1301 -- value. So first we release the session data then we set current
1302 -- session data to point to default session data.
1304 Free
(Cur_Session
.Data
);
1305 Cur_Session
.Data
:= Def_Session
.Data
;