Natools

-- 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.           --
------------------------------------------------------------------------------

with Ada.Calendar.Arithmetic;

package body Natools.Time_Keys is

   function Extract_Sub_Second (Key : String) return Duration;
      --  Read the end of Buffer and compute the Sub_Second part

   -----------------------

   function To_Key
     (Time : Ada.Calendar.Time;
      Max_Sub_Second_Digits : in Natural := 120)
     return String
   is



      Year : Ada.Calendar.Year_Number;
      Month : Ada.Calendar.Month_Number;
      Day : Ada.Calendar.Day_Number;
      Hour : Ada.Calendar.Formatting.Hour_Number;
      Minute : Ada.Calendar.Formatting.Minute_Number;
      Second : Ada.Calendar.Formatting.Second_Number;
      Sub_Second : Ada.Calendar.Formatting.Second_Duration;

      Leap_Second : Boolean;
   begin
      Ada.Calendar.Formatting.Split
        (Time,
         Year, Month, Day, Hour, Minute, Second, Sub_Second,
         Leap_Second);
      return To_Key
        (Year, Month, Day,
         Hour, Minute, Second, Sub_Second,
         Leap_Second,
         Max_Sub_Second_Digits);
   end To_Key;


   function To_Key
     (Year : Ada.Calendar.Year_Number;
      Month : Ada.Calendar.Month_Number;
      Day : Ada.Calendar.Day_Number;
      Hour : Ada.Calendar.Formatting.Hour_Number := 0;
      Minute : Ada.Calendar.Formatting.Minute_Number := 0;
      Second : Ada.Calendar.Formatting.Second_Number := 0;
      Sub_Second : Ada.Calendar.Formatting.Second_Duration := 0.0;
      Leap_Second : Boolean := False;
      Max_Sub_Second_Digits : Natural := 120)
     return String
   is
      procedure Increment_Buffer;

      Buffer : String (1 .. 7 + Max_Sub_Second_Digits);
      Last : Positive;

      procedure Increment_Buffer is
      begin
         while Last > 7 and then Buffer (Last) = '~' loop
            Last := Last - 1;
         end loop;

         if Last > 7 then
            Buffer (Last) := Image (Value (Buffer (Last)) + 1);
            return;
         end if;

         if Second <= 58 then
            Buffer (7) := I_Image (Second + 1);
            Last := 7;

         elsif Minute <= 58 then
            Buffer (6) := I_Image (Minute + 1);
            Last := 6;

         elsif Hour <= 22 then
            Buffer (5) := I_Image (Hour + 1);
            Last := 5;

         else
            Buffer (1 .. 4) := To_Key (Ada.Calendar.Arithmetic."+"
              (Ada.Calendar.Formatting.Time_Of (Year, Month, Day), 1));
            Last := 4;
         end if;
      end Increment_Buffer;

      N : Natural;
      D, Base : Duration;
   begin
      Buffer (1) := I_Image (Year / 64);
      Buffer (2) := I_Image (Year mod 64);
      Buffer (3) := I_Image (Month);
      Buffer (4) := I_Image (Day);
      Buffer (5) := I_Image (Hour);
      Buffer (6) := I_Image (Minute);

      Base := 1.0;
      loop
         Last := Last + 1;
         Base := Base / 64.0;
         N := Natural (D);

         if Last = Buffer'Last or Base = 0.0 then
            if N < 64 then
               Buffer (Last) := I_Image (N);
            else
               Last := Last - 1;
               Increment_Buffer;
            end if;
            exit;
         end if;

         if Duration (N) > D then
            N := N - 1;
            pragma Assert (Duration (N) <= D);
         end if;