| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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-2006, AdaCore -- |
| -- -- |
| -- This specification is derived from the Ada Reference Manual for use with -- |
| -- GNAT. The copyright notice above, and the license provisions that follow -- |
| -- apply solely to the contents of the part following the private keyword. -- |
| -- -- |
| -- 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 2, 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. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- |
| -- Boston, MA 02110-1301, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Calendar; use Ada.Calendar; |
| with Ada.Characters.Handling; |
| with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; |
| with Ada.Text_IO; |
| |
| package body GNAT.Calendar.Time_IO is |
| |
| type Month_Name is |
| (January, |
| February, |
| March, |
| April, |
| May, |
| June, |
| July, |
| August, |
| September, |
| October, |
| November, |
| December); |
| |
| 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 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 set to 0 it does not cut it. |
| |
| 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 |
| |
| ----------- |
| -- 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 (1)) & To_Lower (Str (2 .. 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; |
| |
| 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; |
| |
| 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) 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 := Picture'First; |
| |
| begin |
| Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); |
| |
| loop |
| -- A directive has the following format "%[-_]." |
| |
| if Picture (P) = '%' then |
| |
| Padding := Zero; |
| |
| if P = Picture'Last then |
| raise Picture_Error; |
| 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; |
| 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 |
| Sec : constant Sec_Number := |
| Sec_Number (Julian_Day (Year, Month, Day) - |
| Julian_Day (1970, 1, 1)) * 86_400 |
| + Sec_Number (Hour) * 3_600 |
| + Sec_Number (Minute) * 60 |
| + Sec_Number (Second); |
| |
| begin |
| Result := Result & Image (Sec, None); |
| 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); |
| |
| -- 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 : Natural range 0 .. 6; |
| |
| begin |
| if Day_Of_Week (Date) = Sunday then |
| DOW := 0; |
| else |
| DOW := Day_Name'Pos (Day_Of_Week (Date)); |
| end if; |
| |
| 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; |
| end case; |
| |
| P := P + 2; |
| |
| else |
| Result := Result & Picture (P); |
| P := P + 1; |
| end if; |
| |
| exit when P > Picture'Last; |
| |
| end loop; |
| |
| return To_String (Result); |
| end Image; |
| |
| -------------- |
| -- 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; |
