------------------------------------------------------------------------------
-- --
-- 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;