|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T . C A L E N D A R . T I M E _ I O --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1999-2019, AdaCore --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with Ada.Calendar; use Ada.Calendar;
|
|
|
33 with Ada.Characters.Handling;
|
|
|
34 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
|
|
35 with Ada.Text_IO;
|
|
|
36
|
|
|
37 with GNAT.Case_Util;
|
|
|
38
|
|
|
39 package body GNAT.Calendar.Time_IO is
|
|
|
40
|
|
|
41 type Month_Name is
|
|
|
42 (January,
|
|
|
43 February,
|
|
|
44 March,
|
|
|
45 April,
|
|
|
46 May,
|
|
|
47 June,
|
|
|
48 July,
|
|
|
49 August,
|
|
|
50 September,
|
|
|
51 October,
|
|
|
52 November,
|
|
|
53 December);
|
|
|
54
|
|
|
55 function Month_Name_To_Number
|
|
|
56 (Str : String) return Ada.Calendar.Month_Number;
|
|
|
57 -- Converts a string that contains an abbreviated month name to a month
|
|
|
58 -- number. Constraint_Error is raised if Str is not a valid month name.
|
|
|
59 -- Comparison is case insensitive
|
|
|
60
|
|
|
61 type Padding_Mode is (None, Zero, Space);
|
|
|
62
|
|
|
63 type Sec_Number is mod 2 ** 64;
|
|
|
64 -- Type used to compute the number of seconds since 01/01/1970. A 32 bit
|
|
|
65 -- number will cover only a period of 136 years. This means that for date
|
|
|
66 -- past 2106 the computation is not possible. A 64 bits number should be
|
|
|
67 -- enough for a very large period of time.
|
|
|
68
|
|
|
69 -----------------------
|
|
|
70 -- Local Subprograms --
|
|
|
71 -----------------------
|
|
|
72
|
|
|
73 function Am_Pm (H : Natural) return String;
|
|
|
74 -- Return AM or PM depending on the hour H
|
|
|
75
|
|
|
76 function Hour_12 (H : Natural) return Positive;
|
|
|
77 -- Convert a 1-24h format to a 0-12 hour format
|
|
|
78
|
|
|
79 function Image (Str : String; Length : Natural := 0) return String;
|
|
|
80 -- Return Str capitalized and cut to length number of characters. If
|
|
|
81 -- length is 0, then no cut operation is performed.
|
|
|
82
|
|
|
83 function Image
|
|
|
84 (N : Sec_Number;
|
|
|
85 Padding : Padding_Mode := Zero;
|
|
|
86 Length : Natural := 0) return String;
|
|
|
87 -- Return image of N. This number is eventually padded with zeros or spaces
|
|
|
88 -- depending of the length required. If length is 0 then no padding occurs.
|
|
|
89
|
|
|
90 function Image
|
|
|
91 (N : Natural;
|
|
|
92 Padding : Padding_Mode := Zero;
|
|
|
93 Length : Natural := 0) return String;
|
|
|
94 -- As above with N provided in Integer format
|
|
|
95
|
|
|
96 procedure Parse_ISO_8861_UTC
|
|
|
97 (Date : String;
|
|
|
98 Time : out Ada.Calendar.Time;
|
|
|
99 Success : out Boolean);
|
|
|
100 -- Subsidiary of function Value. It parses the string Date, interpreted as
|
|
|
101 -- an ISO 8861 time representation, and returns corresponding Time value.
|
|
|
102 -- Success is set to False when the string is not a supported ISO 8861
|
|
|
103 -- date. The following regular expression defines the supported format:
|
|
|
104 --
|
|
|
105 -- (yyyymmdd | yyyy'-'mm'-'dd)'T'(hhmmss | hh':'mm':'ss)
|
|
|
106 -- [ ('Z' | ('.' | ',') s{s} | ('+'|'-')hh':'mm) ]
|
|
|
107 --
|
|
|
108 -- Trailing characters (in particular spaces) are not allowed.
|
|
|
109 --
|
|
|
110 -- Examples:
|
|
|
111 --
|
|
|
112 -- 2017-04-14T14:47:06 20170414T14:47:06 20170414T144706
|
|
|
113 -- 2017-04-14T14:47:06,12 20170414T14:47:06.12
|
|
|
114 -- 2017-04-14T19:47:06+05 20170414T09:00:06-05:47
|
|
|
115
|
|
|
116 -----------
|
|
|
117 -- Am_Pm --
|
|
|
118 -----------
|
|
|
119
|
|
|
120 function Am_Pm (H : Natural) return String is
|
|
|
121 begin
|
|
|
122 if H = 0 or else H > 12 then
|
|
|
123 return "PM";
|
|
|
124 else
|
|
|
125 return "AM";
|
|
|
126 end if;
|
|
|
127 end Am_Pm;
|
|
|
128
|
|
|
129 -------------
|
|
|
130 -- Hour_12 --
|
|
|
131 -------------
|
|
|
132
|
|
|
133 function Hour_12 (H : Natural) return Positive is
|
|
|
134 begin
|
|
|
135 if H = 0 then
|
|
|
136 return 12;
|
|
|
137 elsif H <= 12 then
|
|
|
138 return H;
|
|
|
139 else -- H > 12
|
|
|
140 return H - 12;
|
|
|
141 end if;
|
|
|
142 end Hour_12;
|
|
|
143
|
|
|
144 -----------
|
|
|
145 -- Image --
|
|
|
146 -----------
|
|
|
147
|
|
|
148 function Image
|
|
|
149 (Str : String;
|
|
|
150 Length : Natural := 0) return String
|
|
|
151 is
|
|
|
152 use Ada.Characters.Handling;
|
|
|
153 Local : constant String :=
|
|
|
154 To_Upper (Str (Str'First)) &
|
|
|
155 To_Lower (Str (Str'First + 1 .. Str'Last));
|
|
|
156 begin
|
|
|
157 if Length = 0 then
|
|
|
158 return Local;
|
|
|
159 else
|
|
|
160 return Local (1 .. Length);
|
|
|
161 end if;
|
|
|
162 end Image;
|
|
|
163
|
|
|
164 -----------
|
|
|
165 -- Image --
|
|
|
166 -----------
|
|
|
167
|
|
|
168 function Image
|
|
|
169 (N : Natural;
|
|
|
170 Padding : Padding_Mode := Zero;
|
|
|
171 Length : Natural := 0) return String
|
|
|
172 is
|
|
|
173 begin
|
|
|
174 return Image (Sec_Number (N), Padding, Length);
|
|
|
175 end Image;
|
|
|
176
|
|
|
177 function Image
|
|
|
178 (N : Sec_Number;
|
|
|
179 Padding : Padding_Mode := Zero;
|
|
|
180 Length : Natural := 0) return String
|
|
|
181 is
|
|
|
182 function Pad_Char return String;
|
|
|
183
|
|
|
184 --------------
|
|
|
185 -- Pad_Char --
|
|
|
186 --------------
|
|
|
187
|
|
|
188 function Pad_Char return String is
|
|
|
189 begin
|
|
|
190 case Padding is
|
|
|
191 when None => return "";
|
|
|
192 when Zero => return "00";
|
|
|
193 when Space => return " ";
|
|
|
194 end case;
|
|
|
195 end Pad_Char;
|
|
|
196
|
|
|
197 -- Local Declarations
|
|
|
198
|
|
|
199 NI : constant String := Sec_Number'Image (N);
|
|
|
200 NIP : constant String := Pad_Char & NI (2 .. NI'Last);
|
|
|
201
|
|
|
202 -- Start of processing for Image
|
|
|
203
|
|
|
204 begin
|
|
|
205 if Length = 0 or else Padding = None then
|
|
|
206 return NI (2 .. NI'Last);
|
|
|
207 else
|
|
|
208 return NIP (NIP'Last - Length + 1 .. NIP'Last);
|
|
|
209 end if;
|
|
|
210 end Image;
|
|
|
211
|
|
|
212 -----------
|
|
|
213 -- Image --
|
|
|
214 -----------
|
|
|
215
|
|
|
216 function Image
|
|
|
217 (Date : Ada.Calendar.Time;
|
|
|
218 Picture : Picture_String) return String
|
|
|
219 is
|
|
|
220 Padding : Padding_Mode := Zero;
|
|
|
221 -- Padding is set for one directive
|
|
|
222
|
|
|
223 Result : Unbounded_String;
|
|
|
224
|
|
|
225 Year : Year_Number;
|
|
|
226 Month : Month_Number;
|
|
|
227 Day : Day_Number;
|
|
|
228 Hour : Hour_Number;
|
|
|
229 Minute : Minute_Number;
|
|
|
230 Second : Second_Number;
|
|
|
231 Sub_Second : Second_Duration;
|
|
|
232
|
|
|
233 P : Positive;
|
|
|
234
|
|
|
235 begin
|
|
|
236 -- Get current time in split format
|
|
|
237
|
|
|
238 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
|
|
|
239
|
|
|
240 -- Null picture string is error
|
|
|
241
|
|
|
242 if Picture = "" then
|
|
|
243 raise Picture_Error with "null picture string";
|
|
|
244 end if;
|
|
|
245
|
|
|
246 -- Loop through characters of picture string, building result
|
|
|
247
|
|
|
248 Result := Null_Unbounded_String;
|
|
|
249 P := Picture'First;
|
|
|
250 while P <= Picture'Last loop
|
|
|
251
|
|
|
252 -- A directive has the following format "%[-_]."
|
|
|
253
|
|
|
254 if Picture (P) = '%' then
|
|
|
255 Padding := Zero;
|
|
|
256
|
|
|
257 if P = Picture'Last then
|
|
|
258 raise Picture_Error with "picture string ends with '%";
|
|
|
259 end if;
|
|
|
260
|
|
|
261 -- Check for GNU extension to change the padding
|
|
|
262
|
|
|
263 if Picture (P + 1) = '-' then
|
|
|
264 Padding := None;
|
|
|
265 P := P + 1;
|
|
|
266
|
|
|
267 elsif Picture (P + 1) = '_' then
|
|
|
268 Padding := Space;
|
|
|
269 P := P + 1;
|
|
|
270 end if;
|
|
|
271
|
|
|
272 if P = Picture'Last then
|
|
|
273 raise Picture_Error with "picture string ends with '- or '_";
|
|
|
274 end if;
|
|
|
275
|
|
|
276 case Picture (P + 1) is
|
|
|
277
|
|
|
278 -- Literal %
|
|
|
279
|
|
|
280 when '%' =>
|
|
|
281 Result := Result & '%';
|
|
|
282
|
|
|
283 -- A newline
|
|
|
284
|
|
|
285 when 'n' =>
|
|
|
286 Result := Result & ASCII.LF;
|
|
|
287
|
|
|
288 -- A horizontal tab
|
|
|
289
|
|
|
290 when 't' =>
|
|
|
291 Result := Result & ASCII.HT;
|
|
|
292
|
|
|
293 -- Hour (00..23)
|
|
|
294
|
|
|
295 when 'H' =>
|
|
|
296 Result := Result & Image (Hour, Padding, 2);
|
|
|
297
|
|
|
298 -- Hour (01..12)
|
|
|
299
|
|
|
300 when 'I' =>
|
|
|
301 Result := Result & Image (Hour_12 (Hour), Padding, 2);
|
|
|
302
|
|
|
303 -- Hour ( 0..23)
|
|
|
304
|
|
|
305 when 'k' =>
|
|
|
306 Result := Result & Image (Hour, Space, 2);
|
|
|
307
|
|
|
308 -- Hour ( 1..12)
|
|
|
309
|
|
|
310 when 'l' =>
|
|
|
311 Result := Result & Image (Hour_12 (Hour), Space, 2);
|
|
|
312
|
|
|
313 -- Minute (00..59)
|
|
|
314
|
|
|
315 when 'M' =>
|
|
|
316 Result := Result & Image (Minute, Padding, 2);
|
|
|
317
|
|
|
318 -- AM/PM
|
|
|
319
|
|
|
320 when 'p' =>
|
|
|
321 Result := Result & Am_Pm (Hour);
|
|
|
322
|
|
|
323 -- Time, 12-hour (hh:mm:ss [AP]M)
|
|
|
324
|
|
|
325 when 'r' =>
|
|
|
326 Result := Result &
|
|
|
327 Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
|
|
|
328 Image (Minute, Padding, Length => 2) & ':' &
|
|
|
329 Image (Second, Padding, Length => 2) & ' ' &
|
|
|
330 Am_Pm (Hour);
|
|
|
331
|
|
|
332 -- Seconds since 1970-01-01 00:00:00 UTC
|
|
|
333 -- (a nonstandard extension)
|
|
|
334
|
|
|
335 when 's' =>
|
|
|
336 declare
|
|
|
337 -- Compute the number of seconds using Ada.Calendar.Time
|
|
|
338 -- values rather than Julian days to account for Daylight
|
|
|
339 -- Savings Time.
|
|
|
340
|
|
|
341 Neg : Boolean := False;
|
|
|
342 Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);
|
|
|
343
|
|
|
344 begin
|
|
|
345 -- Avoid rounding errors and perform special processing
|
|
|
346 -- for dates earlier than the Unix Epoc.
|
|
|
347
|
|
|
348 if Sec > 0.0 then
|
|
|
349 Sec := Sec - 0.5;
|
|
|
350 elsif Sec < 0.0 then
|
|
|
351 Neg := True;
|
|
|
352 Sec := abs (Sec + 0.5);
|
|
|
353 end if;
|
|
|
354
|
|
|
355 -- Prepend a minus sign to the result since Sec_Number
|
|
|
356 -- cannot handle negative numbers.
|
|
|
357
|
|
|
358 if Neg then
|
|
|
359 Result :=
|
|
|
360 Result & "-" & Image (Sec_Number (Sec), None);
|
|
|
361 else
|
|
|
362 Result := Result & Image (Sec_Number (Sec), None);
|
|
|
363 end if;
|
|
|
364 end;
|
|
|
365
|
|
|
366 -- Second (00..59)
|
|
|
367
|
|
|
368 when 'S' =>
|
|
|
369 Result := Result & Image (Second, Padding, Length => 2);
|
|
|
370
|
|
|
371 -- Milliseconds (3 digits)
|
|
|
372 -- Microseconds (6 digits)
|
|
|
373 -- Nanoseconds (9 digits)
|
|
|
374
|
|
|
375 when 'i' | 'e' | 'o' =>
|
|
|
376 declare
|
|
|
377 Sub_Sec : constant Long_Integer :=
|
|
|
378 Long_Integer (Sub_Second * 1_000_000_000);
|
|
|
379
|
|
|
380 Img1 : constant String := Sub_Sec'Img;
|
|
|
381 Img2 : constant String :=
|
|
|
382 "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
|
|
|
383 Nanos : constant String :=
|
|
|
384 Img2 (Img2'Last - 8 .. Img2'Last);
|
|
|
385
|
|
|
386 begin
|
|
|
387 case Picture (P + 1) is
|
|
|
388 when 'i' =>
|
|
|
389 Result := Result &
|
|
|
390 Nanos (Nanos'First .. Nanos'First + 2);
|
|
|
391
|
|
|
392 when 'e' =>
|
|
|
393 Result := Result &
|
|
|
394 Nanos (Nanos'First .. Nanos'First + 5);
|
|
|
395
|
|
|
396 when 'o' =>
|
|
|
397 Result := Result & Nanos;
|
|
|
398
|
|
|
399 when others =>
|
|
|
400 null;
|
|
|
401 end case;
|
|
|
402 end;
|
|
|
403
|
|
|
404 -- Time, 24-hour (hh:mm:ss)
|
|
|
405
|
|
|
406 when 'T' =>
|
|
|
407 Result := Result &
|
|
|
408 Image (Hour, Padding, Length => 2) & ':' &
|
|
|
409 Image (Minute, Padding, Length => 2) & ':' &
|
|
|
410 Image (Second, Padding, Length => 2);
|
|
|
411
|
|
|
412 -- Locale's abbreviated weekday name (Sun..Sat)
|
|
|
413
|
|
|
414 when 'a' =>
|
|
|
415 Result := Result &
|
|
|
416 Image (Day_Name'Image (Day_Of_Week (Date)), 3);
|
|
|
417
|
|
|
418 -- Locale's full weekday name, variable length
|
|
|
419 -- (Sunday..Saturday)
|
|
|
420
|
|
|
421 when 'A' =>
|
|
|
422 Result := Result &
|
|
|
423 Image (Day_Name'Image (Day_Of_Week (Date)));
|
|
|
424
|
|
|
425 -- Locale's abbreviated month name (Jan..Dec)
|
|
|
426
|
|
|
427 when 'b' | 'h' =>
|
|
|
428 Result := Result &
|
|
|
429 Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
|
|
|
430
|
|
|
431 -- Locale's full month name, variable length
|
|
|
432 -- (January..December).
|
|
|
433
|
|
|
434 when 'B' =>
|
|
|
435 Result := Result &
|
|
|
436 Image (Month_Name'Image (Month_Name'Val (Month - 1)));
|
|
|
437
|
|
|
438 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
|
|
|
439
|
|
|
440 when 'c' =>
|
|
|
441 case Padding is
|
|
|
442 when Zero =>
|
|
|
443 Result := Result & Image (Date, "%a %b %d %T %Y");
|
|
|
444 when Space =>
|
|
|
445 Result := Result & Image (Date, "%a %b %_d %_T %Y");
|
|
|
446 when None =>
|
|
|
447 Result := Result & Image (Date, "%a %b %-d %-T %Y");
|
|
|
448 end case;
|
|
|
449
|
|
|
450 -- Day of month (01..31)
|
|
|
451
|
|
|
452 when 'd' =>
|
|
|
453 Result := Result & Image (Day, Padding, 2);
|
|
|
454
|
|
|
455 -- Date (mm/dd/yy)
|
|
|
456
|
|
|
457 when 'D' | 'x' =>
|
|
|
458 Result := Result &
|
|
|
459 Image (Month, Padding, 2) & '/' &
|
|
|
460 Image (Day, Padding, 2) & '/' &
|
|
|
461 Image (Year, Padding, 2);
|
|
|
462
|
|
|
463 -- Day of year (001..366)
|
|
|
464
|
|
|
465 when 'j' =>
|
|
|
466 Result := Result & Image (Day_In_Year (Date), Padding, 3);
|
|
|
467
|
|
|
468 -- Month (01..12)
|
|
|
469
|
|
|
470 when 'm' =>
|
|
|
471 Result := Result & Image (Month, Padding, 2);
|
|
|
472
|
|
|
473 -- Week number of year with Sunday as first day of week
|
|
|
474 -- (00..53)
|
|
|
475
|
|
|
476 when 'U' =>
|
|
|
477 declare
|
|
|
478 Offset : constant Natural :=
|
|
|
479 (Julian_Day (Year, 1, 1) + 1) mod 7;
|
|
|
480
|
|
|
481 Week : constant Natural :=
|
|
|
482 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
|
|
|
483
|
|
|
484 begin
|
|
|
485 Result := Result & Image (Week, Padding, 2);
|
|
|
486 end;
|
|
|
487
|
|
|
488 -- Day of week (0..6) with 0 corresponding to Sunday
|
|
|
489
|
|
|
490 when 'w' =>
|
|
|
491 declare
|
|
|
492 DOW : constant Natural range 0 .. 6 :=
|
|
|
493 (if Day_Of_Week (Date) = Sunday
|
|
|
494 then 0
|
|
|
495 else Day_Name'Pos (Day_Of_Week (Date)));
|
|
|
496 begin
|
|
|
497 Result := Result & Image (DOW, Length => 1);
|
|
|
498 end;
|
|
|
499
|
|
|
500 -- Week number of year with Monday as first day of week
|
|
|
501 -- (00..53)
|
|
|
502
|
|
|
503 when 'W' =>
|
|
|
504 Result := Result & Image (Week_In_Year (Date), Padding, 2);
|
|
|
505
|
|
|
506 -- Last two digits of year (00..99)
|
|
|
507
|
|
|
508 when 'y' =>
|
|
|
509 declare
|
|
|
510 Y : constant Natural := Year - (Year / 100) * 100;
|
|
|
511 begin
|
|
|
512 Result := Result & Image (Y, Padding, 2);
|
|
|
513 end;
|
|
|
514
|
|
|
515 -- Year (1970...)
|
|
|
516
|
|
|
517 when 'Y' =>
|
|
|
518 Result := Result & Image (Year, None, 4);
|
|
|
519
|
|
|
520 when others =>
|
|
|
521 raise Picture_Error with
|
|
|
522 "unknown format character in picture string";
|
|
|
523 end case;
|
|
|
524
|
|
|
525 -- Skip past % and format character
|
|
|
526
|
|
|
527 P := P + 2;
|
|
|
528
|
|
|
529 -- Character other than % is copied into the result
|
|
|
530
|
|
|
531 else
|
|
|
532 Result := Result & Picture (P);
|
|
|
533 P := P + 1;
|
|
|
534 end if;
|
|
|
535 end loop;
|
|
|
536
|
|
|
537 return To_String (Result);
|
|
|
538 end Image;
|
|
|
539
|
|
|
540 --------------------------
|
|
|
541 -- Month_Name_To_Number --
|
|
|
542 --------------------------
|
|
|
543
|
|
|
544 function Month_Name_To_Number
|
|
|
545 (Str : String) return Ada.Calendar.Month_Number
|
|
|
546 is
|
|
|
547 subtype String3 is String (1 .. 3);
|
|
|
548 Abbrev_Upper_Month_Names :
|
|
|
549 constant array (Ada.Calendar.Month_Number) of String3 :=
|
|
|
550 ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
|
|
|
551 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");
|
|
|
552 -- Short version of the month names, used when parsing date strings
|
|
|
553
|
|
|
554 S : String := Str;
|
|
|
555
|
|
|
556 begin
|
|
|
557 GNAT.Case_Util.To_Upper (S);
|
|
|
558
|
|
|
559 for J in Abbrev_Upper_Month_Names'Range loop
|
|
|
560 if Abbrev_Upper_Month_Names (J) = S then
|
|
|
561 return J;
|
|
|
562 end if;
|
|
|
563 end loop;
|
|
|
564
|
|
|
565 return Abbrev_Upper_Month_Names'First;
|
|
|
566 end Month_Name_To_Number;
|
|
|
567
|
|
|
568 ------------------------
|
|
|
569 -- Parse_ISO_8861_UTC --
|
|
|
570 ------------------------
|
|
|
571
|
|
|
572 procedure Parse_ISO_8861_UTC
|
|
|
573 (Date : String;
|
|
|
574 Time : out Ada.Calendar.Time;
|
|
|
575 Success : out Boolean)
|
|
|
576 is
|
|
|
577 Index : Positive := Date'First;
|
|
|
578 -- The current character scan index. After a call to Advance, Index
|
|
|
579 -- points to the next character.
|
|
|
580
|
|
|
581 End_Of_Source_Reached : exception;
|
|
|
582 -- An exception used to signal that the scan pointer has reached the
|
|
|
583 -- end of the source string.
|
|
|
584
|
|
|
585 Wrong_Syntax : exception;
|
|
|
586 -- An exception used to signal that the scan pointer has reached an
|
|
|
587 -- unexpected character in the source string.
|
|
|
588
|
|
|
589 procedure Advance;
|
|
|
590 pragma Inline (Advance);
|
|
|
591 -- Past the current character of Date
|
|
|
592
|
|
|
593 procedure Advance_Digits (Num_Digits : Positive);
|
|
|
594 pragma Inline (Advance_Digits);
|
|
|
595 -- Past the given number of digit characters
|
|
|
596
|
|
|
597 function Scan_Day return Day_Number;
|
|
|
598 pragma Inline (Scan_Day);
|
|
|
599 -- Scan the two digits of a day number and return its value
|
|
|
600
|
|
|
601 function Scan_Hour return Hour_Number;
|
|
|
602 pragma Inline (Scan_Hour);
|
|
|
603 -- Scan the two digits of an hour number and return its value
|
|
|
604
|
|
|
605 function Scan_Minute return Minute_Number;
|
|
|
606 pragma Inline (Scan_Minute);
|
|
|
607 -- Scan the two digits of a minute number and return its value
|
|
|
608
|
|
|
609 function Scan_Month return Month_Number;
|
|
|
610 pragma Inline (Scan_Month);
|
|
|
611 -- Scan the two digits of a month number and return its value
|
|
|
612
|
|
|
613 function Scan_Second return Second_Number;
|
|
|
614 pragma Inline (Scan_Second);
|
|
|
615 -- Scan the two digits of a second number and return its value
|
|
|
616
|
|
|
617 function Scan_Separator (Expected_Symbol : Character) return Boolean;
|
|
|
618 pragma Inline (Scan_Separator);
|
|
|
619 -- If the current symbol matches the Expected_Symbol then advance the
|
|
|
620 -- scanner index and return True; otherwise do nothing and return False
|
|
|
621
|
|
|
622 procedure Scan_Separator (Required : Boolean; Separator : Character);
|
|
|
623 pragma Inline (Scan_Separator);
|
|
|
624 -- If Required then check that the current character matches Separator
|
|
|
625 -- and advance the scanner index; if not Required then do nothing.
|
|
|
626
|
|
|
627 function Scan_Subsecond return Second_Duration;
|
|
|
628 pragma Inline (Scan_Subsecond);
|
|
|
629 -- Scan all the digits of a subsecond number and return its value
|
|
|
630
|
|
|
631 function Scan_Year return Year_Number;
|
|
|
632 pragma Inline (Scan_Year);
|
|
|
633 -- Scan the four digits of a year number and return its value
|
|
|
634
|
|
|
635 function Symbol return Character;
|
|
|
636 pragma Inline (Symbol);
|
|
|
637 -- Return the current character being scanned
|
|
|
638
|
|
|
639 -------------
|
|
|
640 -- Advance --
|
|
|
641 -------------
|
|
|
642
|
|
|
643 procedure Advance is
|
|
|
644 begin
|
|
|
645 -- Signal the end of the source string. This stops a complex scan by
|
|
|
646 -- bottoming up any recursive calls till control reaches routine Scan
|
|
|
647 -- which handles the exception. Certain scanning scenarios may handle
|
|
|
648 -- this exception on their own.
|
|
|
649
|
|
|
650 if Index > Date'Last then
|
|
|
651 raise End_Of_Source_Reached;
|
|
|
652
|
|
|
653 -- Advance the scan pointer as long as there are characters to scan,
|
|
|
654 -- in other words, the scan pointer has not passed the end of the
|
|
|
655 -- source string.
|
|
|
656
|
|
|
657 else
|
|
|
658 Index := Index + 1;
|
|
|
659 end if;
|
|
|
660 end Advance;
|
|
|
661
|
|
|
662 --------------------
|
|
|
663 -- Advance_Digits --
|
|
|
664 --------------------
|
|
|
665
|
|
|
666 procedure Advance_Digits (Num_Digits : Positive) is
|
|
|
667 begin
|
|
|
668 for J in 1 .. Num_Digits loop
|
|
|
669 if Symbol not in '0' .. '9' then
|
|
|
670 raise Wrong_Syntax;
|
|
|
671 end if;
|
|
|
672
|
|
|
673 Advance; -- past digit
|
|
|
674 end loop;
|
|
|
675 end Advance_Digits;
|
|
|
676
|
|
|
677 --------------
|
|
|
678 -- Scan_Day --
|
|
|
679 --------------
|
|
|
680
|
|
|
681 function Scan_Day return Day_Number is
|
|
|
682 From : constant Positive := Index;
|
|
|
683 begin
|
|
|
684 Advance_Digits (Num_Digits => 2);
|
|
|
685 return Day_Number'Value (Date (From .. Index - 1));
|
|
|
686 end Scan_Day;
|
|
|
687
|
|
|
688 ---------------
|
|
|
689 -- Scan_Hour --
|
|
|
690 ---------------
|
|
|
691
|
|
|
692 function Scan_Hour return Hour_Number is
|
|
|
693 From : constant Positive := Index;
|
|
|
694 begin
|
|
|
695 Advance_Digits (Num_Digits => 2);
|
|
|
696 return Hour_Number'Value (Date (From .. Index - 1));
|
|
|
697 end Scan_Hour;
|
|
|
698
|
|
|
699 -----------------
|
|
|
700 -- Scan_Minute --
|
|
|
701 -----------------
|
|
|
702
|
|
|
703 function Scan_Minute return Minute_Number is
|
|
|
704 From : constant Positive := Index;
|
|
|
705 begin
|
|
|
706 Advance_Digits (Num_Digits => 2);
|
|
|
707 return Minute_Number'Value (Date (From .. Index - 1));
|
|
|
708 end Scan_Minute;
|
|
|
709
|
|
|
710 ----------------
|
|
|
711 -- Scan_Month --
|
|
|
712 ----------------
|
|
|
713
|
|
|
714 function Scan_Month return Month_Number is
|
|
|
715 From : constant Positive := Index;
|
|
|
716 begin
|
|
|
717 Advance_Digits (Num_Digits => 2);
|
|
|
718 return Month_Number'Value (Date (From .. Index - 1));
|
|
|
719 end Scan_Month;
|
|
|
720
|
|
|
721 -----------------
|
|
|
722 -- Scan_Second --
|
|
|
723 -----------------
|
|
|
724
|
|
|
725 function Scan_Second return Second_Number is
|
|
|
726 From : constant Positive := Index;
|
|
|
727 begin
|
|
|
728 Advance_Digits (Num_Digits => 2);
|
|
|
729 return Second_Number'Value (Date (From .. Index - 1));
|
|
|
730 end Scan_Second;
|
|
|
731
|
|
|
732 --------------------
|
|
|
733 -- Scan_Separator --
|
|
|
734 --------------------
|
|
|
735
|
|
|
736 function Scan_Separator (Expected_Symbol : Character) return Boolean is
|
|
|
737 begin
|
|
|
738 if Symbol = Expected_Symbol then
|
|
|
739 Advance;
|
|
|
740 return True;
|
|
|
741 else
|
|
|
742 return False;
|
|
|
743 end if;
|
|
|
744 end Scan_Separator;
|
|
|
745
|
|
|
746 --------------------
|
|
|
747 -- Scan_Separator --
|
|
|
748 --------------------
|
|
|
749
|
|
|
750 procedure Scan_Separator (Required : Boolean; Separator : Character) is
|
|
|
751 begin
|
|
|
752 if Required then
|
|
|
753 if Symbol /= Separator then
|
|
|
754 raise Wrong_Syntax;
|
|
|
755 end if;
|
|
|
756
|
|
|
757 Advance; -- Past the separator
|
|
|
758 end if;
|
|
|
759 end Scan_Separator;
|
|
|
760
|
|
|
761 --------------------
|
|
|
762 -- Scan_Subsecond --
|
|
|
763 --------------------
|
|
|
764
|
|
|
765 function Scan_Subsecond return Second_Duration is
|
|
|
766 From : constant Positive := Index;
|
|
|
767 begin
|
|
|
768 Advance_Digits (Num_Digits => 1);
|
|
|
769
|
|
|
770 while Symbol in '0' .. '9'
|
|
|
771 and then Index < Date'Length
|
|
|
772 loop
|
|
|
773 Advance;
|
|
|
774 end loop;
|
|
|
775
|
|
|
776 if Symbol not in '0' .. '9' then
|
|
|
777 raise Wrong_Syntax;
|
|
|
778 end if;
|
|
|
779
|
|
|
780 Advance;
|
|
|
781 return Second_Duration'Value ("0." & Date (From .. Index - 1));
|
|
|
782 end Scan_Subsecond;
|
|
|
783
|
|
|
784 ---------------
|
|
|
785 -- Scan_Year --
|
|
|
786 ---------------
|
|
|
787
|
|
|
788 function Scan_Year return Year_Number is
|
|
|
789 From : constant Positive := Index;
|
|
|
790 begin
|
|
|
791 Advance_Digits (Num_Digits => 4);
|
|
|
792 return Year_Number'Value (Date (From .. Index - 1));
|
|
|
793 end Scan_Year;
|
|
|
794
|
|
|
795 ------------
|
|
|
796 -- Symbol --
|
|
|
797 ------------
|
|
|
798
|
|
|
799 function Symbol return Character is
|
|
|
800 begin
|
|
|
801 -- Signal the end of the source string. This stops a complex scan by
|
|
|
802 -- bottoming up any recursive calls till control reaches routine Scan
|
|
|
803 -- which handles the exception. Certain scanning scenarios may handle
|
|
|
804 -- this exception on their own.
|
|
|
805
|
|
|
806 if Index > Date'Last then
|
|
|
807 raise End_Of_Source_Reached;
|
|
|
808
|
|
|
809 else
|
|
|
810 return Date (Index);
|
|
|
811 end if;
|
|
|
812 end Symbol;
|
|
|
813
|
|
|
814 -- Local variables
|
|
|
815
|
|
|
816 Date_Separator : constant Character := '-';
|
|
|
817 Hour_Separator : constant Character := ':';
|
|
|
818
|
|
|
819 Day : Day_Number;
|
|
|
820 Month : Month_Number;
|
|
|
821 Year : Year_Number;
|
|
|
822 Hour : Hour_Number := 0;
|
|
|
823 Minute : Minute_Number := 0;
|
|
|
824 Second : Second_Number := 0;
|
|
|
825 Subsec : Second_Duration := 0.0;
|
|
|
826
|
|
|
827 Local_Hour : Hour_Number := 0;
|
|
|
828 Local_Minute : Minute_Number := 0;
|
|
|
829 Local_Sign : Character := ' ';
|
|
|
830 Local_Disp : Duration;
|
|
|
831
|
|
|
832 Sep_Required : Boolean := False;
|
|
|
833 -- True if a separator is seen (and therefore required after it!)
|
|
|
834
|
|
|
835 begin
|
|
|
836 -- Parse date
|
|
|
837
|
|
|
838 Year := Scan_Year;
|
|
|
839 Sep_Required := Scan_Separator (Date_Separator);
|
|
|
840
|
|
|
841 Month := Scan_Month;
|
|
|
842 Scan_Separator (Sep_Required, Date_Separator);
|
|
|
843
|
|
|
844 Day := Scan_Day;
|
|
|
845
|
|
|
846 if Index < Date'Last and then Symbol = 'T' then
|
|
|
847 Advance;
|
|
|
848
|
|
|
849 -- Parse time
|
|
|
850
|
|
|
851 Hour := Scan_Hour;
|
|
|
852 Sep_Required := Scan_Separator (Hour_Separator);
|
|
|
853
|
|
|
854 Minute := Scan_Minute;
|
|
|
855 Scan_Separator (Sep_Required, Hour_Separator);
|
|
|
856
|
|
|
857 Second := Scan_Second;
|
|
|
858
|
|
|
859 -- [('Z' | ('.' | ',') s{s} | ('+'|'-')hh:mm)]
|
|
|
860
|
|
|
861 if Index <= Date'Last then
|
|
|
862
|
|
|
863 -- Suffix 'Z' just confirms that this is an UTC time. No further
|
|
|
864 -- action needed.
|
|
|
865
|
|
|
866 if Symbol = 'Z' then
|
|
|
867 Advance;
|
|
|
868
|
|
|
869 -- A decimal fraction shall have at least one digit, and has as
|
|
|
870 -- many digits as supported by the underlying implementation.
|
|
|
871 -- The valid decimal separators are those specified in ISO 31-0,
|
|
|
872 -- i.e. the comma [,] or full stop [.]. Of these, the comma is
|
|
|
873 -- the preferred separator of ISO-8861.
|
|
|
874
|
|
|
875 elsif Symbol = ',' or else Symbol = '.' then
|
|
|
876 Advance; -- past decimal separator
|
|
|
877 Subsec := Scan_Subsecond;
|
|
|
878
|
|
|
879 -- Difference between local time and UTC: It shall be expressed
|
|
|
880 -- as positive (i.e. with the leading plus sign [+]) if the local
|
|
|
881 -- time is ahead of or equal to UTC of day and as negative (i.e.
|
|
|
882 -- with the leading minus sign [-]) if it is behind UTC of day.
|
|
|
883 -- The minutes time element of the difference may only be omitted
|
|
|
884 -- if the difference between the time scales is exactly an
|
|
|
885 -- integral number of hours.
|
|
|
886
|
|
|
887 elsif Symbol = '+' or else Symbol = '-' then
|
|
|
888 Local_Sign := Symbol;
|
|
|
889 Advance;
|
|
|
890 Local_Hour := Scan_Hour;
|
|
|
891
|
|
|
892 -- Past ':'
|
|
|
893
|
|
|
894 if Index < Date'Last and then Symbol = Hour_Separator then
|
|
|
895 Advance;
|
|
|
896 Local_Minute := Scan_Minute;
|
|
|
897 end if;
|
|
|
898
|
|
|
899 -- Compute local displacement
|
|
|
900
|
|
|
901 Local_Disp := Local_Hour * 3600.0 + Local_Minute * 60.0;
|
|
|
902 else
|
|
|
903 raise Wrong_Syntax;
|
|
|
904 end if;
|
|
|
905 end if;
|
|
|
906 end if;
|
|
|
907
|
|
|
908 -- Sanity checks. The check on Index ensures that there are no trailing
|
|
|
909 -- characters.
|
|
|
910
|
|
|
911 if Index /= Date'Length + 1
|
|
|
912 or else not Year'Valid
|
|
|
913 or else not Month'Valid
|
|
|
914 or else not Day'Valid
|
|
|
915 or else not Hour'Valid
|
|
|
916 or else not Minute'Valid
|
|
|
917 or else not Second'Valid
|
|
|
918 or else not Subsec'Valid
|
|
|
919 or else not Local_Hour'Valid
|
|
|
920 or else not Local_Minute'Valid
|
|
|
921 then
|
|
|
922 raise Wrong_Syntax;
|
|
|
923 end if;
|
|
|
924
|
|
|
925 -- Compute time without local displacement
|
|
|
926
|
|
|
927 if Local_Sign = ' ' then
|
|
|
928 Time := Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec);
|
|
|
929
|
|
|
930 -- Compute time with positive local displacement
|
|
|
931
|
|
|
932 elsif Local_Sign = '+' then
|
|
|
933 Time :=
|
|
|
934 Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec) -
|
|
|
935 Local_Disp;
|
|
|
936
|
|
|
937 -- Compute time with negative local displacement
|
|
|
938
|
|
|
939 elsif Local_Sign = '-' then
|
|
|
940 Time :=
|
|
|
941 Time_Of (Year, Month, Day, Hour, Minute, Second, Subsec) +
|
|
|
942 Local_Disp;
|
|
|
943 end if;
|
|
|
944
|
|
|
945 -- Notify that the input string was successfully parsed
|
|
|
946
|
|
|
947 Success := True;
|
|
|
948
|
|
|
949 exception
|
|
|
950 when End_Of_Source_Reached
|
|
|
951 | Wrong_Syntax
|
|
|
952 =>
|
|
|
953 Success := False;
|
|
|
954 end Parse_ISO_8861_UTC;
|
|
|
955
|
|
|
956 -----------
|
|
|
957 -- Value --
|
|
|
958 -----------
|
|
|
959
|
|
|
960 function Value (Date : String) return Ada.Calendar.Time is
|
|
|
961 D : String (1 .. 21);
|
|
|
962 D_Length : constant Natural := Date'Length;
|
|
|
963
|
|
|
964 Year : Year_Number;
|
|
|
965 Month : Month_Number;
|
|
|
966 Day : Day_Number;
|
|
|
967 Hour : Hour_Number;
|
|
|
968 Minute : Minute_Number;
|
|
|
969 Second : Second_Number;
|
|
|
970
|
|
|
971 procedure Extract_Date
|
|
|
972 (Year : out Year_Number;
|
|
|
973 Month : out Month_Number;
|
|
|
974 Day : out Day_Number;
|
|
|
975 Time_Start : out Natural);
|
|
|
976 -- Try and extract a date value from string D. Time_Start is set to the
|
|
|
977 -- first character that could be the start of time data.
|
|
|
978
|
|
|
979 procedure Extract_Time
|
|
|
980 (Index : Positive;
|
|
|
981 Hour : out Hour_Number;
|
|
|
982 Minute : out Minute_Number;
|
|
|
983 Second : out Second_Number;
|
|
|
984 Check_Space : Boolean := False);
|
|
|
985 -- Try and extract a time value from string D starting from position
|
|
|
986 -- Index. Set Check_Space to True to check whether the character at
|
|
|
987 -- Index - 1 is a space. Raise Constraint_Error if the portion of D
|
|
|
988 -- corresponding to the date is not well formatted.
|
|
|
989
|
|
|
990 ------------------
|
|
|
991 -- Extract_Date --
|
|
|
992 ------------------
|
|
|
993
|
|
|
994 procedure Extract_Date
|
|
|
995 (Year : out Year_Number;
|
|
|
996 Month : out Month_Number;
|
|
|
997 Day : out Day_Number;
|
|
|
998 Time_Start : out Natural)
|
|
|
999 is
|
|
|
1000 begin
|
|
|
1001 if D (3) = '-' or else D (3) = '/' then
|
|
|
1002 if D_Length = 8 or else D_Length = 17 then
|
|
|
1003
|
|
|
1004 -- Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
|
|
|
1005
|
|
|
1006 if D (6) /= D (3) then
|
|
|
1007 raise Constraint_Error;
|
|
|
1008 end if;
|
|
|
1009
|
|
|
1010 Year := Year_Number'Value ("20" & D (1 .. 2));
|
|
|
1011 Month := Month_Number'Value (D (4 .. 5));
|
|
|
1012 Day := Day_Number'Value (D (7 .. 8));
|
|
|
1013 Time_Start := 10;
|
|
|
1014
|
|
|
1015 elsif D_Length = 10 or else D_Length = 19 then
|
|
|
1016
|
|
|
1017 -- Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
|
|
|
1018
|
|
|
1019 if D (6) /= D (3) then
|
|
|
1020 raise Constraint_Error;
|
|
|
1021 end if;
|
|
|
1022
|
|
|
1023 Year := Year_Number'Value (D (7 .. 10));
|
|
|
1024 Month := Month_Number'Value (D (1 .. 2));
|
|
|
1025 Day := Day_Number'Value (D (4 .. 5));
|
|
|
1026 Time_Start := 12;
|
|
|
1027
|
|
|
1028 elsif D_Length = 11 or else D_Length = 20 then
|
|
|
1029
|
|
|
1030 -- Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
|
|
|
1031
|
|
|
1032 if D (7) /= D (3) then
|
|
|
1033 raise Constraint_Error;
|
|
|
1034 end if;
|
|
|
1035
|
|
|
1036 Year := Year_Number'Value (D (8 .. 11));
|
|
|
1037 Month := Month_Name_To_Number (D (4 .. 6));
|
|
|
1038 Day := Day_Number'Value (D (1 .. 2));
|
|
|
1039 Time_Start := 13;
|
|
|
1040
|
|
|
1041 else
|
|
|
1042 raise Constraint_Error;
|
|
|
1043 end if;
|
|
|
1044
|
|
|
1045 elsif D (3) = ' ' then
|
|
|
1046 if D_Length = 11 or else D_Length = 20 then
|
|
|
1047
|
|
|
1048 -- Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
|
|
|
1049
|
|
|
1050 if D (7) /= ' ' then
|
|
|
1051 raise Constraint_Error;
|
|
|
1052 end if;
|
|
|
1053
|
|
|
1054 Year := Year_Number'Value (D (8 .. 11));
|
|
|
1055 Month := Month_Name_To_Number (D (4 .. 6));
|
|
|
1056 Day := Day_Number'Value (D (1 .. 2));
|
|
|
1057 Time_Start := 13;
|
|
|
1058
|
|
|
1059 else
|
|
|
1060 raise Constraint_Error;
|
|
|
1061 end if;
|
|
|
1062
|
|
|
1063 else
|
|
|
1064 if D_Length = 8 or else D_Length = 17 then
|
|
|
1065
|
|
|
1066 -- Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
|
|
|
1067
|
|
|
1068 Year := Year_Number'Value (D (1 .. 4));
|
|
|
1069 Month := Month_Number'Value (D (5 .. 6));
|
|
|
1070 Day := Day_Number'Value (D (7 .. 8));
|
|
|
1071 Time_Start := 10;
|
|
|
1072
|
|
|
1073 elsif D_Length = 10 or else D_Length = 19 then
|
|
|
1074
|
|
|
1075 -- Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
|
|
|
1076
|
|
|
1077 if (D (5) /= '-' and then D (5) /= '/')
|
|
|
1078 or else D (8) /= D (5)
|
|
|
1079 then
|
|
|
1080 raise Constraint_Error;
|
|
|
1081 end if;
|
|
|
1082
|
|
|
1083 Year := Year_Number'Value (D (1 .. 4));
|
|
|
1084 Month := Month_Number'Value (D (6 .. 7));
|
|
|
1085 Day := Day_Number'Value (D (9 .. 10));
|
|
|
1086 Time_Start := 12;
|
|
|
1087
|
|
|
1088 elsif D_Length = 11 or else D_Length = 20 then
|
|
|
1089
|
|
|
1090 -- Possible formats are "yyyy*mmm*dd"
|
|
|
1091
|
|
|
1092 if (D (5) /= '-' and then D (5) /= '/')
|
|
|
1093 or else D (9) /= D (5)
|
|
|
1094 then
|
|
|
1095 raise Constraint_Error;
|
|
|
1096 end if;
|
|
|
1097
|
|
|
1098 Year := Year_Number'Value (D (1 .. 4));
|
|
|
1099 Month := Month_Name_To_Number (D (6 .. 8));
|
|
|
1100 Day := Day_Number'Value (D (10 .. 11));
|
|
|
1101 Time_Start := 13;
|
|
|
1102
|
|
|
1103 elsif D_Length = 12 or else D_Length = 21 then
|
|
|
1104
|
|
|
1105 -- Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
|
|
|
1106
|
|
|
1107 if D (4) /= ' '
|
|
|
1108 or else D (7) /= ','
|
|
|
1109 or else D (8) /= ' '
|
|
|
1110 then
|
|
|
1111 raise Constraint_Error;
|
|
|
1112 end if;
|
|
|
1113
|
|
|
1114 Year := Year_Number'Value (D (9 .. 12));
|
|
|
1115 Month := Month_Name_To_Number (D (1 .. 3));
|
|
|
1116 Day := Day_Number'Value (D (5 .. 6));
|
|
|
1117 Time_Start := 14;
|
|
|
1118
|
|
|
1119 else
|
|
|
1120 raise Constraint_Error;
|
|
|
1121 end if;
|
|
|
1122 end if;
|
|
|
1123 end Extract_Date;
|
|
|
1124
|
|
|
1125 ------------------
|
|
|
1126 -- Extract_Time --
|
|
|
1127 ------------------
|
|
|
1128
|
|
|
1129 procedure Extract_Time
|
|
|
1130 (Index : Positive;
|
|
|
1131 Hour : out Hour_Number;
|
|
|
1132 Minute : out Minute_Number;
|
|
|
1133 Second : out Second_Number;
|
|
|
1134 Check_Space : Boolean := False)
|
|
|
1135 is
|
|
|
1136 begin
|
|
|
1137 -- If no time was specified in the string (do not allow trailing
|
|
|
1138 -- character either)
|
|
|
1139
|
|
|
1140 if Index = D_Length + 2 then
|
|
|
1141 Hour := 0;
|
|
|
1142 Minute := 0;
|
|
|
1143 Second := 0;
|
|
|
1144
|
|
|
1145 else
|
|
|
1146 -- Not enough characters left ?
|
|
|
1147
|
|
|
1148 if Index /= D_Length - 7 then
|
|
|
1149 raise Constraint_Error;
|
|
|
1150 end if;
|
|
|
1151
|
|
|
1152 if Check_Space and then D (Index - 1) /= ' ' then
|
|
|
1153 raise Constraint_Error;
|
|
|
1154 end if;
|
|
|
1155
|
|
|
1156 if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
|
|
|
1157 raise Constraint_Error;
|
|
|
1158 end if;
|
|
|
1159
|
|
|
1160 Hour := Hour_Number'Value (D (Index .. Index + 1));
|
|
|
1161 Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
|
|
|
1162 Second := Second_Number'Value (D (Index + 6 .. Index + 7));
|
|
|
1163 end if;
|
|
|
1164 end Extract_Time;
|
|
|
1165
|
|
|
1166 -- Local Declarations
|
|
|
1167
|
|
|
1168 Success : Boolean;
|
|
|
1169 Time_Start : Natural := 1;
|
|
|
1170 Time : Ada.Calendar.Time;
|
|
|
1171
|
|
|
1172 -- Start of processing for Value
|
|
|
1173
|
|
|
1174 begin
|
|
|
1175 -- Let's try parsing Date as a supported ISO-8861 format. If we do not
|
|
|
1176 -- succeed, then retry using all the other GNAT supported formats.
|
|
|
1177
|
|
|
1178 Parse_ISO_8861_UTC (Date, Time, Success);
|
|
|
1179
|
|
|
1180 if Success then
|
|
|
1181 return Time;
|
|
|
1182 end if;
|
|
|
1183
|
|
|
1184 -- Length checks
|
|
|
1185
|
|
|
1186 if D_Length /= 8
|
|
|
1187 and then D_Length /= 10
|
|
|
1188 and then D_Length /= 11
|
|
|
1189 and then D_Length /= 12
|
|
|
1190 and then D_Length /= 17
|
|
|
1191 and then D_Length /= 19
|
|
|
1192 and then D_Length /= 20
|
|
|
1193 and then D_Length /= 21
|
|
|
1194 then
|
|
|
1195 raise Constraint_Error;
|
|
|
1196 end if;
|
|
|
1197
|
|
|
1198 -- After the correct length has been determined, it is safe to create
|
|
|
1199 -- a local string copy in order to avoid String'First N arithmetic.
|
|
|
1200
|
|
|
1201 D (1 .. D_Length) := Date;
|
|
|
1202
|
|
|
1203 if D_Length /= 8 or else D (3) /= ':' then
|
|
|
1204 Extract_Date (Year, Month, Day, Time_Start);
|
|
|
1205 Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
|
|
|
1206
|
|
|
1207 else
|
|
|
1208 declare
|
|
|
1209 Discard : Second_Duration;
|
|
|
1210 begin
|
|
|
1211 Split (Clock, Year, Month, Day, Hour, Minute, Second,
|
|
|
1212 Sub_Second => Discard);
|
|
|
1213 end;
|
|
|
1214
|
|
|
1215 Extract_Time (1, Hour, Minute, Second, Check_Space => False);
|
|
|
1216 end if;
|
|
|
1217
|
|
|
1218 -- Sanity checks
|
|
|
1219
|
|
|
1220 if not Year'Valid
|
|
|
1221 or else not Month'Valid
|
|
|
1222 or else not Day'Valid
|
|
|
1223 or else not Hour'Valid
|
|
|
1224 or else not Minute'Valid
|
|
|
1225 or else not Second'Valid
|
|
|
1226 then
|
|
|
1227 raise Constraint_Error;
|
|
|
1228 end if;
|
|
|
1229
|
|
|
1230 return Time_Of (Year, Month, Day, Hour, Minute, Second);
|
|
|
1231 end Value;
|
|
|
1232
|
|
|
1233 --------------
|
|
|
1234 -- Put_Time --
|
|
|
1235 --------------
|
|
|
1236
|
|
|
1237 procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
|
|
|
1238 begin
|
|
|
1239 Ada.Text_IO.Put (Image (Date, Picture));
|
|
|
1240 end Put_Time;
|
|
|
1241
|
|
|
1242 end GNAT.Calendar.Time_IO;
|
