1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . C A L E N D A R . T I M E _ I O --
9 -- Copyright (C) 1999-2005 Ada Core Technologies, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 2, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
24 -- Boston, MA 02110-1301, USA. --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
33 -- GNAT was originally developed by the GNAT team at New York University. --
34 -- Extensive contributions were provided by Ada Core Technologies Inc. --
36 ------------------------------------------------------------------------------
38 with Ada
.Calendar
; use Ada
.Calendar
;
39 with Ada
.Characters
.Handling
;
40 with Ada
.Strings
.Unbounded
; use Ada
.Strings
.Unbounded
;
43 package body GNAT
.Calendar
.Time_IO
is
59 type Padding_Mode
is (None
, Zero
, Space
);
61 -----------------------
62 -- Local Subprograms --
63 -----------------------
65 function Am_Pm
(H
: Natural) return String;
66 -- Return AM or PM depending on the hour H
68 function Hour_12
(H
: Natural) return Positive;
69 -- Convert a 1-24h format to a 0-12 hour format
71 function Image
(Str
: String; Length
: Natural := 0) return String;
72 -- Return Str capitalized and cut to length number of characters. If
73 -- length is set to 0 it does not cut it.
77 Padding
: Padding_Mode
:= Zero
;
78 Length
: Natural := 0) return String;
79 -- Return image of N. This number is eventually padded with zeros or spaces
80 -- depending of the length required. If length is 0 then no padding occurs.
84 Padding
: Padding_Mode
:= Zero
;
85 Length
: Natural := 0) return String;
86 -- As above with N provided in Integer format
92 function Am_Pm
(H
: Natural) return String is
94 if H
= 0 or else H
> 12 then
105 function Hour_12
(H
: Natural) return Positive is
122 Length
: Natural := 0) return String
124 use Ada
.Characters
.Handling
;
125 Local
: constant String :=
126 To_Upper
(Str
(1)) & To_Lower
(Str
(2 .. Str
'Last));
132 return Local
(1 .. Length
);
142 Padding
: Padding_Mode
:= Zero
;
143 Length
: Natural := 0) return String
146 return Image
(Long_Integer (N
), Padding
, Length
);
151 Padding
: Padding_Mode
:= Zero
;
152 Length
: Natural := 0) return String
154 function Pad_Char
return String;
160 function Pad_Char
return String is
163 when None
=> return "";
164 when Zero
=> return "00";
165 when Space
=> return " ";
169 NI
: constant String := Long_Integer'Image (N
);
170 NIP
: constant String := Pad_Char
& NI
(2 .. NI
'Last);
172 -- Start of processing for Image
175 if Length
= 0 or else Padding
= None
then
176 return NI
(2 .. NI
'Last);
179 return NIP
(NIP
'Last - Length
+ 1 .. NIP
'Last);
188 (Date
: Ada
.Calendar
.Time
;
189 Picture
: Picture_String
) return String
191 Padding
: Padding_Mode
:= Zero
;
192 -- Padding is set for one directive
194 Result
: Unbounded_String
;
197 Month
: Month_Number
;
200 Minute
: Minute_Number
;
201 Second
: Second_Number
;
202 Sub_Second
: Second_Duration
;
204 P
: Positive := Picture
'First;
207 Split
(Date
, Year
, Month
, Day
, Hour
, Minute
, Second
, Sub_Second
);
210 -- A directive has the following format "%[-_]."
212 if Picture
(P
) = '%' then
216 if P
= Picture
'Last then
220 -- Check for GNU extension to change the padding
222 if Picture
(P
+ 1) = '-' then
225 elsif Picture
(P
+ 1) = '_' then
230 if P
= Picture
'Last then
234 case Picture
(P
+ 1) is
239 Result
:= Result
& '%';
244 Result
:= Result
& ASCII
.LF
;
249 Result
:= Result
& ASCII
.HT
;
254 Result
:= Result
& Image
(Hour
, Padding
, 2);
259 Result
:= Result
& Image
(Hour_12
(Hour
), Padding
, 2);
264 Result
:= Result
& Image
(Hour
, Space
, 2);
269 Result
:= Result
& Image
(Hour_12
(Hour
), Space
, 2);
274 Result
:= Result
& Image
(Minute
, Padding
, 2);
279 Result
:= Result
& Am_Pm
(Hour
);
281 -- Time, 12-hour (hh:mm:ss [AP]M)
285 Image
(Hour_12
(Hour
), Padding
, Length
=> 2) & ':' &
286 Image
(Minute
, Padding
, Length
=> 2) & ':' &
287 Image
(Second
, Padding
, Length
=> 2) & ' ' &
290 -- Seconds since 1970-01-01 00:00:00 UTC
291 -- (a nonstandard extension)
295 Sec
: constant Long_Integer :=
297 ((Julian_Day
(Year
, Month
, Day
) -
298 Julian_Day
(1970, 1, 1)) * 86_400
+
299 Hour
* 3_600
+ Minute
* 60 + Second
);
302 Result
:= Result
& Image
(Sec
, None
);
308 Result
:= Result
& Image
(Second
, Padding
, Length
=> 2);
310 -- Milliseconds (3 digits)
311 -- Microseconds (6 digits)
312 -- Nanoseconds (9 digits)
314 when 'i' |
'e' |
'o' =>
316 Sub_Sec
: constant Long_Integer :=
317 Long_Integer (Sub_Second
* 1_000_000_000
);
319 Img1
: constant String := Sub_Sec
'Img;
320 Img2
: constant String :=
321 "00000000" & Img1
(Img1
'First + 1 .. Img1
'Last);
322 Nanos
: constant String :=
323 Img2
(Img2
'Last - 8 .. Img2
'Last);
326 case Picture
(P
+ 1) is
329 Nanos
(Nanos
'First .. Nanos
'First + 2);
333 Nanos
(Nanos
'First .. Nanos
'First + 5);
336 Result
:= Result
& Nanos
;
343 -- Time, 24-hour (hh:mm:ss)
347 Image
(Hour
, Padding
, Length
=> 2) & ':' &
348 Image
(Minute
, Padding
, Length
=> 2) & ':' &
349 Image
(Second
, Padding
, Length
=> 2);
351 -- Locale's abbreviated weekday name (Sun..Sat)
355 Image
(Day_Name
'Image (Day_Of_Week
(Date
)), 3);
357 -- Locale's full weekday name, variable length
358 -- (Sunday..Saturday)
362 Image
(Day_Name
'Image (Day_Of_Week
(Date
)));
364 -- Locale's abbreviated month name (Jan..Dec)
368 Image
(Month_Name
'Image (Month_Name
'Val (Month
- 1)), 3);
370 -- Locale's full month name, variable length
371 -- (January..December)
375 Image
(Month_Name
'Image (Month_Name
'Val (Month
- 1)));
377 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
382 Result
:= Result
& Image
(Date
, "%a %b %d %T %Y");
384 Result
:= Result
& Image
(Date
, "%a %b %_d %_T %Y");
386 Result
:= Result
& Image
(Date
, "%a %b %-d %-T %Y");
389 -- Day of month (01..31)
392 Result
:= Result
& Image
(Day
, Padding
, 2);
398 Image
(Month
, Padding
, 2) & '/' &
399 Image
(Day
, Padding
, 2) & '/' &
400 Image
(Year
, Padding
, 2);
402 -- Day of year (001..366)
405 Result
:= Result
& Image
(Day_In_Year
(Date
), Padding
, 3);
410 Result
:= Result
& Image
(Month
, Padding
, 2);
412 -- Week number of year with Sunday as first day of week
417 Offset
: constant Natural :=
418 (Julian_Day
(Year
, 1, 1) + 1) mod 7;
420 Week
: constant Natural :=
421 1 + ((Day_In_Year
(Date
) - 1) + Offset
) / 7;
424 Result
:= Result
& Image
(Week
, Padding
, 2);
427 -- Day of week (0..6) with 0 corresponding to Sunday
431 DOW
: Natural range 0 .. 6;
434 if Day_Of_Week
(Date
) = Sunday
then
437 DOW
:= Day_Name
'Pos (Day_Of_Week
(Date
));
440 Result
:= Result
& Image
(DOW
, Length
=> 1);
443 -- Week number of year with Monday as first day of week
447 Result
:= Result
& Image
(Week_In_Year
(Date
), Padding
, 2);
449 -- Last two digits of year (00..99)
453 Y
: constant Natural := Year
- (Year
/ 100) * 100;
455 Result
:= Result
& Image
(Y
, Padding
, 2);
461 Result
:= Result
& Image
(Year
, None
, 4);
470 Result
:= Result
& Picture
(P
);
474 exit when P
> Picture
'Last;
478 return To_String
(Result
);
486 (Date
: Ada
.Calendar
.Time
;
487 Picture
: Picture_String
)
490 Ada
.Text_IO
.Put
(Image
(Date
, Picture
));
493 end GNAT
.Calendar
.Time_IO
;