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