aws/tools/awsres.adb

------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                     Copyright (C) 2002-2024, 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 Software  Foundation;  either version 3,  or (at your option) any  --
--  later version.  This software is distributed in the hope  that it will  --
--  be useful, but WITHOUT ANY WARRANTY;  without even the implied warranty --
--  of MERCHANTABILITY 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  this  software;   see  file COPYING3.  If not, go    --
--  to http://www.gnu.org/licenses for a complete copy of the license.      --
------------------------------------------------------------------------------

--  This programs create a parent package Root_Pck and one children for any
--  files passed as argument.

with Ada.Calendar;
with Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Directories;
with Ada.Exceptions;
with Ada.Integer_Text_IO;
with Ada.Streams;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;

with GNAT.Calendar.Time_IO;
with GNAT.Command_Line;
with GNAT.Regexp;
with GNAT.SHA1;

with AWS.Resources.Streams.Disk;
with AWS.Resources.Streams.ZLib;
with AWS.Utils;

with ZLib;

procedure AwsRes is

   use Ada;
   use Ada.Exceptions;
   use Ada.Strings.Unbounded;
   use AWS;

   Syntax_Error : exception;

   Version  : constant String := "1.3";

   Glob_Pat : constant Strings.Maps.Character_Set :=
                Strings.Maps.To_Set ("*?");
   --  Globbing patterns

   Root_Pck : Unbounded_String := To_Unbounded_String ("res");
   Output   : Unbounded_String := To_Unbounded_String (".");
   Prefix   : Unbounded_String; --  prefix to resources names
   Quiet    : Boolean := False;
   Ada_Name : Boolean := False;

   RT_File  : Text_IO.File_Type;
   --  Root temp file

   R_File   : Text_IO.File_Type;
   --  Root spec/body file

   Compress : Boolean := False;
   --  By default resources are not compressed

   Recursive : Boolean := False;
   --  Do we need to recursively parse sub-directories

   procedure Create (Filename : String);
   --  Create resource package for Filename

   function Package_Name (Filename : String) return String;
   --  Returns package name for Filename

   procedure Parse_Command_Line;
   --  Parse command line

   function Header return String;
   --  Returns file header (AWSRes version, date, time)

   procedure Handle_Resource (Directory, Pattern : String);
   --  Parse the given directory for resources files

   function Output_Filename (Name : String) return String;
   --  Returns the pathname for the output file

   ------------
   -- Create --
   ------------

   procedure Create (Filename : String) is
      use Streams;

      package RS renames AWS.Resources.Streams;

      Max_Data  : constant := 14;
      --  Maximum number of data in a single line

      Unit_Name : constant String := Package_Name (Filename);
      Pck_Name  : constant String :=
                    To_String (Root_Pck) & '-' & Unit_Name & ".ads";

      Buffer    : Stream_Element_Array (1 .. 1_024 * 200);
      --  We need a buffer large enough to contain as much data as
      --  possible. This is more efficient for the compression, 200kb is
      --  certainly large enough for an embedded resource.

      Last      : Stream_Element_Offset;
      I         : Natural;

      File_Time : Calendar.Time;

      O_File    : Text_IO.File_Type;
      I_File    : RS.Stream_Access := new RS.Disk.Stream_Type;

      First     : Boolean := True;

      procedure Unchecked_Free is new Unchecked_Deallocation
        (RS.Stream_Type'Class, RS.Stream_Access);

   begin
      if not Quiet then
         Text_IO.Put ("creating " & Filename);
      end if;

      File_Time := Utils.File_Time_Stamp (Filename);

      begin
         Text_IO.Create (O_File, Text_IO.Out_File, Output_Filename (Pck_Name));
      exception
         when Text_IO.Use_Error =>
            Text_IO.New_Line;

            if Ada_Name and Recursive then
               raise Text_IO.Use_Error
                 with "Filename too long, remove -a option when -R used";
            else
               raise Text_IO.Use_Error
                 with "Cannot create embedded resource file";
            end if;
      end;

      RS.Disk.Open (RS.Disk.Stream_Type (I_File.all), Filename);

      if Compress then
         I_File := RS.ZLib.Deflate_Create (I_File, Header => ZLib.GZip);
      end if;

      --  Output package declaration

      Text_IO.New_Line (O_File);
      Text_IO.Put_Line (O_File, Header);
      Text_IO.New_Line (O_File);
      Text_IO.Put_Line (O_File, "pragma Style_Checks (Off);");
      Text_IO.New_Line (O_File);

      Text_IO.Put_Line (O_File, "with Ada.Streams;");
      Text_IO.New_Line (O_File);

      Text_IO.Put_Line (O_File, "package "
                        & To_String (Root_Pck) & '.' & Unit_Name & " is");
      Text_IO.New_Line (O_File);

      Text_IO.Put_Line (O_File, "   use Ada.Streams;");
      Text_IO.New_Line (O_File);

      Text_IO.Put_Line
        (O_File, "   Content : aliased constant Stream_Element_Array :=");

      --  Output file content

      I := 0;

      loop
         RS.Read (I_File.all, Buffer, Last);

         for K in Buffer'First .. Last loop
            if I /= 0 then
               Text_IO.Put (O_File, ",");

               if I = Max_Data then
                  Text_IO.New_Line (O_File);
                  Text_IO.Put (O_File, "       ");
                  I := 0;
               end if;
            end if;

            if First then
               --  No space after the open parentesis (style check)
               declare
                  V : constant Integer := Integer (Buffer (K));
               begin
                  if V < 10 then
                     Text_IO.Put
                       (O_File, "         [");
                     Integer_Text_IO.Put (O_File, V, Width => 1);
                  elsif V < 100 then
                     Text_IO.Put
                       (O_File, "        [");
                     Integer_Text_IO.Put (O_File, V, Width => 2);
                  else
                     Text_IO.Put
                       (O_File, "       [");
                     Integer_Text_IO.Put (O_File, V, Width => 3);
                  end if;
               end;
               First := False;

            else
               Integer_Text_IO.Put
                 (O_File, Integer (Buffer (K)), Width => 4);
            end if;

            I := I + 1;

            if not Quiet and then K mod 400 = 0 then
               Text_IO.Put ('.');
            end if;
         end loop;

         exit when Last < Buffer'Last;
      end loop;

      --  The resource was empty, nothing output yet

      if First then
         Text_IO.Put (O_File, "         [1 .. 0 => <>");
      end if;

      Text_IO.Put_Line (O_File, "];");

      --  Output end of package

      Text_IO.New_Line (O_File);
      Text_IO.Put_Line
        (O_File, "end " & To_String (Root_Pck) & '.' & Unit_Name & ';');

      RS.Close (I_File.all);
      Unchecked_Free (I_File);

      Text_IO.Close (O_File);

      if not Quiet then
         Text_IO.New_Line;
      end if;

      --  Register package into root package body

      Text_IO.Put_Line (RT_File, "         Register");

      declare
         Max_Len : constant := 50;

         --  The resource name must not have back-slash
         F_Name : constant String :=
                    To_String (Prefix)
                      & Strings.Fixed.Translate
                          (Filename, Strings.Maps.To_Mapping ("\", "/"));
         F, L   : Natural;
      begin
         Text_IO.Put (RT_File, "            (""");

         F := F_Name'First;

         loop
            L := Natural'Min (F_Name'Last, F + Max_Len);
            Text_IO.Put (RT_File, F_Name (F .. L));
            F := L + 1;

            exit when F > F_Name'Last;

            Text_IO.Put_Line (RT_File, """");
            Text_IO.Put (RT_File, "             & """);
         end loop;

         if Compress then
            Text_IO.Put_Line (RT_File, ".gz"",");
         else
            Text_IO.Put_Line (RT_File, """,");
         end if;
      end;

      Text_IO.Put_Line
        (RT_File, "             "
         & To_String (Root_Pck) & '.' & Unit_Name & ".Content'Access,");

      Text_IO.Put_Line
        (RT_File, "             GNAT.Calendar.Time_Of ("
         & GNAT.Calendar.Time_IO.Image
           (File_Time, "%Y, %m, %d, %H, %M, %S, 0.0));"));

      if not Quiet then
         Text_IO.Put_Line ("  -> registered");
      end if;

      --  Add with clause to root body

      Text_IO.Put_Line
        (R_File, "with " & To_String (Root_Pck) & '.' & Unit_Name & ';');
   end Create;

   ---------------------
   -- Handle_Resource --
   ---------------------

   procedure Handle_Resource (Directory, Pattern : String) is

      use Directories;

      File_And_Dir : constant Directories.Filter_Type :=
                       [Directories.Directory | Ordinary_File => True,
                        others                                => False];

      Regexp       : constant GNAT.Regexp.Regexp :=
                       GNAT.Regexp.Compile (Pattern, Glob => True);

      procedure Handle (Directory_Entry : Directory_Entry_Type);

      ------------
      -- Handle --
      ------------

      procedure Handle (Directory_Entry : Directory_Entry_Type) is
         Kind : File_Kind renames Directories.Kind (Directory_Entry);
      begin
         if Kind = Ordinary_File
           and then GNAT.Regexp.Match (Simple_Name (Directory_Entry), Regexp)
         then
            if Directory = "." then
               Create (Simple_Name (Directory_Entry));

            else
               Create (Compose (Directory, Simple_Name (Directory_Entry)));
            end if;

         elsif Recursive
           and then Kind = Directories.Directory
           and then Simple_Name (Directory_Entry) /= "."
           and then Simple_Name (Directory_Entry) /= ".."
         then
            if Directory = "." then
               Handle_Resource (Simple_Name (Directory_Entry), Pattern);
            else
               Handle_Resource
                 (Compose (Directory, Simple_Name (Directory_Entry)), Pattern);
            end if;
         end if;
      end Handle;

   begin
      Directories.Search (Directory, "*", File_And_Dir, Handle'Access);
   end Handle_Resource;

   ------------
   -- Header --
   ------------

   function Header return String is
   begin
      return "--  AWSRes v" & Version & " - Generated on " &
        GNAT.Calendar.Time_IO.Image (Calendar.Clock, "%B %d %Y at %T");
   end Header;

   -----------------
   -- Output_File --
   -----------------

   function Output_Filename (Name : String) return String is
      O : constant String := To_String (Output);
   begin
      if O = "." then
         return Name;
      else
         return Directories.Compose (O, Name);
      end if;
   end Output_Filename;

   ------------------
   -- Package_Name --
   ------------------

   function Package_Name (Filename : String) return String is
      From : constant String := "./\-";
      To   : constant String := "___x";

      Map  : constant Strings.Maps.Character_Mapping :=
               Strings.Maps.To_Mapping (From, To);
   begin
      if Ada_Name then
         return Characters.Handling.To_Lower
           (Strings.Fixed.Translate (Filename, Map));

      else
         --  Else encode package name using SHA1, this it can start with a
         --  digit prefix the result with "p_".

         return "p_" & GNAT.SHA1.Digest (Filename);
      end if;
   end Package_Name;

   ------------------------
   -- Parse_Command_Line --
   ------------------------

   procedure Parse_Command_Line is
   begin
      GNAT.Command_Line.Initialize_Option_Scan
        (Stop_At_First_Non_Switch => True);

      loop
         case GNAT.Command_Line.Getopt ("a r: h q z u o: p: R") is
            when ASCII.NUL =>
               exit;

            when 'a' =>
               Ada_Name := True;

            when 'o' =>
               Output := To_Unbounded_String (GNAT.Command_Line.Parameter);

            when 'R' =>
               Recursive := True;

            when 'p' =>
               Prefix := To_Unbounded_String (GNAT.Command_Line.Parameter);

            when 'r' =>
               Root_Pck := To_Unbounded_String (GNAT.Command_Line.Parameter);

            when 'q' =>
               Quiet := True;

            when 'z' =>
               Compress := True;

            when 'u' =>
               Compress := False;

            when 'h' =>
               raise Syntax_Error;

            when others =>
               raise Syntax_Error;
         end case;
      end loop;

   exception
      when GNAT.Command_Line.Invalid_Switch =>
         raise Syntax_Error;
   end Parse_Command_Line;

   Buffer : String (1 .. 2_048);
   Last   : Natural;

begin
   Parse_Command_Line;

   if not Quiet then
      Text_IO.Put_Line ("AWSRes - Resource Creator v" & Version);
      Text_IO.New_Line;
   end if;

   Text_IO.Create (RT_File, Text_IO.Out_File);
   Text_IO.Create
     (R_File, Text_IO.Out_File,
      Output_Filename (To_String (Root_Pck) & ".adb"));

   Text_IO.New_Line (R_File);
   Text_IO.Put_Line (R_File, Header);
   Text_IO.New_Line (R_File);
   Text_IO.Put_Line (R_File, "pragma Style_Checks (Off);");
   Text_IO.New_Line (R_File);

   Text_IO.New_Line (RT_File);
   Text_IO.Put_Line (RT_File, "with AWS.Resources.Embedded;");
   Text_IO.Put_Line (RT_File, "with GNAT.Calendar;");
   Text_IO.New_Line (RT_File);
   Text_IO.Put_Line (RT_File, "package body " & To_String (Root_Pck) & " is");
   Text_IO.New_Line (RT_File);

   Text_IO.Put_Line (RT_File, "   Initialized : Boolean := False;");
   Text_IO.New_Line (RT_File);
   Text_IO.Put_Line (RT_File, "   procedure Init is");
   Text_IO.Put_Line (RT_File, "      use AWS.Resources.Embedded;");
   Text_IO.Put_Line (RT_File, "   begin");
   Text_IO.Put_Line (RT_File, "      if not Initialized then");
   Text_IO.Put_Line (RT_File, "         Initialized := True;");

   --  Parse directories/files

   loop
      declare
         use Directories;

         S    : constant String :=
                  Utils.Dequote
                    (GNAT.Command_Line.Get_Argument (Do_Expansion => False));
         Glob : constant Boolean := Strings.Fixed.Index (S, Glob_Pat) /= 0;
         Dir  : constant Natural :=
                  Strings.Fixed.Index
                    (S, Strings.Maps.To_Set ("/\"), Going => Strings.Backward);
      begin
         exit when S'Length = 0;

         if S = "-z" then
            Compress := True;

         elsif S = "-u" then
            Compress := False;

         else
            if not Glob and then Exists (S) and then Kind (S) = Directory then
               Handle_Resource (S, "*.*");

            --  No directory specified

            elsif Dir = 0 then
               Handle_Resource (".", S);

            --  A directory specified

            else
               Handle_Resource (S (S'First .. Dir - 1), S (Dir + 1 .. S'Last));
            end if;
         end if;
      end;
   end loop;

   Text_IO.Put_Line (RT_File, "      end if;");
   Text_IO.Put_Line (RT_File, "   end Init;");
   Text_IO.New_Line (RT_File);
   Text_IO.Put_Line (RT_File, "begin");
   Text_IO.Put_Line (RT_File, "   Init;");
   Text_IO.Put_Line (RT_File, "end " & To_String (Root_Pck) & ";");

   --  Copy now all the temp root file into the body file

   Text_IO.Reset (RT_File, Text_IO.In_File);

   while not Text_IO.End_Of_File (RT_File) loop
      Text_IO.Get_Line (RT_File, Buffer, Last);
      Text_IO.Put_Line (R_File, Buffer (1 .. Last));
   end loop;

   Text_IO.Close (RT_File);
   Text_IO.Close (R_File);

   --  Generate now the root package spec

   Text_IO.Create
     (R_File, Text_IO.Out_File,
      Output_Filename (To_String (Root_Pck) & ".ads"));

   Text_IO.New_Line (R_File);
   Text_IO.Put_Line (R_File, Header);
   Text_IO.New_Line (R_File);
   Text_IO.Put_Line (R_File, "package " & To_String (Root_Pck) & " is");
   Text_IO.New_Line (R_File);

   Text_IO.Put_Line (R_File, "   procedure Init;");
   Text_IO.Put_Line (R_File, "   --  Register all resources files");

   Text_IO.New_Line (R_File);
   Text_IO.Put_Line (R_File, "end " & To_String (Root_Pck) & ";");

   Text_IO.Close (R_File);

   Command_Line.Set_Exit_Status (Command_Line.Success);

exception
   when Syntax_Error =>
      Text_IO.Put_Line ("AWSRes - Resource Creator v" & Version);
      Text_IO.New_Line;
      Text_IO.Put_Line
        ("Usage : awsres [-hopqrRzu] file1/dir1 [-zu] [file2/dir2...]");
      Text_IO.New_Line;
      Text_IO.Put_Line
        ("        -a      : packages are named after the actual filenames");
      Text_IO.Put_Line
        ("        -h      : display help");
      Text_IO.Put_Line
        ("        -o dir  : specify the output directory");
      Text_IO.Put_Line
        ("        -p str  : prefix all resource names with the given string");
      Text_IO.Put_Line
        ("        -R      : activate recursivity");
      Text_IO.Put_Line
        ("        -r name : name of the root package (default res)");
      Text_IO.Put_Line
        ("        -z      : enable compression of following resources");
      Text_IO.Put_Line
        ("        -u      : disable compression of following resources");
      Text_IO.Put_Line
        ("        -q      : quiet mode");

      Command_Line.Set_Exit_Status (Command_Line.Failure);

   when E : Text_IO.Use_Error =>
      Text_IO.Put_Line (Exception_Message (E));

      Command_Line.Set_Exit_Status (Command_Line.Failure);
end AwsRes;