ADDED src/natools-time_keys.adb Index: src/natools-time_keys.adb ================================================================== --- src/natools-time_keys.adb +++ src/natools-time_keys.adb @@ -0,0 +1,148 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2015, 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. -- +------------------------------------------------------------------------------ + +with Ada.Calendar.Formatting; + +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 + + + ------------------------------ + -- Local Helper Subprograms -- + ------------------------------ + + function Extract_Sub_Second (Key : String) return Duration is + Sub_Second : Duration := 0.0; + begin + for I in reverse Key'First + 7 .. Key'Last loop + Sub_Second := (Sub_Second + Duration (Value (Key (I)))) / 32; + Sub_Second := (Sub_Second + Duration'Small) / 2; + end loop; + + return Sub_Second; + end Extract_Sub_Second; + + + + ----------------------- + -- Publoic Interface -- + ----------------------- + + function To_Key + (Time : Ada.Calendar.Time; + Max_Sub_Second_Digits : in Natural := 120) + return String + is + Buffer : String (1 .. 7 + Max_Sub_Second_Digits); + Last : Positive; + N : Natural; + 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; + D, Base : Duration; + Leap_Second : Boolean; + begin + Ada.Calendar.Formatting.Split + (Time, + Year, Month, Day, Hour, Minute, Second, Sub_Second, + Leap_Second); + + 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); + + if Leap_Second then + pragma Assert (Second = 59); + Buffer (7) := I_Image (60); + else + Buffer (7) := I_Image (Second); + end if; + + if Sub_Second = 0.0 then + if Second = 0 then + if Minute = 0 then + if Hour = 0 then + return Buffer (1 .. 4); + else + return Buffer (1 .. 5); + end if; + else + return Buffer (1 .. 6); + end if; + else + return Buffer (1 .. 7); + end if; + end if; + + Last := 7; + D := Sub_Second * 64; + Base := 1.0; + loop + Last := Last + 1; + Base := Base / 64.0; + N := Natural (D); + + if Last = Buffer'Last or Base = 0.0 then + Buffer (Last) := I_Image (N); + exit; + end if; + + if Duration (N) > D then + N := N - 1; + pragma Assert (Duration (N) <= D); + end if; + + D := (D - Duration (N)) * 64; + Buffer (Last) := I_Image (N); + + exit when D = 0.0; + end loop; + + return Buffer (1 .. Last); + end To_Key; + + + function To_Time (Key : String) return Ada.Calendar.Time is + Leap_Second : constant Boolean + := Key'First + 6 in Key'Range and then Key (Key'First + 6) = 'x'; + begin + return Ada.Calendar.Formatting.Time_Of + (Year => I_Value (Key (Key'First)) * 64 + + I_Value (Key (Key'First + 1)), + Month => I_Value (Key (Key'First + 2)), + Day => I_Value (Key (Key'First + 3)), + Hour => (if Key'First + 4 in Key'Range + then I_Value (Key (Key'First + 4)) else 0), + Minute => (if Key'First + 5 in Key'Range + then I_Value (Key (Key'First + 5)) else 0), + Second => (if Key'First + 6 in Key'Range + then (if Leap_Second then 59 + else I_Value (Key (Key'First + 6))) + else 0), + Sub_Second => Extract_Sub_Second (Key), + Leap_Second => Leap_Second); + end To_Time; + +end Natools.Time_Keys; ADDED src/natools-time_keys.ads Index: src/natools-time_keys.ads ================================================================== --- src/natools-time_keys.ads +++ src/natools-time_keys.ads @@ -0,0 +1,103 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2015, 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. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Time_Keys provides a concise but printable representation of -- +-- time where lexicographical order matches chronological order. -- +-- It is based on a base-64 symbol set that preserve order, picked from URL -- +-- unreserved character set. -- +-- It consists simply of time components in big-endian order, trimming -- +-- tailing zeros, and using two base-64 digits for the year, which gives a -- +-- 4096 year span. -- +-- This means a second granularity can be achieved with 7 characters. The -- +-- most compact way of encoding such a timestamp would be counting seconds, -- +-- like UNIX time. The time covered by this format is rought 2^37 seconds, -- +-- which would mean 5 bytes or 7 base-64 digits (though 6 would be enough -- +-- for a useful time range). -- +------------------------------------------------------------------------------ + +with Ada.Calendar; + +package Natools.Time_Keys is + + function Is_Valid (Key : String) return Boolean; + -- Check whether Key is a valid encoded time. + -- WARNING: this function returns true for invalid dates, + -- like February 30th. + + function To_Key + (Time : Ada.Calendar.Time; + Max_Sub_Second_Digits : in Natural := 120) + return String + with Post => Is_Valid (To_Key'Result); + -- Convert a time into a key + + function To_Time (Key : String) return Ada.Calendar.Time + with Pre => Is_Valid (Key); + -- Convert a valid key into the original time + +private + + subtype Base_64_Digit is Character with Static_Predicate + => Base_64_Digit in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~'; + + type Base_64_Value is mod 2 ** 6; + + Digit_Offset : constant := 48; -- Character'Pos ('0') + Upper_Offset : constant := 55; -- Character'Pos ('A') - 10 + Lower_Offset : constant := 60; -- Character'Pos ('a') - 37 + + function Value (Digit : Base_64_Digit) return Base_64_Value + is (Base_64_Value + (case Digit is + when '0' .. '9' => Character'Pos (Digit) - Digit_Offset, + when 'A' .. 'Z' => Character'Pos (Digit) - Upper_Offset, + when '_' => 36, + when 'a' .. 'z' => Character'Pos (Digit) - Lower_Offset, + when '~' => 63)); + + function I_Value (Digit : Base_64_Digit) return Integer + is (Integer (Value (Digit))); + + function Image (Digit : Base_64_Value) return Base_64_Digit + is (case Digit is + when 0 .. 9 => Character'Val (Natural (Digit) + Digit_Offset), + when 10 .. 35 => Character'Val (Natural (Digit) + Upper_Offset), + when 36 => '_', + when 37 .. 62 => Character'Val (Natural (Digit) + Lower_Offset), + when 63 => '~'); + + function I_Image (Digit : Integer) return Base_64_Digit + is (Image (Base_64_Value (Digit))); + + function Is_Valid (Key : String) return Boolean + is (Key'Length >= 4 + and then Key (Key'First) + in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~' + and then Key (Key'First + 1) + in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~' + and then Key (Key'First + 2) in '1' .. '9' | 'A' .. 'C' + and then Key (Key'First + 3) in '1' .. '9' | 'A' .. 'V' + and then (Key'First + 4 not in Key'Range + or else Key (Key'First + 4) in '0' .. '9' | 'A' .. 'N') + and then (Key'First + 5 not in Key'Range or else Key (Key'First + 5) + in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'w') + and then (Key'First + 6 not in Key'Range or else Key (Key'First + 6) + in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'x') + and then (for all I in Key'First + 7 .. Key'Last => Key (I) + in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~')); + +end Natools.Time_Keys;