Natools

Check-in [0e268efe7a]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:time_io-rfc_3339: new package for time I/O according to RFC-3339
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0e268efe7a5ad741c02931c4236b00dd5fd6a16e
User & Date: nat on 2014-08-17 21:58:35
Other Links: manifest | tags
Context
2014-08-18
19:21
time_io-tests: add a test suite for RFC-3339 check-in: 0bfc3117df user: nat tags: trunk
2014-08-17
21:58
time_io-rfc_3339: new package for time I/O according to RFC-3339 check-in: 0e268efe7a user: nat tags: trunk
2014-08-16
17:33
time_io-tests: test suite for Time_IO subprograms, checking time interval images check-in: 830bf444c4 user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added src/natools-time_io-rfc_3339.adb version [254f3dab5b]. 













































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, 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_IO provides subprograms to serialize and deserialize times  --
-- to and from various String representations.                              --
------------------------------------------------------------------------------

with Ada.Calendar.Formatting;

package body Natools.Time_IO.RFC_3339 is

   ---------------------
   -- Validity Checks --
   ---------------------

   function Is_Valid_Prefix (Image : String) return Boolean
     is (Image (Image'First) in Digit_Character
        and then Image (Image'First + 1) in Digit_Character
        and then Image (Image'First + 2) in Digit_Character
        and then Image (Image'First + 3) in Digit_Character
        and then Image (Image'First + 4) = Date_Separator
        and then Image (Image'First + 5) in Digit_Character
        and then Image (Image'First + 6) in Digit_Character
        and then Image (Image'First + 7) = Date_Separator
        and then Image (Image'First + 8) in Digit_Character
        and then Image (Image'First + 9) in Digit_Character
        and then Image (Image'First + 10) = Date_Time_Separator
        and then Image (Image'First + 11) in Digit_Character
        and then Image (Image'First + 12) in Digit_Character
        and then Image (Image'First + 13) = Time_Separator
        and then Image (Image'First + 14) in Digit_Character
        and then Image (Image'First + 15) in Digit_Character
        and then Image (Image'First + 16) = Time_Separator
        and then Image (Image'First + 17) in Digit_Character
        and then Image (Image'First + 18) in Digit_Character);

   function Is_Valid_Time_Zone (Image : String) return Boolean
     is (Image (Image'Last - 5) in '+' | '-'
        and then Image (Image'Last - 4) in Digit_Character
        and then Image (Image'Last - 3) in Digit_Character
        and then Image (Image'Last - 2) = Time_Separator
        and then Image (Image'Last - 1) in Digit_Character
        and then Image (Image'Last) in Digit_Character);

   function Is_Valid_Subsecond (Sub_Image : String) return Boolean
     is (Sub_Image'Length = 0
        or else (Sub_Image'Length >= 2
           and then Sub_Image (Sub_Image'First) = Subsecond_Separator
           and then (for all I in Sub_Image'First + 1 .. Sub_Image'Last
              => Sub_Image (I) in Digit_Character)));

   function Is_Valid (Image : String) return Boolean is
   begin
      return Image'Length >= 20
        and then Is_Valid_Prefix (Image)
        and then ((Image (Image'Last) = 'Z'
              and then Is_Valid_Subsecond
                    (Image (Image'First + 19 .. Image'Last - 1)))
           or else (Is_Valid_Time_Zone (Image)
              and then Is_Valid_Subsecond
                    (Image (Image'First + 19 .. Image'Last - 6))));
   end Is_Valid;



   --------------------
   -- Time To String --
   --------------------

   function Image
     (Date : Ada.Calendar.Time;
      Subsecond_Digits : Natural := 0)
     return String is
   begin
      return Image
        (Date,
         Ada.Calendar.Time_Zones.UTC_Time_Offset (Date),
         Subsecond_Digits);
   end Image;


   function Image
     (Date : Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset;
      Subsecond_Digits : Natural := 0)
     return String
   is
      function Subsecond_Image
        (Subsecond : Ada.Calendar.Formatting.Second_Duration)
        return String;

      function Time_Zone_Image return String;

      function Subsecond_Image
        (Subsecond : Ada.Calendar.Formatting.Second_Duration)
        return String
      is
         Remaining : Duration := Subsecond;
         Number : Digit_Number;
         N : Natural;
      begin
         if Subsecond_Digits = 0  then
            return "";
         end if;

         return Result : String (1 .. Subsecond_Digits + 1) do
            Result (1) := Subsecond_Separator;
            for I in 2 .. Subsecond_Digits + 1 loop
               Remaining := Remaining * 10;
               N := Natural (Remaining);
               if Duration (N) > Remaining then
                  Number := N - 1;
               else
                  Number := N;
               end if;
               Remaining := Remaining - Duration (Number);
               Result (I) := Image (Number);
            end loop;
         end return;
      end Subsecond_Image;

      function Time_Zone_Image return String is
         use type Ada.Calendar.Time_Zones.Time_Offset;
      begin
         if Time_Zone = 0 then
            return "Z";
         else
            declare
               Hour : constant Ada.Calendar.Time_Zones.Time_Offset
                 := (abs Time_Zone) / 60;
               Minute : constant Ada.Calendar.Time_Zones.Time_Offset
                 := (abs Time_Zone) mod 60;
               Sign : Character;
            begin
               if Time_Zone < 0 then
                  Sign := '-';
               else
                  Sign := '+';
               end if;

               return String'(Sign,
                 Image (Digit_Number (Hour / 10)),
                 Image (Digit_Number (Hour mod 10)),
                 Time_Separator,
                 Image (Digit_Number (Minute / 10)),
                 Image (Digit_Number (Minute mod 10)));
            end;
         end if;
      end Time_Zone_Image;

      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;
      Subsecond : Ada.Calendar.Formatting.Second_Duration;
      Leap_Second : Boolean;
      Used_Second : Natural;
   begin
      Ada.Calendar.Formatting.Split
        (Date,
         Year, Month, Day,
         Hour, Minute, Second,
         Subsecond,
         Leap_Second,
         Time_Zone);

      if Leap_Second then
         pragma Assert (Second = 59);
         Used_Second := 60;
      else
         Used_Second := Second;
      end if;

      return
        (Image (Year / 1000),
         Image ((Year / 100) mod 10),
         Image ((Year / 10) mod 10),
         Image (Year mod 10),
         Date_Separator,
         Image (Month / 10),
         Image (Month mod 10),
         Date_Separator,
         Image (Day / 10),
         Image (Day mod 10),
         Date_Time_Separator,
         Image (Hour / 10),
         Image (Hour mod 10),
         Time_Separator,
         Image (Minute / 10),
         Image (Minute mod 10),
         Time_Separator,
         Image (Used_Second / 10),
         Image (Used_Second mod 10))
        & Subsecond_Image (Subsecond)
        & Time_Zone_Image;
   end Image;



   --------------------
   -- String To Time --
   --------------------

   function Value (Image : String) return Ada.Calendar.Time is
      Result : Ada.Calendar.Time;
      Discarded : Ada.Calendar.Time_Zones.Time_Offset;
   begin
      Value (Image, Result, Discarded);
      return Result;
   end Value;


   procedure Value
     (Image : in String;
      Date : out Ada.Calendar.Time;
      Time_Zone : out Ada.Calendar.Time_Zones.Time_Offset)
   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;
      Subsecond : Ada.Calendar.Formatting.Second_Duration := 0.0;
      Leap_Second : Boolean;
   begin
      Year := Natural'Value (Image (Image'First .. Image'First + 3));
      Month := Natural'Value (Image (Image'First + 5 .. Image'First + 6));
      Day := Natural'Value (Image (Image'First + 8 .. Image'First + 9));
      Hour := Natural'Value (Image (Image'First + 11 .. Image'First + 12));
      Minute := Natural'Value
        (Image (Image'First + 14 .. Image'First + 15));

      declare
         Number : constant Natural
           := Natural'Value (Image (Image'First + 17 .. Image'First + 18));
      begin
         if Number = 60 then
            Leap_Second := True;
            Second := 59;
         else
            Second := Number;
         end if;
      end;

      if Image (Image'First + 19) = Subsecond_Separator then
         declare
            I : Positive := Image'First + 20;
            Current : Duration := 0.1;
         begin
            while Image (I) in Digit_Character loop
               Subsecond := Subsecond + Current
                 * (Character'Pos (Image (I)) - Character'Pos ('0'));
               Current := Current / 10;
               I := I + 1;
            end loop;
         end;
      end if;

      if Image (Image'Last) = 'Z' then
         Time_Zone := 0;
      else
         Time_Zone := Ada.Calendar.Time_Zones.Time_Offset
           (Natural'Value (Image (Image'Last - 4 .. Image'Last - 3)) * 60
            + Natural'Value (Image (Image'Last - 1 .. Image'Last)));
         case Image (Image'Last - 5) is
            when '-' =>
               Time_Zone := Ada.Calendar.Time_Zones."-" (Time_Zone);
            when '+' =>
               null;
            when others =>
               raise Constraint_Error
                 with "Invalid time zone separator in RFC 3339 date";
         end case;
      end if;

      Date := Ada.Calendar.Formatting.Time_Of
        (Year, Month, Day,
         Hour, Minute, Second,
         Subsecond, Leap_Second, Time_Zone);
   end Value;

end Natools.Time_IO.RFC_3339;








Added src/natools-time_io-rfc_3339.ads version [25471d80ad].

































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, 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_IO.RFC_3339 provides subprograms to serialize and           --
-- deserialize times to and from String representations according to        --
-- RFC 3339, which is also a valid subset of ISO 8601.                      --
------------------------------------------------------------------------------

with Ada.Calendar.Time_Zones;

package Natools.Time_IO.RFC_3339 is

   Date_Separator : constant Character := '-';
   Date_Time_Separator : constant Character := 'T';
   Time_Separator : constant Character := ':';
   Subsecond_Separator : constant Character := '.';

   function Is_Valid (Image : String) return Boolean;
      --  Check whether Image is a valid RFC-3339 date

   function Image
     (Date : Ada.Calendar.Time;
      Subsecond_Digits : Natural := 0)
     return String
     with Post => Is_Valid (Image'Result);
      --  Return the RFC-3339 representation of Date in current time zone

   function Image
     (Date : Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset;
      Subsecond_Digits : Natural := 0)
     return String
     with Post => Is_Valid (Image'Result);
      --  Return the RFC-3339 representation of Date in Time_Zone

   function Value (Image : String) return Ada.Calendar.Time
     with Pre => Is_Valid (Image) or else raise Constraint_Error;
      --  Return the time associated with the given RFC-3339 representation

   procedure Value
     (Image : in String;
      Date : out Ada.Calendar.Time;
      Time_Zone : out Ada.Calendar.Time_Zones.Time_Offset)
     with Pre => Is_Valid (Image) or else raise Constraint_Error;
      --  Return the time associated with the given RFC-3339 representation

end Natools.Time_IO.RFC_3339;













This page was generated in about
0.004s by
Fossil 2.23 [47362306a7] 2023-11-01 18:56:47