ext/Time/Piece/Piece.pm

   1 package Time::Piece;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
   5
   6 require Exporter;
   7 require DynaLoader;
   8 use Time::Seconds;
   9 use Carp;
  10
  11 @ISA = qw(Exporter DynaLoader);
  12
  13 @EXPORT = qw(
  14     localtime
  15     gmtime
  16 );
  17
  18 %EXPORT_TAGS = (
  19         ':override' => 'internal',
  20         );
  21
  22 $VERSION = '0.13';
  23
  24 bootstrap Time::Piece $VERSION;
  25
  26 my $DATE_SEP = '-';
  27 my $TIME_SEP = ':';
  28 my @MON_NAMES = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  29 my @WDAY_NAMES = qw(Sun Mon Tue Wed Thu Fri Sat);
  30 my @MONTH_NAMES = qw(January February March April May June
  31                      July August September October Novemeber December);
  32 my @WEEKDAY_NAMES = qw(Sunday Monday Tuesday Wednesday
  33                        Thursday Friday Saturday);
  34
  35 use constant 'c_sec' => 0;
  36 use constant 'c_min' => 1;
  37 use constant 'c_hour' => 2;
  38 use constant 'c_mday' => 3;
  39 use constant 'c_mon' => 4;
  40 use constant 'c_year' => 5;
  41 use constant 'c_wday' => 6;
  42 use constant 'c_yday' => 7;
  43 use constant 'c_isdst' => 8;
  44 use constant 'c_epoch' => 9;
  45 use constant 'c_islocal' => 10;
  46
  47 sub localtime {
  48     my $time = shift;
  49     $time = time if (!defined $time);
  50     _mktime($time, 1);
  51 }
  52
  53 sub gmtime {
  54     my $time = shift;
  55     $time = time if (!defined $time);
  56     _mktime($time, 0);
  57 }
  58
  59 sub new {
  60     my $proto = shift;
  61     my $class = ref($proto) || $proto;
  62     my $time = shift;
  63
  64     my $self;
  65
  66     if (defined($time)) {
  67         $self = &localtime($time);
  68     }
  69     elsif (ref($proto) && $proto->isa('Time::Piece')) {
  70         $self = _mktime($proto->[c_epoch], $proto->[c_islocal]);
  71     }
  72     else {
  73         $self = &localtime();
  74     }
  75
  76     return bless $self, $class;
  77 }
  78
  79 sub _mktime {
  80     my ($time, $islocal) = @_;
  81     my @time = $islocal ?
  82             CORE::localtime($time)
  83             :
  84             CORE::gmtime($time);
  85     wantarray ? @time : bless [@time, $time, $islocal], 'Time::Piece';
  86 }
  87
  88 sub import {
  89     # replace CORE::GLOBAL localtime and gmtime if required
  90     my $class = shift;
  91     my %params;
  92     map($params{$_}++,@_,@EXPORT);
  93     if (delete $params{':override'}) {
  94         $class->export('CORE::GLOBAL', keys %params);
  95     }
  96     else {
  97         $class->export((caller)[0], keys %params);
  98     }
  99 }
 100
 101 ## Methods ##
 102
 103 sub s {
 104     my $time = shift;
 105     $time->[c_sec];
 106 }
 107
 108 *sec = \&s;
 109 *second = \&s;
 110
 111 sub min {
 112     my $time = shift;
 113     $time->[c_min];
 114 }
 115
 116 *minute = \&min;
 117
 118 sub h {
 119     my $time = shift;
 120     $time->[c_hour];
 121 }
 122
 123 *hour = \&h;
 124
 125 sub d {
 126     my $time = shift;
 127     $time->[c_mday];
 128 }
 129
 130 *mday = \&d;
 131 *day_of_month = \&d;
 132
 133 sub mon {
 134     my $time = shift;
 135     $time->[c_mon] + 1;
 136 }
 137
 138 sub _mon {
 139     my $time = shift;
 140     $time->[c_mon];
 141 }
 142
 143 sub has_mon_names {
 144     my $time = shift;
 145     return 0;
 146 }
 147
 148 sub monname {
 149     my $time = shift;
 150     if (@_) {
 151         return $_[$time->[c_mon]];
 152     }
 153     elsif ($time->has_mon_names) {
 154         return $time->mon_name($time->[c_mon]);
 155     }
 156     return $MON_NAMES[$time->[c_mon]];
 157 }
 158
 159 sub has_month_names {
 160     my $time = shift;
 161     return 0;
 162 }
 163
 164 sub monthname {
 165     my $time = shift;
 166     if (@_) {
 167         return $_[$time->[c_mon]];
 168     }
 169     elsif ($time->has_month_names) {
 170         return $time->month_name($time->[c_mon]);
 171     }
 172     return $MONTH_NAMES[$time->[c_mon]];
 173 }
 174
 175 *month = \&monthname;
 176
 177 sub y {
 178     my $time = shift;
 179     $time->[c_year] + 1900;
 180 }
 181
 182 *year = \&y;
 183
 184 sub _year {
 185     my $time = shift;
 186     $time->[c_year];
 187 }
 188
 189 sub wday {
 190     my $time = shift;
 191     $time->[c_wday] + 1;
 192 }
 193
 194 sub _wday {
 195     my $time = shift;
 196     $time->[c_wday];
 197 }
 198
 199 *day_of_week = \&_wday;
 200
 201 sub has_wday_names {
 202     my $time = shift;
 203     return 0;
 204 }
 205
 206 sub wdayname {
 207     my $time = shift;
 208     if (@_) {
 209         return $_[$time->[c_wday]];
 210     }
 211     elsif ($time->has_wday_names) {
 212         return $time->wday_name($time->[c_mon]);
 213     }
 214     return $WDAY_NAMES[$time->[c_wday]];
 215 }
 216
 217 sub has_weekday_names {
 218     my $time = shift;
 219     return 0;
 220 }
 221
 222 sub weekdayname {
 223     my $time = shift;
 224     if (@_) {
 225         return $_[$time->[c_wday]];
 226     }
 227     elsif ($time->has_weekday_names) {
 228         return $time->weekday_name($time->[c_mon]);
 229     }
 230     return $WEEKDAY_NAMES[$time->[c_wday]];
 231 }
 232
 233 *weekdayname = \&weekdayname;
 234 *weekday = \&weekdayname;
 235
 236 sub yday {
 237     my $time = shift;
 238     $time->[c_yday];
 239 }
 240
 241 *day_of_year = \&yday;
 242
 243 sub isdst {
 244     my $time = shift;
 245     $time->[c_isdst];
 246 }
 247
 248 *daylight_savings = \&isdst;
 249
 250 # Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm
 251 sub tzoffset {
 252     my $time = shift;
 253
 254     my $epoch = $time->[c_epoch];
 255
 256     my $j = sub { # Tweaked Julian day number algorithm.
 257
 258         my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900;
 259
 260         # Standard Julian day number algorithm without constant.
 261         #
 262         my $y1 = $m > 2 ? $y : $y - 1;
 263
 264         my $m1 = $m > 2 ? $m + 1 : $m + 13;
 265
 266         my $day = int(365.25 * $y1) + int(30.6001 * $m1) + $d;
 267
 268         # Modify to include hours/mins/secs in floating portion.
 269         #
 270         return $day + ($h + ($n + $s / 60) / 60) / 24;
 271     };
 272
 273     # Compute floating offset in hours.
 274     #
 275     my $delta = 24 * (&$j(CORE::localtime $epoch) - &$j(CORE::gmtime $epoch));
 276
 277     # Return value in seconds rounded to nearest minute.
 278     return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60);
 279 }
 280
 281 sub epoch {
 282     my $time = shift;
 283     $time->[c_epoch];
 284 }
 285
 286 sub hms {
 287     my $time = shift;
 288     my $sep = @_ ? shift(@_) : $TIME_SEP;
 289     sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]);
 290 }
 291
 292 *time = \&hms;
 293
 294 sub ymd {
 295     my $time = shift;
 296     my $sep = @_ ? shift(@_) : $DATE_SEP;
 297     sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]);
 298 }
 299
 300 *date = \&ymd;
 301
 302 sub mdy {
 303     my $time = shift;
 304     my $sep = @_ ? shift(@_) : $DATE_SEP;
 305     sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year);
 306 }
 307
 308 sub dmy {
 309     my $time = shift;
 310     my $sep = @_ ? shift(@_) : $DATE_SEP;
 311     sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year);
 312 }
 313
 314 sub datetime {
 315     my $time = shift;
 316     my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_);
 317     return join($seps{T}, $time->date($seps{date}), $time->time($seps{time}));
 318 }
 319
 320 # taken from Time::JulianDay
 321 sub julian_day {
 322     my $time = shift;
 323     my ($year, $month, $day) = ($time->year, $time->mon, $time->mday);
 324     my ($tmp, $secs);
 325
 326     $tmp = $day - 32075
 327       + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4
 328       + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
 329       - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4
 330       ;
 331
 332     return $tmp;
 333 }
 334
 335 # Hi Mark-Jason!
 336 sub mjd {
 337     return shift->julian_day - 2_400_000.5;
 338 }
 339
 340 sub week {
 341     # taken from the Calendar FAQ
 342     use integer;
 343     my $J  = shift->julian_day;
 344     my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461;
 345     my $L  = $d4 / 1460;
 346     my $d1 = (($d4 - $L) % 365) + $L;
 347     return $d1 / 7 + 1;
 348 }
 349
 350 sub _is_leap_year {
 351     my $year = shift;
 352     return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0)
 353                ? 1 : 0;
 354 }
 355
 356 sub is_leap_year {
 357     my $time = shift;
 358     my $year = $time->year;
 359     return _is_leap_year($year);
 360 }
 361
 362 my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31);
 363
 364 sub month_last_day {
 365     my $time = shift;
 366     my $year = $time->year;
 367     my $_mon = $time->_mon;
 368     return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0);
 369 }
 370
 371 use vars qw($_ftime);
 372
 373 $_ftime =
 374 {
 375  '%' => sub {
 376      return "%";
 377  },
 378  'a' => sub {
 379      my ($format, $time) = @_;
 380      $time->wdayname();
 381  },
 382  'A' => sub {
 383      my ($format, $time) = @_;
 384      $time->weekdayname();
 385  },
 386  'b' => sub {
 387      my ($format, $time) = @_;
 388      $time->monname();
 389  },
 390  'B' => sub {
 391      my ($format, $time) = @_;
 392      $time->monthname();
 393  },
 394  'c' => sub {
 395      my ($format, $time) = @_;
 396      $time->cdate();
 397  },
 398  'C' => sub {
 399      my ($format, $time) = @_;
 400      sprintf("%02d", int($time->y() / 100));
 401  },
 402  'd' => sub {
 403      my ($format, $time) = @_;
 404      sprintf("%02d", $time->d());
 405  },
 406  'D' => sub {
 407      my ($format, $time) = @_;
 408      join("/",
 409           $_ftime->{'m'}->('m', $time),
 410           $_ftime->{'d'}->('d', $time),
 411           $_ftime->{'y'}->('y', $time));
 412  },
 413  'e' => sub {
 414      my ($format, $time) = @_;
 415      sprintf("%2d", $time->d());
 416  },
 417  'h' => sub {
 418      my ($format, $time, @rest) = @_;
 419      $time->monname(@rest);
 420  },
 421  'H' => sub {
 422      my ($format, $time) = @_;
 423      sprintf("%02d", $time->h());
 424  },
 425  'I' => sub {
 426      my ($format, $time) = @_;
 427      my $h = $time->h();
 428      sprintf("%02d", $h == 0 ? 12 : ($h < 13 ? $h : $h % 12));
 429  },
 430  'j' => sub {
 431      my ($format, $time) = @_;
 432      sprintf("%03d", $time->yday());
 433  },
 434  'm' => sub {
 435      my ($format, $time) = @_;
 436      sprintf("%02d", $time->mon());
 437  },
 438  'M' => sub {
 439      my ($format, $time) = @_;
 440      sprintf("%02d", $time->min());
 441  },
 442  'n' => sub {
 443      return "\n";
 444  },
 445  'p' => sub {
 446      my ($format, $time) = @_;
 447      my $h = $time->h();
 448      $h == 0 ? 'pm' : ($h < 13 ? 'am' : 'pm');
 449  },
 450  'r' => sub {
 451      my ($format, $time) = @_;
 452      join(":",
 453           $_ftime->{'I'}->('I', $time),
 454           $_ftime->{'M'}->('M', $time),
 455           $_ftime->{'S'}->('S', $time)) .
 456               " " . $_ftime->{'p'}->('p', $time);
 457  },
 458  'R' => sub {
 459      my ($format, $time) = @_;
 460      join(":",
 461           $_ftime->{'H'}->('H', $time),
 462           $_ftime->{'M'}->('M', $time));
 463  },
 464  'S' => sub {
 465      my ($format, $time) = @_;
 466      sprintf("%02d", $time->s());
 467  },
 468  't' => sub {
 469      return "\t";
 470  },
 471  'T' => sub {
 472      my ($format, $time) = @_;
 473      join(":",
 474           $_ftime->{'H'}->('H', $time),
 475           $_ftime->{'M'}->('M', $time),
 476           $_ftime->{'S'}->('S', $time));
 477  },
 478  'u' => sub {
 479      my ($format, $time) = @_;
 480      ($time->wday() + 5) % 7 + 1;
 481  },
 482  # U taken care by libc
 483  'V' => sub {
 484      my ($format, $time) = @_;
 485      sprintf("%02d", $time->week());
 486  },
 487  'w' => sub {
 488      my ($format, $time) = @_;
 489      $time->_wday();
 490  },
 491  # W taken care by libc
 492  'x' => sub {
 493      my ($format, $time) = @_;
 494      join("/",
 495           $_ftime->{'m'}->('m', $time),
 496           $_ftime->{'d'}->('d', $time),
 497           $_ftime->{'y'}->('y', $time));
 498  },
 499  'y' => sub {
 500      my ($format, $time) = @_;
 501      sprintf("%02d", $time->y() % 100);
 502  },
 503  'Y' => sub {
 504      my ($format, $time) = @_;
 505      sprintf("%4d", $time->y());
 506  },
 507  # Z taken care by libc
 508 };
 509
 510 sub has_ftime {
 511     my ($format) = @_;
 512     exists $_ftime->{$format};
 513 }
 514
 515 sub has_ftimes {
 516     keys %$_ftime;
 517 }
 518
 519 sub delete_ftime {
 520     delete $_ftime->{@_};
 521 }
 522
 523 sub ftime {
 524     my ($format) = $_[0];
 525     if (@_ == 1) {
 526         return $_ftime->{$format};
 527     } elsif (@_ == 2) {
 528         if (ref $_[0] eq 'CODE') {
 529             $_ftime->{$format} = $_[1];
 530         } else {
 531             require Carp;
 532             Carp::croak "ftime: second argument not a code ref";
 533         }
 534     } else {
 535         require Carp;
 536         Carp::croak "ftime: want one or two arguments";
 537     }
 538 }
 539
 540 sub _ftime {
 541     my ($format, $time, @rest) = @_;
 542     if (has_ftime($format)) {
 543         # We are passing format to the anonsubs so that
 544         # one can share the same sub among several formats.
 545         return $_ftime->{$format}->($format, $time, @rest);
 546     }
 547     # If we don't know it, pass it down to the libc layer.
 548     # (In other words, cheat.)
 549     # This pays for for '%Z', though, and for all the
 550     # locale-specific %Ex and %Oy formats.
 551     return $time->_strftime("%$format");
 552 }
 553
 554 sub strftime {
 555     my $time = shift;
 556     my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
 557     $format =~ s/%(.)/_ftime($1, $time, @_)/ge;
 558     return $format;
 559 }
 560
 561 sub _strftime {
 562     my $time = shift;
 563     my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
 564     return __strftime($format, (@$time)[c_sec..c_isdst]);
 565 }
 566
 567 use vars qw($_ptime);
 568
 569 $_ptime =
 570 {
 571  '%' => sub {
 572      $_[1] =~ s/^%//                      && $1;
 573  },
 574  # a unimplemented
 575  # A unimplemented
 576  # b unimplemented
 577  # B unimplemented
 578  # c unimplemented
 579  'C' => sub {
 580      $_[1] =~ s/^(0[0-9])//               && $1;
 581  },
 582  'd' => sub {
 583      $_[1] =~ s/^(0[1-9]|2[0-9]|3[01])//  && $1;
 584  },
 585  'D' => sub {
 586      my %D;
 587      my $D;
 588      if (defined ($D = $_ptime->{'m'}->($_[0], $_[1]))) {
 589          $D{m} = $D;
 590      } else {
 591          return;
 592      }
 593      $_[1] =~ s:^/:: || return;
 594      if (defined ($D = $_ptime->{'d'}->($_[0], $_[1]))) {
 595          $D{d} = $D;
 596      } else {
 597          return;
 598      }
 599      $_[1] =~ s:^/:: || return;
 600      if (defined ($D = $_ptime->{'y'}->($_[0], $_[1]))) {
 601          $D{y} = $D;
 602      } else {
 603          return;
 604      }
 605      return { %D };
 606  },
 607  'e' => sub {
 608      $_[1] =~ s/^( [1-9]|2[0-9]|3[01])//  && $1;
 609  },
 610  # h unimplemented
 611  'H' => sub {
 612      $_[1] =~ s/^([0-1][0-9]|2[0-3])//    && $1;
 613  },
 614  'I' => sub {
 615      $_[1] =~ s/^(0[1-9]|1[012])//        && $1;
 616  },
 617  'j' => sub {
 618      $_[1] =~ s/^([0-9][0-9][0-9])// && $1 >= 1 && $1 <= 366 && $1;
 619  },
 620  'm' => sub {
 621      $_[1] =~ s/^(0[1-9]|1[012])//        && $1;
 622  },
 623  'M' => sub {
 624      $_[1] =~ s/^([0-5][0-9])//           && $1;
 625  },
 626  't' => sub {
 627      $_[1] =~ s/^\n//                     && $1;
 628  },
 629  'p' => sub {
 630      $_[1] =~ s/^(am|pm)//                && $1;
 631  },
 632  'r' => sub {
 633      my %r;
 634      my $r;
 635      if (defined ($r = $_ptime->{'I'}->($_[0], $_[1]))) {
 636          $r{I} = $r;
 637      } else {
 638          return;
 639      }
 640      $_[1] =~ s/^:// || return;
 641      if (defined ($r = $_ptime->{'M'}->($_[0], $_[1]))) {
 642          $r{M} = $r;
 643      } else {
 644          return;
 645      }
 646      $_[1] =~ s/^:// || return;
 647      if (defined ($r = $_ptime->{'S'}->($_[0], $_[1]))) {
 648          $r{S} = $r;
 649      } else {
 650          return;
 651      }
 652      $_[1] =~ s/^ // || return;
 653      if (defined ($r = $_ptime->{'p'}->($_[0], $_[1]))) {
 654          $r{p} = $r;
 655      } else {
 656          return;
 657      }
 658      return { %r };
 659  },
 660  'R' => sub {
 661      my %R;
 662      my $R;
 663      if (defined ($R = $_ptime->{'H'}->($_[0], $_[1]))) {
 664          $R{H} = $R;
 665      } else {
 666          return;
 667      }
 668      $_[1] =~ s/^:// || return;
 669      if (defined ($R = $_ptime->{'M'}->($_[0], $_[1]))) {
 670          $R{M} = $R;
 671      } else {
 672          return;
 673      }
 674      return { %R };
 675  },
 676  'S' => sub {
 677      $_[1] =~ s/^([0-5][0-9])//           && $1;
 678  },
 679  't' => sub {
 680      $_[1] =~ s/^\t//                     && $1;
 681  },
 682  'T' => sub {
 683      my %T;
 684      my $T;
 685      if (defined ($T = $_ptime->{'H'}->($_[0], $_[1]))) {
 686          $T{H} = $T;
 687      } else {
 688          return;
 689      }
 690      $_[1] =~ s/^:// || return;
 691      if (defined ($T = $_ptime->{'M'}->($_[0], $_[1]))) {
 692          $T{M} = $T;
 693      } else {
 694          return;
 695      }
 696      $_[1] =~ s/^:// || return;
 697      if (defined ($T = $_ptime->{'S'}->($_[0], $_[1]))) {
 698          $T{S} = $T;
 699      } else {
 700          return;
 701      }
 702      return { %T };
 703  },
 704  # u unimplemented
 705  # U unimplemented
 706  # w unimplemented
 707  # W unimplemented
 708  'x' => sub {
 709      my %x;
 710      my $x;
 711      if (defined ($x = $_ptime->{'m'}->($_[0], $_[1]))) {
 712          $x{m} = $x;
 713      } else {
 714          return;
 715      }
 716      $_[1] =~ s:^/:: || return;
 717      if (defined ($x = $_ptime->{'d'}->($_[0], $_[1]))) {
 718          $x{d} = $x;
 719      } else {
 720          return;
 721      }
 722      $_[1] =~ s:^/:: || return;
 723      if (defined ($x = $_ptime->{'y'}->($_[0], $_[1]))) {
 724          $x{y} = $x;
 725      } else {
 726          return;
 727      }
 728      return { %x };
 729  },
 730  'y' => sub {
 731      $_[1] =~ s/^([0-9][0-9])//           && $1;
 732  },
 733  'Y' => sub {
 734      $_[1] =~ s/^([1-9][0-9][0-9][0-9])// && $1;
 735  },
 736  # Z too unportable
 737 };
 738
 739 sub has_ptime {
 740     my ($format) = @_;
 741     exists $_ptime->{$format};
 742 }
 743
 744 sub has_ptimes {
 745     keys %$_ptime;
 746 }
 747
 748 sub delete_ptime {
 749     delete $_ptime->{@_};
 750 }
 751
 752 sub ptime {
 753     my ($format) = $_[0];
 754     if (@_ == 1) {
 755         return $_ptime->{$format};
 756     } elsif (@_ == 2) {
 757         if (ref $_[0] eq 'CODE') {
 758             $_ptime->{$format} = $_[1];
 759         } else {
 760             require Carp;
 761             Carp::croak "ptime: second argument not a code ref";
 762         }
 763     } else {
 764         require Carp;
 765         Carp::croak "ptime: want one or two arguments";
 766     }
 767 }
 768
 769 sub _ptime {
 770     my ($format, $stime) = @_;
 771     if (has_ptime($format)) {
 772         # We are passing format to the anonsubs so that
 773         # one can share the same sub among several formats.
 774         return $_ptime->{$format}->($format, $_[1]);
 775     }
 776     die "strptime: unknown format %$format (time '$stime')\n";
 777 }
 778
 779 sub strptime {
 780     my $time   = shift;
 781     my $format = shift;
 782     my $stime =  @_ ? shift : "$time";
 783     my %ptime;
 784
 785     while ($format ne '') {
 786         if ($format =~ s/^([^%]+)//) {
 787             my $skip = $1;
 788             last unless $stime =~ s/^\Q$skip//;
 789         }
 790         while ($format =~ s/^%(.)//) {
 791             my $f = $1;
 792             my $t = _ptime($f, $stime);
 793             if (defined $t) {
 794                 if (ref $t eq 'HASH') {
 795                     @ptime{keys %$t} = values %$t;
 796                 } else {
 797                     $ptime{$f} = $t;
 798                 }
 799             }
 800         }
 801     }
 802
 803     return %ptime;
 804 }
 805
 806 sub wday_names {
 807     shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
 808     my @old = @WDAY_NAMES;
 809     if (@_) {
 810         @WDAY_NAMES = @_;
 811     }
 812     return @old;
 813 }
 814
 815 sub weekday_names {
 816     shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
 817     my @old = @WEEKDAY_NAMES;
 818     if (@_) {
 819         @WEEKDAY_NAMES = @_;
 820     }
 821     return @old;
 822 }
 823
 824 sub mon_names {
 825     shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
 826     my @old = @MON_NAMES;
 827     if (@_) {
 828         @MON_NAMES = @_;
 829     }
 830     return @old;
 831 }
 832
 833 sub month_names {
 834     shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
 835     my @old = @MONTH_NAMES;
 836     if (@_) {
 837         @MONTH_NAMES = @_;
 838     }
 839     return @old;
 840 }
 841
 842 sub time_separator {
 843     shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
 844     my $old = $TIME_SEP;
 845     if (@_) {
 846         $TIME_SEP = $_[0];
 847     }
 848     return $old;
 849 }
 850
 851 sub date_separator {
 852     shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
 853     my $old = $DATE_SEP;
 854     if (@_) {
 855         $DATE_SEP = $_[0];
 856     }
 857     return $old;
 858 }
 859
 860 use overload '""' => \&cdate;
 861
 862 sub cdate {
 863     my $time = shift;
 864     if ($time->[c_islocal]) {
 865         return scalar(CORE::localtime($time->[c_epoch]));
 866     }
 867     else {
 868         return scalar(CORE::gmtime($time->[c_epoch]));
 869     }
 870 }
 871
 872 use overload
 873         '-' => \&subtract,
 874         '+' => \&add;
 875
 876 sub subtract {
 877     my $time = shift;
 878     my $rhs = shift;
 879     die "Can't subtract a date from something!" if shift;
 880
 881     if (ref($rhs) && $rhs->isa('Time::Piece')) {
 882         return Time::Seconds->new($time->[c_epoch] - $rhs->epoch);
 883     }
 884     else {
 885         # rhs is seconds.
 886         return _mktime(($time->[c_epoch] - $rhs), $time->[c_islocal]);
 887     }
 888 }
 889
 890 sub add {
 891     warn "add\n";
 892     my $time = shift;
 893     my $rhs = shift;
 894     croak "Invalid rhs of addition: $rhs" if ref($rhs);
 895
 896     return _mktime(($time->[c_epoch] + $rhs), $time->[c_islocal]);
 897 }
 898
 899 use overload
 900         '<=>' => \&compare;
 901
 902 sub get_epochs {
 903     my ($time, $rhs, $reverse) = @_;
 904     $time = $time->epoch;
 905     if (UNIVERSAL::isa($rhs, 'Time::Piece')) {
 906         $rhs = $rhs->epoch;
 907     }
 908     if ($reverse) {
 909         return $rhs, $time;
 910     }
 911     return $time, $rhs;
 912 }
 913
 914 sub compare {
 915     my ($lhs, $rhs) = get_epochs(@_);
 916     return $lhs <=> $rhs;
 917 }
 918
 919 1;
 920 __END__
 921
 922 =head1 NAME
 923
 924 Time::Piece - Object Oriented time objects
 925
 926 =head1 SYNOPSIS
 927
 928     use Time::Piece;
 929
 930     my $t = localtime;
 931     print "Time is $t\n";
 932     print "Year is ", $t->year, "\n";
 933
 934 =head1 DESCRIPTION
 935
 936 This module replaces the standard localtime and gmtime functions with
 937 implementations that return objects. It does so in a backwards
 938 compatible manner, so that using localtime/gmtime in the way documented
 939 in perlfunc will still return what you expect.
 940
 941 The module actually implements most of an interface described by
 942 Larry Wall on the perl5-porters mailing list here:
 943 http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html
 944
 945 =head1 USAGE
 946
 947 After importing this module, when you use localtime or gmtime in a scalar
 948 context, rather than getting an ordinary scalar string representing the
 949 date and time, you get a Time::Piece object, whose stringification happens
 950 to produce the same effect as the localtime and gmtime functions. There is
 951 also a new() constructor provided, which is the same as localtime(), except
 952 when passed a Time::Piece object, in which case it's a copy constructor. The
 953 following methods are available on the object:
 954
 955     $t->s                    # 0..61 [1]
 956                              # and 61: leap second and double leap second
 957     $t->sec                  # same as $t->s
 958     $t->second               # same as $t->s
 959     $t->min                  # 0..59
 960     $t->h                    # 0..24
 961     $t->hour                 # same as $t->h
 962     $t->d                    # 1..31
 963     $t->mday                 # same as $t->d
 964     $t->mon                  # 1 = January
 965     $t->_mon                 # 0 = January
 966     $t->monname              # Feb
 967     $t->monthname            # February
 968     $t->month                # same as $t->monthname
 969     $t->y                    # based at 0 (year 0 AD is, of course 1 BC)
 970     $t->year                 # same as $t->y
 971     $t->_year                # year minus 1900
 972     $t->wday                 # 1 = Sunday
 973     $t->day_of_week          # 0 = Sunday
 974     $t->_wday                # 0 = Sunday
 975     $t->wdayname             # Tue
 976     $t->weekdayname          # Tuesday
 977     $t->weekday              # same as weekdayname
 978     $t->yday                 # also available as $t->day_of_year, 0 = Jan 01
 979     $t->isdst                # also available as $t->daylight_savings
 980     $t->daylight_savings     # same as $t->isdst
 981
 982     $t->hms                  # 12:34:56
 983     $t->hms(".")             # 12.34.56
 984     $t->time                 # same as $t->hms
 985
 986     $t->ymd                  # 2000-02-29
 987     $t->date                 # same as $t->ymd
 988     $t->mdy                  # 02-29-2000
 989     $t->mdy("/")             # 02/29/2000
 990     $t->dmy                  # 29-02-2000
 991     $t->dmy(".")             # 29.02.2000
 992     $t->datetime             # 2000-02-29T12:34:56 (ISO 8601)
 993     $t->cdate                # Tue Feb 29 12:34:56 2000
 994     "$t"                     # same as $t->cdate
 995
 996     $t->epoch                # seconds since the epoch
 997     $t->tzoffset             # timezone offset in a Time::Seconds object
 998
 999     $t->julian_day           # number of days since Julian period began
1000     $t->mjd                  # modified Julian day
1001
1002     $t->week                 # week number (ISO 8601)
1003
1004     $t->is_leap_year         # true if it its
1005     $t->month_last_day       # 28-31
1006
1007     $t->time_separator($s)   # set the default separator (default ":")
1008     $t->date_separator($s)   # set the default separator (default "-")
1009     $t->wday(@days)          # set the default weekdays, abbreviated
1010     $t->weekday_names(@days) # set the default weekdays
1011     $t->mon_names(@days)     # set the default months, abbreviated
1012     $t->month_names(@days)   # set the default months
1013
1014     $t->strftime($format)    # data and time formatting
1015     $t->strftime()           # "Tue, 29 Feb 2000 12:34:56 GMT"
1016
1017     $t->_strftime($format)   # same as POSIX::strftime (without the
1018                              # overhead of the full POSIX extension),
1019                              # calls the operating system libraries,
1020                              # as opposed to $t->strftime()
1021
1022 =head2 Local Locales
1023
1024 Both wdayname (day) and monname (month) allow passing in a list to use
1025 to index the name of the days against. This can be useful if you need
1026 to implement some form of localisation without actually installing or
1027 using locales.
1028
1029   my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
1030
1031   my $french_day = localtime->day(@days);
1032
1033 These settings can be overriden globally too:
1034
1035   Time::Piece::weekday_names(@days);
1036
1037 Or for months:
1038
1039   Time::Piece::month_names(@months);
1040
1041 And locally for months:
1042
1043   print localtime->month(@months);
1044
1045 =head2 Date Calculations
1046
1047 It's possible to use simple addition and subtraction of objects:
1048
1049     use Time::Seconds;
1050
1051     my $seconds = $t1 - $t2;
1052     $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds)
1053
1054 The following are valid ($t1 and $t2 are Time::Piece objects):
1055
1056     $t1 - $t2; # returns Time::Seconds object
1057     $t1 - 42; # returns Time::Piece object
1058     $t1 + 533; # returns Time::Piece object
1059
1060 However adding a Time::Piece object to another Time::Piece object
1061 will cause a runtime error.
1062
1063 Note that the first of the above returns a Time::Seconds object, so
1064 while examining the object will print the number of seconds (because
1065 of the overloading), you can also get the number of minutes, hours,
1066 days, weeks and years in that delta, using the Time::Seconds API.
1067
1068 =head2 Date Comparisons
1069
1070 Date comparisons are also possible, using the full suite of "<", ">",
1071 "<=", ">=", "<=>", "==" and "!=".
1072
1073 =head2 YYYY-MM-DDThh:mm:ss
1074
1075 The ISO 8601 standard defines the date format to be YYYY-MM-DD, and
1076 the time format to be hh:mm:ss (24 hour clock), and if combined, they
1077 should be concatenated with date first and with a capital 'T' in front
1078 of the time.
1079
1080 =head2 Week Number
1081
1082 The I<week number> may be an unknown concept to some readers.  The ISO
1083 8601 standard defines that weeks begin on a Monday and week 1 of the
1084 year is the week that includes both January 4th and the first Thursday
1085 of the year.  In other words, if the first Monday of January is the
1086 2nd, 3rd, or 4th, the preceding days of the January are part of the
1087 last week of the preceding year.  Week numbers range from 1 to 53.
1088
1089 =head2 Global Overriding
1090
1091 Finally, it's possible to override localtime and gmtime everywhere, by
1092 including the ':override' tag in the import list:
1093
1094     use Time::Piece ':override';
1095
1096 =head1 SEE ALSO
1097
1098 The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html
1099
1100 =head1 AUTHOR
1101
1102 Matt Sergeant, matt@sergeant.org
1103
1104 This module is based on Time::Object, with changes suggested by Jarkko
1105 Hietaniemi before including in core perl.
1106
1107 =head2 License
1108
1109 This module is free software, you may distribute it under the same terms
1110 as Perl.
1111
1112 =head2 Bugs
1113
1114 The test harness leaves much to be desired. Patches welcome.
1115
1116 =cut