gcc/ada/g-awk.adb

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