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-2010, 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 3, 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Calendar; use Ada.Calendar;
33 with Ada.Characters.Handling;
34 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
39 package body GNAT.Calendar.Time_IO is
55 function Month_Name_To_Number
56 (Str : String) return Ada.Calendar.Month_Number;
57 -- Converts a string that contains an abbreviated month name to a month
58 -- number. Constraint_Error is raised if Str is not a valid month name.
59 -- Comparison is case insensitive
61 type Padding_Mode is (None, Zero, Space);
63 type Sec_Number is mod 2 ** 64;
64 -- Type used to compute the number of seconds since 01/01/1970. A 32 bit
65 -- number will cover only a period of 136 years. This means that for date
66 -- past 2106 the computation is not possible. A 64 bits number should be
67 -- enough for a very large period of time.
69 -----------------------
70 -- Local Subprograms --
71 -----------------------
73 function Am_Pm (H : Natural) return String;
74 -- Return AM or PM depending on the hour H
76 function Hour_12 (H : Natural) return Positive;
77 -- Convert a 1-24h format to a 0-12 hour format
79 function Image (Str : String; Length : Natural := 0) return String;
80 -- Return Str capitalized and cut to length number of characters. If
81 -- length is 0, then no cut operation is performed.
85 Padding : Padding_Mode := Zero;
86 Length : Natural := 0) return String;
87 -- Return image of N. This number is eventually padded with zeros or spaces
88 -- depending of the length required. If length is 0 then no padding occurs.
92 Padding : Padding_Mode := Zero;
93 Length : Natural := 0) return String;
94 -- As above with N provided in Integer format
100 function Am_Pm (H : Natural) return String is
102 if H = 0 or else H > 12 then
113 function Hour_12 (H : Natural) return Positive is
130 Length : Natural := 0) return String
132 use Ada.Characters.Handling;
133 Local : constant String :=
134 To_Upper (Str (Str'First)) &
135 To_Lower (Str (Str'First + 1 .. Str'Last));
140 return Local (1 .. Length);
150 Padding : Padding_Mode := Zero;
151 Length : Natural := 0) return String
154 return Image (Sec_Number (N), Padding, Length);
159 Padding : Padding_Mode := Zero;
160 Length : Natural := 0) return String
162 function Pad_Char return String;
168 function Pad_Char return String is
171 when None => return "";
172 when Zero => return "00";
173 when Space => return " ";
177 -- Local Declarations
179 NI : constant String := Sec_Number'Image (N);
180 NIP : constant String := Pad_Char & NI (2 .. NI'Last);
182 -- Start of processing for Image
185 if Length = 0 or else Padding = None then
186 return NI (2 .. NI'Last);
188 return NIP (NIP'Last - Length + 1 .. NIP'Last);
197 (Date : Ada.Calendar.Time;
198 Picture : Picture_String) return String
200 Padding : Padding_Mode := Zero;
201 -- Padding is set for one directive
203 Result : Unbounded_String;
206 Month : Month_Number;
209 Minute : Minute_Number;
210 Second : Second_Number;
211 Sub_Second : Second_Duration;
216 -- Get current time in split format
218 Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
220 -- Null picture string is error
223 raise Picture_Error with "null picture string";
226 -- Loop through characters of picture string, building result
228 Result := Null_Unbounded_String;
230 while P <= Picture'Last loop
232 -- A directive has the following format "%[-_]."
234 if Picture (P) = '%' then
237 if P = Picture'Last then
238 raise Picture_Error with "picture string ends with '%";
241 -- Check for GNU extension to change the padding
243 if Picture (P + 1) = '-' then
247 elsif Picture (P + 1) = '_' then
252 if P = Picture'Last then
253 raise Picture_Error with "picture string ends with '- or '_";
256 case Picture (P + 1) is
261 Result := Result & '%';
266 Result := Result & ASCII.LF;
271 Result := Result & ASCII.HT;
276 Result := Result & Image (Hour, Padding, 2);
281 Result := Result & Image (Hour_12 (Hour), Padding, 2);
286 Result := Result & Image (Hour, Space, 2);
291 Result := Result & Image (Hour_12 (Hour), Space, 2);
296 Result := Result & Image (Minute, Padding, 2);
301 Result := Result & Am_Pm (Hour);
303 -- Time, 12-hour (hh:mm:ss [AP]M)
307 Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
308 Image (Minute, Padding, Length => 2) & ':' &
309 Image (Second, Padding, Length => 2) & ' ' &
312 -- Seconds since 1970-01-01 00:00:00 UTC
313 -- (a nonstandard extension)
317 -- Compute the number of seconds using Ada.Calendar.Time
318 -- values rather than Julian days to account for Daylight
321 Neg : Boolean := False;
322 Sec : Duration := Date - Time_Of (1970, 1, 1, 0.0);
325 -- Avoid rounding errors and perform special processing
326 -- for dates earlier than the Unix Epoc.
332 Sec := abs (Sec + 0.5);
335 -- Prepend a minus sign to the result since Sec_Number
336 -- cannot handle negative numbers.
340 Result & "-" & Image (Sec_Number (Sec), None);
342 Result := Result & Image (Sec_Number (Sec), None);
349 Result := Result & Image (Second, Padding, Length => 2);
351 -- Milliseconds (3 digits)
352 -- Microseconds (6 digits)
353 -- Nanoseconds (9 digits)
355 when 'i' | 'e' | 'o' =>
357 Sub_Sec : constant Long_Integer :=
358 Long_Integer (Sub_Second * 1_000_000_000);
360 Img1 : constant String := Sub_Sec'Img;
361 Img2 : constant String :=
362 "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
363 Nanos : constant String :=
364 Img2 (Img2'Last - 8 .. Img2'Last);
367 case Picture (P + 1) is
370 Nanos (Nanos'First .. Nanos'First + 2);
374 Nanos (Nanos'First .. Nanos'First + 5);
377 Result := Result & Nanos;
384 -- Time, 24-hour (hh:mm:ss)
388 Image (Hour, Padding, Length => 2) & ':' &
389 Image (Minute, Padding, Length => 2) & ':' &
390 Image (Second, Padding, Length => 2);
392 -- Locale's abbreviated weekday name (Sun..Sat)
396 Image (Day_Name'Image (Day_Of_Week (Date)), 3);
398 -- Locale's full weekday name, variable length
399 -- (Sunday..Saturday)
403 Image (Day_Name'Image (Day_Of_Week (Date)));
405 -- Locale's abbreviated month name (Jan..Dec)
409 Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
411 -- Locale's full month name, variable length
412 -- (January..December).
416 Image (Month_Name'Image (Month_Name'Val (Month - 1)));
418 -- Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
423 Result := Result & Image (Date, "%a %b %d %T %Y");
425 Result := Result & Image (Date, "%a %b %_d %_T %Y");
427 Result := Result & Image (Date, "%a %b %-d %-T %Y");
430 -- Day of month (01..31)
433 Result := Result & Image (Day, Padding, 2);
439 Image (Month, Padding, 2) & '/' &
440 Image (Day, Padding, 2) & '/' &
441 Image (Year, Padding, 2);
443 -- Day of year (001..366)
446 Result := Result & Image (Day_In_Year (Date), Padding, 3);
451 Result := Result & Image (Month, Padding, 2);
453 -- Week number of year with Sunday as first day of week
458 Offset : constant Natural :=
459 (Julian_Day (Year, 1, 1) + 1) mod 7;
461 Week : constant Natural :=
462 1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
465 Result := Result & Image (Week, Padding, 2);
468 -- Day of week (0..6) with 0 corresponding to Sunday
472 DOW : constant Natural range 0 .. 6 :=
473 (if Day_Of_Week (Date) = Sunday
475 else Day_Name'Pos (Day_Of_Week (Date)));
477 Result := Result & Image (DOW, Length => 1);
480 -- Week number of year with Monday as first day of week
484 Result := Result & Image (Week_In_Year (Date), Padding, 2);
486 -- Last two digits of year (00..99)
490 Y : constant Natural := Year - (Year / 100) * 100;
492 Result := Result & Image (Y, Padding, 2);
498 Result := Result & Image (Year, None, 4);
501 raise Picture_Error with
502 "unknown format character in picture string";
506 -- Skip past % and format character
510 -- Character other than % is copied into the result
513 Result := Result & Picture (P);
518 return To_String (Result);
521 --------------------------
522 -- Month_Name_To_Number --
523 --------------------------
525 function Month_Name_To_Number
526 (Str : String) return Ada.Calendar.Month_Number
528 subtype String3 is String (1 .. 3);
529 Abbrev_Upper_Month_Names :
530 constant array (Ada.Calendar.Month_Number) of String3 :=
531 ("JAN", "FEB", "MAR", "APR", "MAY", "JUN",
532 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC");
533 -- Short version of the month names, used when parsing date strings
538 GNAT.Case_Util.To_Upper (S);
540 for J in Abbrev_Upper_Month_Names'Range loop
541 if Abbrev_Upper_Month_Names (J) = S then
546 return Abbrev_Upper_Month_Names'First;
547 end Month_Name_To_Number;
553 function Value (Date : String) return Ada.Calendar.Time is
554 D : String (1 .. 21);
555 D_Length : constant Natural := Date'Length;
558 Month : Month_Number;
561 Minute : Minute_Number;
562 Second : Second_Number;
564 procedure Extract_Date
565 (Year : out Year_Number;
566 Month : out Month_Number;
567 Day : out Day_Number;
568 Time_Start : out Natural);
569 -- Try and extract a date value from string D. Time_Start is set to the
570 -- first character that could be the start of time data.
572 procedure Extract_Time
574 Hour : out Hour_Number;
575 Minute : out Minute_Number;
576 Second : out Second_Number;
577 Check_Space : Boolean := False);
578 -- Try and extract a time value from string D starting from position
579 -- Index. Set Check_Space to True to check whether the character at
580 -- Index - 1 is a space. Raise Constraint_Error if the portion of D
581 -- corresponding to the date is not well formatted.
587 procedure Extract_Date
588 (Year : out Year_Number;
589 Month : out Month_Number;
590 Day : out Day_Number;
591 Time_Start : out Natural)
594 if D (3) = '-' or else D (3) = '/' then
595 if D_Length = 8 or else D_Length = 17 then
597 -- Formats are "yy*mm*dd" or "yy*mm*dd hh:mm:ss"
599 if D (6) /= D (3) then
600 raise Constraint_Error;
603 Year := Year_Number'Value ("20" & D (1 .. 2));
604 Month := Month_Number'Value (D (4 .. 5));
605 Day := Day_Number'Value (D (7 .. 8));
608 elsif D_Length = 10 or else D_Length = 19 then
610 -- Formats are "mm*dd*yyyy" or "mm*dd*yyyy hh:mm:ss"
612 if D (6) /= D (3) then
613 raise Constraint_Error;
616 Year := Year_Number'Value (D (7 .. 10));
617 Month := Month_Number'Value (D (1 .. 2));
618 Day := Day_Number'Value (D (4 .. 5));
621 elsif D_Length = 11 or else D_Length = 20 then
623 -- Formats are "dd*mmm*yyyy" or "dd*mmm*yyyy hh:mm:ss"
625 if D (7) /= D (3) then
626 raise Constraint_Error;
629 Year := Year_Number'Value (D (8 .. 11));
630 Month := Month_Name_To_Number (D (4 .. 6));
631 Day := Day_Number'Value (D (1 .. 2));
635 raise Constraint_Error;
638 elsif D (3) = ' ' then
639 if D_Length = 11 or else D_Length = 20 then
641 -- Possible formats are "dd mmm yyyy", "dd mmm yyyy hh:mm:ss"
644 raise Constraint_Error;
647 Year := Year_Number'Value (D (8 .. 11));
648 Month := Month_Name_To_Number (D (4 .. 6));
649 Day := Day_Number'Value (D (1 .. 2));
653 raise Constraint_Error;
657 if D_Length = 8 or else D_Length = 17 then
659 -- Possible formats are "yyyymmdd" or "yyyymmdd hh:mm:ss"
661 Year := Year_Number'Value (D (1 .. 4));
662 Month := Month_Number'Value (D (5 .. 6));
663 Day := Day_Number'Value (D (7 .. 8));
666 elsif D_Length = 10 or else D_Length = 19 then
668 -- Possible formats are "yyyy*mm*dd" or "yyyy*mm*dd hh:mm:ss"
670 if (D (5) /= '-' and then D (5) /= '/')
671 or else D (8) /= D (5)
673 raise Constraint_Error;
676 Year := Year_Number'Value (D (1 .. 4));
677 Month := Month_Number'Value (D (6 .. 7));
678 Day := Day_Number'Value (D (9 .. 10));
681 elsif D_Length = 11 or else D_Length = 20 then
683 -- Possible formats are "yyyy*mmm*dd"
685 if (D (5) /= '-' and then D (5) /= '/')
686 or else D (9) /= D (5)
688 raise Constraint_Error;
691 Year := Year_Number'Value (D (1 .. 4));
692 Month := Month_Name_To_Number (D (6 .. 8));
693 Day := Day_Number'Value (D (10 .. 11));
696 elsif D_Length = 12 or else D_Length = 21 then
698 -- Formats are "mmm dd, yyyy" or "mmm dd, yyyy hh:mm:ss"
704 raise Constraint_Error;
707 Year := Year_Number'Value (D (9 .. 12));
708 Month := Month_Name_To_Number (D (1 .. 3));
709 Day := Day_Number'Value (D (5 .. 6));
713 raise Constraint_Error;
722 procedure Extract_Time
724 Hour : out Hour_Number;
725 Minute : out Minute_Number;
726 Second : out Second_Number;
727 Check_Space : Boolean := False)
730 -- If no time was specified in the string (do not allow trailing
733 if Index = D_Length + 2 then
739 -- Not enough characters left ?
741 if Index /= D_Length - 7 then
742 raise Constraint_Error;
745 if Check_Space and then D (Index - 1) /= ' ' then
746 raise Constraint_Error;
749 if D (Index + 2) /= ':' or else D (Index + 5) /= ':' then
750 raise Constraint_Error;
753 Hour := Hour_Number'Value (D (Index .. Index + 1));
754 Minute := Minute_Number'Value (D (Index + 3 .. Index + 4));
755 Second := Second_Number'Value (D (Index + 6 .. Index + 7));
759 -- Local Declarations
761 Time_Start : Natural := 1;
763 -- Start of processing for Value
769 and then D_Length /= 10
770 and then D_Length /= 11
771 and then D_Length /= 12
772 and then D_Length /= 17
773 and then D_Length /= 19
774 and then D_Length /= 20
775 and then D_Length /= 21
777 raise Constraint_Error;
780 -- After the correct length has been determined, it is safe to create
781 -- a local string copy in order to avoid String'First N arithmetic.
783 D (1 .. D_Length) := Date;
785 if D_Length /= 8 or else D (3) /= ':' then
786 Extract_Date (Year, Month, Day, Time_Start);
787 Extract_Time (Time_Start, Hour, Minute, Second, Check_Space => True);
791 Discard : Second_Duration;
792 pragma Unreferenced (Discard);
794 Split (Clock, Year, Month, Day, Hour, Minute, Second,
795 Sub_Second => Discard);
798 Extract_Time (1, Hour, Minute, Second, Check_Space => False);
804 or else not Month'Valid
805 or else not Day'Valid
806 or else not Hour'Valid
807 or else not Minute'Valid
808 or else not Second'Valid
810 raise Constraint_Error;
813 return Time_Of (Year, Month, Day, Hour, Minute, Second);
820 procedure Put_Time (Date : Ada.Calendar.Time; Picture : Picture_String) is
822 Ada.Text_IO.Put (Image (Date, Picture));
825 end GNAT.Calendar.Time_IO;