| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUN-TIME COMPONENTS -- |
| -- -- |
| -- G N A T . C A L E N D A R . T I M E _ I O -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1999-2023, AdaCore -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Characters.Handling; |
| with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; |
| with Ada.Text_IO; |
| |
| with GNAT.Case_Util; |
| |
| package body GNAT.Calendar.Time_IO is |
| |
| type Month_Name is |
| (January, |
| February, |
| March, |
| April, |
| May, |
| June, |
| July, |
| August, |
| September, |
| October, |
| November, |
| December); |
| |
| function Month_Name_To_Number |
| (Str : String) return Ada.Calendar.Month_Number; |
| -- Converts a string that contains an abbreviated month name to a month |
| -- number. Constraint_Error is raised if Str is not a valid month name. |
| -- Comparison is case insensitive |
| |
| type Padding_Mode is (None, Zero, Space); |
| |
| type Sec_Number is mod 2 ** 64; |
| -- Type used to compute the number of seconds since 01/01/1970. A 32 bit |
| -- number will cover only a period of 136 years. This means that for date |
| -- past 2106 the computation is not possible. A 64 bits number should be |
| -- enough for a very large period of time. |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| function Image_Helper |
| (Date : Ada.Calendar.Time; |
| Picture : Picture_String; |
| Time_Zone : Time_Zones.Time_Offset) return String; |
| -- This is called by the two exported Image functions. It uses the local |
| -- time zone for its computations, but uses Time_Zone when interpreting the |
| -- "%:::z" tag. |
| |
| function Am_Pm (H : Natural) return String; |
| -- Return AM or PM depending on the hour H |
| |
| function Hour_12 (H : Natural) return Positive; |
| -- Convert a 1-24h format to a 0-12 hour format |
| |
| function Image (Str : String; Length : Natural := 0) return String; |
| -- Return Str capitalized and cut to length number of characters. If |
| -- length is 0, then no cut operation is performed. |
| |
| function Image |
| (N : Sec_Number; |
| Padding : Padding_Mode := Zero; |
| Length : Natural := 0) return String; |
| -- Return image of N. This number is eventually padded with zeros or spaces |
| -- depending of the length required. If length is 0 then no padding occurs. |
| |
| function Image |
| (N : Natural; |
| Padding : Padding_Mode := Zero; |
| Length : Natural := 0) return String; |
| -- As above with N provided in Integer format |
| |
| procedure Parse_ISO_8601 |
| (Date : String; |
| Time : out Ada.Calendar.Time; |
| Success : out Boolean); |
| -- Subsidiary of function Value. It parses the string Date, interpreted as |
| -- an ISO 8601 time representation, and returns corresponding Time value. |
| -- Success is set to False when the string is not a supported ISO 8601 |
| -- date. |
| -- |
| -- Examples: |
| -- |
| -- 2017-04-14T14:47:06 20170414T14:47:06 20170414T144706 |
| -- 2017-04-14T14:47:06,12 20170414T14:47:06.12 |
| -- 2017-04-14T19:47:06+05 20170414T09:00:06-05:47 |
| |
| ----------- |
| -- Am_Pm -- |
| ----------- |
| |
| function Am_Pm (H : Natural) return String is |
| begin |
| if H = 0 or else H > 12 then |
| return "PM"; |
| else |
| return "AM"; |
| end if; |
| end Am_Pm; |
| |
| ------------- |
| -- Hour_12 -- |
| ------------- |
| |
| function Hour_12 (H : Natural) return Positive is |
| begin |
| if H = 0 then |
| return 12; |
| elsif H <= 12 then |
| return H; |
| else -- H > 12 |
| return H - 12; |
| end if; |
| end Hour_12; |
| |
| ----------- |
| -- Image -- |
| ----------- |
| |
| function Image |
| (Str : String; |
| Length : Natural := 0) return String |
| is |
| use Ada.Characters.Handling; |
| Local : constant String := |
| To_Upper (Str (Str'First)) & |
| To_Lower (Str (Str'First + 1 .. Str'Last)); |
| begin |
| if Length = 0 then |
| return Local; |
| else |
| return Local (1 .. Length); |
| end if; |
| end Image; |
| |
| ----------- |
| -- Image -- |
| ----------- |
| |
| function Image |
| (N : Natural; |
| Padding : Padding_Mode := Zero; |
| Length : Natural := 0) return String |
| is |
| begin |
| return Image (Sec_Number (N), Padding, Length); |
| end Image; |
| |
| ----------- |
| -- Image -- |
| ----------- |
| |
| function Image |
| (N : Sec_Number; |
| Padding : Padding_Mode := Zero; |
| Length : Natural := 0) return String |
| is |
| function Pad_Char return String; |
| |
| -------------- |
| -- Pad_Char -- |
| -------------- |
| |
| function Pad_Char return String is |
| begin |
| case Padding is |
| when None => return ""; |
| when Zero => return "00"; |
| when Space => return " "; |
| end case; |
| end Pad_Char; |
| |
| -- Local Declarations |
| |
| NI : constant String := Sec_Number'Image (N); |
| NIP : constant String := Pad_Char & NI (2 .. NI'Last); |
| |
| -- Start of processing for Image |
| |
| begin |
| if Length = 0 or else Padding = None then |
| return NI (2 .. NI'Last); |
| else |
| return NIP (NIP'Last - Length + 1 .. NIP'Last); |
| end if; |
| end Image; |
| |
| ----------- |
| -- Image -- |
| ----------- |
| |
| function Image |
| (Date : Ada.Calendar.Time; |
| Picture : Picture_String; |
| Time_Zone : Time_Zones.Time_Offset) return String |
| is |
| -- We subtract off the local time zone, and add in the requested |
| -- Time_Zone, and then pass it on to Image_Helper, which uses the |
| -- local time zone. |
| |
| use Time_Zones; |
| Local_TZ : constant Time_Offset := Local_Time_Offset (Date); |
| Minute_Offset : constant Integer := Integer (Time_Zone - Local_TZ); |
| Second_Offset : constant Integer := Minute_Offset * 60; |
| begin |
| return Image_Helper |
| (Date + Duration (Second_Offset), Picture, Time_Zone); |
| end Image; |
| |
| ----------- |
| -- Image -- |
| ----------- |
| |
| function Image |
| (Date : Ada.Calendar.Time; |
| Picture : Picture_String) return String |
| is |
| use Time_Zones; |
| Local_TZ : constant Time_Offset := Local_Time_Offset (Date); |
| begin |
| return Image_Helper (Date, Picture, Local_TZ); |
| end Image; |
| |
| ------------------ |
| -- Image_Helper -- |
| ------------------ |
| |
| function Image_Helper |
| (Date : Ada.Calendar.Time; |
| Picture : Picture_String; |
| Time_Zone : Time_Zones.Time_Offset) return String |
| is |
| Padding : Padding_Mode := Zero; |
| -- Padding is set for one directive |
| |
| Result : Unbounded_String; |
| |
| Year : Year_Number; |
| Month : Month_Number; |
| Day : Day_Number; |
| Hour : Hour_Number; |
| Minute : Minute_Number; |
| Second : Second_Number; |
| Sub_Second : Second_Duration; |
| |
| P : Positive; |
| |
| begin |
| -- Get current time in split format |
| |
| Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); |
| |
| -- Null picture string is error |
| |
| if Picture = "" then |
| raise Picture_Error with "null picture string"; |
| end if; |
| |
| -- Loop through characters of picture string, building result |
| |
| Result := Null_Unbounded_String; |
| P := Picture'First; |
| while P <= Picture'Last loop |
| |
| -- A directive has the following format "%[-_]." |
| |
| if Picture (P) = '%' then |
| Padding := Zero; |
| |
| if P = Picture'Last then |
| raise Picture_Error with "picture string ends with '%"; |
| end if; |
| |
| -- Check for GNU extension to change the padding |
| |
| if Picture (P + 1) = '-' then |
| Padding := None; |
| P := P + 1; |
| |
| elsif Picture (P + 1) = '_' then |
| Padding := Space; |
| P := P + 1; |
| end if; |
| |
| if P = Picture'Last then |
| raise Picture_Error with "picture string ends with '- or '_"; |
| end if; |
| |
| case Picture (P + 1) is |
| |
| -- Literal % |
| |
| when '%' => |
| Result := Result & '%'; |
| |
| -- A newline |
| |
| when 'n' => |
| Result := Result & ASCII.LF; |
| |
| -- A horizontal tab |
| |
| when 't' => |
| Result := Result & ASCII.HT; |
| |
| -- Hour (00..23) |
| |
| when 'H' => |
| Result := Result & Image (Hour, Padding, 2); |
| |
| -- Hour (01..12) |
| |
| when 'I' => |
| Result := Result & Image (Hour_12 (Hour), Padding, 2); |
| |
| -- Hour ( 0..23) |
| |
| when 'k' => |
| Result := Result & Image (Hour, Space, 2); |
| |
| -- Hour ( 1..12) |
| |
| when 'l' => |
| Result := Result & Image (Hour_12 (Hour), Space, 2); |
| |
| -- Minute (00..59) |
| |
| when 'M' => |
| Result := Result & Image (Minute, Padding, 2); |
| |
| -- AM/PM |
| |
| when 'p' => |
| Result := Result & Am_Pm (Hour); |
| |
| -- Time, 12-hour (hh:mm:ss [AP]M) |
| |
| when 'r' => |
| Result := Result & |
| Image (Hour_12 (Hour), Padding, Length => 2) & ':' & |
| Image (Minute, Padding, Length => 2) & ':' & |
| Image (Second, Padding, Length => 2) & ' ' & |
| Am_Pm (Hour); |
| |
| -- Seconds since 1970-01-01 00:00:00 UTC |
| -- (a nonstandard extension) |
| |
| when 's' => |
| declare |
| -- Compute the number of seconds using Ada.Calendar.Time |
| -- values rather than Julian days to account for Daylight |
| -- Savings Time. |
| |
| Neg : Boolean := False; |
| Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0); |
| |
| begin |
| -- Avoid rounding errors and perform special processing |
| -- for dates earlier than the Unix Epoc. |
| |
| if Sec > 0.0 then |
| Sec := Sec - 0.5; |
| elsif Sec < 0.0 then |
| Neg := True; |
| Sec := abs (Sec + 0.5); |
| end if; |
| |
| -- Prepend a minus sign to the result since Sec_Number |
| -- cannot handle negative numbers. |
| |
| if Neg then |
| Result := |
| Result & "-" & Image (Sec_Number (Sec), None); |
| else |
| Result := Result & Image (Sec_Number (Sec), None); |
| end if; |
| end; |
| |
| -- Second (00..59) |
| |
| when 'S' => |
| Result := Result & Image (Second, Padding, Length => 2); |
| |
| -- Milliseconds (3 digits) |
| -- Microseconds (6 digits) |
| -- Nanoseconds (9 digits) |
| |
| when 'i' | 'e' | 'o' => |
| declare |
| Sub_Sec : constant Long_Integer := |
| Long_Integer (Sub_Second * 1_000_000_000); |
| |
| Img1 : constant String := Sub_Sec'Img; |
| Img2 : constant String := |
| "00000000" & Img1 (Img1'First + 1 .. Img1'Last); |
| Nanos : constant String := |
| Img2 (Img2'Last - 8 .. Img2'Last); |
| |
| begin |
| case Picture (P + 1) is |
| when 'i' => |
| Result := Result & |
| Nanos (Nanos'First .. Nanos'First + 2); |
| |
| when 'e' => |
| Result := Result & |
| Nanos (Nanos'First .. Nanos'First + 5); |
| |
| when 'o' => |
| Result := Result & Nanos; |
| |
| when others => |
| null; |
| end case; |
| end; |
| |
| -- Time, 24-hour (hh:mm:ss) |
| |
| when 'T' => |
| Result := Result & |
| Image (Hour, Padding, Length => 2) & ':' & |
| Image (Minute, Padding, Length => 2) & ':' & |
| Image (Second, Padding, Length => 2); |
| |
| -- Time zone. Append "+hh", "-hh", "+hh:mm", or "-hh:mm", as |
| -- appropriate. |
| |
| when ':' => |
| declare |
| use type Time_Zones.Time_Offset; |
| TZ_Form : constant Picture_String := "%:::z"; |
| TZ : constant Natural := Natural (abs Time_Zone); |
| begin |
| if P + TZ_Form'Length - 1 <= Picture'Last |
| and then Picture (P .. P + TZ_Form'Length - 1) = "%:::z" |
| then |
| if Time_Zone >= 0 then |
| Result := Result & "+"; |
| else |
| Result := Result & "-"; |
| end if; |
| |
| Result := Result & |
| Image (Integer (TZ / 60), Padding, Length => 2); |
| |
| if TZ mod 60 /= 0 then |
| Result := Result & ":"; |
| Result := Result & |
| Image (TZ mod 60, Padding, Length => 2); |
| end if; |
| |
| P := P + TZ_Form'Length - 2; -- will add 2 below |
| |
| -- We do not support any of the other standard GNU |
| -- time-zone formats (%z, %:z, %::z, %Z). |
| |
| else |
| raise Picture_Error with "unsupported picture format"; |
| end if; |
| end; |
| |
| -- Locale's abbreviated weekday name (Sun..Sat) |
| |
| when 'a' => |
| Result := Result & |
| Image (Day_Name'Image (Day_Of_Week (Date)), 3); |
| |
| -- Locale's full weekday name, variable length |
| -- (Sunday..Saturday) |
| |
| when 'A' => |
| Result := Result & |
| Image (Day_Name'Image (Day_Of_Week (Date))); |
| |
| -- Locale's abbreviated month name (Jan..Dec) |
| |
| when 'b' | 'h' => |
| Result := Result & |
| Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3); |
| |
| -- Locale's full month name, variable length |
| -- (January..December). |
| |
| when 'B' => |
| Result := Result & |
| Image (Month_Name'Image (Month_Name'Val (Month - 1))); |
| |
| -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989) |
| |
| when 'c' => |
| case Padding is |
| when Zero => |
| Result := Result & Image (Date, "%a %b %d %T %Y"); |
| when Space => |
| Result := Result & Image (Date, "%a %b %_d %_T %Y"); |
| when None => |
| Result := Result & Image (Date, "%a %b %-d %-T %Y"); |
| end case; |
| |
| -- Day of month (01..31) |
| |
| when 'd' => |
| Result := Result & Image (Day, Padding, 2); |
| |
| -- Date (mm/dd/yy) |
| |
| when 'D' | 'x' => |
| Result := Result & |
| Image (Month, Padding, 2) & '/' & |
| Image (Day, Padding, 2) & '/' & |
| Image (Year, Padding, 2); |
| |
| -- Day of year (001..366) |
| |
| when 'j' => |
| Result := Result & Image (Day_In_Year (Date), Padding, 3); |
| |
| -- Month (01..12) |
| |
| when 'm' => |
| Result := Result & Image (Month, Padding, 2); |
| |
| -- Week number of year with Sunday as first day of week |
| -- (00..53) |
| |
| when 'U' => |
| declare |
| Offset : constant Natural := |
| (Julian_Day (Year, 1, 1) + 1) mod 7; |
| |
| Week : constant Natural := |
| 1 + ((Day_In_Year (Date) - 1) + Offset) / 7; |
| |
| begin |
| Result := Result & Image (Week, Padding, 2); |
| end; |
| |
| -- Day of week (0..6) with 0 corresponding to Sunday |
| |
| when 'w' => |
| declare |
| DOW : constant Natural range 0 .. 6 := |
| (if Day_Of_Week (Date) = Sunday |
| then 0 |
| else Day_Name'Pos (Day_Of_Week (Date))); |
| begin |
| Result := Result & Image (DOW, Length => 1); |
| end; |
| |
| -- Week number of year with Monday as first day of week |
| -- (00..53) |
| |
| when 'W' => |
| Result := Result & Image (Week_In_Year (Date), Padding, 2); |
| |
| -- Last two digits of year (00..99) |
| |
| when 'y' => |
| declare |
| Y : constant Natural := Year - (Year / 100) * 100; |
| begin |
| Result := Result & Image (Y, Padding, 2); |
| end; |
| |
| -- Year (1970...) |
| |
| when 'Y' => |
| Result := Result & Image (Year, None, 4); |
| |
| when others => |
| raise Picture_Error with |
| "unknown format character in picture string"; |
| end case; |
| |
| -- Skip past % and format character |
| |
| P := P + 2; |
| |
| -- Character other than % is copied into the result |
| |
| else |
| Result := Result & Picture (P); |
| P := P + 1; |
| end if; |
| end loop; |
| |
| return To_String (Result); |
| end Image_Helper; |
| |
| -------------------------- |
| -- Month_Name_To_Number -- |
| -------------------------- |
| |
| function Month_Name_To_Number |
| (Str : String) return Ada.Calendar.Month_Number |
| is |
| subtype String3 is String (1 .. 3); |
| Abbrev_Upper_Month_Names : |
| constant array (Ada.Calendar.Month_Number) of String3 := |
| ["JAN", "FEB", "MAR", "APR", "MAY", "JUN", |
| "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"]; |
| -- Short version of the month names, used when parsing date strings |
| |
| S : String := Str; |
| |
| begin |
| GNAT.Case_Util.To_Upper (S); |
| |
| for J in Abbrev_Upper_Month_Names'Range loop |
| if Abbrev_Upper_Month_Names (J) = S then |
| return J; |
| end if; |
| end loop; |
| |
| return Abbrev_Upper_Month_Names'First; |
| end Month_Name_To_Number; |
| |
| -------------------- |
| -- Parse_ISO_8601 -- |
| -------------------- |
| |
| procedure Parse_ISO_8601 |
| (Date : String; |
| Time : out Ada.Calendar.Time; |
| Success : out Boolean) |
| is |
| pragma Unsuppress (All_Checks); |
| -- This is necessary because the run-time library is usually compiled |
| -- with checks suppressed, and we are relying on constraint checks in |
| -- this code to catch syntax errors in the Date string (e.g. out of |
| -- bounds slices). |
| |
| Index : Positive := Date'First; |
| -- The current character scan index. After a call to Advance, Index |
| -- points to the next character. |
| |
| Wrong_Syntax : exception; |
| -- An exception used to signal that the scan pointer has reached an |
| -- unexpected character in the source string, or if premature |
| -- end-of-source was reached. |
| |
| procedure Advance; |
| pragma Inline (Advance); |
| -- Past the current character of Date |
| |
| procedure Advance_Digits (Num_Digits : Positive); |
| pragma Inline (Advance_Digits); |
| -- Past the given number of digit characters |
| |
| function Scan_Day return Day_Number; |
| pragma Inline (Scan_Day); |
| -- Scan the two digits of a day number and return its value |
| |
| function Scan_Hour return Hour_Number; |
| pragma Inline (Scan_Hour); |
| -- Scan the two digits of an hour number and return its value |
| |
| function Scan_Minute return Minute_Number; |
| pragma Inline (Scan_Minute); |
| -- Scan the two digits of a minute number and return its value |
| |
| function Scan_Month return Month_Number; |
| pragma Inline (Scan_Month); |
| -- Scan the two digits of a month number and return its value |
| |
| function Scan_Second return Second_Number; |
| pragma Inline (Scan_Second); |
| -- Scan the two digits of a second number and return its value |
| |
| function Scan_Separator (Expected_Symbol : Character) return Boolean; |
| pragma Inline (Scan_Separator); |
| -- If the current symbol matches the Expected_Symbol then advance the |
| -- scanner index and return True; otherwise do nothing and return False |
| |
| procedure Scan_Separator (Required : Boolean; Separator : Character); |
| pragma Inline (Scan_Separator); |
| -- If Required then check that the current character matches Separator |
| -- and advance the scanner index; if not Required then do nothing. |
| |
| function Scan_Subsecond return Second_Duration; |
| pragma Inline (Scan_Subsecond); |
| -- Scan all the digits of a subsecond number and return its value |
| |
| function Scan_Year return Year_Number; |
| pragma Inline (Scan_Year); |
| -- Scan the four digits of a year number and return its value |
| |
| function Symbol return Character; |
| pragma Inline (Symbol); |
| -- Return the current character being scanned |
| |
| ------------- |
| -- Advance -- |
| ------------- |
| |
| procedure Advance is |
| begin |
| -- Signal the end of the source string. This stops a complex scan |
| -- by bottoming up any recursive calls till control reaches routine |
| -- Scan, which handles the exception. |
| |
| if Index > Date'Last then |
| raise Wrong_Syntax; |
| |
| -- Advance the scan pointer as long as there are characters to scan, |
| -- in other words, the scan pointer has not passed the end of the |
| -- source string. |
| |
| else |
| Index := Index + 1; |
| end if; |
| end Advance; |
| |
| -------------------- |
| -- Advance_Digits -- |
| -------------------- |
| |
| procedure Advance_Digits (Num_Digits : Positive) is |
| begin |
| for J in 1 .. Num_Digits loop |
| if Symbol not in '0' .. '9' then |
| raise Wrong_Syntax; |
| end if; |
| |
| Advance; -- past digit |
| end loop; |
| end Advance_Digits; |
| |
| -------------- |
| -- Scan_Day -- |
| -------------- |
| |
| function Scan_Day return Day_Number is |
| From : constant Positive := Index; |
| begin |
| Advance_Digits (Num_Digits => 2); |
| return Day_Number'Value (Date (From .. Index - 1)); |
| end Scan_Day; |
| |
| --------------- |
| -- Scan_Hour -- |
| --------------- |
| |
| function Scan_Hour return Hour_Number is |
| From : constant Positive := Index; |
| begin |
| Advance_Digits (Num_Digits => 2); |
| return Hour_Number'Value (Date (From .. Index - 1)); |
| end Scan_Hour; |
| |
| ----------------- |
| -- Scan_Minute -- |
| ----------------- |
| |
| function Scan_Minute return Minute_Number is |
| From : constant Positive := Index; |
| begin |
| Advance_Digits (Num_Digits => 2); |
| return Minute_Number'Value (Date (From .. Index - 1)); |
| end Scan_Minute; |
| |
| ---------------- |
| -- Scan_Month -- |
| ---------------- |
| |
| function Scan_Month return Month_Number is |
| From : constant Positive := Index; |
| begin |
| Advance_Digits (Num_Digits => 2); |
| return Month_Number'Value (Date (From .. Index - 1)); |
| end Scan_Month; |
| |
| ----------------- |
| -- Scan_Second -- |
| ----------------- |
| |
| function Scan_Second return Second_Number is |
| From : constant Positive := Index; |
| begin |
| Advance_Digits (Num_Digits => 2); |
| return Second_Number'Value (Date (From .. Index - 1)); |
| end Scan_Second; |
| |
| -------------------- |
| -- Scan_Separator -- |
| -------------------- |
| |
| function Scan_Separator (Expected_Symbol : Character) return Boolean is |
| begin |
| if Symbol = Expected_Symbol then |
| Advance; |
| return True; |
| else |
| return False; |
| end if; |
| end Scan_Separator; |
| |
| -------------------- |
| -- Scan_Separator -- |
| -------------------- |
| |
| procedure Scan_Separator (Required : Boolean; Separator : Character) is |
| begin |
| if Required then |
| if Symbol /= Separator then |
| raise Wrong_Syntax; |
| end if; |
| |
| Advance; -- Past the separator |
| end if; |
| end Scan_Separator; |
| |
| -------------------- |
| -- Scan_Subsecond -- |
| -------------------- |
| |
| function Scan_Subsecond return Second_Duration is |
| From : constant Positive := Index; |
| begin |
| Advance_Digits (Num_Digits => 1); |
| |
| while Index <= Date'Length and then Symbol in '0' .. '9' loop |
| Advance; |
| end loop; |
| |
| return Second_Duration'Value ("0." & Date (From .. Index - 1)); |
| end Scan_Subsecond; |
| |
| --------------- |
| -- Scan_Year -- |
| --------------- |
| |
| function Scan_Year return Year_Number is |
| From : constant Positive := Index; |
| begin |
| Advance_Digits (Num_Digits => 4); |
| return Year_Number'Value (Date (From .. Index - 1)); |
| end Scan_Year; |
| |
| ------------ |
| -- Symbol -- |
| ------------ |
| |
| function Symbol return Character is |
| begin |
| -- Signal the end of the source string. This stops a complex scan by |
| -- bottoming up any recursive calls till control reaches routine Scan |
| -- which handles the exception. Certain scanning scenarios may handle |
| -- this exception on their own. |
| |
| if Index > Date'Last then |
| raise Wrong_Syntax; |
| |
| else |
| return Date (Index); |
| end if; |
| end Symbol; |
| |
| -- Local variables |
| |
| use Time_Zones; |
| |
| Date_Separator : constant Character := '-'; |
| Hour_Separator : constant Character := ':'; |
| |
| Day : Day_Number; |
| Month : Month_Number; |
| Year : Year_Number; |
| Hour : Hour_Number := 0; |
| Minute : Minute_Number := 0; |
| Second : Second_Number := 0; |
| Subsec : Second_Duration := 0.0; |
| |
| Time_Zone_Seen : Boolean := False; |
| Time_Zone_Offset : Time_Offset; -- Valid only if Time_Zone_Seen |
| |
| Sep_Required : Boolean := False; |
| -- True if a separator is seen (and therefore required after it!) |
| |
| subtype Sign_Type is Character with Predicate => Sign_Type in '+' | '-'; |
| |
| -- Start of processing for Parse_ISO_8601 |
| |
| begin |
| -- Parse date |
| |
| Year := Scan_Year; |
| Sep_Required := Scan_Separator (Date_Separator); |
| |
| Month := Scan_Month; |
| Scan_Separator (Sep_Required, Date_Separator); |
| |
| Day := Scan_Day; |
| |
| if Index < Date'Last and then Symbol = 'T' then |
| Advance; |
| |
| -- Parse time |
| |
| Hour := Scan_Hour; |
| Sep_Required := Scan_Separator (Hour_Separator); |
| |
| Minute := Scan_Minute; |
| Scan_Separator (Sep_Required, Hour_Separator); |
| |
| Second := Scan_Second; |
| |
| -- [ ('.' | ',') s{s} ] |
| |
| if Index <= Date'Last then |
| -- A decimal fraction shall have at least one digit, and has as |
| -- many digits as supported by the underlying implementation. |
| -- The valid decimal separators are those specified in ISO 31-0, |
| -- i.e. the comma [,] or full stop [.]. Of these, the comma is |
| -- the preferred separator of ISO-8601. |
| |
| if Symbol = ',' or else Symbol = '.' then |
| Advance; -- past decimal separator |
| Subsec := Scan_Subsecond; |
| end if; |
| end if; |
| |
| -- [ ('Z' | ('+'|'-')hh':'mm) ] |
| |
| if Index <= Date'Last then |
| Time_Zone_Seen := Symbol in 'Z' | Sign_Type; |
| |
| -- Suffix 'Z' signifies that this is UTC time (time zone 0) |
| |
| if Symbol = 'Z' then |
| Time_Zone_Offset := 0; |
| Advance; |
| |
| -- Difference between local time and UTC: It shall be expressed |
| -- as positive (i.e. with the leading plus sign [+]) if the local |
| -- time is ahead of or equal to UTC of day and as negative (i.e. |
| -- with the leading minus sign [-]) if it is behind UTC of day. |
| -- The minutes time element of the difference may only be omitted |
| -- if the difference between the time scales is exactly an |
| -- integral number of hours. |
| |
| elsif Symbol in Sign_Type then |
| declare |
| Time_Zone_Sign : constant Sign_Type := Symbol; |
| Time_Zone_Hour : Hour_Number; |
| Time_Zone_Minute : Minute_Number; |
| begin |
| Advance; |
| Time_Zone_Hour := Scan_Hour; |
| |
| -- Past ':' |
| |
| if Index < Date'Last and then Symbol = Hour_Separator then |
| Advance; |
| Time_Zone_Minute := Scan_Minute; |
| else |
| Time_Zone_Minute := 0; |
| end if; |
| |
| -- Compute Time_Zone_Offset |
| |
| Time_Zone_Offset := |
| Time_Offset (Time_Zone_Hour * 60 + Time_Zone_Minute); |
| |
| case Time_Zone_Sign is |
| when '+' => null; |
| when '-' => Time_Zone_Offset := -Time_Zone_Offset; |
| end case; |
| end; |
| else |
| raise Wrong_Syntax; |
| end if; |
| end if; |
| end if; |
| |
| -- Check for trailing characters |
| |
| if Index /= Date'Length + 1 then |
| raise Wrong_Syntax; |
| end if; |
| |
| -- If a time zone was specified, use Ada.Calendar.Formatting.Time_Of, |
| -- and specify the time zone. Otherwise, call GNAT.Calendar.Time_Of, |
| -- which uses local time. |
| |
| if Time_Zone_Seen then |
| Time := Ada.Calendar.Formatting.Time_Of |
| (Year, Month, Day, Hour, Minute, Second, Subsec, |
| Time_Zone => Time_Zone_Offset); |
| else |
| Time := GNAT.Calendar.Time_Of |
| (Year, Month, Day, Hour, Minute, Second, Subsec); |
| end if; |
| |
| -- Notify that the input string was successfully parsed |
| |
| Success := True; |
| |
| exception |
| when Wrong_Syntax | Constraint_Error => |
| -- If constraint check fails, we want to behave the same as |
| -- Wrong_Syntax; we want the caller (Value) to try other |
| -- allowed syntaxes. |
| Time := |
| Time_Of (Year_Number'First, Month_Number'First, Day_Number'First); |
| Success := False; |
| end Parse_ISO_8601; |
| |
| ----------- |
| -- Value -- |
| ----------- |
| |
| function Value (Date : String) return Ada.Calendar.Time is |
| pragma Unsuppress (All_Checks); -- see comment in Parse_ISO_8601 |
| |
| D : String (1 .. 21); |
| D_Length : constant Natural := Date'Length; |
| |
| Year : Year_Number; |
| Month : Month_Number; |
| Day : Day_Number; |
| Hour : Hour_Number; |
| Minute : Minute_Number; |
| Second : Second_Number; |
| |
| procedure Extract_Date |
| (Year : out Year_Number; |
| Month : out Month_Number; |
| Day : out Day_Number; |
| Time_Start : out Natural); |
| -- Try and extract a date value from string D. Time_Start is set to the |
| -- first character that could be the start of time data. |
| |
| procedure Extract_Time |
| (Index : Positive; |
| Hour : out Hour_Number; |
| Minute : out Minute_Number; |
| Second : out Second_Number; |
| Check_Space : Boolean := False); |
| -- Try and extract a time value from string D starting from position |
| -- Index. Set Check_Space to True to check whether the character at |
| -- Index - 1 is a space. Raise Constraint_Error if the portion of D |
| -- corresponding to the date is not well formatted. |
| |
| ------------------ |
| -- Extract_Date -- |
| ------------------ |
| |
| procedure Extract_Date |
| (Year : out Year_Number; |
| Month : out Month_Number; |
| Day : out Day_Number; |
| Time_Start : out Natural) |
| is |
| begin |
| if D (3) = '-' or else D (3) = '/' then |
| if D_Length = 8 or else D_Length = 17 then |
| |
| -- Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss" |
| |
| if D (6) /= D (3) then |
| raise Constraint_Error; |
| end if; |
| |
| Year := Year_Number'Value ("20" & D (1 .. 2)); |
| Month := Month_Number'Value (D (4 .. 5)); |
| Day := Day_Number'Value (D (7 .. 8)); |
| Time_Start := 10; |
| |
| elsif D_Length = 10 or else D_Length = 19 then |
| |
| -- Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss" |
| |
| if D (6) /= D (3) then |
| raise Constraint_Error; |
| end if; |
| |
| Year := Year_Number'Value (D (7 .. 10)); |
| Month := Month_Number'Value (D (1 .. 2)); |
| Day := Day_Number'Value (D (4 .. 5)); |
| Time_Start := 12; |
| |
| elsif D_Length = 11 or else D_Length = 20 then |
| |
| -- Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss" |
| |
| if D (7) /= D (3) then |
| raise Constraint_Error; |
| end if; |
| |
| Year := Year_Number'Value (D (8 .. 11)); |
| Month := Month_Name_To_Number (D (4 .. 6)); |
| Day := Day_Number'Value (D (1 .. 2)); |
| Time_Start := 13; |
| |
| else |
| raise Constraint_Error; |
| end if; |
| |
| elsif D (3) = ' ' then |
| if D_Length = 11 or else D_Length = 20 then |
| |
| -- Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss" |
| |
| if D (7) /= ' ' then |
| raise Constraint_Error; |
| end if; |
| |
| Year := Year_Number'Value (D (8 .. 11)); |
| Month := Month_Name_To_Number (D (4 .. 6)); |
| Day := Day_Number'Value (D (1 .. 2)); |
| Time_Start := 13; |
| |
| else |
| raise Constraint_Error; |
| end if; |
| |
| else |
| if D_Length = 8 or else D_Length = 17 then |
| |
| -- Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss" |
| |
| Year := Year_Number'Value (D (1 .. 4)); |
| Month := Month_Number'Value (D (5 .. 6)); |
| Day := Day_Number'Value (D (7 .. 8)); |
| Time_Start := 10; |
| |
| elsif D_Length = 10 or else D_Length = 19 then |
| |
| -- Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss" |
| |
| if (D (5) /= '-' and then D (5) /= '/') |
| or else D (8) /= D (5) |
| then |
| raise Constraint_Error; |
| end if; |
| |
| Year := Year_Number'Value (D (1 .. 4)); |
| Month := Month_Number'Value (D (6 .. 7)); |
| Day := Day_Number'Value (D (9 .. 10)); |
| Time_Start := 12; |
| |
| elsif D_Length = 11 or else D_Length = 20 then |
| |
| -- Possible formats are "yyyy*mmm*dd" |
| |
| if (D (5) /= '-' and then D (5) /= '/') |
| or else D (9) /= D (5) |
| then |
| raise Constraint_Error; |
| end if; |
| |
| Year := Year_Number'Value (D (1 .. 4)); |
| Month := Month_Name_To_Number (D (6 .. 8)); |
| Day := Day_Number'Value (D (10 .. 11)); |
| Time_Start := 13; |
| |
| elsif D_Length = 12 or else D_Length = 21 then |
| |
| -- Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss" |
| |
| if D (4) /= ' ' |
| or else D (7) /= ',' |
| or else D (8) /= ' ' |
| then |
| raise Constraint_Error; |
| end if; |
| |
| Year := Year_Number'Value (D (9 .. 12)); |
| Month := Month_Name_To_Number (D (1 .. 3)); |
| Day := Day_Number'Value (D (5 .. 6)); |
| Time_Start := 14; |
| |
| else |
| raise Constraint_Error; |
| end if; |
| end if; |
| end Extract_Date; |
| |
| ------------------ |
| -- Extract_Time -- |
| ------------------ |
| |
| procedure Extract_Time |
| (Index : Positive; |
| Hour : out Hour_Number; |
| Minute : out Minute_Number; |
| Second : out Second_Number; |
| Check_Space : Boolean := False) |
| is |
| begin |
| -- If no time was specified in the string (do not allow trailing |
| -- character either) |
| |
| if Index = D_Length + 2 then |
| Hour := 0; |
| Minute := 0; |
| Second := 0; |
| |
| else |
| -- Not enough characters left ? |
| |
| if Index /= D_Length - 7 then |
| raise Constraint_Error; |
| end if; |
| |
| if Check_Space and then D (Index - 1) /= ' ' then |
| raise Constraint_Error; |
| end if; |
| |
| if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then |
| raise Constraint_Error; |
| end if; |
| |
| Hour := Hour_Number'Value (D (Index .. Index + 1)); |
| Minute := Minute_Number'Value (D (Index + 3 .. Index + 4)); |
| Second := Second_Number'Value (D (Index + 6 .. Index + 7)); |
| end if; |
| end Extract_Time; |
| |
| -- Local Declarations |
| |
| Success : Boolean; |
| Time_Start : Natural := 1; |
| Time : Ada.Calendar.Time; |
| |
| -- Start of processing for Value |
| |
| begin |
| -- Let's try parsing Date as a supported ISO-8601 format. If we do not |
| -- succeed, then retry using all the other GNAT supported formats. |
| |
| Parse_ISO_8601 (Date, Time, Success); |
| |
| if Success then |
| return Time; |
| end if; |
| |
| -- Length checks |
| |
| if D_Length not in 8 | 10 | 11 | 12 | 17 | 19 | 20 | 21 then |
| raise Constraint_Error; |
| end if; |
| |
| -- After the correct length has been determined, it is safe to create |
| -- a local string copy in order to avoid String'First N arithmetic. |
| |
| D (1 .. D_Length) := Date; |
| |
| if D_Length /= 8 or else D (3) /= ':' then |
| Extract_Date (Year, Month, Day, Time_Start); |
| Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True); |
| |
| else |
| declare |
| Discard : Second_Duration; |
| begin |
| Split (Clock, Year, Month, Day, Hour, Minute, Second, |
| Sub_Second => Discard); |
| end; |
| |
| Extract_Time (1, Hour, Minute, Second, Check_Space => False); |
| end if; |
| |
| return Time_Of (Year, Month, Day, Hour, Minute, Second); |
| end Value; |
| |
| -------------- |
| -- Put_Time -- |
| -------------- |
| |
| procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is |
| begin |
| Ada.Text_IO.Put (Image (Date, Picture)); |
| end Put_Time; |
| |
| end GNAT.Calendar.Time_IO; |
