------------------------------------------------------------------------------
-- --
-- GPR2 PROJECT MANAGER --
-- --
-- Copyright (C) 2020-2023, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for more details. You should have received a copy of the GNU --
-- General Public License distributed with GNAT; see file COPYING. If not, --
-- see . --
-- --
------------------------------------------------------------------------------
-- This utility collects all files of the GPRconfig Knowledge Base and
-- composes them into a single file intended for embedding in GPR2 library.
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Characters.Handling;
with Ada.Directories;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with GNAT.Command_Line;
with GNAT.OS_Lib;
with Direct_IO;
procedure Collect_KB is
use Ada;
use Ada.Strings.Unbounded;
use GNAT;
Collect_KB_Error : exception;
-- Raised to terminate execution
Default_Output_Name : constant String := "config.kb";
Output_File : Unbounded_String :=
To_Unbounded_String
(OS_Lib.Normalize_Pathname
(Default_Output_Name,
Directory => Directories.Current_Directory,
Case_Sensitive => False));
-- Output file where composed knoledge base should be written
KB_Dir : Unbounded_String;
-- Location of knowledge base
Search : Directories.Search_Type;
File : Directories.Directory_Entry_Type;
KB_File_In : Text_IO.File_Type;
procedure Help;
-- Displays help on using this application
procedure Fail (S : String);
-- Outputs S to Standard_Error and raises Collect_KB_Error
procedure Add_Buffer_To_Input (F_Name : String);
-- Adds contents of Input_Buffer to All_Input, prepending it by base name
-- of F_Name and length of buffer contents:
-- ::
----------
-- Fail --
----------
procedure Fail (S : String) is
begin
Text_IO.Put_Line (Text_IO.Standard_Error, S);
raise Collect_KB_Error;
end Fail;
----------
-- Help --
----------
procedure Help is
begin
Text_IO.Put_Line ("Usage: collect_kb [opts] dirname");
Text_IO.Put_Line (" -h : Show help message");
Text_IO.Put_Line (" -v : Verbose mode");
Text_IO.Put_Line (" -o : Output file name");
Text_IO.Put_Line
(" Default is " & Default_Output_Name);
end Help;
Verbose_Mode : Boolean := False;
-- Verbose output
package String_Lists is new
Ada.Containers.Indefinite_Doubly_Linked_Lists (String);
use String_Lists;
Entities : List;
XML_Files : List;
Schema : Unbounded_String;
Input_Buffer, All_Input : Unbounded_String;
-------------------------
-- Add_Buffer_To_Input --
-------------------------
procedure Add_Buffer_To_Input (F_Name : String) is
use Ada.Strings.Fixed;
Length_Img : constant String :=
Trim (Length (Input_Buffer)'Img, Ada.Strings.Both);
begin
Append
(All_Input,
Directories.Simple_Name (F_Name)
& ":" & Length_Img & ":" & Input_Buffer);
end Add_Buffer_To_Input;
begin
loop
case Command_Line.Getopt ("h v o:") is
when ASCII.NUL =>
exit;
when 'o' =>
Output_File := To_Unbounded_String
(OS_Lib.Normalize_Pathname
(Command_Line.Parameter,
Directory => Directories.Current_Directory,
Case_Sensitive => False));
when 'h' =>
Help;
return;
when 'v' =>
Verbose_Mode := True;
when others =>
Fail ("collect_kb: unknown switch " & Command_Line.Full_Switch);
end case;
end loop;
KB_Dir := To_Unbounded_String
(OS_Lib.Normalize_Pathname
(Command_Line.Get_Argument,
Case_Sensitive => False));
if KB_Dir = "" then
Fail ("collect_kb: knowledge base dirname not specified");
elsif not OS_Lib.Is_Directory (To_String (KB_Dir)) then
Fail ("collect_kb: cannot find directory " & To_String (KB_Dir));
end if;
if Verbose_Mode then
Text_IO.Put_Line ("collect_kb: parsing " & To_String (KB_Dir));
end if;
Directories.Start_Search
(Search,
Directory => To_String (KB_Dir),
Pattern => "",
Filter => (Directories.Ordinary_File => True, others => False));
while Directories.More_Entries (Search) loop
Directories.Get_Next_Entry (Search, File);
if Verbose_Mode then
Text_IO.Put_Line (" " & Directories.Full_Name (File));
end if;
declare
Ext : constant String :=
Characters.Handling.To_Lower
(Directories.Extension (Directories.Full_Name (File)));
begin
if Ext = "xml" then
XML_Files.Append (Directories.Full_Name (File));
elsif Ext = "ent" then
Entities.Append (Directories.Full_Name (File));
elsif Ext = "xsd" then
if Schema = Null_Unbounded_String then
Schema := To_Unbounded_String (Directories.Full_Name (File));
else
Fail ("collect_kb: only one schema file is allowed");
end if;
else
if Verbose_Mode then
Text_IO.Put_Line (" unknown file type, skipping");
end if;
end if;
end;
end loop;
Directories.End_Search (Search);
if XML_Files.Is_Empty then
Fail ("collect_kb: no xml files found in " & To_String (KB_Dir));
end if;
if Schema /= Null_Unbounded_String then
Text_IO.Open (KB_File_In, Text_IO.In_File, To_String (Schema));
while not Text_IO.End_Of_File (KB_File_In) loop
Append (Input_Buffer, Text_IO.Get_Line (KB_File_In) & ASCII.LF);
end loop;
Text_IO.Close (KB_File_In);
Add_Buffer_To_Input (To_String (Schema));
end if;
Input_Buffer := Null_Unbounded_String;
for Ent_File of Entities loop
Text_IO.Open (KB_File_In, Text_IO.In_File, Ent_File);
while not Text_IO.End_Of_File (KB_File_In) loop
Append (Input_Buffer, Text_IO.Get_Line (KB_File_In) & ASCII.LF);
end loop;
Text_IO.Close (KB_File_In);
Add_Buffer_To_Input (Ent_File);
Input_Buffer := Null_Unbounded_String;
end loop;
Entities.Clear;
for XML_File of XML_Files loop
Text_IO.Open (KB_File_In, Text_IO.In_File, XML_File);
while not Text_IO.End_Of_File (KB_File_In) loop
Append (Input_Buffer, Text_IO.Get_Line (KB_File_In) & ASCII.LF);
end loop;
Text_IO.Close (KB_File_In);
Add_Buffer_To_Input (XML_File);
Input_Buffer := Null_Unbounded_String;
end loop;
XML_Files.Clear;
declare
type Substring is new String (1 .. Length (All_Input));
package Output is new Direct_IO (Substring);
F : Output.File_Type;
begin
Output.Create (F, Output.Out_File, To_String (Output_File));
Output.Write (F, Substring (To_String (All_Input)));
Output.Close (F);
end;
exception
when Ex : Command_Line.Invalid_Switch =>
Text_IO.Put_Line
(Text_IO.Standard_Error, Ada.Exceptions.Exception_Message (Ex));
Help;
OS_Lib.OS_Exit (1);
when Ex : others =>
Text_IO.Put_Line
(Text_IO.Standard_Error, Ada.Exceptions.Exception_Information (Ex));
OS_Lib.OS_Exit (2);
end Collect_KB;