]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T . A W K -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 2000-2003 Ada Core Technologies, Inc. -- |
38cbfe40 RK |
10 | -- -- |
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. -- | |
21 | -- -- | |
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. -- | |
28 | -- -- | |
fbf5a39b AC |
29 | -- GNAT was originally developed by the GNAT team at New York University. -- |
30 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
38cbfe40 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
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). | |
37 | ||
38 | with Ada.Exceptions; | |
39 | with Ada.Text_IO; | |
40 | with Ada.Strings.Unbounded; | |
41 | with Ada.Strings.Fixed; | |
42 | with Ada.Strings.Maps; | |
43 | with Ada.Unchecked_Deallocation; | |
44 | ||
45 | with GNAT.Directory_Operations; | |
46 | with GNAT.Dynamic_Tables; | |
47 | with GNAT.OS_Lib; | |
48 | ||
49 | package body GNAT.AWK is | |
50 | ||
51 | use Ada; | |
52 | use Ada.Strings.Unbounded; | |
53 | ||
54 | ---------------- | |
55 | -- Split mode -- | |
56 | ---------------- | |
57 | ||
58 | package Split is | |
59 | ||
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. | |
63 | ||
64 | type Mode_Access is access Mode'Class; | |
65 | ||
66 | procedure Current_Line (S : Mode; Session : Session_Type) | |
67 | is abstract; | |
68 | -- Split Session's current line using split mode. | |
69 | ||
70 | ------------------------ | |
71 | -- Split on separator -- | |
72 | ------------------------ | |
73 | ||
74 | type Separator (Size : Positive) is new Mode with record | |
75 | Separators : String (1 .. Size); | |
76 | end record; | |
77 | ||
78 | procedure Current_Line | |
79 | (S : Separator; | |
80 | Session : Session_Type); | |
81 | ||
82 | --------------------- | |
83 | -- Split on column -- | |
84 | --------------------- | |
85 | ||
86 | type Column (Size : Positive) is new Mode with record | |
87 | Columns : Widths_Set (1 .. Size); | |
88 | end record; | |
89 | ||
90 | procedure Current_Line (S : Column; Session : Session_Type); | |
91 | ||
92 | end Split; | |
93 | ||
94 | procedure Free is new Unchecked_Deallocation | |
95 | (Split.Mode'Class, Split.Mode_Access); | |
96 | ||
97 | ---------------- | |
98 | -- File_Table -- | |
99 | ---------------- | |
100 | ||
101 | type AWK_File is access String; | |
102 | ||
103 | package File_Table is | |
104 | new Dynamic_Tables (AWK_File, Natural, 1, 5, 50); | |
105 | -- List of filename associated with a Session. | |
106 | ||
107 | procedure Free is new Unchecked_Deallocation (String, AWK_File); | |
108 | ||
109 | ----------------- | |
110 | -- Field_Table -- | |
111 | ----------------- | |
112 | ||
113 | type Field_Slice is record | |
114 | First : Positive; | |
115 | Last : Natural; | |
116 | end record; | |
117 | -- This is a field slice (First .. Last) in session's current line. | |
118 | ||
119 | package Field_Table is | |
120 | new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100); | |
121 | -- List of fields for the current line. | |
122 | ||
123 | -------------- | |
124 | -- Patterns -- | |
125 | -------------- | |
126 | ||
127 | -- Define all patterns style : exact string, regular expression, boolean | |
128 | -- function. | |
129 | ||
130 | package Patterns is | |
131 | ||
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. | |
135 | ||
136 | type Pattern_Access is access Pattern'Class; | |
137 | ||
138 | function Match | |
139 | (P : Pattern; | |
140 | Session : Session_Type) | |
141 | return Boolean | |
142 | is abstract; | |
143 | -- Returns True if P match for the current session and False otherwise. | |
144 | ||
145 | procedure Release (P : in out Pattern); | |
146 | -- Release memory used by the pattern structure. | |
147 | ||
148 | -------------------------- | |
149 | -- Exact string pattern -- | |
150 | -------------------------- | |
151 | ||
152 | type String_Pattern is new Pattern with record | |
153 | Str : Unbounded_String; | |
154 | Rank : Count; | |
155 | end record; | |
156 | ||
157 | function Match | |
158 | (P : String_Pattern; | |
159 | Session : Session_Type) | |
160 | return Boolean; | |
161 | ||
162 | -------------------------------- | |
163 | -- Regular expression pattern -- | |
164 | -------------------------------- | |
165 | ||
166 | type Pattern_Matcher_Access is access Regpat.Pattern_Matcher; | |
167 | ||
168 | type Regexp_Pattern is new Pattern with record | |
169 | Regx : Pattern_Matcher_Access; | |
170 | Rank : Count; | |
171 | end record; | |
172 | ||
173 | function Match | |
174 | (P : Regexp_Pattern; | |
175 | Session : Session_Type) | |
176 | return Boolean; | |
177 | ||
178 | procedure Release (P : in out Regexp_Pattern); | |
179 | ||
180 | ------------------------------ | |
181 | -- Boolean function pattern -- | |
182 | ------------------------------ | |
183 | ||
184 | type Callback_Pattern is new Pattern with record | |
185 | Pattern : Pattern_Callback; | |
186 | end record; | |
187 | ||
188 | function Match | |
189 | (P : Callback_Pattern; | |
190 | Session : Session_Type) | |
191 | return Boolean; | |
192 | ||
193 | end Patterns; | |
194 | ||
195 | procedure Free is new Unchecked_Deallocation | |
196 | (Patterns.Pattern'Class, Patterns.Pattern_Access); | |
197 | ||
198 | ------------- | |
199 | -- Actions -- | |
200 | ------------- | |
201 | ||
202 | -- Define all action style : simple call, call with matches | |
203 | ||
204 | package Actions is | |
205 | ||
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. | |
209 | ||
210 | type Action_Access is access Action'Class; | |
211 | ||
212 | procedure Call | |
213 | (A : Action; | |
214 | Session : Session_Type) | |
215 | is abstract; | |
216 | -- Call action A as required. | |
217 | ||
218 | ------------------- | |
219 | -- Simple action -- | |
220 | ------------------- | |
221 | ||
222 | type Simple_Action is new Action with record | |
223 | Proc : Action_Callback; | |
224 | end record; | |
225 | ||
226 | procedure Call | |
227 | (A : Simple_Action; | |
228 | Session : Session_Type); | |
229 | ||
230 | ------------------------- | |
231 | -- Action with matches -- | |
232 | ------------------------- | |
233 | ||
234 | type Match_Action is new Action with record | |
235 | Proc : Match_Action_Callback; | |
236 | end record; | |
237 | ||
238 | procedure Call | |
239 | (A : Match_Action; | |
240 | Session : Session_Type); | |
241 | ||
242 | end Actions; | |
243 | ||
244 | procedure Free is new Unchecked_Deallocation | |
245 | (Actions.Action'Class, Actions.Action_Access); | |
246 | ||
247 | -------------------------- | |
248 | -- Pattern/Action table -- | |
249 | -------------------------- | |
250 | ||
251 | type Pattern_Action is record | |
252 | Pattern : Patterns.Pattern_Access; -- If Pattern is True | |
253 | Action : Actions.Action_Access; -- Action will be called | |
254 | end record; | |
255 | ||
256 | package Pattern_Action_Table is | |
257 | new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50); | |
258 | ||
259 | ------------------ | |
260 | -- Session Data -- | |
261 | ------------------ | |
262 | ||
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; | |
271 | NR : Natural := 0; | |
272 | FNR : Natural := 0; | |
273 | Matches : Regpat.Match_Array (0 .. 100); | |
274 | -- latest matches for the regexp pattern | |
275 | end record; | |
276 | ||
277 | procedure Free is | |
278 | new Unchecked_Deallocation (Session_Data, Session_Data_Access); | |
279 | ||
280 | ---------------- | |
281 | -- Initialize -- | |
282 | ---------------- | |
283 | ||
284 | procedure Initialize (Session : in out Session_Type) is | |
285 | begin | |
286 | Session.Data := new Session_Data; | |
287 | ||
288 | -- Initialize separators | |
289 | ||
290 | Session.Data.Separators := | |
291 | new Split.Separator'(Default_Separators'Length, Default_Separators); | |
292 | ||
293 | -- Initialize all tables | |
294 | ||
295 | File_Table.Init (Session.Data.Files); | |
296 | Field_Table.Init (Session.Data.Fields); | |
297 | Pattern_Action_Table.Init (Session.Data.Filters); | |
298 | end Initialize; | |
299 | ||
300 | ----------------------- | |
301 | -- Session Variables -- | |
302 | ----------------------- | |
303 | ||
304 | -- These must come after the body of Initialize, since they make | |
305 | -- implicit calls to Initialize at elaboration time. | |
306 | ||
307 | Def_Session : Session_Type; | |
308 | Cur_Session : Session_Type; | |
309 | ||
310 | -------------- | |
311 | -- Finalize -- | |
312 | -------------- | |
313 | ||
314 | -- Note: Finalize must come after Initialize and the definition | |
315 | -- of the Def_Session and Cur_Session variables, since it references | |
316 | -- the latter. | |
317 | ||
318 | procedure Finalize (Session : in out Session_Type) is | |
319 | begin | |
320 | -- We release the session data only if it is not the default session. | |
321 | ||
322 | if Session.Data /= Def_Session.Data then | |
323 | Free (Session.Data); | |
324 | ||
325 | -- Since we have closed the current session, set it to point | |
326 | -- now to the default session. | |
327 | ||
328 | Cur_Session.Data := Def_Session.Data; | |
329 | end if; | |
330 | end Finalize; | |
331 | ||
332 | ---------------------- | |
333 | -- Private Services -- | |
334 | ---------------------- | |
335 | ||
336 | function Always_True return Boolean; | |
337 | -- A function that always returns True. | |
338 | ||
339 | function Apply_Filters | |
340 | (Session : Session_Type := Current_Session) | |
341 | return Boolean; | |
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). | |
345 | ||
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. | |
351 | ||
352 | procedure Raise_With_Info | |
353 | (E : Exceptions.Exception_Id; | |
354 | Message : String; | |
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. | |
359 | ||
360 | procedure Read_Line (Session : Session_Type); | |
361 | -- Read a line for the Session and set Current_Line. | |
362 | ||
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. | |
366 | ||
367 | ---------------------- | |
368 | -- Private Packages -- | |
369 | ---------------------- | |
370 | ||
371 | ------------- | |
372 | -- Actions -- | |
373 | ------------- | |
374 | ||
375 | package body Actions is | |
376 | ||
377 | ---------- | |
378 | -- Call -- | |
379 | ---------- | |
380 | ||
381 | procedure Call | |
382 | (A : Simple_Action; | |
383 | Session : Session_Type) | |
384 | is | |
fbf5a39b | 385 | pragma Unreferenced (Session); |
07fc65c4 | 386 | |
38cbfe40 RK |
387 | begin |
388 | A.Proc.all; | |
389 | end Call; | |
390 | ||
391 | ---------- | |
392 | -- Call -- | |
393 | ---------- | |
394 | ||
395 | procedure Call | |
396 | (A : Match_Action; | |
397 | Session : Session_Type) | |
398 | is | |
399 | begin | |
400 | A.Proc (Session.Data.Matches); | |
401 | end Call; | |
402 | ||
403 | end Actions; | |
404 | ||
405 | -------------- | |
406 | -- Patterns -- | |
407 | -------------- | |
408 | ||
409 | package body Patterns is | |
410 | ||
411 | ----------- | |
412 | -- Match -- | |
413 | ----------- | |
414 | ||
415 | function Match | |
416 | (P : String_Pattern; | |
417 | Session : Session_Type) | |
418 | return Boolean | |
419 | is | |
420 | begin | |
421 | return P.Str = Field (P.Rank, Session); | |
422 | end Match; | |
423 | ||
424 | ----------- | |
425 | -- Match -- | |
426 | ----------- | |
427 | ||
428 | function Match | |
429 | (P : Regexp_Pattern; | |
430 | Session : Session_Type) | |
431 | return Boolean | |
432 | is | |
433 | use type Regpat.Match_Location; | |
434 | ||
435 | begin | |
436 | Regpat.Match | |
437 | (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches); | |
438 | return Session.Data.Matches (0) /= Regpat.No_Match; | |
439 | end Match; | |
440 | ||
441 | ----------- | |
442 | -- Match -- | |
443 | ----------- | |
444 | ||
445 | function Match | |
446 | (P : Callback_Pattern; | |
447 | Session : Session_Type) | |
448 | return Boolean | |
449 | is | |
fbf5a39b | 450 | pragma Unreferenced (Session); |
07fc65c4 | 451 | |
38cbfe40 RK |
452 | begin |
453 | return P.Pattern.all; | |
454 | end Match; | |
455 | ||
456 | ------------- | |
457 | -- Release -- | |
458 | ------------- | |
459 | ||
460 | procedure Release (P : in out Pattern) is | |
fbf5a39b | 461 | pragma Unreferenced (P); |
07fc65c4 | 462 | |
38cbfe40 RK |
463 | begin |
464 | null; | |
465 | end Release; | |
466 | ||
467 | ------------- | |
468 | -- Release -- | |
469 | ------------- | |
470 | ||
471 | procedure Release (P : in out Regexp_Pattern) is | |
472 | procedure Free is new Unchecked_Deallocation | |
473 | (Regpat.Pattern_Matcher, Pattern_Matcher_Access); | |
474 | ||
475 | begin | |
476 | Free (P.Regx); | |
477 | end Release; | |
478 | ||
479 | end Patterns; | |
480 | ||
481 | ----------- | |
482 | -- Split -- | |
483 | ----------- | |
484 | ||
485 | package body Split is | |
486 | ||
487 | use Ada.Strings; | |
488 | ||
489 | ------------------ | |
490 | -- Current_Line -- | |
491 | ------------------ | |
492 | ||
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; | |
496 | ||
fbf5a39b | 497 | Start : Natural; |
38cbfe40 RK |
498 | Stop : Natural; |
499 | ||
fbf5a39b | 500 | Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators); |
38cbfe40 RK |
501 | |
502 | begin | |
503 | -- First field start here | |
504 | ||
505 | Start := Line'First; | |
506 | ||
507 | -- Record the first field start position which is the first character | |
508 | -- in the line. | |
509 | ||
510 | Field_Table.Increment_Last (Fields); | |
511 | Fields.Table (Field_Table.Last (Fields)).First := Start; | |
512 | ||
513 | loop | |
514 | -- Look for next separator | |
515 | ||
516 | Stop := Fixed.Index | |
517 | (Source => Line (Start .. Line'Last), | |
518 | Set => Seps); | |
519 | ||
520 | exit when Stop = 0; | |
521 | ||
522 | Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1; | |
523 | ||
fbf5a39b | 524 | -- If separators are set to the default (space and tab) we skip |
38cbfe40 RK |
525 | -- all spaces and tabs following current field. |
526 | ||
527 | if S.Separators = Default_Separators then | |
528 | Start := Fixed.Index | |
529 | (Line (Stop + 1 .. Line'Last), | |
530 | Maps.To_Set (Default_Separators), | |
531 | Outside, | |
532 | Strings.Forward); | |
fbf5a39b AC |
533 | |
534 | if Start = 0 then | |
535 | Start := Stop + 1; | |
536 | end if; | |
38cbfe40 RK |
537 | else |
538 | Start := Stop + 1; | |
539 | end if; | |
540 | ||
541 | -- Record in the field table the start of this new field | |
542 | ||
543 | Field_Table.Increment_Last (Fields); | |
544 | Fields.Table (Field_Table.Last (Fields)).First := Start; | |
545 | ||
546 | end loop; | |
547 | ||
548 | Fields.Table (Field_Table.Last (Fields)).Last := Line'Last; | |
549 | end Current_Line; | |
550 | ||
551 | ------------------ | |
552 | -- Current_Line -- | |
553 | ------------------ | |
554 | ||
555 | procedure Current_Line (S : Column; Session : Session_Type) is | |
556 | Line : constant String := To_String (Session.Data.Current_Line); | |
557 | Fields : Field_Table.Instance renames Session.Data.Fields; | |
558 | Start : Positive := Line'First; | |
559 | ||
560 | begin | |
561 | -- Record the first field start position which is the first character | |
562 | -- in the line. | |
563 | ||
564 | for C in 1 .. S.Columns'Length loop | |
565 | ||
566 | Field_Table.Increment_Last (Fields); | |
567 | ||
568 | Fields.Table (Field_Table.Last (Fields)).First := Start; | |
569 | ||
570 | Start := Start + S.Columns (C); | |
571 | ||
572 | Fields.Table (Field_Table.Last (Fields)).Last := Start - 1; | |
573 | ||
574 | end loop; | |
575 | ||
576 | -- If there is some remaining character on the line, add them in a | |
577 | -- new field. | |
578 | ||
579 | if Start - 1 < Line'Length then | |
580 | ||
581 | Field_Table.Increment_Last (Fields); | |
582 | ||
583 | Fields.Table (Field_Table.Last (Fields)).First := Start; | |
584 | ||
585 | Fields.Table (Field_Table.Last (Fields)).Last := Line'Last; | |
586 | end if; | |
587 | end Current_Line; | |
588 | ||
589 | end Split; | |
590 | ||
591 | -------------- | |
592 | -- Add_File -- | |
593 | -------------- | |
594 | ||
595 | procedure Add_File | |
596 | (Filename : String; | |
597 | Session : Session_Type := Current_Session) | |
598 | is | |
599 | Files : File_Table.Instance renames Session.Data.Files; | |
600 | ||
601 | begin | |
602 | if OS_Lib.Is_Regular_File (Filename) then | |
603 | File_Table.Increment_Last (Files); | |
604 | Files.Table (File_Table.Last (Files)) := new String'(Filename); | |
605 | else | |
606 | Raise_With_Info | |
607 | (File_Error'Identity, | |
608 | "File " & Filename & " not found.", | |
609 | Session); | |
610 | end if; | |
611 | end Add_File; | |
612 | ||
613 | --------------- | |
614 | -- Add_Files -- | |
615 | --------------- | |
616 | ||
617 | procedure Add_Files | |
618 | (Directory : String; | |
619 | Filenames : String; | |
620 | Number_Of_Files_Added : out Natural; | |
621 | Session : Session_Type := Current_Session) | |
622 | is | |
623 | use Directory_Operations; | |
624 | ||
625 | Dir : Dir_Type; | |
626 | Filename : String (1 .. 200); | |
627 | Last : Natural; | |
628 | ||
629 | begin | |
630 | Number_Of_Files_Added := 0; | |
631 | ||
632 | Open (Dir, Directory); | |
633 | ||
634 | loop | |
635 | Read (Dir, Filename, Last); | |
636 | exit when Last = 0; | |
637 | ||
638 | Add_File (Filename (1 .. Last), Session); | |
639 | Number_Of_Files_Added := Number_Of_Files_Added + 1; | |
640 | end loop; | |
641 | ||
642 | Close (Dir); | |
643 | ||
644 | exception | |
645 | when others => | |
646 | Raise_With_Info | |
647 | (File_Error'Identity, | |
648 | "Error scaning directory " & Directory | |
649 | & " for files " & Filenames & '.', | |
650 | Session); | |
651 | end Add_Files; | |
652 | ||
653 | ----------------- | |
654 | -- Always_True -- | |
655 | ----------------- | |
656 | ||
657 | function Always_True return Boolean is | |
658 | begin | |
659 | return True; | |
660 | end Always_True; | |
661 | ||
662 | ------------------- | |
663 | -- Apply_Filters -- | |
664 | ------------------- | |
665 | ||
666 | function Apply_Filters | |
667 | (Session : Session_Type := Current_Session) | |
668 | return Boolean | |
669 | is | |
670 | Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; | |
671 | Results : Boolean := False; | |
672 | ||
673 | begin | |
638e383e | 674 | -- Iterate through the filters table, if pattern match call action. |
38cbfe40 RK |
675 | |
676 | for F in 1 .. Pattern_Action_Table.Last (Filters) loop | |
677 | if Patterns.Match (Filters.Table (F).Pattern.all, Session) then | |
678 | Results := True; | |
679 | Actions.Call (Filters.Table (F).Action.all, Session); | |
680 | end if; | |
681 | end loop; | |
682 | ||
683 | return Results; | |
684 | end Apply_Filters; | |
685 | ||
686 | ----------- | |
687 | -- Close -- | |
688 | ----------- | |
689 | ||
690 | procedure Close (Session : Session_Type) is | |
691 | Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; | |
692 | Files : File_Table.Instance renames Session.Data.Files; | |
693 | ||
694 | begin | |
695 | -- Close current file if needed | |
696 | ||
697 | if Text_IO.Is_Open (Session.Data.Current_File) then | |
698 | Text_IO.Close (Session.Data.Current_File); | |
699 | end if; | |
700 | ||
701 | -- Release separators | |
702 | ||
703 | Free (Session.Data.Separators); | |
704 | ||
705 | -- Release Filters table | |
706 | ||
707 | for F in 1 .. Pattern_Action_Table.Last (Filters) loop | |
708 | Patterns.Release (Filters.Table (F).Pattern.all); | |
709 | Free (Filters.Table (F).Pattern); | |
710 | Free (Filters.Table (F).Action); | |
711 | end loop; | |
712 | ||
713 | for F in 1 .. File_Table.Last (Files) loop | |
714 | Free (Files.Table (F)); | |
715 | end loop; | |
716 | ||
717 | File_Table.Set_Last (Session.Data.Files, 0); | |
718 | Field_Table.Set_Last (Session.Data.Fields, 0); | |
719 | Pattern_Action_Table.Set_Last (Session.Data.Filters, 0); | |
720 | ||
721 | Session.Data.NR := 0; | |
722 | Session.Data.FNR := 0; | |
723 | Session.Data.File_Index := 0; | |
724 | Session.Data.Current_Line := Null_Unbounded_String; | |
725 | end Close; | |
726 | ||
727 | --------------------- | |
728 | -- Current_Session -- | |
729 | --------------------- | |
730 | ||
731 | function Current_Session return Session_Type is | |
732 | begin | |
733 | return Cur_Session; | |
734 | end Current_Session; | |
735 | ||
736 | --------------------- | |
737 | -- Default_Session -- | |
738 | --------------------- | |
739 | ||
740 | function Default_Session return Session_Type is | |
741 | begin | |
742 | return Def_Session; | |
743 | end Default_Session; | |
744 | ||
745 | -------------------- | |
746 | -- Discrete_Field -- | |
747 | -------------------- | |
748 | ||
749 | function Discrete_Field | |
750 | (Rank : Count; | |
751 | Session : Session_Type := Current_Session) | |
752 | return Discrete | |
753 | is | |
754 | begin | |
755 | return Discrete'Value (Field (Rank, Session)); | |
756 | end Discrete_Field; | |
757 | ||
758 | ----------------- | |
759 | -- End_Of_Data -- | |
760 | ----------------- | |
761 | ||
762 | function End_Of_Data | |
763 | (Session : Session_Type := Current_Session) | |
764 | return Boolean | |
765 | is | |
766 | begin | |
767 | return Session.Data.File_Index = File_Table.Last (Session.Data.Files) | |
768 | and then End_Of_File (Session); | |
769 | end End_Of_Data; | |
770 | ||
771 | ----------------- | |
772 | -- End_Of_File -- | |
773 | ----------------- | |
774 | ||
775 | function End_Of_File | |
776 | (Session : Session_Type := Current_Session) | |
777 | return Boolean | |
778 | is | |
779 | begin | |
780 | return Text_IO.End_Of_File (Session.Data.Current_File); | |
781 | end End_Of_File; | |
782 | ||
783 | ----------- | |
784 | -- Field -- | |
785 | ----------- | |
786 | ||
787 | function Field | |
788 | (Rank : Count; | |
789 | Session : Session_Type := Current_Session) | |
790 | return String | |
791 | is | |
792 | Fields : Field_Table.Instance renames Session.Data.Fields; | |
793 | ||
794 | begin | |
795 | if Rank > Number_Of_Fields (Session) then | |
796 | Raise_With_Info | |
797 | (Field_Error'Identity, | |
798 | "Field number" & Count'Image (Rank) & " does not exist.", | |
799 | Session); | |
800 | ||
801 | elsif Rank = 0 then | |
802 | ||
803 | -- Returns the whole line, this is what $0 does under Session_Type. | |
804 | ||
805 | return To_String (Session.Data.Current_Line); | |
806 | ||
807 | else | |
808 | return Slice (Session.Data.Current_Line, | |
809 | Fields.Table (Positive (Rank)).First, | |
810 | Fields.Table (Positive (Rank)).Last); | |
811 | end if; | |
812 | end Field; | |
813 | ||
814 | function Field | |
815 | (Rank : Count; | |
816 | Session : Session_Type := Current_Session) | |
817 | return Integer | |
818 | is | |
819 | begin | |
820 | return Integer'Value (Field (Rank, Session)); | |
821 | ||
822 | exception | |
823 | when Constraint_Error => | |
824 | Raise_With_Info | |
825 | (Field_Error'Identity, | |
826 | "Field number" & Count'Image (Rank) | |
827 | & " cannot be converted to an integer.", | |
828 | Session); | |
829 | end Field; | |
830 | ||
831 | function Field | |
832 | (Rank : Count; | |
833 | Session : Session_Type := Current_Session) | |
834 | return Float | |
835 | is | |
836 | begin | |
837 | return Float'Value (Field (Rank, Session)); | |
838 | ||
839 | exception | |
840 | when Constraint_Error => | |
841 | Raise_With_Info | |
842 | (Field_Error'Identity, | |
843 | "Field number" & Count'Image (Rank) | |
844 | & " cannot be converted to a float.", | |
845 | Session); | |
846 | end Field; | |
847 | ||
848 | ---------- | |
849 | -- File -- | |
850 | ---------- | |
851 | ||
852 | function File | |
853 | (Session : Session_Type := Current_Session) | |
854 | return String | |
855 | is | |
856 | Files : File_Table.Instance renames Session.Data.Files; | |
857 | ||
858 | begin | |
859 | if Session.Data.File_Index = 0 then | |
860 | return "??"; | |
861 | else | |
862 | return Files.Table (Session.Data.File_Index).all; | |
863 | end if; | |
864 | end File; | |
865 | ||
866 | -------------------- | |
867 | -- For_Every_Line -- | |
868 | -------------------- | |
869 | ||
870 | procedure For_Every_Line | |
871 | (Separators : String := Use_Current; | |
872 | Filename : String := Use_Current; | |
873 | Callbacks : Callback_Mode := None; | |
874 | Session : Session_Type := Current_Session) | |
875 | is | |
876 | Filter_Active : Boolean; | |
877 | Quit : Boolean; | |
878 | ||
879 | begin | |
880 | Open (Separators, Filename, Session); | |
881 | ||
882 | while not End_Of_Data (Session) loop | |
883 | Read_Line (Session); | |
884 | Split_Line (Session); | |
885 | ||
886 | if Callbacks in Only .. Pass_Through then | |
887 | Filter_Active := Apply_Filters (Session); | |
888 | end if; | |
889 | ||
890 | if Callbacks /= Only then | |
891 | Quit := False; | |
892 | Action (Quit); | |
893 | exit when Quit; | |
894 | end if; | |
895 | end loop; | |
896 | ||
897 | Close (Session); | |
898 | end For_Every_Line; | |
899 | ||
900 | -------------- | |
901 | -- Get_Line -- | |
902 | -------------- | |
903 | ||
904 | procedure Get_Line | |
905 | (Callbacks : Callback_Mode := None; | |
906 | Session : Session_Type := Current_Session) | |
907 | is | |
908 | Filter_Active : Boolean; | |
909 | ||
910 | begin | |
911 | if not Text_IO.Is_Open (Session.Data.Current_File) then | |
912 | raise File_Error; | |
913 | end if; | |
914 | ||
915 | loop | |
916 | Read_Line (Session); | |
917 | Split_Line (Session); | |
918 | ||
07fc65c4 GB |
919 | case Callbacks is |
920 | ||
921 | when None => | |
922 | exit; | |
923 | ||
924 | when Only => | |
925 | Filter_Active := Apply_Filters (Session); | |
926 | exit when not Filter_Active; | |
38cbfe40 | 927 | |
07fc65c4 GB |
928 | when Pass_Through => |
929 | Filter_Active := Apply_Filters (Session); | |
930 | exit; | |
38cbfe40 | 931 | |
07fc65c4 | 932 | end case; |
38cbfe40 RK |
933 | end loop; |
934 | end Get_Line; | |
935 | ||
936 | ---------------------- | |
937 | -- Number_Of_Fields -- | |
938 | ---------------------- | |
939 | ||
940 | function Number_Of_Fields | |
941 | (Session : Session_Type := Current_Session) | |
942 | return Count | |
943 | is | |
944 | begin | |
945 | return Count (Field_Table.Last (Session.Data.Fields)); | |
946 | end Number_Of_Fields; | |
947 | ||
948 | -------------------------- | |
949 | -- Number_Of_File_Lines -- | |
950 | -------------------------- | |
951 | ||
952 | function Number_Of_File_Lines | |
953 | (Session : Session_Type := Current_Session) | |
954 | return Count | |
955 | is | |
956 | begin | |
957 | return Count (Session.Data.FNR); | |
958 | end Number_Of_File_Lines; | |
959 | ||
960 | --------------------- | |
961 | -- Number_Of_Files -- | |
962 | --------------------- | |
963 | ||
964 | function Number_Of_Files | |
965 | (Session : Session_Type := Current_Session) | |
966 | return Natural | |
967 | is | |
968 | Files : File_Table.Instance renames Session.Data.Files; | |
969 | ||
970 | begin | |
971 | return File_Table.Last (Files); | |
972 | end Number_Of_Files; | |
973 | ||
974 | --------------------- | |
975 | -- Number_Of_Lines -- | |
976 | --------------------- | |
977 | ||
978 | function Number_Of_Lines | |
979 | (Session : Session_Type := Current_Session) | |
980 | return Count | |
981 | is | |
982 | begin | |
983 | return Count (Session.Data.NR); | |
984 | end Number_Of_Lines; | |
985 | ||
986 | ---------- | |
987 | -- Open -- | |
988 | ---------- | |
989 | ||
990 | procedure Open | |
991 | (Separators : String := Use_Current; | |
992 | Filename : String := Use_Current; | |
993 | Session : Session_Type := Current_Session) | |
994 | is | |
995 | begin | |
996 | if Text_IO.Is_Open (Session.Data.Current_File) then | |
997 | raise Session_Error; | |
998 | end if; | |
999 | ||
1000 | if Filename /= Use_Current then | |
1001 | File_Table.Init (Session.Data.Files); | |
1002 | Add_File (Filename, Session); | |
1003 | end if; | |
1004 | ||
1005 | if Separators /= Use_Current then | |
1006 | Set_Field_Separators (Separators, Session); | |
1007 | end if; | |
1008 | ||
1009 | Open_Next_File (Session); | |
1010 | ||
1011 | exception | |
1012 | when End_Error => | |
1013 | raise File_Error; | |
1014 | end Open; | |
1015 | ||
1016 | -------------------- | |
1017 | -- Open_Next_File -- | |
1018 | -------------------- | |
1019 | ||
1020 | procedure Open_Next_File | |
1021 | (Session : Session_Type := Current_Session) | |
1022 | is | |
1023 | Files : File_Table.Instance renames Session.Data.Files; | |
1024 | ||
1025 | begin | |
1026 | if Text_IO.Is_Open (Session.Data.Current_File) then | |
1027 | Text_IO.Close (Session.Data.Current_File); | |
1028 | end if; | |
1029 | ||
1030 | Session.Data.File_Index := Session.Data.File_Index + 1; | |
1031 | ||
1032 | -- If there are no mores file in the table, raise End_Error | |
1033 | ||
1034 | if Session.Data.File_Index > File_Table.Last (Files) then | |
1035 | raise End_Error; | |
1036 | end if; | |
1037 | ||
1038 | Text_IO.Open | |
1039 | (File => Session.Data.Current_File, | |
1040 | Name => Files.Table (Session.Data.File_Index).all, | |
1041 | Mode => Text_IO.In_File); | |
1042 | end Open_Next_File; | |
1043 | ||
1044 | ----------- | |
1045 | -- Parse -- | |
1046 | ----------- | |
1047 | ||
1048 | procedure Parse | |
1049 | (Separators : String := Use_Current; | |
1050 | Filename : String := Use_Current; | |
1051 | Session : Session_Type := Current_Session) | |
1052 | is | |
1053 | Filter_Active : Boolean; | |
fbf5a39b AC |
1054 | pragma Unreferenced (Filter_Active); |
1055 | ||
38cbfe40 RK |
1056 | begin |
1057 | Open (Separators, Filename, Session); | |
1058 | ||
1059 | while not End_Of_Data (Session) loop | |
1060 | Get_Line (None, Session); | |
1061 | Filter_Active := Apply_Filters (Session); | |
1062 | end loop; | |
1063 | ||
1064 | Close (Session); | |
1065 | end Parse; | |
1066 | ||
1067 | --------------------- | |
1068 | -- Raise_With_Info -- | |
1069 | --------------------- | |
1070 | ||
1071 | procedure Raise_With_Info | |
1072 | (E : Exceptions.Exception_Id; | |
1073 | Message : String; | |
1074 | Session : Session_Type) | |
1075 | is | |
1076 | function Filename return String; | |
1077 | -- Returns current filename and "??" if the informations is not | |
1078 | -- available. | |
1079 | ||
1080 | function Line return String; | |
1081 | -- Returns current line number without the leading space | |
1082 | ||
1083 | -------------- | |
1084 | -- Filename -- | |
1085 | -------------- | |
1086 | ||
1087 | function Filename return String is | |
1088 | File : constant String := AWK.File (Session); | |
1089 | ||
1090 | begin | |
1091 | if File = "" then | |
1092 | return "??"; | |
1093 | else | |
1094 | return File; | |
1095 | end if; | |
1096 | end Filename; | |
1097 | ||
1098 | ---------- | |
1099 | -- Line -- | |
1100 | ---------- | |
1101 | ||
1102 | function Line return String is | |
1103 | L : constant String := Natural'Image (Session.Data.FNR); | |
1104 | ||
1105 | begin | |
1106 | return L (2 .. L'Last); | |
1107 | end Line; | |
1108 | ||
1109 | -- Start of processing for Raise_With_Info | |
1110 | ||
1111 | begin | |
1112 | Exceptions.Raise_Exception | |
1113 | (E, | |
1114 | '[' & Filename & ':' & Line & "] " & Message); | |
1115 | raise Constraint_Error; -- to please GNAT as this is a No_Return proc | |
1116 | end Raise_With_Info; | |
1117 | ||
1118 | --------------- | |
1119 | -- Read_Line -- | |
1120 | --------------- | |
1121 | ||
1122 | procedure Read_Line (Session : Session_Type) is | |
1123 | ||
1124 | function Read_Line return String; | |
1125 | -- Read a line in the current file. This implementation is recursive | |
1126 | -- and does not have a limitation on the line length. | |
1127 | ||
1128 | NR : Natural renames Session.Data.NR; | |
1129 | FNR : Natural renames Session.Data.FNR; | |
1130 | ||
1131 | function Read_Line return String is | |
1132 | Buffer : String (1 .. 1_024); | |
1133 | Last : Natural; | |
1134 | ||
1135 | begin | |
1136 | Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last); | |
1137 | ||
1138 | if Last = Buffer'Last then | |
1139 | return Buffer & Read_Line; | |
1140 | else | |
1141 | return Buffer (1 .. Last); | |
1142 | end if; | |
1143 | end Read_Line; | |
1144 | ||
1145 | -- Start of processing for Read_Line | |
1146 | ||
1147 | begin | |
1148 | if End_Of_File (Session) then | |
1149 | Open_Next_File (Session); | |
1150 | FNR := 0; | |
1151 | end if; | |
1152 | ||
1153 | Session.Data.Current_Line := To_Unbounded_String (Read_Line); | |
1154 | ||
1155 | NR := NR + 1; | |
1156 | FNR := FNR + 1; | |
1157 | end Read_Line; | |
1158 | ||
1159 | -------------- | |
1160 | -- Register -- | |
1161 | -------------- | |
1162 | ||
1163 | procedure Register | |
1164 | (Field : Count; | |
1165 | Pattern : String; | |
1166 | Action : Action_Callback; | |
1167 | Session : Session_Type := Current_Session) | |
1168 | is | |
1169 | Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; | |
1170 | U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern); | |
1171 | ||
1172 | begin | |
1173 | Pattern_Action_Table.Increment_Last (Filters); | |
1174 | ||
1175 | Filters.Table (Pattern_Action_Table.Last (Filters)) := | |
1176 | (Pattern => new Patterns.String_Pattern'(U_Pattern, Field), | |
1177 | Action => new Actions.Simple_Action'(Proc => Action)); | |
1178 | end Register; | |
1179 | ||
1180 | procedure Register | |
1181 | (Field : Count; | |
1182 | Pattern : GNAT.Regpat.Pattern_Matcher; | |
1183 | Action : Action_Callback; | |
1184 | Session : Session_Type := Current_Session) | |
1185 | is | |
1186 | Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; | |
1187 | ||
fbf5a39b | 1188 | A_Pattern : constant Patterns.Pattern_Matcher_Access := |
38cbfe40 RK |
1189 | new Regpat.Pattern_Matcher'(Pattern); |
1190 | begin | |
1191 | Pattern_Action_Table.Increment_Last (Filters); | |
1192 | ||
1193 | Filters.Table (Pattern_Action_Table.Last (Filters)) := | |
1194 | (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field), | |
1195 | Action => new Actions.Simple_Action'(Proc => Action)); | |
1196 | end Register; | |
1197 | ||
1198 | procedure Register | |
1199 | (Field : Count; | |
1200 | Pattern : GNAT.Regpat.Pattern_Matcher; | |
1201 | Action : Match_Action_Callback; | |
1202 | Session : Session_Type := Current_Session) | |
1203 | is | |
1204 | Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; | |
1205 | ||
fbf5a39b | 1206 | A_Pattern : constant Patterns.Pattern_Matcher_Access := |
38cbfe40 RK |
1207 | new Regpat.Pattern_Matcher'(Pattern); |
1208 | begin | |
1209 | Pattern_Action_Table.Increment_Last (Filters); | |
1210 | ||
1211 | Filters.Table (Pattern_Action_Table.Last (Filters)) := | |
1212 | (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field), | |
1213 | Action => new Actions.Match_Action'(Proc => Action)); | |
1214 | end Register; | |
1215 | ||
1216 | procedure Register | |
1217 | (Pattern : Pattern_Callback; | |
1218 | Action : Action_Callback; | |
1219 | Session : Session_Type := Current_Session) | |
1220 | is | |
1221 | Filters : Pattern_Action_Table.Instance renames Session.Data.Filters; | |
1222 | ||
1223 | begin | |
1224 | Pattern_Action_Table.Increment_Last (Filters); | |
1225 | ||
1226 | Filters.Table (Pattern_Action_Table.Last (Filters)) := | |
1227 | (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern), | |
1228 | Action => new Actions.Simple_Action'(Proc => Action)); | |
1229 | end Register; | |
1230 | ||
1231 | procedure Register | |
1232 | (Action : Action_Callback; | |
1233 | Session : Session_Type := Current_Session) | |
1234 | is | |
1235 | begin | |
1236 | Register (Always_True'Access, Action, Session); | |
1237 | end Register; | |
1238 | ||
1239 | ----------------- | |
1240 | -- Set_Current -- | |
1241 | ----------------- | |
1242 | ||
1243 | procedure Set_Current (Session : Session_Type) is | |
1244 | begin | |
1245 | Cur_Session.Data := Session.Data; | |
1246 | end Set_Current; | |
1247 | ||
1248 | -------------------------- | |
1249 | -- Set_Field_Separators -- | |
1250 | -------------------------- | |
1251 | ||
1252 | procedure Set_Field_Separators | |
1253 | (Separators : String := Default_Separators; | |
1254 | Session : Session_Type := Current_Session) | |
1255 | is | |
1256 | begin | |
1257 | Free (Session.Data.Separators); | |
1258 | ||
1259 | Session.Data.Separators := | |
1260 | new Split.Separator'(Separators'Length, Separators); | |
1261 | ||
1262 | -- If there is a current line read, split it according to the new | |
1263 | -- separators. | |
1264 | ||
1265 | if Session.Data.Current_Line /= Null_Unbounded_String then | |
1266 | Split_Line (Session); | |
1267 | end if; | |
1268 | end Set_Field_Separators; | |
1269 | ||
1270 | ---------------------- | |
1271 | -- Set_Field_Widths -- | |
1272 | ---------------------- | |
1273 | ||
1274 | procedure Set_Field_Widths | |
1275 | (Field_Widths : Widths_Set; | |
1276 | Session : Session_Type := Current_Session) is | |
1277 | ||
1278 | begin | |
1279 | Free (Session.Data.Separators); | |
1280 | ||
1281 | Session.Data.Separators := | |
1282 | new Split.Column'(Field_Widths'Length, Field_Widths); | |
1283 | ||
1284 | -- If there is a current line read, split it according to | |
1285 | -- the new separators. | |
1286 | ||
1287 | if Session.Data.Current_Line /= Null_Unbounded_String then | |
1288 | Split_Line (Session); | |
1289 | end if; | |
1290 | end Set_Field_Widths; | |
1291 | ||
1292 | ---------------- | |
1293 | -- Split_Line -- | |
1294 | ---------------- | |
1295 | ||
1296 | procedure Split_Line (Session : Session_Type) is | |
1297 | Fields : Field_Table.Instance renames Session.Data.Fields; | |
1298 | ||
1299 | begin | |
1300 | Field_Table.Init (Fields); | |
1301 | ||
1302 | Split.Current_Line (Session.Data.Separators.all, Session); | |
1303 | end Split_Line; | |
1304 | ||
1305 | begin | |
1306 | -- We have declared two sessions but both should share the same data. | |
1307 | -- The current session must point to the default session as its initial | |
1308 | -- value. So first we release the session data then we set current | |
1309 | -- session data to point to default session data. | |
1310 | ||
1311 | Free (Cur_Session.Data); | |
1312 | Cur_Session.Data := Def_Session.Data; | |
1313 | end GNAT.AWK; |