1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . C A L E N D A R . F O R M A T T I N G --
9 -- Copyright (C) 2006, Free Software Foundation, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
37 package body Ada.Calendar.Formatting is
39 --------------------------
40 -- Implementation Notes --
41 --------------------------
43 -- All operations in this package are target and time representation
44 -- independent, thus only one source file is needed for multiple targets.
46 procedure Check_Char (S : String; C : Character; Index : Integer);
47 -- Subsidiary to the two versions of Value. Determine whether the
48 -- input strint S has character C at position Index. Raise
49 -- Constraint_Error if there is a mismatch.
51 procedure Check_Digit (S : String; Index : Integer);
52 -- Subsidiary to the two versions of Value. Determine whether the
53 -- character of string S at position Index is a digit. This catches
54 -- invalid input such as 1983-*1-j3 u5:n7:k9 which should be
55 -- 1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
61 procedure Check_Char (S : String; C : Character; Index : Integer) is
63 if S (Index) /= C then
64 raise Constraint_Error;
72 procedure Check_Digit (S : String; Index : Integer) is
74 if S (Index) not in '0' .. '9' then
75 raise Constraint_Error;
85 Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
97 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
105 function Day_Of_Week (Date : Time) return Day_Name is
107 return Day_Name'Val (Formatting_Operations.Day_Of_Week (Date));
116 Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
124 Ss : Second_Duration;
128 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
137 (Elapsed_Time : Duration;
138 Include_Time_Fraction : Boolean := False) return String
141 Minute : Minute_Number;
142 Second : Second_Number;
143 Sub_Second : Second_Duration;
146 Result : String := "00:00:00.00";
149 Split (Elapsed_Time, Hour, Minute, Second, Sub_Second);
150 SS_Nat := Natural (Sub_Second * 100.0);
153 Hour_Str : constant String := Hour_Number'Image (Hour);
154 Minute_Str : constant String := Minute_Number'Image (Minute);
155 Second_Str : constant String := Second_Number'Image (Second);
156 SS_Str : constant String := Natural'Image (SS_Nat);
159 -- Hour processing, positions 1 and 2
162 Result (2) := Hour_Str (2);
164 Result (1) := Hour_Str (2);
165 Result (2) := Hour_Str (3);
168 -- Minute processing, positions 4 and 5
171 Result (5) := Minute_Str (2);
173 Result (4) := Minute_Str (2);
174 Result (5) := Minute_Str (3);
177 -- Second processing, positions 7 and 8
180 Result (8) := Second_Str (2);
182 Result (7) := Second_Str (2);
183 Result (8) := Second_Str (3);
186 -- Optional sub second processing, positions 10 and 11
188 if Include_Time_Fraction then
190 Result (11) := SS_Str (2);
192 Result (10) := SS_Str (2);
193 Result (11) := SS_Str (3);
198 return Result (1 .. 8);
209 Include_Time_Fraction : Boolean := False;
210 Time_Zone : Time_Zones.Time_Offset := 0) return String
213 Month : Month_Number;
216 Minute : Minute_Number;
217 Second : Second_Number;
218 Sub_Second : Second_Duration;
220 Leap_Second : Boolean;
222 Result : String := "0000-00-00 00:00:00.00";
225 Split (Date, Year, Month, Day,
226 Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
228 SS_Nat := Natural (Sub_Second * 100.0);
231 Year_Str : constant String := Year_Number'Image (Year);
232 Month_Str : constant String := Month_Number'Image (Month);
233 Day_Str : constant String := Day_Number'Image (Day);
234 Hour_Str : constant String := Hour_Number'Image (Hour);
235 Minute_Str : constant String := Minute_Number'Image (Minute);
236 Second_Str : constant String := Second_Number'Image (Second);
237 SS_Str : constant String := Natural'Image (SS_Nat);
240 -- Year processing, positions 1, 2, 3 and 4
242 Result (1) := Year_Str (2);
243 Result (2) := Year_Str (3);
244 Result (3) := Year_Str (4);
245 Result (4) := Year_Str (5);
247 -- Month processing, positions 6 and 7
250 Result (7) := Month_Str (2);
252 Result (6) := Month_Str (2);
253 Result (7) := Month_Str (3);
256 -- Day processing, positions 9 and 10
259 Result (10) := Day_Str (2);
261 Result (9) := Day_Str (2);
262 Result (10) := Day_Str (3);
265 -- Hour processing, positions 12 and 13
268 Result (13) := Hour_Str (2);
270 Result (12) := Hour_Str (2);
271 Result (13) := Hour_Str (3);
274 -- Minute processing, positions 15 and 16
277 Result (16) := Minute_Str (2);
279 Result (15) := Minute_Str (2);
280 Result (16) := Minute_Str (3);
283 -- Second processing, positions 18 and 19
286 Result (19) := Second_Str (2);
288 Result (18) := Second_Str (2);
289 Result (19) := Second_Str (3);
292 -- Optional sub second processing, positions 21 and 22
294 if Include_Time_Fraction then
296 Result (22) := SS_Str (2);
298 Result (21) := SS_Str (2);
299 Result (22) := SS_Str (3);
304 return Result (1 .. 19);
315 Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
323 Ss : Second_Duration;
326 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
336 Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
344 Ss : Second_Duration;
347 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
355 function Second (Date : Time) return Second_Number is
362 Ss : Second_Duration;
365 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
375 Minute : Minute_Number;
376 Second : Second_Number := 0;
377 Sub_Second : Second_Duration := 0.0) return Day_Duration is
383 or else not Minute'Valid
384 or else not Second'Valid
385 or else not Sub_Second'Valid
387 raise Constraint_Error;
390 return Day_Duration (Hour * 3_600) +
391 Day_Duration (Minute * 60) +
392 Day_Duration (Second) +
401 (Seconds : Day_Duration;
402 Hour : out Hour_Number;
403 Minute : out Minute_Number;
404 Second : out Second_Number;
405 Sub_Second : out Second_Duration)
412 if not Seconds'Valid then
413 raise Constraint_Error;
416 if Seconds = 0.0 then
419 Secs := Natural (Seconds - 0.5);
422 Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
423 Hour := Hour_Number (Secs / 3_600);
424 Secs := Secs mod 3_600;
425 Minute := Minute_Number (Secs / 60);
426 Second := Second_Number (Secs mod 60);
431 or else not Minute'Valid
432 or else not Second'Valid
433 or else not Sub_Second'Valid
445 Year : out Year_Number;
446 Month : out Month_Number;
447 Day : out Day_Number;
448 Seconds : out Day_Duration;
449 Leap_Second : out Boolean;
450 Time_Zone : Time_Zones.Time_Offset := 0)
456 Tz : constant Long_Integer := Long_Integer (Time_Zone);
459 Formatting_Operations.Split
469 Leap_Sec => Leap_Second,
476 or else not Month'Valid
477 or else not Day'Valid
478 or else not Seconds'Valid
490 Year : out Year_Number;
491 Month : out Month_Number;
492 Day : out Day_Number;
493 Hour : out Hour_Number;
494 Minute : out Minute_Number;
495 Second : out Second_Number;
496 Sub_Second : out Second_Duration;
497 Time_Zone : Time_Zones.Time_Offset := 0)
501 Tz : constant Long_Integer := Long_Integer (Time_Zone);
504 Formatting_Operations.Split
513 Sub_Sec => Sub_Second,
521 or else not Month'Valid
522 or else not Day'Valid
523 or else not Hour'Valid
524 or else not Minute'Valid
525 or else not Second'Valid
526 or else not Sub_Second'Valid
538 Year : out Year_Number;
539 Month : out Month_Number;
540 Day : out Day_Number;
541 Hour : out Hour_Number;
542 Minute : out Minute_Number;
543 Second : out Second_Number;
544 Sub_Second : out Second_Duration;
545 Leap_Second : out Boolean;
546 Time_Zone : Time_Zones.Time_Offset := 0)
549 Tz : constant Long_Integer := Long_Integer (Time_Zone);
552 Formatting_Operations.Split
561 Sub_Sec => Sub_Second,
562 Leap_Sec => Leap_Second,
569 or else not Month'Valid
570 or else not Day'Valid
571 or else not Hour'Valid
572 or else not Minute'Valid
573 or else not Second'Valid
574 or else not Sub_Second'Valid
584 function Sub_Second (Date : Time) return Second_Duration is
591 Ss : Second_Duration;
594 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
604 Month : Month_Number;
606 Seconds : Day_Duration := 0.0;
607 Leap_Second : Boolean := False;
608 Time_Zone : Time_Zones.Time_Offset := 0) return Time
610 Adj_Year : Year_Number := Year;
611 Adj_Month : Month_Number := Month;
612 Adj_Day : Day_Number := Day;
614 H : constant Integer := 1;
615 M : constant Integer := 1;
616 Se : constant Integer := 1;
617 Ss : constant Duration := 0.1;
618 Tz : constant Long_Integer := Long_Integer (Time_Zone);
624 or else not Month'Valid
625 or else not Day'Valid
626 or else not Seconds'Valid
627 or else not Time_Zone'Valid
629 raise Constraint_Error;
632 -- A Seconds value of 86_400 denotes a new day. This case requires an
633 -- adjustment to the input values.
635 if Seconds = 86_400.0 then
636 if Day < Days_In_Month (Month)
637 or else (Is_Leap (Year)
645 Adj_Month := Month + 1;
648 Adj_Year := Year + 1;
654 Formatting_Operations.Time_Of
663 Leap_Sec => Leap_Second,
664 Use_Day_Secs => True,
675 Month : Month_Number;
678 Minute : Minute_Number;
679 Second : Second_Number;
680 Sub_Second : Second_Duration := 0.0;
681 Leap_Second : Boolean := False;
682 Time_Zone : Time_Zones.Time_Offset := 0) return Time
684 Dd : constant Day_Duration := Day_Duration'First;
685 Tz : constant Long_Integer := Long_Integer (Time_Zone);
691 or else not Month'Valid
692 or else not Day'Valid
693 or else not Hour'Valid
694 or else not Minute'Valid
695 or else not Second'Valid
696 or else not Sub_Second'Valid
697 or else not Time_Zone'Valid
699 raise Constraint_Error;
703 Formatting_Operations.Time_Of
711 Sub_Sec => Sub_Second,
712 Leap_Sec => Leap_Second,
713 Use_Day_Secs => False,
724 Time_Zone : Time_Zones.Time_Offset := 0) return Time
726 D : String (1 .. 22);
728 Month : Month_Number;
731 Minute : Minute_Number;
732 Second : Second_Number;
733 Sub_Second : Second_Duration := 0.0;
738 if not Time_Zone'Valid then
739 raise Constraint_Error;
745 and then Date'Length /= 22
747 raise Constraint_Error;
750 -- After the correct length has been determined, it is safe to
751 -- copy the Date in order to avoid Date'First + N indexing.
753 D (1 .. Date'Length) := Date;
757 Check_Char (D, '-', 5);
758 Check_Char (D, '-', 8);
759 Check_Char (D, ' ', 11);
760 Check_Char (D, ':', 14);
761 Check_Char (D, ':', 17);
763 if Date'Length = 22 then
764 Check_Char (D, '.', 20);
767 -- Leading zero checks
775 if Date'Length = 22 then
781 Year := Year_Number (Year_Number'Value (D (1 .. 4)));
782 Month := Month_Number (Month_Number'Value (D (6 .. 7)));
783 Day := Day_Number (Day_Number'Value (D (9 .. 10)));
784 Hour := Hour_Number (Hour_Number'Value (D (12 .. 13)));
785 Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
786 Second := Second_Number (Second_Number'Value (D (18 .. 19)));
790 if Date'Length = 22 then
791 Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
797 or else not Month'Valid
798 or else not Day'Valid
799 or else not Hour'Valid
800 or else not Minute'Valid
801 or else not Second'Valid
802 or else not Sub_Second'Valid
804 raise Constraint_Error;
807 return Time_Of (Year, Month, Day,
808 Hour, Minute, Second, Sub_Second, False, Time_Zone);
811 when others => raise Constraint_Error;
818 function Value (Elapsed_Time : String) return Duration is
819 D : String (1 .. 11);
821 Minute : Minute_Number;
822 Second : Second_Number;
823 Sub_Second : Second_Duration := 0.0;
828 if Elapsed_Time'Length /= 8
829 and then Elapsed_Time'Length /= 11
831 raise Constraint_Error;
834 -- After the correct length has been determined, it is safe to
835 -- copy the Elapsed_Time in order to avoid Date'First + N indexing.
837 D (1 .. Elapsed_Time'Length) := Elapsed_Time;
841 Check_Char (D, ':', 3);
842 Check_Char (D, ':', 6);
844 if Elapsed_Time'Length = 11 then
845 Check_Char (D, '.', 9);
848 -- Leading zero checks
854 if Elapsed_Time'Length = 11 then
860 Hour := Hour_Number (Hour_Number'Value (D (1 .. 2)));
861 Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
862 Second := Second_Number (Second_Number'Value (D (7 .. 8)));
866 if Elapsed_Time'Length = 11 then
867 Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
873 or else not Minute'Valid
874 or else not Second'Valid
875 or else not Sub_Second'Valid
877 raise Constraint_Error;
880 return Seconds_Of (Hour, Minute, Second, Sub_Second);
883 when others => raise Constraint_Error;
892 Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
900 Ss : Second_Duration;
904 Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
908 end Ada.Calendar.Formatting;