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-2009, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada.Calendar; use Ada.Calendar;
35 with Ada.Characters.Handling;
36 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
41 package body GNAT.Calendar.Time_IO is
57 function Month_Name_To_Number
58 (Str : String) return Ada.Calendar.Month_Number;
59 -- Converts a string that contains an abbreviated month name to a month
60 -- number. Constraint_Error is raised if Str is not a valid month name.
61 -- Comparison is case insensitive
63 type Padding_Mode is (None, Zero, Space);
65 type Sec_Number is mod 2 ** 64;
66 -- Type used to compute the number of seconds since 01/01/1970. A 32 bit
67 -- number will cover only a period of 136 years. This means that for date
68 -- past 2106 the computation is not possible. A 64 bits number should be
69 -- enough for a very large period of time.
71 -----------------------
72 -- Local Subprograms --
73 -----------------------
75 function Am_Pm (H : Natural) return String;
76 -- Return AM or PM depending on the hour H
78 function Hour_12 (H : Natural) return Positive;
79 -- Convert a 1-24h format to a 0-12 hour format
81 function Image (Str : String; Length : Natural := 0) return String;
82 -- Return Str capitalized and cut to length number of characters. If
83 -- length is 0, then no cut operation is performed.
87 Padding : Padding_Mode := Zero;
88 Length : Natural := 0) return String;
89 -- Return image of N. This number is eventually padded with zeros or spaces
90 -- depending of the length required. If length is 0 then no padding occurs.
94 Padding : Padding_Mode := Zero;
95 Length : Natural := 0) return String;
96 -- As above with N provided in Integer format
102 function Am_Pm (H : Natural) return String is
104 if H = 0 or else H > 12 then
115 function Hour_12 (H : Natural) return Positive is
132 Length : Natural := 0) return String
134 use Ada.Characters.Handling;
135 Local : constant String :=
136 To_Upper (Str (Str'First)) &
137 To_Lower (Str (Str'First + 1 .. Str'Last));
142 return Local (1 .. Length);
152 Padding : Padding_Mode := Zero;
153 Length : Natural := 0) return String
156 return Image (Sec_Number (N), Padding, Length);
161 Padding : Padding_Mode := Zero;
162 Length : Natural := 0) return String
164 function Pad_Char return String;
170 function Pad_Char return String is
173 when None => return "";
174 when Zero => return "00";
175 when Space => return " ";
179 -- Local Declarations
181 NI : constant String := Sec_Number'Image (N);
182 NIP : constant String := Pad_Char & NI (2 .. NI'Last);
184 -- Start of processing for Image
187 if Length = 0 or else Padding = None then
188 return NI (2 .. NI'Last);
190 return NIP (NIP'Last - Length + 1 .. NIP'Last);
199 (Date : Ada.Calendar.Time;
200 Picture : Picture_String) return String
202 Padding : Padding_Mode := Zero;
203 -- Padding is set for one directive
205 Result : Unbounded_String;
208 Month : Month_Number;
211 Minute : Minute_Number;
212 Second : Second_Number;
213 Sub_Second : Second_Duration;
218 -- Get current time in split format
220 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
222 -- Null picture string is error
225 raise Picture_Error with "null picture string";
228 -- Loop through characters of picture string, building result
230 Result := Null_Unbounded_String;
232 while P <= Picture'Last loop
234 -- A directive has the following format "%[-_]."
236 if Picture (P) = '%' then
239 if P = Picture'Last then
240 raise Picture_Error with "picture string ends with '%";
243 -- Check for GNU extension to change the padding
245 if Picture (P + 1) = '-' then
249 elsif Picture (P + 1) = '_' then
254 if P = Picture'Last then
255 raise Picture_Error with "picture string ends with '- or '_";
258 case Picture (P + 1) is
263 Result := Result & '%';
268 Result := Result & ASCII.LF;
273 Result := Result & ASCII.HT;
278 Result := Result & Image (Hour, Padding, 2);
283 Result := Result & Image (Hour_12 (Hour), Padding, 2);
288 Result := Result & Image (Hour, Space, 2);
293 Result := Result & Image (Hour_12 (Hour), Space, 2);
298 Result := Result & Image (Minute, Padding, 2);
303 Result := Result & Am_Pm (Hour);
305 -- Time, 12-hour (hh:mm:ss [AP]M)
309 Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
310 Image (Minute, Padding, Length => 2) & ':' &
311 Image (Second, Padding, Length => 2) & ' ' &
314 -- Seconds since 1970-01-01 00:00:00 UTC
315 -- (a nonstandard extension)
319 -- Compute the number of seconds using Ada.Calendar.Time
320 -- values rather than Julian days to account for Daylight
323 Neg : Boolean := False;
324 Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);
327 -- Avoid rounding errors and perform special processing
328 -- for dates earlier than the Unix Epoc.
334 Sec := abs (Sec + 0.5);
337 -- Prepend a minus sign to the result since Sec_Number
338 -- cannot handle negative numbers.
342 Result & "-" & Image (Sec_Number (Sec), None);
344 Result := Result & Image (Sec_Number (Sec), None);
351 Result := Result & Image (Second, Padding, Length => 2);
353 -- Milliseconds (3 digits)
354 -- Microseconds (6 digits)
355 -- Nanoseconds (9 digits)
357 when 'i' | 'e' | 'o' =>
359 Sub_Sec : constant Long_Integer :=
360 Long_Integer (Sub_Second * 1_000_000_000);
362 Img1 : constant String := Sub_Sec'Img;
363 Img2 : constant String :=
364 "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
365 Nanos : constant String :=
366 Img2 (Img2'Last - 8 .. Img2'Last);
369 case Picture (P + 1) is
372 Nanos (Nanos'First .. Nanos'First + 2);
376 Nanos (Nanos'First .. Nanos'First + 5);
379 Result := Result & Nanos;
386 -- Time, 24-hour (hh:mm:ss)
390 Image (Hour, Padding, Length => 2) & ':' &
391 Image (Minute, Padding, Length => 2) & ':' &
392 Image (Second, Padding, Length => 2);
394 -- Locale's abbreviated weekday name (Sun..Sat)
398 Image (Day_Name'Image (Day_Of_Week (Date)), 3);
400 -- Locale's full weekday name, variable length
401 -- (Sunday..Saturday)
405 Image (Day_Name'Image (Day_Of_Week (Date)));
407 -- Locale's abbreviated month name (Jan..Dec)
411 Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
413 -- Locale's full month name, variable length
414 -- (January..December).
418 Image (Month_Name'Image (Month_Name'Val (Month - 1)));
420 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
425 Result := Result & Image (Date, "%a %b %d %T %Y");
427 Result := Result & Image (Date, "%a %b %_d %_T %Y");
429 Result := Result & Image (Date, "%a %b %-d %-T %Y");
432 -- Day of month (01..31)
435 Result := Result & Image (Day, Padding, 2);
441 Image (Month, Padding, 2) & '/' &
442 Image (Day, Padding, 2) & '/' &
443 Image (Year, Padding, 2);
445 -- Day of year (001..366)
448 Result := Result & Image (Day_In_Year (Date), Padding, 3);
453 Result := Result & Image (Month, Padding, 2);
455 -- Week number of year with Sunday as first day of week
460 Offset : constant Natural :=
461 (Julian_Day (Year, 1, 1) + 1) mod 7;
463 Week : constant Natural :=
464 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
467 Result := Result & Image (Week, Padding, 2);
470 -- Day of week (0..6) with 0 corresponding to Sunday
474 DOW : constant Natural range 0 .. 6 :=
475 (if Day_Of_Week (Date) = Sunday
477 else Day_Name'Pos (Day_Of_Week (Date)));
479 Result := Result & Image (DOW, Length => 1);
482 -- Week number of year with Monday as first day of week
486 Result := Result & Image (Week_In_Year (Date), Padding, 2);
488 -- Last two digits of year (00..99)
492 Y : constant Natural := Year - (Year / 100) * 100;
494 Result := Result & Image (Y, Padding, 2);
500 Result := Result & Image (Year, None, 4);
503 raise Picture_Error with
504 "unknown format character in picture string";
508 -- Skip past % and format character
512 -- Character other than % is copied into the result
515 Result := Result & Picture (P);
520 return To_String (Result);
523 --------------------------
524 -- Month_Name_To_Number --
525 --------------------------
527 function Month_Name_To_Number
528 (Str : String) return Ada.Calendar.Month_Number
530 subtype String3 is String (1 .. 3);
531 Abbrev_Upper_Month_Names :
532 constant array (Ada.Calendar.Month_Number) of String3 :=
533 ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
534 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");
535 -- Short version of the month names, used when parsing date strings
540 GNAT.Case_Util.To_Upper (S);
542 for J in Abbrev_Upper_Month_Names'Range loop
543 if Abbrev_Upper_Month_Names (J) = S then
548 return Abbrev_Upper_Month_Names'First;
549 end Month_Name_To_Number;
555 function Value (Date : String) return Ada.Calendar.Time is
556 D : String (1 .. 21);
557 D_Length : constant Natural := Date'Length;
560 Month : Month_Number;
563 Minute : Minute_Number;
564 Second : Second_Number;
566 procedure Extract_Date
567 (Year : out Year_Number;
568 Month : out Month_Number;
569 Day : out Day_Number;
570 Time_Start : out Natural);
571 -- Try and extract a date value from string D. Time_Start is set to the
572 -- first character that could be the start of time data.
574 procedure Extract_Time
576 Hour : out Hour_Number;
577 Minute : out Minute_Number;
578 Second : out Second_Number;
579 Check_Space : Boolean := False);
580 -- Try and extract a time value from string D starting from position
581 -- Index. Set Check_Space to True to check whether the character at
582 -- Index - 1 is a space. Raise Constraint_Error if the portion of D
583 -- corresponding to the date is not well formatted.
589 procedure Extract_Date
590 (Year : out Year_Number;
591 Month : out Month_Number;
592 Day : out Day_Number;
593 Time_Start : out Natural)
596 if D (3) = '-' or else D (3) = '/' then
597 if D_Length = 8 or else D_Length = 17 then
599 -- Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
601 if D (6) /= D (3) then
602 raise Constraint_Error;
605 Year := Year_Number'Value ("20" & D (1 .. 2));
606 Month := Month_Number'Value (D (4 .. 5));
607 Day := Day_Number'Value (D (7 .. 8));
610 elsif D_Length = 10 or else D_Length = 19 then
612 -- Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
614 if D (6) /= D (3) then
615 raise Constraint_Error;
618 Year := Year_Number'Value (D (7 .. 10));
619 Month := Month_Number'Value (D (1 .. 2));
620 Day := Day_Number'Value (D (4 .. 5));
623 elsif D_Length = 11 or else D_Length = 20 then
625 -- Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
627 if D (7) /= D (3) then
628 raise Constraint_Error;
631 Year := Year_Number'Value (D (8 .. 11));
632 Month := Month_Name_To_Number (D (4 .. 6));
633 Day := Day_Number'Value (D (1 .. 2));
637 raise Constraint_Error;
640 elsif D (3) = ' ' then
641 if D_Length = 11 or else D_Length = 20 then
643 -- Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
646 raise Constraint_Error;
649 Year := Year_Number'Value (D (8 .. 11));
650 Month := Month_Name_To_Number (D (4 .. 6));
651 Day := Day_Number'Value (D (1 .. 2));
655 raise Constraint_Error;
659 if D_Length = 8 or else D_Length = 17 then
661 -- Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
663 Year := Year_Number'Value (D (1 .. 4));
664 Month := Month_Number'Value (D (5 .. 6));
665 Day := Day_Number'Value (D (7 .. 8));
668 elsif D_Length = 10 or else D_Length = 19 then
670 -- Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
672 if (D (5) /= '-' and then D (5) /= '/')
673 or else D (8) /= D (5)
675 raise Constraint_Error;
678 Year := Year_Number'Value (D (1 .. 4));
679 Month := Month_Number'Value (D (6 .. 7));
680 Day := Day_Number'Value (D (9 .. 10));
683 elsif D_Length = 11 or else D_Length = 20 then
685 -- Possible formats are "yyyy*mmm*dd"
687 if (D (5) /= '-' and then D (5) /= '/')
688 or else D (9) /= D (5)
690 raise Constraint_Error;
693 Year := Year_Number'Value (D (1 .. 4));
694 Month := Month_Name_To_Number (D (6 .. 8));
695 Day := Day_Number'Value (D (10 .. 11));
698 elsif D_Length = 12 or else D_Length = 21 then
700 -- Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
706 raise Constraint_Error;
709 Year := Year_Number'Value (D (9 .. 12));
710 Month := Month_Name_To_Number (D (1 .. 3));
711 Day := Day_Number'Value (D (5 .. 6));
715 raise Constraint_Error;
724 procedure Extract_Time
726 Hour : out Hour_Number;
727 Minute : out Minute_Number;
728 Second : out Second_Number;
729 Check_Space : Boolean := False)
732 -- If no time was specified in the string (do not allow trailing
735 if Index = D_Length + 2 then
741 -- Not enough characters left ?
743 if Index /= D_Length - 7 then
744 raise Constraint_Error;
747 if Check_Space and then D (Index - 1) /= ' ' then
748 raise Constraint_Error;
751 if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
752 raise Constraint_Error;
755 Hour := Hour_Number'Value (D (Index .. Index + 1));
756 Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
757 Second := Second_Number'Value (D (Index + 6 .. Index + 7));
761 -- Local Declarations
763 Time_Start : Natural := 1;
765 -- Start of processing for Value
771 and then D_Length /= 10
772 and then D_Length /= 11
773 and then D_Length /= 12
774 and then D_Length /= 17
775 and then D_Length /= 19
776 and then D_Length /= 20
777 and then D_Length /= 21
779 raise Constraint_Error;
782 -- After the correct length has been determined, it is safe to create
783 -- a local string copy in order to avoid String'First N arithmetic.
785 D (1 .. D_Length) := Date;
787 if D_Length /= 8 or else D (3) /= ':' then
788 Extract_Date (Year, Month, Day, Time_Start);
789 Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
793 Discard : Second_Duration;
794 pragma Unreferenced (Discard);
796 Split (Clock, Year, Month, Day, Hour, Minute, Second,
797 Sub_Second => Discard);
800 Extract_Time (1, Hour, Minute, Second, Check_Space => False);
806 or else not Month'Valid
807 or else not Day'Valid
808 or else not Hour'Valid
809 or else not Minute'Valid
810 or else not Second'Valid
812 raise Constraint_Error;
815 return Time_Of (Year, Month, Day, Hour, Minute, Second);
822 procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
824 Ada.Text_IO.Put (Image (Date, Picture));
827 end GNAT.Calendar.Time_IO;