Natools

natools-smaz_implementations-base_64.adb at [aaf366bd15]
Login

File src/natools-smaz_implementations-base_64.adb artifact d47cc06763 part of check-in aaf366bd15


------------------------------------------------------------------------------
-- Copyright (c) 2016-2017, 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.           --
------------------------------------------------------------------------------

package body Natools.Smaz_Implementations.Base_64 is

   package Tools renames Natools.Smaz_Implementations.Base_64_Tools;

   use type Ada.Streams.Stream_Element_Offset;
   use type Tools.Base_64_Digit;


   ----------------------
   -- Public Interface --
   ----------------------

   procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Verbatim_Length : out Natural;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Ignored : String (1 .. 2);
      Offset_Backup : Ada.Streams.Stream_Element_Offset;
      Finished : Boolean;
   begin
      Tools.Next_Digit_Or_End (Input, Offset, Code, Finished);

      if Finished then
         Code := Base_64_Tools.Base_64_Digit'Last;
         Verbatim_Length := 0;
         return;
      end if;

      if Code <= Last_Code then
         Verbatim_Length := 0;

      elsif Variable_Length_Verbatim then
         if Code < 63 then
            Verbatim_Length := 63 - Natural (Code);
         else
            Tools.Next_Digit (Input, Offset, Code);
            Verbatim_Length := Natural (Code) + 63 - Natural (Last_Code);
         end if;
         Code := 0;

      elsif Code = 63 then
         Tools.Next_Digit (Input, Offset, Code);
         Verbatim_Length := Natural (Code) * 3 + 3;
         Code := 0;

      elsif Code = 62 then
         Offset_Backup := Offset;
         Tools.Decode_Single (Input, Offset, Ignored (1), Code);
         Verbatim_Length := Natural (Code) * 3 + 1;
         Offset := Offset_Backup;
         Code := 0;

      else
         Offset_Backup := Offset;
         Verbatim_Length := (61 - Natural (Code)) * 4;
         Tools.Decode_Double (Input, Offset, Ignored, Code);
         Verbatim_Length := (Verbatim_Length + Natural (Code)) * 3 + 2;
         Offset := Offset_Backup;
         Code := 0;
      end if;
   end Read_Code;


   procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String)
   is
      Ignored : Tools.Base_64_Digit;
      Output_Index : Natural := Output'First - 1;
   begin
      if Output'Length mod 3 = 1 then
         Tools.Decode_Single
           (Input, Offset, Output (Output_Index + 1), Ignored);
         Output_Index := Output_Index + 1;
      elsif Output'Length mod 3 = 2 then
         Tools.Decode_Double
           (Input, Offset,
            Output (Output_Index + 1 .. Output_Index + 2), Ignored);
         Output_Index := Output_Index + 2;
      end if;

      if Output_Index < Output'Last then
         Tools.Decode
           (Input, Offset, Output (Output_Index + 1 .. Output'Last));
      end if;
   end Read_Verbatim;


   procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive)
   is
      Code : Tools.Base_64_Digit;
   begin
      for I in 1 .. Tools.Image_Length (Verbatim_Length) loop
         Tools.Next_Digit (Input, Offset, Code);
      end loop;
   end Skip_Verbatim;


   function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count is
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Single : constant Positive := 62 - Natural (Last_Code);
            Largest_Run : constant Positive := 64 + Largest_Single;
            Run_Count : constant Natural
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
            Last_Run_Header_Size : constant Ada.Streams.Stream_Element_Count
              := (if Last_Run_Size > Largest_Single then 2 else 1);
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count)
                    * (Tools.Image_Length (Largest_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + Last_Run_Header_Size;
         end;
      else
         declare
            Largest_Prefix : constant Natural
              := (case Input_Length mod 3 is
                  when 1 => 15 * 3 + 1,
                  when 2 => ((62 - Natural (Last_Code)) * 4 - 1) * 3 + 2,
                  when others => 0);
            Prefix_Header_Size : constant Ada.Streams.Stream_Element_Count
              := (if Largest_Prefix > 0 then 1 else 0);
            Largest_Run : constant Positive := 64 * 3;
            Prefix_Size : constant Natural
              := Natural'Min (Largest_Prefix, Input_Length);
            Run_Count : constant Natural
              := (Input_Length - Prefix_Size + Largest_Run - 1) / Largest_Run;
         begin
            if Run_Count > 0 then
               return Prefix_Header_Size + Tools.Image_Length (Prefix_Size)
                 + Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 2)
                 + Tools.Image_Length (Input_Length - Prefix_Size
                                       - (Run_Count - 1) * Largest_Run)
                   + 2;
            else
               return Prefix_Header_Size + Tools.Image_Length (Prefix_Size);
            end if;
         end;
      end if;
   end Verbatim_Size;


   procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit) is
   begin
      Output (Offset) := Tools.Image (Code);
      Offset := Offset + 1;
   end Write_Code;


   procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Index : Positive := Input'First;
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Single : constant Positive := 62 - Natural (Last_Code);
            Largest_Run : constant Positive := 64 + Largest_Single;
            Length, Last : Natural;
         begin
            while Index in Input'Range loop
               Length := Positive'Min (Largest_Run, Input'Last + 1 - Index);

               if Length > Largest_Single then
                  Write_Code (Output, Offset, 63);
                  Write_Code
                    (Output, Offset,
                     Tools.Base_64_Digit (Length - Largest_Single - 1));
               else
                  Write_Code
                    (Output, Offset,
                     Tools.Base_64_Digit (63 - Length));
               end if;

               if Length mod 3 = 1 then
                  Tools.Encode_Single (Input (Index), 0, Output, Offset);
                  Index := Index + 1;
                  Length := Length - 1;
               elsif Length mod 3 = 2 then
                  Tools.Encode_Double
                    (Input (Index .. Index + 1), 0, Output, Offset);
                  Index := Index + 2;
                  Length := Length - 2;
               end if;

               if Length > 0 then
                  Last := Index + Length - 1;
                  Tools.Encode (Input (Index .. Last), Output, Offset);
                  Index := Last + 1;
               end if;
            end loop;
         end;
      else
         if Input'Length mod 3 = 1 then
            declare
               Extra_Blocks : constant Natural
                 := Natural'Min (15, Input'Length / 3);
            begin
               Output (Offset) := Tools.Image (62);
               Offset := Offset + 1;

               Tools.Encode_Single
                 (Input (Index), Tools.Single_Byte_Padding (Extra_Blocks),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         elsif Input'Length mod 3 = 2 then
            declare
               Extra_Blocks : constant Natural := Natural'Min
                 (Input'Length / 3,
                  (62 - Natural (Last_Code)) * 4 - 1);
            begin
               Output (Offset)
                 := Tools.Image (61 - Tools.Base_64_Digit (Extra_Blocks / 4));
               Offset := Offset + 1;

               Tools.Encode_Double
                 (Input (Index .. Index + 1),
                  Tools.Double_Byte_Padding (Extra_Blocks mod 4),
                  Output, Offset);
               Index := Index + 2;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         end if;

         pragma Assert ((Input'Last + 1 - Index) mod 3 = 0);

         while Index <= Input'Last loop
            declare
               Block_Count : constant Natural
                 := Natural'Min (64, (Input'Last + 1 - Index) / 3);
            begin
               Output (Offset) := Tools.Image (63);
               Output (Offset + 1)
                 := Tools.Image (Tools.Base_64_Digit (Block_Count - 1));
               Offset := Offset + 2;

               Tools.Encode
                 (Input (Index .. Index + Block_Count * 3 - 1),
                  Output, Offset);
               Index := Index + Block_Count * 3;
            end;
         end loop;
      end if;
   end Write_Verbatim;

end Natools.Smaz_Implementations.Base_64;