gcc/ada/g-catiio.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                G N A T . C A L E N D A R . T I M E _ I O                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 1999-2006, AdaCore                     --
  10 --                                                                          --
  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. --
  14 --                                                                          --
  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.                                              --
  25 --                                                                          --
  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.                                      --
  32 --                                                                          --
  33 -- GNAT was originally developed  by the GNAT team at  New York University. --
  34 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  35 --                                                                          --
  36 ------------------------------------------------------------------------------
  37
  38 with Ada.Calendar;            use Ada.Calendar;
  39 with Ada.Characters.Handling;
  40 with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
  41 with Ada.Text_IO;
  42
  43 package body GNAT.Calendar.Time_IO is
  44
  45    type Month_Name is
  46      (January,
  47       February,
  48       March,
  49       April,
  50       May,
  51       June,
  52       July,
  53       August,
  54       September,
  55       October,
  56       November,
  57       December);
  58
  59    type Padding_Mode is (None, Zero, Space);
  60
  61    type Sec_Number is mod 2 ** 64;
  62    --  Type used to compute the number of seconds since 01/01/1970. A 32 bit
  63    --  number will cover only a period of 136 years. This means that for date
  64    --  past 2106 the computation is not possible. A 64 bits number should be
  65    --  enough for a very large period of time.
  66
  67    -----------------------
  68    -- Local Subprograms --
  69    -----------------------
  70
  71    function Am_Pm (H : Natural) return String;
  72    --  Return AM or PM depending on the hour H
  73
  74    function Hour_12 (H : Natural) return Positive;
  75    --  Convert a 1-24h format to a 0-12 hour format
  76
  77    function Image (Str : String; Length : Natural := 0) return String;
  78    --  Return Str capitalized and cut to length number of characters. If
  79    --  length is set to 0 it does not cut it.
  80
  81    function Image
  82      (N       : Sec_Number;
  83       Padding : Padding_Mode := Zero;
  84       Length  : Natural := 0) return String;
  85    --  Return image of N. This number is eventually padded with zeros or spaces
  86    --  depending of the length required. If length is 0 then no padding occurs.
  87
  88    function Image
  89      (N       : Natural;
  90       Padding : Padding_Mode := Zero;
  91       Length  : Natural := 0) return String;
  92    --  As above with N provided in Integer format
  93
  94    -----------
  95    -- Am_Pm --
  96    -----------
  97
  98    function Am_Pm (H : Natural) return String is
  99    begin
 100       if H = 0 or else H > 12 then
 101          return "PM";
 102       else
 103          return "AM";
 104       end if;
 105    end Am_Pm;
 106
 107    -------------
 108    -- Hour_12 --
 109    -------------
 110
 111    function Hour_12 (H : Natural) return Positive is
 112    begin
 113       if H = 0 then
 114          return 12;
 115       elsif H <= 12 then
 116          return H;
 117       else --  H > 12
 118          return H - 12;
 119       end if;
 120    end Hour_12;
 121
 122    -----------
 123    -- Image --
 124    -----------
 125
 126    function Image
 127      (Str    : String;
 128       Length : Natural := 0) return String
 129    is
 130       use Ada.Characters.Handling;
 131       Local : constant String :=
 132                 To_Upper (Str (1)) & To_Lower (Str (2 .. Str'Last));
 133    begin
 134       if Length = 0 then
 135          return Local;
 136       else
 137          return Local (1 .. Length);
 138       end if;
 139    end Image;
 140
 141    -----------
 142    -- Image --
 143    -----------
 144
 145    function Image
 146      (N       : Natural;
 147       Padding : Padding_Mode := Zero;
 148       Length  : Natural := 0) return String
 149    is
 150    begin
 151       return Image (Sec_Number (N), Padding, Length);
 152    end Image;
 153
 154    function Image
 155      (N       : Sec_Number;
 156       Padding : Padding_Mode := Zero;
 157       Length  : Natural := 0) return String
 158    is
 159       function Pad_Char return String;
 160
 161       --------------
 162       -- Pad_Char --
 163       --------------
 164
 165       function Pad_Char return String is
 166       begin
 167          case Padding is
 168             when None  => return "";
 169             when Zero  => return "00";
 170             when Space => return "  ";
 171          end case;
 172       end Pad_Char;
 173
 174       NI  : constant String := Sec_Number'Image (N);
 175       NIP : constant String := Pad_Char & NI (2 .. NI'Last);
 176
 177    --  Start of processing for Image
 178
 179    begin
 180       if Length = 0 or else Padding = None then
 181          return NI (2 .. NI'Last);
 182       else
 183          return NIP (NIP'Last - Length + 1 .. NIP'Last);
 184       end if;
 185    end Image;
 186
 187    -----------
 188    -- Image --
 189    -----------
 190
 191    function Image
 192      (Date    : Ada.Calendar.Time;
 193       Picture : Picture_String) return String
 194    is
 195       Padding : Padding_Mode := Zero;
 196       --  Padding is set for one directive
 197
 198       Result : Unbounded_String;
 199
 200       Year       : Year_Number;
 201       Month      : Month_Number;
 202       Day        : Day_Number;
 203       Hour       : Hour_Number;
 204       Minute     : Minute_Number;
 205       Second     : Second_Number;
 206       Sub_Second : Second_Duration;
 207
 208       P : Positive := Picture'First;
 209
 210    begin
 211       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
 212
 213       loop
 214          --  A directive has the following format "%[-_]."
 215
 216          if Picture (P) = '%' then
 217
 218             Padding := Zero;
 219
 220             if P = Picture'Last then
 221                raise Picture_Error;
 222             end if;
 223
 224             --  Check for GNU extension to change the padding
 225
 226             if Picture (P + 1) = '-' then
 227                Padding := None;
 228                P := P + 1;
 229             elsif Picture (P + 1) = '_' then
 230                Padding := Space;
 231                P := P + 1;
 232             end if;
 233
 234             if P = Picture'Last then
 235                raise Picture_Error;
 236             end if;
 237
 238             case Picture (P + 1) is
 239
 240                --  Literal %
 241
 242                when '%' =>
 243                   Result := Result & '%';
 244
 245                --  A newline
 246
 247                when 'n' =>
 248                   Result := Result & ASCII.LF;
 249
 250                --  A horizontal tab
 251
 252                when 't' =>
 253                   Result := Result & ASCII.HT;
 254
 255                --  Hour (00..23)
 256
 257                when 'H' =>
 258                   Result := Result & Image (Hour, Padding, 2);
 259
 260                --  Hour (01..12)
 261
 262                when 'I' =>
 263                   Result := Result & Image (Hour_12 (Hour), Padding, 2);
 264
 265                --  Hour ( 0..23)
 266
 267                when 'k' =>
 268                   Result := Result & Image (Hour, Space, 2);
 269
 270                --  Hour ( 1..12)
 271
 272                when 'l' =>
 273                   Result := Result & Image (Hour_12 (Hour), Space, 2);
 274
 275                --  Minute (00..59)
 276
 277                when 'M' =>
 278                   Result := Result & Image (Minute, Padding, 2);
 279
 280                --  AM/PM
 281
 282                when 'p' =>
 283                   Result := Result & Am_Pm (Hour);
 284
 285                --  Time, 12-hour (hh:mm:ss [AP]M)
 286
 287                when 'r' =>
 288                   Result := Result &
 289                     Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
 290                     Image (Minute, Padding, Length => 2) & ':' &
 291                     Image (Second, Padding, Length => 2) & ' ' &
 292                     Am_Pm (Hour);
 293
 294                --   Seconds  since 1970-01-01  00:00:00 UTC
 295                --   (a nonstandard extension)
 296
 297                when 's' =>
 298                   declare
 299                      Sec : constant Sec_Number :=
 300                              Sec_Number (Julian_Day (Year, Month, Day) -
 301                                        Julian_Day (1970, 1, 1)) * 86_400
 302                                          + Sec_Number (Hour) * 3_600
 303                                          + Sec_Number (Minute) * 60
 304                                          + Sec_Number (Second);
 305
 306                   begin
 307                      Result := Result & Image (Sec, None);
 308                   end;
 309
 310                --  Second (00..59)
 311
 312                when 'S' =>
 313                   Result := Result & Image (Second, Padding, Length => 2);
 314
 315                --  Milliseconds (3 digits)
 316                --  Microseconds (6 digits)
 317                --  Nanoseconds  (9 digits)
 318
 319                when 'i' | 'e' | 'o' =>
 320                   declare
 321                      Sub_Sec : constant Long_Integer :=
 322                                  Long_Integer (Sub_Second * 1_000_000_000);
 323
 324                      Img1  : constant String := Sub_Sec'Img;
 325                      Img2  : constant String :=
 326                                "00000000" & Img1 (Img1'First + 1 .. Img1'Last);
 327                      Nanos : constant String :=
 328                                Img2 (Img2'Last - 8 .. Img2'Last);
 329
 330                   begin
 331                      case Picture (P + 1) is
 332                         when 'i' =>
 333                            Result := Result &
 334                              Nanos (Nanos'First .. Nanos'First + 2);
 335
 336                         when 'e' =>
 337                            Result := Result &
 338                              Nanos (Nanos'First .. Nanos'First + 5);
 339
 340                         when 'o' =>
 341                            Result := Result & Nanos;
 342
 343                         when others =>
 344                            null;
 345                      end case;
 346                   end;
 347
 348                --  Time, 24-hour (hh:mm:ss)
 349
 350                when 'T' =>
 351                   Result := Result &
 352                     Image (Hour, Padding, Length => 2) & ':' &
 353                     Image (Minute, Padding, Length => 2) & ':' &
 354                     Image (Second, Padding, Length => 2);
 355
 356                --  Locale's abbreviated weekday name (Sun..Sat)
 357
 358                when 'a' =>
 359                   Result := Result &
 360                     Image (Day_Name'Image (Day_Of_Week (Date)), 3);
 361
 362                --  Locale's full weekday name, variable length
 363                --  (Sunday..Saturday)
 364
 365                when 'A' =>
 366                   Result := Result &
 367                     Image (Day_Name'Image (Day_Of_Week (Date)));
 368
 369                --  Locale's abbreviated month name (Jan..Dec)
 370
 371                when 'b' | 'h' =>
 372                   Result := Result &
 373                     Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
 374
 375                --  Locale's full month name, variable length
 376                --  (January..December)
 377
 378                when 'B' =>
 379                   Result := Result &
 380                     Image (Month_Name'Image (Month_Name'Val (Month - 1)));
 381
 382                --  Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
 383
 384                when 'c' =>
 385                   case Padding is
 386                      when Zero =>
 387                         Result := Result & Image (Date, "%a %b %d %T %Y");
 388                      when Space =>
 389                         Result := Result & Image (Date, "%a %b %_d %_T %Y");
 390                      when None =>
 391                         Result := Result & Image (Date, "%a %b %-d %-T %Y");
 392                   end case;
 393
 394                --   Day of month (01..31)
 395
 396                when 'd' =>
 397                   Result := Result & Image (Day, Padding, 2);
 398
 399                --  Date (mm/dd/yy)
 400
 401                when 'D' | 'x' =>
 402                   Result := Result &
 403                               Image (Month, Padding, 2) & '/' &
 404                               Image (Day, Padding, 2) & '/' &
 405                               Image (Year, Padding, 2);
 406
 407                --  Day of year (001..366)
 408
 409                when 'j' =>
 410                   Result := Result & Image (Day_In_Year (Date), Padding, 3);
 411
 412                --  Month (01..12)
 413
 414                when 'm' =>
 415                   Result := Result & Image (Month, Padding, 2);
 416
 417                --  Week number of year with Sunday as first day of week
 418                --  (00..53)
 419
 420                when 'U' =>
 421                   declare
 422                      Offset : constant Natural :=
 423                                 (Julian_Day (Year, 1, 1) + 1) mod 7;
 424
 425                      Week : constant Natural :=
 426                               1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
 427
 428                   begin
 429                      Result := Result & Image (Week, Padding, 2);
 430                   end;
 431
 432                --  Day of week (0..6) with 0 corresponding to Sunday
 433
 434                when 'w' =>
 435                   declare
 436                      DOW : Natural range 0 .. 6;
 437
 438                   begin
 439                      if Day_Of_Week (Date) = Sunday then
 440                         DOW := 0;
 441                      else
 442                         DOW := Day_Name'Pos (Day_Of_Week (Date));
 443                      end if;
 444
 445                      Result := Result & Image (DOW, Length => 1);
 446                   end;
 447
 448                --  Week number of year with Monday as first day of week
 449                --  (00..53)
 450
 451                when 'W' =>
 452                   Result := Result & Image (Week_In_Year (Date), Padding, 2);
 453
 454                --  Last two digits of year (00..99)
 455
 456                when 'y' =>
 457                   declare
 458                      Y : constant Natural := Year - (Year / 100) * 100;
 459                   begin
 460                      Result := Result & Image (Y, Padding, 2);
 461                   end;
 462
 463                --   Year (1970...)
 464
 465                when 'Y' =>
 466                   Result := Result & Image (Year, None, 4);
 467
 468                when others =>
 469                   raise Picture_Error;
 470             end case;
 471
 472             P := P + 2;
 473
 474          else
 475             Result := Result & Picture (P);
 476             P := P + 1;
 477          end if;
 478
 479          exit when P > Picture'Last;
 480
 481       end loop;
 482
 483       return To_String (Result);
 484    end Image;
 485
 486    --------------
 487    -- Put_Time --
 488    --------------
 489
 490    procedure Put_Time
 491      (Date    : Ada.Calendar.Time;
 492       Picture : Picture_String)
 493    is
 494    begin
 495       Ada.Text_IO.Put (Image (Date, Picture));
 496    end Put_Time;
 497
 498 end GNAT.Calendar.Time_IO;