------------------------------------------------------------------------------ -- -- -- 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-2020, 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 -- -- . -- -- -- -- 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;