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,
Febuary,
March,
April,
May,
June,
July,
August,
September,
October,
November,
December);
type Padding_Mode is (None, Zero, Space);
function Am_Pm (H : Natural) return String;
function Hour_12 (H : Natural) return Positive;
function Image (Str : String; Length : Natural := 0) return String;
function Image
(N : Long_Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String;
function Image
(N : Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String;
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;
function Hour_12 (H : Natural) return Positive is
begin
if H = 0 then
return 12;
elsif H <= 12 then
return H;
else return H - 12;
end if;
end Hour_12;
function Image
(Str : String;
Length : Natural := 0)
return String
is
use Ada.Characters.Handling;
Local : 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;
function Image
(N : Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String
is
begin
return Image (Long_Integer (N), Padding, Length);
end Image;
function Image
(N : Long_Integer;
Padding : Padding_Mode := Zero;
Length : Natural := 0)
return String
is
function Pad_Char return String;
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 := Long_Integer'Image (N);
NIP : constant String := Pad_Char & NI (2 .. NI'Last);
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;
function Image
(Date : Ada.Calendar.Time;
Picture : Picture_String)
return String
is
Padding : Padding_Mode := Zero;
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
if Picture (P) = '%' then
Padding := Zero;
if P = Picture'Last then
raise Picture_Error;
end if;
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
when '%' =>
Result := Result & '%';
when 'n' =>
Result := Result & ASCII.LF;
when 't' =>
Result := Result & ASCII.HT;
when 'H' =>
Result := Result & Image (Hour, Padding, 2);
when 'I' =>
Result := Result & Image (Hour_12 (Hour), Padding, 2);
when 'k' =>
Result := Result & Image (Hour, Space, 2);
when 'l' =>
Result := Result & Image (Hour_12 (Hour), Space, 2);
when 'M' =>
Result := Result & Image (Minute, Padding, 2);
when 'p' =>
Result := Result & Am_Pm (Hour);
when 'r' =>
Result := Result &
Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
Image (Minute, Padding, Length => 2) & ':' &
Image (Second, Padding, Length => 2) & ' ' &
Am_Pm (Hour);
when 's' =>
declare
Sec : constant Long_Integer :=
Long_Integer
((Julian_Day (Year, Month, Day) -
Julian_Day (1970, 1, 1)) * 86_400 +
Hour * 3_600 + Minute * 60 + Second);
begin
Result := Result & Image (Sec, None);
end;
when 'S' =>
Result := Result & Image (Second, Padding, Length => 2);
when 'T' =>
Result := Result &
Image (Hour, Padding, Length => 2) & ':' &
Image (Minute, Padding, Length => 2) & ':' &
Image (Second, Padding, Length => 2);
when 'a' =>
Result := Result &
Image (Day_Name'Image (Day_Of_Week (Date)), 3);
when 'A' =>
Result := Result &
Image (Day_Name'Image (Day_Of_Week (Date)));
when 'b' | 'h' =>
Result := Result &
Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
when 'B' =>
Result := Result &
Image (Month_Name'Image (Month_Name'Val (Month - 1)));
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;
when 'd' =>
Result := Result & Image (Day, Padding, 2);
when 'D' | 'x' =>
Result := Result &
Image (Month, Padding, 2) & '/' &
Image (Day, Padding, 2) & '/' &
Image (Year, Padding, 2);
when 'j' =>
Result := Result & Image (Day_In_Year (Date), Padding, 3);
when 'm' =>
Result := Result & Image (Month, Padding, 2);
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;
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;
when 'W' =>
Result := Result & Image (Week_In_Year (Date), Padding, 2);
when 'y' =>
declare
Y : constant Natural := Year - (Year / 100) * 100;
begin
Result := Result & Image (Y, Padding, 2);
end;
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;
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;