------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Command Line Interface for primitives in Natools.Smaz.Tools.             --
------------------------------------------------------------------------------

with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Text_IO.Text_Streams;
with Natools.Getopt_Long;
with Natools.S_Expressions.Parsers;
with Natools.S_Expressions.Printers;
with Natools.Smaz.Tools;
with Natools.Smaz.Tools.GNAT;

procedure Smaz is
   function To_SEA (S : String) return Ada.Streams.Stream_Element_Array
     renames Natools.S_Expressions.To_Atom;

   package Actions is
      type Enum is
        (Nothing,
         Decode,
         Encode);
   end Actions;

   package Options is
      type Id is
        (Output_Ada_Dictionary,
         Decode,
         Encode,
         Output_Hash,
         Help,
         Stat_Output,
         No_Stat_Output,
         Sx_Output,
         No_Sx_Output);
   end Options;

   package Getopt is new Natools.Getopt_Long (Options.Id);

   type Callback is new Getopt.Handlers.Callback with record
      Display_Help : Boolean := False;
      Need_Dictionary : Boolean := False;
      Stat_Output : Boolean := False;
      Sx_Output : Boolean := False;
      Action : Actions.Enum := Actions.Nothing;
      Ada_Dictionary : Ada.Strings.Unbounded.Unbounded_String;
      Hash_Package : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String);

   overriding procedure Argument
     (Handler  : in out Callback;
      Argument : in String)
     is null;

   function Getopt_Config return Getopt.Configuration;
      --  Build the configuration object

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
      --  print the given dictionary in the given file

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type);
      --  Print the help text to the given file

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String) is
   begin
      case Id is
         when Options.Help =>
            Handler.Display_Help := True;

         when Options.Decode =>
            Handler.Need_Dictionary := True;
            Handler.Action := Actions.Decode;

         when Options.Encode =>
            Handler.Need_Dictionary := True;
            Handler.Action := Actions.Encode;

         when Options.No_Stat_Output =>
            Handler.Stat_Output := False;

         when Options.No_Sx_Output =>
            Handler.Sx_Output := False;

         when Options.Output_Ada_Dictionary =>
            Handler.Need_Dictionary := True;

            if Argument'Length > 0 then
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String (Argument);
            else
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String ("-");
            end if;

         when Options.Output_Hash =>
            Handler.Need_Dictionary := True;
            Handler.Hash_Package
              := Ada.Strings.Unbounded.To_Unbounded_String (Argument);

         when Options.Stat_Output =>
            Handler.Stat_Output := True;

         when Options.Sx_Output =>
            Handler.Sx_Output := True;
      end case;
   end Option;

   function Getopt_Config return Getopt.Configuration is
      use Getopt;
      use Options;
      R : Getopt.Configuration;
   begin
      R.Add_Option ("ada-dict", 'A', Optional_Argument, Output_Ada_Dictionary);
      R.Add_Option ("decode",   'd', No_Argument,       Decode);
      R.Add_Option ("encode",   'e', No_Argument,       Encode);
      R.Add_Option ("help",     'h', No_Argument,       Help);
      R.Add_Option ("hash-pkg", 'H', Required_Argument, Output_Hash);
      R.Add_Option ("stats",    's', No_Argument,       Stat_Output);
      R.Add_Option ("no-stats", 'S', No_Argument,       No_Stat_Output);
      R.Add_Option ("s-expr",   'x', No_Argument,       Sx_Output);
      R.Add_Option ("no-s-expr", 'X', No_Argument,       No_Sx_Output);

      return R;
   end Getopt_Config;

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "") is
   begin
      if Filename = "-" then
         Print_Dictionary
           (Ada.Text_IO.Current_Output, Dictionary, Hash_Package_Name);
      elsif Filename'Length > 0 then
         declare
            File : Ada.Text_IO.File_Type;
         begin
            Ada.Text_IO.Create (File, Name => Filename);
            Print_Dictionary (File, Dictionary, Hash_Package_Name);
            Ada.Text_IO.Close (File);
         end;
      end if;
   end Print_Dictionary;

   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "")
   is
      procedure Put_Line (Line : in String);

      procedure Put_Line (Line : in String) is
      begin
         Ada.Text_IO.Put_Line (Output, Line);
      end Put_Line;

      procedure Print_Dictionary_In_Ada is
        new Natools.Smaz.Tools.Print_Dictionary_In_Ada (Put_Line);
   begin
      if Hash_Package_Name'Length > 0 then
         Print_Dictionary_In_Ada
           (Dictionary,
            Hash_Image => Hash_Package_Name & ".Hash'Access");
      else
         Print_Dictionary_In_Ada (Dictionary);
      end if;
   end Print_Dictionary;

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type)
   is
      use Ada.Text_IO;
      Indent : constant String := "    ";
   begin
      Put_Line (Output, "Usage:");

      for Id in Options.Id loop
         Put (Output, Indent & Opt.Format_Names (Id));

         case Id is
            when Options.Help =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Display this help text");

            when Options.Decode =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Read a list of strings and decode them");

            when Options.Encode =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Read a list of strings and encode them");

            when Options.No_Stat_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Do not output filter statistics");

            when Options.No_Sx_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Do not output filtered results in a S-expression");

            when Options.Output_Ada_Dictionary =>
               Put_Line (Output, "=[filename]");
               Put_Line (Output, Indent & Indent
                 & "Output the current dictionary as Ada code in the given");
               Put_Line (Output, Indent & Indent
                 & "file, or standard output if filename is ""-""");

            when Options.Output_Hash =>
               Put_Line (Output, " <Hash Package Name>");
               Put_Line (Output, Indent & Indent
                 & "Build a package with a perfect hash function for the");
               Put_Line (Output, Indent & Indent
                 & "current dictionary.");

            when Options.Stat_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Output filter statistics");

            when Options.Sx_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Output filtered results in a S-expression");
         end case;
      end loop;
   end Print_Help;

   Opt_Config : constant Getopt.Configuration := Getopt_Config;
   Handler : Callback;
   Input_List, Input_Data : Natools.Smaz.Tools.String_Lists.List;
begin
   Process_Command_Line :
   begin
      Opt_Config.Process (Handler);
   exception
      when Getopt.Option_Error =>
         Print_Help (Opt_Config, Ada.Text_IO.Current_Error);
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
         return;
   end Process_Command_Line;

   if Handler.Display_Help then
      Print_Help (Opt_Config, Ada.Text_IO.Current_Output);
   end if;

   if not Handler.Need_Dictionary then
      return;
   end if;

   if not (Handler.Stat_Output or Handler.Sx_Output) then
      Handler.Sx_Output := True;
   end if;

   Read_Input_List :
   declare
      use type Actions.Enum;

      Input : constant access Ada.Streams.Root_Stream_Type'Class
        := Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Input);
      Parser : Natools.S_Expressions.Parsers.Stream_Parser (Input);
   begin
      Parser.Next;
      Natools.Smaz.Tools.Read_List (Input_List, Parser);

      if Handler.Action /= Actions.Nothing then
         Parser.Next;
         Natools.Smaz.Tools.Read_List (Input_Data, Parser);
      end if;
   end Read_Input_List;

   Build_Dictionary :
   declare
      Dictionary : Natools.Smaz.Dictionary
        := Natools.Smaz.Tools.To_Dictionary (Input_List, True);
      Sx_Output : Natools.S_Expressions.Printers.Canonical
        (Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Output));
      Ada_Dictionary : constant String
        := Ada.Strings.Unbounded.To_String (Handler.Ada_Dictionary);
      Hash_Package : constant String
        := Ada.Strings.Unbounded.To_String (Handler.Hash_Package);
   begin
      Dictionary.Hash := Natools.Smaz.Tools.Linear_Search'Access;
      Natools.Smaz.Tools.List_For_Linear_Search := Input_List;

      if Ada_Dictionary'Length > 0 then
         Print_Dictionary (Ada_Dictionary, Dictionary, Hash_Package);
      end if;

      if Hash_Package'Length > 0 then
         Natools.Smaz.Tools.GNAT.Build_Perfect_Hash (Input_List, Hash_Package);
      end if;

      case Handler.Action is
         when Actions.Nothing => null;

         when Actions.Decode =>
            if Handler.Sx_Output then
               Sx_Output.Open_List;
               for S of Input_Data loop
                  Sx_Output.Append_String
                    (Natools.Smaz.Decompress (Dictionary, To_SEA (S)));
               end loop;
               Sx_Output.Close_List;
            end if;

            if Handler.Stat_Output then
               declare
                  procedure Print_Line (Original, Output : Natural);

                  procedure Print_Line (Original, Output : Natural) is
                  begin
                     Ada.Text_IO.Put_Line
                       (Natural'Image (Original)
                        & Ada.Characters.Latin_1.HT
                        & Natural'Image (Output)
                        & Ada.Characters.Latin_1.HT
                        & Float'Image (Float (Original) / Float (Output)));
                  end Print_Line;
                  Original_Total : Natural := 0;
                  Output_Total : Natural := 0;
               begin
                  for S of Input_Data loop
                     declare
                        Original_Size : constant Natural := S'Length;
                        Output_Size : constant Natural
                          := Natools.Smaz.Decompress
                             (Dictionary, To_SEA (S))'Length;
                     begin
                        Print_Line (Original_Size, Output_Size);
                        Original_Total := Original_Total + Original_Size;
                        Output_Total := Output_Total + Output_Size;
                     end;
                  end loop;

                  Print_Line (Original_Total, Output_Total);
               end;
            end if;

         when Actions.Encode =>
            if Handler.Sx_Output then
               Sx_Output.Open_List;
               for S of Input_Data loop
                  Sx_Output.Append_Atom
                    (Natools.Smaz.Compress (Dictionary, S));
               end loop;
               Sx_Output.Close_List;
            end if;

            if Handler.Stat_Output then
               declare
                  procedure Print_Line (Original, Output, Base64 : Natural);

                  procedure Print_Line (Original, Output, Base64 : Natural) is
                  begin
                     Ada.Text_IO.Put_Line
                       (Natural'Image (Original)
                        & Ada.Characters.Latin_1.HT
                        & Natural'Image (Output)
                        & Ada.Characters.Latin_1.HT
                        & Natural'Image (Base64)
                        & Ada.Characters.Latin_1.HT
                        & Float'Image (Float (Output) / Float (Original))
                        & Ada.Characters.Latin_1.HT
                        & Float'Image (Float (Base64) / Float (Original)));
                  end Print_Line;
                  Original_Total : Natural := 0;
                  Output_Total : Natural := 0;
                  Base64_Total : Natural := 0;
               begin
                  for S of Input_Data loop
                     declare
                        Original_Size : constant Natural := S'Length;
                        Output_Size : constant Natural
                          := Natools.Smaz.Compress (Dictionary, S)'Length;
                        Base64_Size : constant Natural
                          := ((Output_Size + 2) / 3) * 4;
                     begin
                        Print_Line (Original_Size, Output_Size, Base64_Size);
                        Original_Total := Original_Total + Original_Size;
                        Output_Total := Output_Total + Output_Size;
                        Base64_Total := Base64_Total + Base64_Size;
                     end;
                  end loop;

                  Print_Line (Original_Total, Output_Total, Base64_Total);
               end;
            end if;
      end case;
   end Build_Dictionary;
end Smaz;

------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Command Line Interface for primitives in Natools.Smaz.Tools.             --
------------------------------------------------------------------------------

with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Text_IO.Text_Streams;
with Natools.Getopt_Long;
with Natools.S_Expressions.Parsers;
with Natools.S_Expressions.Printers;
with Natools.Smaz.Tools;
with Natools.Smaz.Tools.GNAT;

procedure Smaz is
   function To_SEA (S : String) return Ada.Streams.Stream_Element_Array
     renames Natools.S_Expressions.To_Atom;

   package Actions is
      type Enum is
        (Nothing,
         Decode,
         Encode);
   end Actions;

   package Dict_Sources is
      type Enum is
        (S_Expression,
         Word_List);
   end Dict_Sources;

   package Options is
      type Id is
        (Output_Ada_Dict,
         Dictionary_Input,
         Decode,
         Encode,
         Output_Hash,
         Help,
         Stat_Output,
         No_Stat_Output,
         Word_List_Input,
         Sx_Output,
         No_Sx_Output);
   end Options;

   package Getopt is new Natools.Getopt_Long (Options.Id);

   type Callback is new Getopt.Handlers.Callback with record
      Display_Help : Boolean := False;
      Need_Dictionary : Boolean := False;
      Stat_Output : Boolean := False;
      Sx_Output : Boolean := False;
      Action : Actions.Enum := Actions.Nothing;
      Ada_Dictionary : Ada.Strings.Unbounded.Unbounded_String;
      Hash_Package : Ada.Strings.Unbounded.Unbounded_String;
      Dict_Source : Dict_Sources.Enum := Dict_Sources.S_Expression;
   end record;

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String);

   overriding procedure Argument
     (Handler  : in out Callback;
      Argument : in String)
     is null;

   function Getopt_Config return Getopt.Configuration;
      --  Build the configuration object

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
      --  print the given dictionary in the given file

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type);
      --  Print the help text to the given file

   function To_Dictionary
     (Handler : in Callback'Class;
      Input : in Natools.Smaz.Tools.String_Lists.List)
     return Natools.Smaz.Dictionary;
      --  Convert the input into a dictionary given the option in Handler

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String) is
   begin
      case Id is
         when Options.Help =>
            Handler.Display_Help := True;

         when Options.Decode =>
            Handler.Need_Dictionary := True;
            Handler.Action := Actions.Decode;

         when Options.Encode =>
            Handler.Need_Dictionary := True;
            Handler.Action := Actions.Encode;

         when Options.No_Stat_Output =>
            Handler.Stat_Output := False;

         when Options.No_Sx_Output =>
            Handler.Sx_Output := False;

         when Options.Output_Ada_Dict =>
            Handler.Need_Dictionary := True;

            if Argument'Length > 0 then
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String (Argument);
            else
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String ("-");
            end if;

         when Options.Output_Hash =>
            Handler.Need_Dictionary := True;
            Handler.Hash_Package
              := Ada.Strings.Unbounded.To_Unbounded_String (Argument);

         when Options.Stat_Output =>
            Handler.Stat_Output := True;

         when Options.Sx_Output =>
            Handler.Sx_Output := True;

         when Options.Dictionary_Input =>
            Handler.Dict_Source := Dict_Sources.S_Expression;

         when Options.Word_List_Input =>
            Handler.Dict_Source := Dict_Sources.Word_List;
      end case;
   end Option;

   function Getopt_Config return Getopt.Configuration is
      use Getopt;
      use Options;
      R : Getopt.Configuration;
   begin
      R.Add_Option ("ada-dict",  'A', Optional_Argument, Output_Ada_Dict);
      R.Add_Option ("decode",    'd', No_Argument,       Decode);
      R.Add_Option ("dict",      'D', No_Argument,       Dictionary_Input);
      R.Add_Option ("encode",    'e', No_Argument,       Encode);
      R.Add_Option ("help",      'h', No_Argument,       Help);
      R.Add_Option ("hash-pkg",  'H', Required_Argument, Output_Hash);
      R.Add_Option ("stats",     's', No_Argument,       Stat_Output);
      R.Add_Option ("no-stats",  'S', No_Argument,       No_Stat_Output);
      R.Add_Option ("word-list", 'w', No_Argument,       Word_List_Input);
      R.Add_Option ("s-expr",    'x', No_Argument,       Sx_Output);
      R.Add_Option ("no-s-expr", 'X', No_Argument,       No_Sx_Output);

      return R;
   end Getopt_Config;

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "") is
   begin
      if Filename = "-" then
         Print_Dictionary
           (Ada.Text_IO.Current_Output, Dictionary, Hash_Package_Name);
      elsif Filename'Length > 0 then
         declare
            File : Ada.Text_IO.File_Type;
         begin
            Ada.Text_IO.Create (File, Name => Filename);
            Print_Dictionary (File, Dictionary, Hash_Package_Name);
            Ada.Text_IO.Close (File);
         end;
      end if;
   end Print_Dictionary;

   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "")
   is
      procedure Put_Line (Line : in String);

      procedure Put_Line (Line : in String) is
      begin
         Ada.Text_IO.Put_Line (Output, Line);
      end Put_Line;

      procedure Print_Dictionary_In_Ada is
        new Natools.Smaz.Tools.Print_Dictionary_In_Ada (Put_Line);
   begin
      if Hash_Package_Name'Length > 0 then
         Print_Dictionary_In_Ada
           (Dictionary,
            Hash_Image => Hash_Package_Name & ".Hash'Access");
      else
         Print_Dictionary_In_Ada (Dictionary);
      end if;
   end Print_Dictionary;

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type)
   is
      use Ada.Text_IO;
      Indent : constant String := "    ";
   begin
      Put_Line (Output, "Usage:");

      for Id in Options.Id loop
         Put (Output, Indent & Opt.Format_Names (Id));

         case Id is
            when Options.Help =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Display this help text");

            when Options.Decode =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Read a list of strings and decode them");

            when Options.Encode =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Read a list of strings and encode them");

            when Options.No_Stat_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Do not output filter statistics");

            when Options.No_Sx_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Do not output filtered results in a S-expression");

            when Options.Output_Ada_Dict =>
               Put_Line (Output, "=[filename]");
               Put_Line (Output, Indent & Indent
                 & "Output the current dictionary as Ada code in the given");
               Put_Line (Output, Indent & Indent
                 & "file, or standard output if filename is ""-""");

            when Options.Output_Hash =>
               Put_Line (Output, " <Hash Package Name>");
               Put_Line (Output, Indent & Indent
                 & "Build a package with a perfect hash function for the");
               Put_Line (Output, Indent & Indent
                 & "current dictionary.");

            when Options.Stat_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Output filter statistics");

            when Options.Sx_Output =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Output filtered results in a S-expression");

            when Options.Dictionary_Input =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Read dictionary directly in input S-expression (default)");

            when Options.Word_List_Input =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Compute dictionary from word list in input S-expression");
         end case;
      end loop;
   end Print_Help;

   function To_Dictionary
     (Handler : in Callback'Class;
      Input : in Natools.Smaz.Tools.String_Lists.List)
     return Natools.Smaz.Dictionary is
   begin
      case Handler.Dict_Source is
         when Dict_Sources.S_Expression =>
            return Natools.Smaz.Tools.To_Dictionary (Input, True);

         when Dict_Sources.Word_List =>
            declare
               Counter : Natools.Smaz.Tools.Word_Counter;
            begin
               for S of Input loop
                  Natools.Smaz.Tools.Add_Substrings (Counter, S, 1, 3);
               end loop;

               return Natools.Smaz.Tools.To_Dictionary
                 (Natools.Smaz.Tools.Most_Common_Words (Counter, 254),
                  True);
            end;
      end case;
   end To_Dictionary;

   Opt_Config : constant Getopt.Configuration := Getopt_Config;
   Handler : Callback;
   Input_List, Input_Data : Natools.Smaz.Tools.String_Lists.List;
begin
   Process_Command_Line :
   begin
      Opt_Config.Process (Handler);
   exception
      when Getopt.Option_Error =>
         Print_Help (Opt_Config, Ada.Text_IO.Current_Error);
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
         return;
   end Process_Command_Line;

   if Handler.Display_Help then
      Print_Help (Opt_Config, Ada.Text_IO.Current_Output);
   end if;

   if not Handler.Need_Dictionary then
      return;
   end if;

   if not (Handler.Stat_Output or Handler.Sx_Output) then
      Handler.Sx_Output := True;
   end if;

   Read_Input_List :
   declare
      use type Actions.Enum;

      Input : constant access Ada.Streams.Root_Stream_Type'Class
        := Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Input);
      Parser : Natools.S_Expressions.Parsers.Stream_Parser (Input);
   begin
      Parser.Next;
      Natools.Smaz.Tools.Read_List (Input_List, Parser);

      if Handler.Action /= Actions.Nothing then
         Parser.Next;
         Natools.Smaz.Tools.Read_List (Input_Data, Parser);
      end if;
   end Read_Input_List;

   Build_Dictionary :
   declare
      Dictionary : Natools.Smaz.Dictionary
        := To_Dictionary (Handler, Input_List);
      Sx_Output : Natools.S_Expressions.Printers.Canonical
        (Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Output));
      Ada_Dictionary : constant String
        := Ada.Strings.Unbounded.To_String (Handler.Ada_Dictionary);
      Hash_Package : constant String
        := Ada.Strings.Unbounded.To_String (Handler.Hash_Package);
   begin
      Dictionary.Hash := Natools.Smaz.Tools.Linear_Search'Access;
      Natools.Smaz.Tools.List_For_Linear_Search := Input_List;

      if Ada_Dictionary'Length > 0 then
         Print_Dictionary (Ada_Dictionary, Dictionary, Hash_Package);
      end if;

      if Hash_Package'Length > 0 then
         Natools.Smaz.Tools.GNAT.Build_Perfect_Hash (Input_List, Hash_Package);
      end if;

      case Handler.Action is
         when Actions.Nothing => null;

         when Actions.Decode =>
            if Handler.Sx_Output then
               Sx_Output.Open_List;
               for S of Input_Data loop
                  Sx_Output.Append_String
                    (Natools.Smaz.Decompress (Dictionary, To_SEA (S)));
               end loop;
               Sx_Output.Close_List;
            end if;

            if Handler.Stat_Output then
               declare
                  procedure Print_Line (Original, Output : Natural);

                  procedure Print_Line (Original, Output : Natural) is
                  begin
                     Ada.Text_IO.Put_Line
                       (Natural'Image (Original)
                        & Ada.Characters.Latin_1.HT
                        & Natural'Image (Output)
                        & Ada.Characters.Latin_1.HT
                        & Float'Image (Float (Original) / Float (Output)));
                  end Print_Line;
                  Original_Total : Natural := 0;
                  Output_Total : Natural := 0;
               begin
                  for S of Input_Data loop
                     declare
                        Original_Size : constant Natural := S'Length;
                        Output_Size : constant Natural
                          := Natools.Smaz.Decompress
                             (Dictionary, To_SEA (S))'Length;
                     begin
                        Print_Line (Original_Size, Output_Size);
                        Original_Total := Original_Total + Original_Size;
                        Output_Total := Output_Total + Output_Size;
                     end;
                  end loop;

                  Print_Line (Original_Total, Output_Total);
               end;
            end if;

         when Actions.Encode =>
            if Handler.Sx_Output then
               Sx_Output.Open_List;
               for S of Input_Data loop
                  Sx_Output.Append_Atom
                    (Natools.Smaz.Compress (Dictionary, S));
               end loop;
               Sx_Output.Close_List;
            end if;

            if Handler.Stat_Output then
               declare
                  procedure Print_Line (Original, Output, Base64 : Natural);

                  procedure Print_Line (Original, Output, Base64 : Natural) is
                  begin
                     Ada.Text_IO.Put_Line
                       (Natural'Image (Original)
                        & Ada.Characters.Latin_1.HT
                        & Natural'Image (Output)
                        & Ada.Characters.Latin_1.HT
                        & Natural'Image (Base64)
                        & Ada.Characters.Latin_1.HT
                        & Float'Image (Float (Output) / Float (Original))
                        & Ada.Characters.Latin_1.HT
                        & Float'Image (Float (Base64) / Float (Original)));
                  end Print_Line;
                  Original_Total : Natural := 0;
                  Output_Total : Natural := 0;
                  Base64_Total : Natural := 0;
               begin
                  for S of Input_Data loop
                     declare
                        Original_Size : constant Natural := S'Length;
                        Output_Size : constant Natural
                          := Natools.Smaz.Compress (Dictionary, S)'Length;
                        Base64_Size : constant Natural
                          := ((Output_Size + 2) / 3) * 4;
                     begin
                        Print_Line (Original_Size, Output_Size, Base64_Size);
                        Original_Total := Original_Total + Original_Size;
                        Output_Total := Output_Total + Output_Size;
                        Base64_Total := Base64_Total + Base64_Size;
                     end;
                  end loop;

                  Print_Line (Original_Total, Output_Total, Base64_Total);
               end;
            end if;
      end case;
   end Build_Dictionary;
end Smaz;

tools/smaz: add support for dictionary generation from a word list


--  Copyright (c) 2016 onox <denkpadje@gmail.com>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with Ada.Streams;

private package Orka.Base64 is
   pragma Preelaborate;

   use Ada.Streams;

   Data_Prefix : constant String;

   function Base64_Encoded (Text : String) return Boolean is
     (Text'Length >= Data_Prefix'Length
        and then Text (Text'First .. Data_Prefix'Length) = Data_Prefix)
     with Inline;

   function Decode (Input : String) return Stream_Element_Array;

   Encoding_Error : exception;

private

   Data_Prefix : constant String := "data:text/plain;base64,";

end Orka.Base64;

--  Copyright (c) 2016 onox <denkpadje@gmail.com>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with Ada.Streams;

private package Orka.Base64 is
   pragma Preelaborate;

   use Ada.Streams;

   Data_Prefix : constant String;

   function Base64_Encoded (Text : String) return Boolean is
     (Text'Length >= Data_Prefix'Length
        and then Text (Text'First .. Text'First + Data_Prefix'Length - 1) = Data_Prefix)
     with Inline;

   function Decode (Input : String) return Stream_Element_Array;

   Encoding_Error : exception;

private

   Data_Prefix : constant String := "data:text/plain;base64,";

end Orka.Base64;

Fix Base64_Encoded function

orka: Fix Base64_Encoded function

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  gtkmatp -- Gtk MAT application
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Targets.Gtkmat;

with Gtk.Widget;
procedure GtkMatp is
   Main    : Gtk.Widget.Gtk_Widget;
   Target  : MAT.Targets.Gtkmat.Target_Type;
begin
   Target.Initialize_Options;
   Target.Initialize_Widget (Main);
   MAT.Commands.Initialize_Files (Target);
   Target.Start;
   Target.Interactive;
   Target.Stop;
end GtkMatp;

-----------------------------------------------------------------------
--  gtkmatp -- Gtk MAT application
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with MAT.Commands;
with MAT.Targets;
with MAT.Targets.Gtkmat;

with Gtk.Widget;
procedure GtkMatp is
   Main    : Gtk.Widget.Gtk_Widget;
   Target  : aliased MAT.Targets.Gtkmat.Target_Type;
begin
   Target.Initialize_Options;
   Target.Initialize_Widget (Main);
   MAT.Commands.Initialize_Files (Target);
   Target.Start;
   Target.Interactive;
   Target.Stop;
end GtkMatp;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  gen-commands-docs -- Extract and generate documentation for the project
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with GNAT.Command_Line;

with Ada.Text_IO;

with Gen.Artifacts.Docs;
with Gen.Model.Packages;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);

      Doc : Gen.Artifacts.Docs.Artifact;
      M   : Gen.Model.Packages.Model_Definition;
   begin
      Generator.Read_Project ("dynamo.xml", False);

      --  Setup the target directory where the distribution is created.
      declare
         Target_Dir : constant String := Get_Argument;
      begin
         if Target_Dir'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Target_Dir);
      end;

      Doc.Prepare (M, Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

-----------------------------------------------------------------------
--  gen-commands-docs -- Extract and generate documentation for the project
--  Copyright (C) 2012, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with GNAT.Command_Line;

with Ada.Text_IO;

with Gen.Artifacts.Docs;
with Gen.Model.Packages;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);

      Doc  : Gen.Artifacts.Docs.Artifact;
      M    : Gen.Model.Packages.Model_Definition;
      Arg1 : constant String := Get_Argument;
      Arg2 : constant String := Get_Argument;
      Fmt  : Gen.Artifacts.Docs.Doc_Format := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
   begin
      Generator.Read_Project ("dynamo.xml", False);

      if Arg1'Length = 0 then
         Generator.Error ("Missing target directory");
         return;
      elsif Arg1 (Arg1'First) /= '-' then
         if Arg2'Length /= 0 then
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         --  Setup the target directory where the distribution is created.
         Generator.Set_Result_Directory (Arg1);
      else
         if Arg1 = "-markdown" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
         elsif Arg1 = "-google" then
            Fmt := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
         else
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         if Arg2'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Arg2);
      end if;
      Doc.Set_Format (Fmt);
      Doc.Prepare (M, Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc [-markdown|-google] target-dir");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

Add new optional option to the build-doc command to configure the output documentation format


-----------------------------------------------------------------------
--  wiki-attributes -- Wiki document attributes
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Characters.Conversions;

package body Wiki.Attributes is

   use Ada.Characters;

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Ada.Characters.Conversions.To_String (Attr.Value.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wiki.Strings.WString is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Unbounded_Wide_Wide_String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return To_Unbounded_Wide_Wide_String (Attr.Value.Value);
   end Get_Unbounded_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Ref := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Value.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Unbounded_Wide_Wide_String is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Unbounded_Wide_Value (Attr);
      else
         return Null_Unbounded_Wide_Wide_String;
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.WString is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Wide_Value (Attr);
      else
         return "";
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.WString;
                     Value : in Wiki.Strings.WString) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Conversions.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
   begin
      Append (List, Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Name),
              Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Value));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
      Val  : constant Wiki.Strings.WString := To_Wide_Wide_String (Value);
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Val'Length,
                           Name         => Name,
                           Value        => Val);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List) is
   begin
      List.List.Clear;
   end Clear;

   --  ------------------------------
   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name  : in String;
                                                           Value : in Wiki.Strings.WString)) is
      Iter : Attribute_Vectors.Cursor := List.List.First;
      Item : Attribute_Ref;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         Item := Attribute_Vectors.Element (Iter);
         Process (Item.Value.Name, Item.Value.Value);
         Attribute_Vectors.Next (Iter);
      end loop;
   end Iterate;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

-----------------------------------------------------------------------
--  wiki-attributes -- Wiki document attributes
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Characters.Conversions;

package body Wiki.Attributes is

   use Ada.Characters;

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Ada.Characters.Conversions.To_String (Attr.Value.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wiki.Strings.WString is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Wiki.Strings.UString is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Wiki.Strings.To_UString (Attr.Value.Value);
   end Get_Unbounded_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Ref := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Value.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.UString is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Unbounded_Wide_Value (Attr);
      else
         return Wiki.Strings.Null_UString;
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.WString is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Wide_Value (Attr);
      else
         return "";
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.WString;
                     Value : in Wiki.Strings.WString) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Conversions.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.UString;
                     Value : in Wiki.Strings.UString) is
   begin
      Append (List, Wiki.Strings.To_WString (Name), Wiki.Strings.To_WString (Value));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Wiki.Strings.UString) is
      Val  : constant Wiki.Strings.WString := Wiki.Strings.To_WString (Value);
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Val'Length,
                           Name         => Name,
                           Value        => Val);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List) is
   begin
      List.List.Clear;
   end Clear;

   --  ------------------------------
   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name  : in String;
                                                           Value : in Wiki.Strings.WString)) is
      Iter : Attribute_Vectors.Cursor := List.List.First;
      Item : Attribute_Ref;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         Item := Attribute_Vectors.Element (Iter);
         Process (Item.Value.Name, Item.Value.Value);
         Attribute_Vectors.Next (Iter);
      end loop;
   end Iterate;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

Use the Wiki.Strings.UString type

Use the Wiki.Strings.UString type


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with Ada.Directories;
with Ada.Direct_IO;
with Ada.Text_IO;
with HelperText;

package body File_Operations is

   package DIR renames Ada.Directories;
   package TIO renames Ada.Text_IO;
   package HT  renames HelperText;

   --------------------------------------------------------------------------------------------
   --  get_file_contents
   --------------------------------------------------------------------------------------------
   function get_file_contents (dossier : String) return String
   is
      File_Size : Natural := Natural (DIR.Size (dossier));

      subtype File_String    is String (1 .. File_Size);
      package File_String_IO is new Ada.Direct_IO (File_String);

      file_handle : File_String_IO.File_Type;
      contents    : File_String;
      attempts    : Natural := 0;
   begin
      if File_Size = 0 then
         return "";
      end if;
      --  The introduction of variants causes a buildsheet to be scanned once per variant.
      --  It's possible (even common) for simultaneous requests to scan the same buildsheet to
      --  occur.  Thus, if the file is already open, wait and try again (up to 5 times)
      loop
         begin
            File_String_IO.Open  (File => file_handle,
                                  Mode => File_String_IO.In_File,
                                  Name => dossier);
            exit;
         exception
            when File_String_IO.Status_Error | File_String_IO.Use_Error =>
               if attempts = 5 then
                  raise file_handling with "get_file_contents: remained open: " & dossier;
               end if;
               attempts := attempts + 1;
               delay 0.1;
         end;
      end loop;
      File_String_IO.Read  (File => file_handle, Item => contents);
      File_String_IO.Close (file_handle);
      return contents;
   exception
      when others =>
         if File_String_IO.Is_Open (file_handle) then
            File_String_IO.Close (file_handle);
         end if;
         raise file_handling with "get_file_contents: " & dossier;
   end get_file_contents;

   --------------------------------------------------------------------------------------------
   --  dump_contents_to_file
   --------------------------------------------------------------------------------------------
   procedure dump_contents_to_file
     (contents : String;
      dossier  : String)
   is
      File_Size : Natural := contents'Length;

      subtype File_String    is String (1 .. File_Size);
      package File_String_IO is new Ada.Direct_IO (File_String);

      file_handle : File_String_IO.File_Type;
   begin
      mkdirp_from_filename (dossier);
      File_String_IO.Create (File => file_handle,
                             Mode => File_String_IO.Out_File,
                             Name => dossier);
      File_String_IO.Write  (File => file_handle,
                             Item => contents);
      File_String_IO.Close  (file_handle);
   exception
      when others =>
         if File_String_IO.Is_Open (file_handle) then
            File_String_IO.Close (file_handle);
         end if;
         raise file_handling;
   end dump_contents_to_file;

   --------------------------------------------------------------------------------------------
   --  create_subdirectory
   --------------------------------------------------------------------------------------------
   procedure create_subdirectory
     (extraction_directory : String;
      subdirectory         : String)
   is
      abspath : String := extraction_directory & "/" & subdirectory;
   begin
      if subdirectory = "" then
         return;
      end if;
      if not DIR.Exists (abspath) then
         DIR.Create_Directory (abspath);
      end if;
   end create_subdirectory;

   --------------------------------------------------------------------------------------------
   --  head_n1
   --------------------------------------------------------------------------------------------
   function head_n1 (filename : String) return String
   is
      handle : TIO.File_Type;
   begin
      TIO.Open (File => handle, Mode => TIO.In_File, Name => filename);
      if TIO.End_Of_File (handle) then
         TIO.Close (handle);
         return "";
      end if;

      declare
         line : constant String := TIO.Get_Line (handle);
      begin
         TIO.Close (handle);
         return line;
      end;
   end head_n1;

   --------------------------------------------------------------------------------------------
   --  create_pidfile
   --------------------------------------------------------------------------------------------
   procedure create_pidfile (pidfile : String)
   is
      pidtext : constant String := HT.int2str (Get_PID);
      handle  : TIO.File_Type;
   begin
      TIO.Create (File => handle, Mode => TIO.Out_File, Name => pidfile);
      TIO.Put_Line (handle, pidtext);
      TIO.Close (handle);
   end create_pidfile;

   --------------------------------------------------------------------------------------------
   --  destroy_pidfile
   --------------------------------------------------------------------------------------------
   procedure destroy_pidfile (pidfile : String) is
   begin
      if DIR.Exists (pidfile) then
         DIR.Delete_File (pidfile);
      end if;
   exception
      when others => null;
   end destroy_pidfile;

   --------------------------------------------------------------------------------------------
   --  mkdirp_from_filename
   --------------------------------------------------------------------------------------------
   procedure mkdirp_from_filename (filename : String)
   is
      condir : String := DIR.Containing_Directory (Name => filename);
   begin
      DIR.Create_Path (New_Directory => condir);
   end mkdirp_from_filename;

   --------------------------------------------------------------------------------------------
   --  concatenate_file
   --------------------------------------------------------------------------------------------
   procedure concatenate_file (basefile : String; another_file : String)
   is
      handle : TIO.File_Type;
   begin
      if not DIR.Exists (another_file) then
         raise file_handling with "concatenate_file: new_file does not exist => " & another_file;
      end if;
      if DIR.Exists (basefile) then
         TIO.Open (File => handle,
                   Mode => TIO.Append_File,
                   Name => basefile);
         declare
            contents : constant String := get_file_contents (another_file);
         begin
            TIO.Put (handle, contents);
         end;
         TIO.Close (handle);
      else
         DIR.Copy_File (Source_Name => another_file,
                        Target_Name => basefile);
      end if;
   exception
      when others =>
         if TIO.Is_Open (handle) then
            TIO.Close (handle);
         end if;
         raise file_handling;
   end concatenate_file;

   --------------------------------------------------------------------------------------------
   --  create_cookie
   --------------------------------------------------------------------------------------------
   procedure create_cookie (fullpath : String)
   is
      subtype File_String    is String (1 .. 1);
      package File_String_IO is new Ada.Direct_IO (File_String);

      file_handle : File_String_IO.File_Type;
   begin
      mkdirp_from_filename (fullpath);
      File_String_IO.Create (File => file_handle,
                             Mode => File_String_IO.Out_File,
                             Name => fullpath);
      File_String_IO.Close  (file_handle);
   exception
      when others =>
         raise file_handling;
   end create_cookie;

   --------------------------------------------------------------------------------------------
   --  replace_directory_contents
   --------------------------------------------------------------------------------------------
   procedure replace_directory_contents
     (source_directory : String;
      target_directory : String;
      pattern          : String)
   is
      search : DIR.Search_Type;
      dirent : DIR.Directory_Entry_Type;
      filter : constant DIR.Filter_Type := (DIR.Ordinary_File => True, others => False);
   begin
      DIR.Start_Search (Search    => search,
                        Directory => target_directory,
                        Pattern   => pattern,
                        Filter    => filter);
      while DIR.More_Entries (search) loop
         DIR.Get_Next_Entry (search, dirent);
         declare
            SN      : constant String := DIR.Simple_Name (dirent);
            oldfile : constant String := target_directory & "/" & SN;
            newfile : constant String := source_directory & "/" & SN;
         begin
            if DIR.Exists (newfile) then
               DIR.Copy_File (Source_Name => newfile, Target_Name => oldfile);
            end if;
         exception
            when others =>
               TIO.Put_Line ("Failed to copy " & newfile & " over to " & oldfile);
         end;
      end loop;
      DIR.End_Search (search);
   end replace_directory_contents;

end File_Operations;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with Ada.Directories;
with Ada.Direct_IO;
with Ada.Text_IO;
with HelperText;

package body File_Operations is

   package DIR renames Ada.Directories;
   package TIO renames Ada.Text_IO;
   package HT  renames HelperText;

   --------------------------------------------------------------------------------------------
   --  get_file_contents
   --------------------------------------------------------------------------------------------
   function get_file_contents (dossier : String) return String
   is
      File_Size : Natural := Natural (DIR.Size (dossier));

      subtype File_String    is String (1 .. File_Size);
      package File_String_IO is new Ada.Direct_IO (File_String);

      file_handle : File_String_IO.File_Type;
      contents    : File_String;
      attempts    : Natural := 0;
   begin
      if File_Size = 0 then
         return "";
      end if;
      --  The introduction of variants causes a buildsheet to be scanned once per variant.
      --  It's possible (even common) for simultaneous requests to scan the same buildsheet to
      --  occur.  Thus, if the file is already open, wait and try again (up to 5 times)
      loop
         begin
            File_String_IO.Open  (File => file_handle,
                                  Mode => File_String_IO.In_File,
                                  Name => dossier);
            exit;
         exception
            when File_String_IO.Status_Error | File_String_IO.Use_Error =>
               if attempts = 5 then
                  raise file_handling with "get_file_contents: remained open: " & dossier;
               end if;
               attempts := attempts + 1;
               delay 0.1;
         end;
      end loop;
      File_String_IO.Read  (File => file_handle, Item => contents);
      File_String_IO.Close (file_handle);
      return contents;
   exception
      when others =>
         if File_String_IO.Is_Open (file_handle) then
            File_String_IO.Close (file_handle);
         end if;
         raise file_handling with "get_file_contents: " & dossier;
   end get_file_contents;

   --------------------------------------------------------------------------------------------
   --  dump_contents_to_file
   --------------------------------------------------------------------------------------------
   procedure dump_contents_to_file
     (contents : String;
      dossier  : String)
   is
      File_Size : Natural := contents'Length;

      subtype File_String    is String (1 .. File_Size);
      package File_String_IO is new Ada.Direct_IO (File_String);

      file_handle : File_String_IO.File_Type;
   begin
      mkdirp_from_filename (dossier);
      File_String_IO.Create (File => file_handle,
                             Mode => File_String_IO.Out_File,
                             Name => dossier);
      File_String_IO.Write  (File => file_handle,
                             Item => contents);
      File_String_IO.Close  (file_handle);
   exception
      when others =>
         if File_String_IO.Is_Open (file_handle) then
            File_String_IO.Close (file_handle);
         end if;
         raise file_handling;
   end dump_contents_to_file;

   --------------------------------------------------------------------------------------------
   --  create_subdirectory
   --------------------------------------------------------------------------------------------
   procedure create_subdirectory
     (extraction_directory : String;
      subdirectory         : String)
   is
      abspath : String := extraction_directory & "/" & subdirectory;
   begin
      if subdirectory = "" then
         return;
      end if;
      if not DIR.Exists (abspath) then
         DIR.Create_Directory (abspath);
      end if;
   end create_subdirectory;

   --------------------------------------------------------------------------------------------
   --  head_n1
   --------------------------------------------------------------------------------------------
   function head_n1 (filename : String) return String
   is
      handle : TIO.File_Type;
   begin
      TIO.Open (File => handle, Mode => TIO.In_File, Name => filename);
      if TIO.End_Of_File (handle) then
         TIO.Close (handle);
         return "";
      end if;

      declare
         line : constant String := TIO.Get_Line (handle);
      begin
         TIO.Close (handle);
         return line;
      end;
   end head_n1;

   --------------------------------------------------------------------------------------------
   --  create_pidfile
   --------------------------------------------------------------------------------------------
   procedure create_pidfile (pidfile : String)
   is
      pidtext : constant String := HT.int2str (Get_PID);
      handle  : TIO.File_Type;
   begin
      TIO.Create (File => handle, Mode => TIO.Out_File, Name => pidfile);
      TIO.Put_Line (handle, pidtext);
      TIO.Close (handle);
   end create_pidfile;

   --------------------------------------------------------------------------------------------
   --  destroy_pidfile
   --------------------------------------------------------------------------------------------
   procedure destroy_pidfile (pidfile : String) is
   begin
      if DIR.Exists (pidfile) then
         DIR.Delete_File (pidfile);
      end if;
   exception
      when others => null;
   end destroy_pidfile;

   --------------------------------------------------------------------------------------------
   --  mkdirp_from_filename
   --------------------------------------------------------------------------------------------
   procedure mkdirp_from_filename (filename : String)
   is
      condir : String := DIR.Containing_Directory (Name => filename);
   begin
      DIR.Create_Path (New_Directory => condir);
   end mkdirp_from_filename;

   --------------------------------------------------------------------------------------------
   --  concatenate_file
   --------------------------------------------------------------------------------------------
   procedure concatenate_file (basefile : String; another_file : String)
   is
      handle : TIO.File_Type;
   begin
      if not DIR.Exists (another_file) then
         raise file_handling with "concatenate_file: new_file does not exist => " & another_file;
      end if;
      if DIR.Exists (basefile) then
         TIO.Open (File => handle,
                   Mode => TIO.Append_File,
                   Name => basefile);
         declare
            contents : constant String := get_file_contents (another_file);
         begin
            TIO.Put (handle, contents);
         end;
         TIO.Close (handle);
      else
         DIR.Copy_File (Source_Name => another_file,
                        Target_Name => basefile);
      end if;
   exception
      when others =>
         if TIO.Is_Open (handle) then
            TIO.Close (handle);
         end if;
         raise file_handling;
   end concatenate_file;

   --------------------------------------------------------------------------------------------
   --  create_cookie
   --------------------------------------------------------------------------------------------
   procedure create_cookie (fullpath : String)
   is
      subtype File_String    is String (1 .. 1);
      package File_String_IO is new Ada.Direct_IO (File_String);

      file_handle : File_String_IO.File_Type;
   begin
      mkdirp_from_filename (fullpath);
      File_String_IO.Create (File => file_handle,
                             Mode => File_String_IO.Out_File,
                             Name => fullpath);
      File_String_IO.Close  (file_handle);
   exception
      when others =>
         raise file_handling;
   end create_cookie;

   --------------------------------------------------------------------------------------------
   --  replace_directory_contents
   --------------------------------------------------------------------------------------------
   procedure replace_directory_contents
     (source_directory : String;
      target_directory : String;
      pattern          : String)
   is
      search : DIR.Search_Type;
      dirent : DIR.Directory_Entry_Type;
      filter : constant DIR.Filter_Type := (DIR.Ordinary_File => True, others => False);
   begin
      if not DIR.Exists (target_directory) then
         return;
      end if;
      DIR.Start_Search (Search    => search,
                        Directory => target_directory,
                        Pattern   => pattern,
                        Filter    => filter);
      while DIR.More_Entries (search) loop
         DIR.Get_Next_Entry (search, dirent);
         declare
            SN      : constant String := DIR.Simple_Name (dirent);
            oldfile : constant String := target_directory & "/" & SN;
            newfile : constant String := source_directory & "/" & SN;
         begin
            if DIR.Exists (newfile) then
               DIR.Copy_File (Source_Name => newfile, Target_Name => oldfile);
            end if;
         exception
            when others =>
               TIO.Put_Line ("Failed to copy " & newfile & " over to " & oldfile);
         end;
      end loop;
      DIR.End_Search (search);
   end replace_directory_contents;

end File_Operations;

Add safeguard for non-existent directory

procedure: replace_directory_contents


-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body AWA.Wikis.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Wikis.Models.Wiki_Space_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the wiki space.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Wiki_Space (Bean);
   end Save;

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Wiki_Space_Bean bean instance.
   --  ------------------------------
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Wiki_Space_Bean_Access := new Wiki_Space_Bean;
   begin
      Object.Service   := Module;
      return Object.all'Access;
   end Create_Wiki_Space_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Wiki_Page_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Wikis.Models.Wiki_Page_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Wiki_Page_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      elsif Name = "title" then
         From.Set_Title (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the wiki page.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      if Bean.Is_Inserted then
         Bean.Service.Save (Bean);
      else
         Bean.Service.Create_Wiki_Page (Bean.Wiki_Space, Bean);
      end if;
   end Save;

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Wiki_Page_Bean bean instance.
   --  ------------------------------
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Wiki_Page_Bean_Access := new Wiki_Page_Bean;
   begin
      Object.Service   := Module;
      return Object.all'Access;
   end Create_Wiki_Page_Bean;

end AWA.Wikis.Beans;

-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ADO.Utils;
with ADO.Queries;
with ADO.Sessions;
with ADO.Sessions.Entities;

with AWA.Services;
with AWA.Services.Contexts;

package body AWA.Wikis.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Wikis.Models.Wiki_Space_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the wiki space.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Wiki_Space (Bean);
   end Save;

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Wiki_Space_Bean bean instance.
   --  ------------------------------
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Wiki_Space_Bean_Access := new Wiki_Space_Bean;
   begin
      Object.Service   := Module;
      return Object.all'Access;
   end Create_Wiki_Space_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Wiki_Page_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Wikis.Models.Wiki_Page_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Wiki_Page_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      elsif Name = "title" then
         From.Set_Title (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the wiki page.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      if Bean.Is_Inserted then
         Bean.Service.Save (Bean);
      else
         Bean.Service.Create_Wiki_Page (Bean.Wiki_Space, Bean);
      end if;
   end Save;

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Wiki_Page_Bean bean instance.
   --  ------------------------------
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Wiki_Page_Bean_Access := new Wiki_Page_Bean;
   begin
      Object.Service   := Module;
      return Object.all'Access;
   end Create_Wiki_Page_Bean;

   --  ------------------------------
   --  Load the list of wikis.
   --  ------------------------------
   procedure Load_Wikis (List : in Wiki_Admin_Bean) is
      use AWA.Wikis.Models;
      use AWA.Services;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := List.Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Wikis.Models.Query_Wiki_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                        Name    => "table",
                                        Table   => AWA.Wikis.Models.WIKI_SPACE_TABLE,
                                        Session => Session);
      AWA.Wikis.Models.List (List.Wiki_List_Bean.all, Session, Query);
      List.Flags (INIT_WIKI_LIST) := True;
   end Load_Wikis;

   --  ------------------------------
   --  Get the wiki space identifier.
   --  ------------------------------
   function Get_Wiki_Id (List : in Wiki_Admin_Bean) return ADO.Identifier is
      use type ADO.Identifier;
   begin
      if List.Wiki_Id = ADO.NO_IDENTIFIER then
         if not List.Flags (INIT_WIKI_LIST) then
            Load_Wikis (List);
         end if;
         if not List.Wiki_List.List.Is_Empty then
            return List.Wiki_List.List.Element (0).Id;
         end if;
      end if;
      return List.Wiki_Id;
   end Get_Wiki_Id;

   overriding
   function Get_Value (List : in Wiki_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "wikis" then
         if not List.Init_Flags (INIT_WIKI_LIST) then
            Load_Wikis (List);
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Wiki_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "id" then
         declare
            use type ADO.Identifier;

            Id : constant ADO.Identifier := List.Get_Wiki_Id;
         begin
            if Id = ADO.NO_IDENTIFIER then
               return Util.Beans.Objects.Null_Object;
            else
               return Util.Beans.Objects.To_Object (Long_Long_Integer (Id));
            end if;
         end;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Wiki_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         From.Wiki_Id := ADO.Utils.To_Identifier (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the Wiki_Admin_Bean bean instance.
   --  ------------------------------
   function Create_Wiki_Admin_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Wiki_Admin_Bean_Access := new Wiki_Admin_Bean;
   begin
      Object.Module            := Module;
      Object.Flags             := Object.Init_Flags'Access;
      Object.Wiki_List_Bean    := Object.Wiki_List'Access;
      return Object.all'Access;
   end Create_Wiki_Admin_Bean;

end AWA.Wikis.Beans;

Implement the Wiki_Admin_Bean

Implement the Wiki_Admin_Bean