rt/lib/RT/Date.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 =head1 NAME
  50
  51   RT::Date - a simple Object Oriented date.
  52
  53 =head1 SYNOPSIS
  54
  55   use RT::Date
  56
  57 =head1 DESCRIPTION
  58
  59 RT Date is a simple Date Object designed to be speedy and easy for RT to use.
  60
  61 The fact that it assumes that a time of 0 means "never" is probably a bug.
  62
  63
  64 =head1 METHODS
  65
  66 =cut
  67
  68
  69 package RT::Date;
  70
  71
  72 use strict;
  73 use warnings;
  74
  75 use base qw/RT::Base/;
  76
  77 use DateTime;
  78
  79 use Time::Local;
  80 use POSIX qw(tzset);
  81 use vars qw($MINUTE $HOUR $DAY $WEEK $MONTH $YEAR);
  82
  83 $MINUTE = 60;
  84 $HOUR   = 60 * $MINUTE;
  85 $DAY    = 24 * $HOUR;
  86 $WEEK   = 7 * $DAY;
  87 $MONTH  = 30.4375 * $DAY;
  88 $YEAR   = 365.25 * $DAY;
  89
  90 our @MONTHS = (
  91     'Jan', # loc
  92     'Feb', # loc
  93     'Mar', # loc
  94     'Apr', # loc
  95     'May', # loc
  96     'Jun', # loc
  97     'Jul', # loc
  98     'Aug', # loc
  99     'Sep', # loc
 100     'Oct', # loc
 101     'Nov', # loc
 102     'Dec', # loc
 103 );
 104
 105 our @DAYS_OF_WEEK = (
 106     'Sun', # loc
 107     'Mon', # loc
 108     'Tue', # loc
 109     'Wed', # loc
 110     'Thu', # loc
 111     'Fri', # loc
 112     'Sat', # loc
 113 );
 114
 115 our @FORMATTERS = (
 116     'DefaultFormat',     # loc
 117     'ISO',               # loc
 118     'W3CDTF',            # loc
 119     'RFC2822',           # loc
 120     'RFC2616',           # loc
 121     'iCal',              # loc
 122     'LocalizedDateTime', # loc
 123 );
 124
 125 =head2 new
 126
 127 Object constructor takes one argument C<RT::CurrentUser> object.
 128
 129 =cut
 130
 131 sub new {
 132     my $proto = shift;
 133     my $class = ref($proto) || $proto;
 134     my $self  = {};
 135     bless ($self, $class);
 136     $self->CurrentUser(@_);
 137     $self->Unix(0);
 138     return $self;
 139 }
 140
 141 =head2 Set
 142
 143 Takes a param hash with the fields C<Format>, C<Value> and C<Timezone>.
 144
 145 If $args->{'Format'} is 'unix', takes the number of seconds since the epoch.
 146
 147 If $args->{'Format'} is ISO, tries to parse an ISO date.
 148
 149 If $args->{'Format'} is 'unknown', require Time::ParseDate and make it figure
 150 things out. This is a heavyweight operation that should never be called from
 151 within RT's core. But it's really useful for something like the textbox date
 152 entry where we let the user do whatever they want.
 153
 154 If $args->{'Value'} is 0, assumes you mean never.
 155
 156 =cut
 157
 158 sub Set {
 159     my $self = shift;
 160     my %args = (
 161         Format   => 'unix',
 162         Value    => time,
 163         Timezone => 'user',
 164         @_
 165     );
 166
 167     return $self->Unix(0) unless $args{'Value'} && $args{'Value'} =~ /\S/;
 168
 169     my $format = lc $args{'Format'};
 170
 171     if ( $format eq 'unix' ) {
 172         return $self->Unix( $args{'Value'} );
 173     }
 174     elsif (
 175         ($format eq 'sql' || $format eq 'iso')
 176         && $args{'Value'} =~ /^(\d{4})-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/
 177     ) {
 178         local $@;
 179         my $u = eval { Time::Local::timegm($6, $5, $4, $3, $2-1, $1) } || 0;
 180         $RT::Logger->warning("Invalid date $args{'Value'}: $@") if $@ && !$u;
 181         return $self->Unix( $u > 0 ? $u : 0 );
 182     }
 183     elsif ( $format =~ /^(sql|datemanip|iso)$/ ) {
 184         $args{'Value'} =~ s!/!-!g;
 185
 186         if (   ( $args{'Value'} =~ /^(\d{4})?(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ )
 187             || ( $args{'Value'} =~ /^(\d{4})?(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/ )
 188             || ( $args{'Value'} =~ /^(?:(\d{4})-)?(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/ )
 189             || ( $args{'Value'} =~ /^(?:(\d{4})-)?(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)\+00$/ )
 190           ) {
 191
 192             my ($year, $mon, $mday, $hours, $min, $sec)  = ($1, $2, $3, $4, $5, $6);
 193
 194             # use current year if string has no value
 195             $year ||= (localtime time)[5] + 1900;
 196
 197             #timegm expects month as 0->11
 198             $mon--;
 199
 200             #now that we've parsed it, deal with the case where everything was 0
 201             return $self->Unix(0) if $mon < 0 || $mon > 11;
 202
 203             my $tz = lc $args{'Format'} eq 'datemanip'? 'user': 'utc';
 204             $self->Unix( $self->Timelocal( $tz, $sec, $min, $hours, $mday, $mon, $year ) );
 205
 206             $self->Unix(0) unless $self->Unix > 0;
 207         }
 208         else {
 209             $RT::Logger->warning(
 210                 "Couldn't parse date '$args{'Value'}' as a $args{'Format'} format"
 211             );
 212             return $self->Unix(0);
 213         }
 214     }
 215     elsif ( $format eq 'unknown' ) {
 216         require Time::ParseDate;
 217         # the module supports only legacy timezones like PDT or EST...
 218         # so we parse date as GMT and later apply offset, this only
 219         # should be applied to absolute times, so compensate shift in NOW
 220         my $now = time;
 221         $now += ($self->Localtime( $args{Timezone}, $now ))[9];
 222         my ($date, $error) = Time::ParseDate::parsedate(
 223             $args{'Value'},
 224             GMT           => 1,
 225             NOW           => $now,
 226             UK            => RT->Config->Get('DateDayBeforeMonth'),
 227             PREFER_PAST   => RT->Config->Get('AmbiguousDayInPast'),
 228             PREFER_FUTURE => RT->Config->Get('AmbiguousDayInFuture'),
 229         );
 230         unless ( defined $date ) {
 231             $RT::Logger->warning(
 232                 "Couldn't parse date '$args{'Value'}' by Time::ParseDate"
 233             );
 234             return $self->Unix(0);
 235         }
 236
 237         # apply timezone offset
 238         $date -= ($self->Localtime( $args{Timezone}, $date ))[9];
 239
 240         $RT::Logger->debug(
 241             "RT::Date used Time::ParseDate to make '$args{'Value'}' $date\n"
 242         );
 243
 244         return $self->Unix($date || 0);
 245     }
 246     else {
 247         $RT::Logger->error(
 248             "Unknown Date format: $args{'Format'}\n"
 249         );
 250         return $self->Unix(0);
 251     }
 252
 253     return $self->Unix;
 254 }
 255
 256 =head2 SetToNow
 257
 258 Set the object's time to the current time. Takes no arguments
 259 and returns unix time.
 260
 261 =cut
 262
 263 sub SetToNow {
 264     return $_[0]->Unix(time);
 265 }
 266
 267 =head2 SetToMidnight [Timezone => 'utc']
 268
 269 Sets the date to midnight (at the beginning of the day).
 270 Returns the unixtime at midnight.
 271
 272 Arguments:
 273
 274 =over 4
 275
 276 =item Timezone
 277
 278 Timezone context C<user>, C<server> or C<UTC>. See also L</Timezone>.
 279
 280 =back
 281
 282 =cut
 283
 284 sub SetToMidnight {
 285     my $self = shift;
 286     my %args = ( Timezone => '', @_ );
 287     my $new = $self->Timelocal(
 288         $args{'Timezone'},
 289         0,0,0,($self->Localtime( $args{'Timezone'} ))[3..9]
 290     );
 291     return $self->Unix( $new );
 292 }
 293
 294 =head2 SetToStart PERIOD[, Timezone => 'utc' ]
 295
 296 Set to the beginning of the current PERIOD, which can be
 297 "year", "month", "day", "hour", or "minute".
 298
 299 =cut
 300
 301 sub SetToStart {
 302     my $self = shift;
 303     my $p = uc(shift);
 304     my %args = @_;
 305     my $tz = $args{'Timezone'} || '';
 306     my @localtime = $self->Localtime($tz);
 307     #remove 'offset' so that DST is figured based on the resulting time.
 308     pop @localtime;
 309
 310     # This is the cleanest way to implement it, I swear.
 311     {
 312         $localtime[0]=0;
 313         last if ($p eq 'MINUTE');
 314         $localtime[1]=0;
 315         last if ($p eq 'HOUR');
 316         $localtime[2]=0;
 317         last if ($p eq 'DAY');
 318         $localtime[3]=1;
 319         last if ($p eq 'MONTH');
 320         $localtime[4]=0;
 321         last if ($p eq 'YEAR');
 322         $RT::Logger->warning("Couldn't find start date of '$p'.");
 323         return;
 324     }
 325     my $new = $self->Timelocal($tz, @localtime);
 326     return $self->Unix($new);
 327 }
 328
 329 =head2 Diff
 330
 331 Takes either an C<RT::Date> object or the date in unixtime format as a string,
 332 if nothing is specified uses the current time.
 333
 334 Returns the differnce between the time in the current object and that time
 335 as a number of seconds. Returns C<undef> if any of two compared values is
 336 incorrect or not set.
 337
 338 =cut
 339
 340 sub Diff {
 341     my $self = shift;
 342     my $other = shift;
 343     $other = time unless defined $other;
 344     if ( UNIVERSAL::isa( $other, 'RT::Date' ) ) {
 345         $other = $other->Unix;
 346     }
 347     return undef unless $other=~ /^\d+$/ && $other > 0;
 348
 349     my $unix = $self->Unix;
 350     return undef unless $unix > 0;
 351
 352     return $unix - $other;
 353 }
 354
 355 =head2 DiffAsString
 356
 357 Takes either an C<RT::Date> object or the date in unixtime format as a string,
 358 if nothing is specified uses the current time.
 359
 360 Returns the differnce between C<$self> and that time as a number of seconds as
 361 a localized string fit for human consumption. Returns empty string if any of
 362 two compared values is incorrect or not set.
 363
 364 =cut
 365
 366 sub DiffAsString {
 367     my $self = shift;
 368     my $diff = $self->Diff( @_ );
 369     return '' unless defined $diff;
 370
 371     return $self->DurationAsString( $diff );
 372 }
 373
 374 =head2 DurationAsString
 375
 376 Takes a number of seconds. Returns a localized string describing
 377 that duration.
 378
 379 Takes optional named arguments:
 380
 381 =over 4
 382
 383 =item * Show
 384
 385 How many elements to show, how precise it should be. Default is 1,
 386 most vague variant.
 387
 388 =item * Short
 389
 390 Turn on short notation with one character units, for example
 391 "3M 2d 1m 10s".
 392
 393 =back
 394
 395 =cut
 396
 397 sub DurationAsString {
 398     my $self     = shift;
 399     my $duration = int shift;
 400     my %args = ( Show => 1, Short => 0, @_ );
 401
 402     unless ( $duration ) {
 403         return $args{Short}? $self->loc("0s") : $self->loc("0 seconds");
 404     }
 405
 406     my $negative;
 407     $negative = 1 if $duration < 0;
 408     $duration = abs $duration;
 409
 410     my @res;
 411
 412     my $coef = 2;
 413     my $i = 0;
 414     while ( $duration > 0 && ++$i <= $args{'Show'} ) {
 415
 416         my ($locstr, $unit);
 417         if ( $duration < $MINUTE ) {
 418             $locstr = $args{Short}
 419                     ? '[_1]s'                      # loc
 420                     : '[quant,_1,second,seconds]'; # loc
 421             $unit = 1;
 422         }
 423         elsif ( $duration < ( $coef * $HOUR ) ) {
 424             $locstr = $args{Short}
 425                     ? '[_1]m'                      # loc
 426                     : '[quant,_1,minute,minutes]'; # loc
 427             $unit = $MINUTE;
 428         }
 429         elsif ( $duration < ( $coef * $DAY ) ) {
 430             $locstr = $args{Short}
 431                     ? '[_1]h'                      # loc
 432                     : '[quant,_1,hour,hours]';     # loc
 433             $unit = $HOUR;
 434         }
 435         elsif ( $duration < ( $coef * $WEEK ) ) {
 436             $locstr = $args{Short}
 437                     ? '[_1]d'                      # loc
 438                     : '[quant,_1,day,days]';       # loc
 439             $unit = $DAY;
 440         }
 441         elsif ( $duration < ( $coef * $MONTH ) ) {
 442             $locstr = $args{Short}
 443                     ? '[_1]W'                      # loc
 444                     : '[quant,_1,week,weeks]';     # loc
 445             $unit = $WEEK;
 446         }
 447         elsif ( $duration < $YEAR ) {
 448             $locstr = $args{Short}
 449                     ? '[_1]M'                      # loc
 450                     : '[quant,_1,month,months]';   # loc
 451             $unit = $MONTH;
 452         }
 453         else {
 454             $locstr = $args{Short}
 455                     ? '[_1]Y'                      # loc
 456                     : '[quant,_1,year,years]';     # loc
 457             $unit = $YEAR;
 458         }
 459         my $value = int( $duration / $unit  + ($i < $args{'Show'}? 0 : 0.5) );
 460         $duration -= int( $value * $unit );
 461
 462         push @res, $self->loc($locstr, $value);
 463
 464         $coef = 1;
 465     }
 466
 467     if ( $negative ) {
 468         return $self->loc( "[_1] ago", join ' ', @res );
 469     }
 470     else {
 471         return join ' ', @res;
 472     }
 473 }
 474
 475 =head2 AgeAsString
 476
 477 Takes nothing. Returns a string that's the difference between the
 478 time in the object and now.
 479
 480 =cut
 481
 482 sub AgeAsString { return $_[0]->DiffAsString }
 483
 484
 485
 486 =head2 AsString
 487
 488 Returns the object's time as a localized string with curent user's preferred
 489 format and timezone.
 490
 491 If the current user didn't choose preferred format then system wide setting is
 492 used or L</DefaultFormat> if the latter is not specified. See config option
 493 C<DateTimeFormat>.
 494
 495 =cut
 496
 497 sub AsString {
 498     my $self = shift;
 499     my %args = (@_);
 500
 501     return $self->loc("Not set") unless $self->IsSet;
 502
 503     my $format = RT->Config->Get( 'DateTimeFormat', $self->CurrentUser ) || 'DefaultFormat';
 504     $format = { Format => $format } unless ref $format;
 505     %args = (%$format, %args);
 506
 507     return $self->Get( Timezone => 'user', %args );
 508 }
 509
 510 =head2 GetWeekday DAY
 511
 512 Takes an integer day of week and returns a localized string for
 513 that day of week. Valid values are from range 0-6, Note that B<0
 514 is sunday>.
 515
 516 =cut
 517
 518 sub GetWeekday {
 519     my $self = shift;
 520     my $dow = shift;
 521
 522     return $self->loc($DAYS_OF_WEEK[$dow])
 523         if $DAYS_OF_WEEK[$dow];
 524     return '';
 525 }
 526
 527 =head2 GetMonth MONTH
 528
 529 Takes an integer month and returns a localized string for that month.
 530 Valid values are from from range 0-11.
 531
 532 =cut
 533
 534 sub GetMonth {
 535     my $self = shift;
 536     my $mon = shift;
 537
 538     return $self->loc($MONTHS[$mon])
 539         if $MONTHS[$mon];
 540     return '';
 541 }
 542
 543 =head2 AddSeconds SECONDS
 544
 545 Takes a number of seconds and returns the new unix time.
 546
 547 Negative value can be used to substract seconds.
 548
 549 =cut
 550
 551 sub AddSeconds {
 552     my $self = shift;
 553     my $delta = shift or return $self->Unix;
 554
 555     $self->Set(Format => 'unix', Value => ($self->Unix + $delta));
 556
 557     return ($self->Unix);
 558 }
 559
 560 =head2 AddDays [DAYS]
 561
 562 Adds C<24 hours * DAYS> to the current time. Adds one day when
 563 no argument is specified. Negative value can be used to substract
 564 days.
 565
 566 Returns new unix time.
 567
 568 =cut
 569
 570 sub AddDays {
 571     my $self = shift;
 572     my $days = shift;
 573     $days = 1 unless defined $days;
 574     return $self->AddSeconds( $days * $DAY );
 575 }
 576
 577 =head2 AddDay
 578
 579 Adds 24 hours to the current time. Returns new unix time.
 580
 581 =cut
 582
 583 sub AddDay { return $_[0]->AddSeconds($DAY) }
 584
 585 =head2 AddMonth
 586
 587 Adds one month to the current time. Returns new
 588 unix time.
 589
 590 =cut
 591
 592 sub AddMonth {
 593     my $self = shift;
 594     my %args = @_;
 595     my @localtime = $self->Localtime($args{'Timezone'});
 596     # remove offset, as with SetToStart
 597     pop @localtime;
 598
 599     $localtime[4]++; #month
 600     if ( $localtime[4] == 12 ) {
 601       $localtime[4] = 0;
 602       $localtime[5]++; #year
 603     }
 604
 605     my $new = $self->Timelocal($args{'Timezone'}, @localtime);
 606     return $self->Unix($new);
 607 }
 608
 609 =head2 Unix [unixtime]
 610
 611 Optionally takes a date in unix seconds since the epoch format.
 612 Returns the number of seconds since the epoch
 613
 614 =cut
 615
 616 sub Unix {
 617     my $self = shift;
 618
 619     if (@_) {
 620         my $time = int(shift || 0);
 621         if ($time < 0) {
 622             RT->Logger->notice("Passed a unix time less than 0, forcing to 0: [$time]");
 623             $time = 0;
 624         }
 625         $self->{'time'} = int $time;
 626     }
 627     return $self->{'time'};
 628 }
 629
 630 =head2 DateTime
 631
 632 Alias for L</Get> method. Arguments C<Date> and C<Time>
 633 are fixed to true values, other arguments could be used
 634 as described in L</Get>.
 635
 636 =cut
 637
 638 sub DateTime {
 639     my $self = shift;
 640     unless (defined $self) {
 641         use Carp; Carp::confess("undefined $self");
 642     }
 643     return $self->Get( @_, Date => 1, Time => 1 );
 644 }
 645
 646 =head2 Date
 647
 648 Takes Format argument which allows you choose date formatter.
 649 Pass throught other arguments to the formatter method.
 650
 651 Returns the object's formatted date. Default formatter is ISO.
 652
 653 =cut
 654
 655 sub Date {
 656     my $self = shift;
 657     return $self->Get( @_, Date => 1, Time => 0 );
 658 }
 659
 660 =head2 Time
 661
 662
 663 =cut
 664
 665 sub Time {
 666     my $self = shift;
 667     return $self->Get( @_, Date => 0, Time => 1 );
 668 }
 669
 670 =head2 Get
 671
 672 Returns a formatted and localized string that represents the time of
 673 the current object.
 674
 675
 676 =cut
 677
 678 sub Get
 679 {
 680     my $self = shift;
 681     my %args = (Format => 'ISO', @_);
 682     my $formatter = $args{'Format'};
 683     unless ( $self->ValidFormatter($formatter) ) {
 684         RT->Logger->warning("Invalid date formatter '$formatter', falling back to ISO");
 685         $formatter = 'ISO';
 686     }
 687     $formatter = 'ISO' unless $self->can($formatter);
 688     return $self->$formatter( %args );
 689 }
 690
 691 =head2 Output formatters
 692
 693 Fomatter is a method that returns date and time in different configurable
 694 format.
 695
 696 Each method takes several arguments:
 697
 698 =over 1
 699
 700 =item Date
 701
 702 =item Time
 703
 704 =item Timezone - Timezone context C<server>, C<user> or C<UTC>
 705
 706 =back
 707
 708 Formatters may also add own arguments to the list, for example
 709 in RFC2822 format day of time in output is optional so it
 710 understands boolean argument C<DayOfTime>.
 711
 712 =head3 Formatters
 713
 714 Returns an array of available formatters.
 715
 716 =cut
 717
 718 sub Formatters
 719 {
 720     my $self = shift;
 721
 722     return @FORMATTERS;
 723 }
 724
 725 =head3 ValidFormatter FORMAT
 726
 727 Returns a true value if C<FORMAT> is a known formatter.  Otherwise returns
 728 false.
 729
 730 =cut
 731
 732 sub ValidFormatter {
 733     my $self   = shift;
 734     my $format = shift;
 735     return (grep { $_ eq $format } $self->Formatters and $self->can($format))
 736                 ? 1 : 0;
 737 }
 738
 739 =head3 DefaultFormat
 740
 741 =cut
 742
 743 sub DefaultFormat
 744 {
 745     my $self = shift;
 746     my %args = ( Date => 1,
 747                  Time => 1,
 748                  Timezone => '',
 749                  Seconds => 1,
 750                  @_,
 751                );
 752
 753        #  0    1    2     3     4    5     6     7      8      9
 754     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 755                             $self->Localtime($args{'Timezone'});
 756     $wday = $self->GetWeekday($wday);
 757     $mon = $self->GetMonth($mon);
 758     $_ = sprintf "%02d", $_ foreach $mday, $hour, $min, $sec;
 759
 760     if( $args{'Date'} && !$args{'Time'} ) {
 761         return $self->loc('[_1] [_2] [_3] [_4]',
 762                           $wday,$mon,$mday,$year);
 763     } elsif( !$args{'Date'} && $args{'Time'} ) {
 764         if( $args{'Seconds'} ) {
 765             return $self->loc('[_1]:[_2]:[_3]',
 766                               $hour,$min,$sec);
 767         } else {
 768             return $self->loc('[_1]:[_2]',
 769                               $hour,$min);
 770         }
 771     } else {
 772         if( $args{'Seconds'} ) {
 773             return $self->loc('[_1] [_2] [_3] [_4]:[_5]:[_6] [_7]',
 774                               $wday,$mon,$mday,$hour,$min,$sec,$year);
 775         } else {
 776             return $self->loc('[_1] [_2] [_3] [_4]:[_5] [_6]',
 777                               $wday,$mon,$mday,$hour,$min,$year);
 778         }
 779     }
 780 }
 781
 782 =head2 LocaleObj
 783
 784 Returns the L<DateTime::Locale> object representing the current user's locale.
 785
 786 =cut
 787
 788 sub LocaleObj {
 789     my $self = shift;
 790
 791     my $lang = $self->CurrentUser->UserObj->Lang;
 792     unless ($lang) {
 793         require I18N::LangTags::Detect;
 794         $lang = ( I18N::LangTags::Detect::detect(), 'en' )[0];
 795     }
 796
 797     return DateTime::Locale->load($lang);
 798 }
 799
 800 =head3 LocalizedDateTime
 801
 802 Returns date and time as string, with user localization.
 803
 804 Supports arguments: C<DateFormat> and C<TimeFormat> which may contains date and
 805 time format as specified in L<DateTime::Locale> (default to C<date_format_full> and
 806 C<time_format_medium>), C<AbbrDay> and C<AbbrMonth> which may be set to 0 if
 807 you want full Day/Month names instead of abbreviated ones.
 808
 809 =cut
 810
 811 sub LocalizedDateTime
 812 {
 813     my $self = shift;
 814     my %args = ( Date => 1,
 815                  Time => 1,
 816                  Timezone => '',
 817                  DateFormat => '',
 818                  TimeFormat => '',
 819                  AbbrDay => 1,
 820                  AbbrMonth => 1,
 821                  @_,
 822                );
 823
 824     # Require valid names for the format methods
 825     my $date_format = $args{DateFormat} =~ /^\w+$/
 826                     ? $args{DateFormat} : 'date_format_full';
 827
 828     my $time_format = $args{TimeFormat} =~ /^\w+$/
 829                     ? $args{TimeFormat} : 'time_format_medium';
 830
 831     my $formatter = $self->LocaleObj;
 832     $date_format = $formatter->$date_format;
 833     $time_format = $formatter->$time_format;
 834     $date_format =~ s/EEEE/EEE/g if ( $args{'AbbrDay'} );
 835     $date_format =~ s/MMMM/MMM/g if ( $args{'AbbrMonth'} );
 836
 837     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 838                             $self->Localtime($args{'Timezone'});
 839     $mon++;
 840     my $tz = $self->Timezone($args{'Timezone'});
 841
 842     # FIXME : another way to call this module without conflict with local
 843     # DateTime method?
 844     my $dt = DateTime::->new( locale => $formatter,
 845                             time_zone => $tz,
 846                             year => $year,
 847                             month => $mon,
 848                             day => $mday,
 849                             hour => $hour,
 850                             minute => $min,
 851                             second => $sec,
 852                             nanosecond => 0,
 853                           );
 854
 855     if ( $args{'Date'} && !$args{'Time'} ) {
 856         return $dt->format_cldr($date_format);
 857     } elsif ( !$args{'Date'} && $args{'Time'} ) {
 858         return $dt->format_cldr($time_format);
 859     } else {
 860         return $dt->format_cldr($date_format) . " " . $dt->format_cldr($time_format);
 861     }
 862 }
 863
 864 =head3 ISO
 865
 866 Returns the object's date in ISO format C<YYYY-MM-DD mm:hh:ss>.
 867 ISO format is locale-independent, but adding timezone offset info
 868 is not implemented yet.
 869
 870 Supports arguments: C<Timezone>, C<Date>, C<Time> and C<Seconds>.
 871 See L</Output formatters> for description of arguments.
 872
 873 =cut
 874
 875 sub ISO {
 876     my $self = shift;
 877     my %args = ( Date => 1,
 878                  Time => 1,
 879                  Timezone => '',
 880                  Seconds => 1,
 881                  @_,
 882                );
 883        #  0    1    2     3     4    5     6     7      8      9
 884     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 885                             $self->Localtime($args{'Timezone'});
 886
 887     #the month needs incrementing, as gmtime returns 0-11
 888     $mon++;
 889
 890     my $res = '';
 891     $res .= sprintf("%04d-%02d-%02d", $year, $mon, $mday) if $args{'Date'};
 892     $res .= sprintf(' %02d:%02d', $hour, $min) if $args{'Time'};
 893     $res .= sprintf(':%02d', $sec) if $args{'Time'} && $args{'Seconds'};
 894     $res =~ s/^\s+//;
 895
 896     return $res;
 897 }
 898
 899 =head3 W3CDTF
 900
 901 Returns the object's date and time in W3C date time format
 902 (L<http://www.w3.org/TR/NOTE-datetime>).
 903
 904 Format is locale-independent and is close enough to ISO, but
 905 note that date part is B<not optional> and output string
 906 has timezone offset mark in C<[+-]hh:mm> format.
 907
 908 Supports arguments: C<Timezone>, C<Time> and C<Seconds>.
 909 See L</Output formatters> for description of arguments.
 910
 911 =cut
 912
 913 sub W3CDTF {
 914     my $self = shift;
 915     my %args = (
 916         Time => 1,
 917         Timezone => '',
 918         Seconds => 1,
 919         @_,
 920         Date => 1,
 921     );
 922        #  0    1    2     3     4    5     6     7      8      9
 923     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 924                             $self->Localtime( $args{'Timezone'} );
 925
 926     #the month needs incrementing, as gmtime returns 0-11
 927     $mon++;
 928
 929     my $res = '';
 930     $res .= sprintf("%04d-%02d-%02d", $year, $mon, $mday);
 931     if ( $args{'Time'} ) {
 932         $res .= sprintf('T%02d:%02d', $hour, $min);
 933         $res .= sprintf(':%02d', $sec) if $args{'Seconds'};
 934         if ( $offset ) {
 935             $res .= sprintf "%s%02d:%02d", $self->_SplitOffset( $offset );
 936         } else {
 937             $res .= 'Z';
 938         }
 939     }
 940
 941     return $res;
 942 };
 943
 944
 945 =head3 RFC2822 (MIME)
 946
 947 Returns the object's date and time in RFC2822 format,
 948 for example C<Sun, 06 Nov 1994 08:49:37 +0000>.
 949 Format is locale-independent as required by RFC. Time
 950 part always has timezone offset in digits with sign prefix.
 951
 952 Supports arguments: C<Timezone>, C<Date>, C<Time>, C<DayOfWeek>
 953 and C<Seconds>. See L</Output formatters> for description of
 954 arguments.
 955
 956 =cut
 957
 958 sub RFC2822 {
 959     my $self = shift;
 960     my %args = ( Date => 1,
 961                  Time => 1,
 962                  Timezone => '',
 963                  DayOfWeek => 1,
 964                  Seconds => 1,
 965                  @_,
 966                );
 967
 968        #  0    1    2     3     4    5     6     7      8     9
 969     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 970                             $self->Localtime($args{'Timezone'});
 971
 972     my ($date, $time) = ('','');
 973     $date .= "$DAYS_OF_WEEK[$wday], " if $args{'DayOfWeek'} && $args{'Date'};
 974     $date .= sprintf("%02d %s %04d", $mday, $MONTHS[$mon], $year) if $args{'Date'};
 975
 976     if ( $args{'Time'} ) {
 977         $time .= sprintf("%02d:%02d", $hour, $min);
 978         $time .= sprintf(":%02d", $sec) if $args{'Seconds'};
 979         $time .= sprintf " %s%02d%02d", $self->_SplitOffset( $offset );
 980     }
 981
 982     return join ' ', grep $_, ($date, $time);
 983 }
 984
 985 =head3 RFC2616 (HTTP)
 986
 987 Returns the object's date and time in RFC2616 (HTTP/1.1) format,
 988 for example C<Sun, 06 Nov 1994 08:49:37 GMT>. While the RFC describes
 989 version 1.1 of HTTP, but the same form date can be used in version 1.0.
 990
 991 Format is fixed-length, locale-independent and always represented in GMT
 992 which makes it quite useless for users, but any date in HTTP transfers
 993 must be presented using this format.
 994
 995     HTTP-date = rfc1123 | ...
 996     rfc1123   = wkday "," SP date SP time SP "GMT"
 997     date      = 2DIGIT SP month SP 4DIGIT
 998                 ; day month year (e.g., 02 Jun 1982)
 999     time      = 2DIGIT ":" 2DIGIT ":" 2DIGIT
1000                 ; 00:00:00 - 23:59:59
1001     wkday     = "Mon" | "Tue" | "Wed" | "Thu" | "Fri" | "Sat" | "Sun"
1002     month     = "Jan" | "Feb" | "Mar" | "Apr" | "May" | "Jun"
1003               | "Jul" | "Aug" | "Sep" | "Oct" | "Nov" | "Dec"
1004
1005 Supports arguments: C<Date> and C<Time>, but you should use them only for
1006 some personal reasons, RFC2616 doesn't define any optional parts.
1007 See L</Output formatters> for description of arguments.
1008
1009 =cut
1010
1011 sub RFC2616 {
1012     my $self = shift;
1013     my %args = ( Date => 1, Time => 1,
1014                  @_,
1015                  Timezone => 'utc',
1016                  Seconds => 1, DayOfWeek => 1,
1017                );
1018
1019     my $res = $self->RFC2822( %args );
1020     $res =~ s/\s*[+-]\d\d\d\d$/ GMT/ if $args{'Time'};
1021     return $res;
1022 }
1023
1024 =head4 iCal
1025
1026 Returns the object's date and time in iCalendar format.
1027 If only date requested then user's timezone is used, otherwise
1028 it's UTC.
1029
1030 Supports arguments: C<Date> and C<Time>.
1031 See L</Output formatters> for description of arguments.
1032
1033 =cut
1034
1035 sub iCal {
1036     my $self = shift;
1037     my %args = (
1038         Date => 1, Time => 1,
1039         @_,
1040     );
1041
1042     my $res;
1043     if ( $args{'Date'} && !$args{'Time'} ) {
1044         my (undef, undef, undef, $mday, $mon, $year) =
1045             $self->Localtime( 'user' );
1046         $res = sprintf( '%04d%02d%02d', $year, $mon+1, $mday );
1047     } elsif ( !$args{'Date'} && $args{'Time'} ) {
1048         my ($sec, $min, $hour) =
1049             $self->Localtime( 'utc' );
1050         $res = sprintf( 'T%02d%02d%02dZ', $hour, $min, $sec );
1051     } else {
1052         my ($sec, $min, $hour, $mday, $mon, $year) =
1053             $self->Localtime( 'utc' );
1054         $res = sprintf( '%04d%02d%02dT%02d%02d%02dZ', $year, $mon+1, $mday, $hour, $min, $sec );
1055     }
1056     return $res;
1057 }
1058
1059 # it's been added by mistake in 3.8.0
1060 sub iCalDate { return (shift)->iCal( Time => 0, @_ ) }
1061
1062 sub _SplitOffset {
1063     my ($self, $offset) = @_;
1064     my $sign = $offset < 0? '-': '+';
1065     $offset = int( (abs $offset) / 60 + 0.001 );
1066     my $mins = $offset % 60;
1067     my $hours = int( $offset/60 + 0.001 );
1068     return $sign, $hours, $mins;
1069 }
1070
1071 =head2 Timezones handling
1072
1073 =head3 Localtime $context [$time]
1074
1075 Takes one mandatory argument C<$context>, which determines whether
1076 we want "user local", "system" or "UTC" time. Also, takes optional
1077 argument unix C<$time>, default value is the current unix time.
1078
1079 Returns object's date and time in the format provided by perl's
1080 builtin functions C<localtime> and C<gmtime> with two exceptions:
1081
1082 =over
1083
1084 =item 1)
1085
1086 "Year" is a four-digit year, rather than "years since 1900"
1087
1088 =item 2)
1089
1090 The last element of the array returned is C<offset>, which
1091 represents timezone offset against C<UTC> in seconds.
1092
1093 =back
1094
1095 =cut
1096
1097 sub Localtime
1098 {
1099     my $self = shift;
1100     my $tz = $self->Timezone(shift);
1101
1102     my $unix = shift || $self->Unix;
1103     $unix = 0 unless $unix >= 0;
1104
1105     my @local;
1106     if ($tz eq 'UTC') {
1107         @local = gmtime($unix);
1108     } else {
1109         {
1110             local $ENV{'TZ'} = $tz;
1111             ## Using POSIX::tzset fixes a bug where the TZ environment variable
1112             ## is cached.
1113             POSIX::tzset();
1114             @local = localtime($unix);
1115         }
1116         POSIX::tzset(); # return back previous value
1117     }
1118     $local[5] += 1900; # change year to 4+ digits format
1119     my $offset = Time::Local::timegm_nocheck(@local) - $unix;
1120     return @local, $offset;
1121 }
1122
1123 =head3 Timelocal $context @time
1124
1125 Takes argument C<$context>, which determines whether we should
1126 treat C<@time> as "user local", "system" or "UTC" time.
1127
1128 C<@time> is array returned by L</Localtime> functions. Only first
1129 six elements are mandatory - $sec, $min, $hour, $mday, $mon and $year.
1130 You may pass $wday, $yday and $isdst, these are ignored.
1131
1132 If you pass C<$offset> as ninth argument, it's used instead of
1133 C<$context>. It's done such way as code
1134 C<< $self->Timelocal('utc', $self->Localtime('server')) >> doesn't
1135 make much sense and most probably would produce unexpected
1136 results, so the method ignores 'utc' context and uses the offset
1137 returned by the L</Localtime> method.
1138
1139 =cut
1140
1141 sub Timelocal {
1142     my $self = shift;
1143     my $tz = shift;
1144     if ( defined $_[9] ) {
1145         return timegm(@_[0..5]) - $_[9];
1146     } else {
1147         $tz = $self->Timezone( $tz );
1148         if ( $tz eq 'UTC' ) {
1149             return Time::Local::timegm(@_[0..5]);
1150         } else {
1151             my $rv;
1152             {
1153                 local $ENV{'TZ'} = $tz;
1154                 ## Using POSIX::tzset fixes a bug where the TZ environment variable
1155                 ## is cached.
1156                 POSIX::tzset();
1157                 $rv = Time::Local::timelocal(@_[0..5]);
1158             };
1159             POSIX::tzset(); # switch back to previouse value
1160             return $rv;
1161         }
1162     }
1163 }
1164
1165
1166 =head3 Timezone $context
1167
1168 Returns the timezone name for the specified context.  C<$context>
1169 should be one of these values:
1170
1171 =over
1172
1173 =item C<user>
1174
1175 The current user's Timezone value will be returned.
1176
1177 =item C<server>
1178
1179 The value of the C<Timezone> RT config option will be returned.
1180
1181 =back
1182
1183 For any other value of C<$context>, or if the specified context has no
1184 defined timezone, C<UTC> is returned.
1185
1186 =cut
1187
1188 sub Timezone {
1189     my $self = shift;
1190
1191     if (@_ == 0) {
1192         Carp::carp 'RT::Date->Timezone requires a context argument';
1193         return undef;
1194     }
1195
1196     my $context = lc(shift);
1197
1198     my $tz;
1199     if( $context eq 'user' ) {
1200         $tz = $self->CurrentUser->UserObj->Timezone;
1201     } elsif( $context eq 'server') {
1202         $tz = RT->Config->Get('Timezone');
1203     } else {
1204         $tz = 'UTC';
1205     }
1206     $tz ||= RT->Config->Get('Timezone') || 'UTC';
1207     $tz = 'UTC' if lc $tz eq 'gmt';
1208     return $tz;
1209 }
1210
1211 =head3 IsSet
1212
1213 Returns true if this Date is set in the database, otherwise returns a false value.
1214
1215 This avoids needing to compare to 1970-01-01 in any of your code.
1216
1217 =cut
1218
1219 sub IsSet {
1220     my $self = shift;
1221     return $self->Unix ? 1 : 0;
1222
1223 }
1224
1225
1226 RT::Base->_ImportOverlays();
1227
1228 1;