lib/RT/Date.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2013 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 Diff
 295
 296 Takes either an C<RT::Date> object or the date in unixtime format as a string,
 297 if nothing is specified uses the current time.
 298
 299 Returns the differnce between the time in the current object and that time
 300 as a number of seconds. Returns C<undef> if any of two compared values is
 301 incorrect or not set.
 302
 303 =cut
 304
 305 sub Diff {
 306     my $self = shift;
 307     my $other = shift;
 308     $other = time unless defined $other;
 309     if ( UNIVERSAL::isa( $other, 'RT::Date' ) ) {
 310         $other = $other->Unix;
 311     }
 312     return undef unless $other=~ /^\d+$/ && $other > 0;
 313
 314     my $unix = $self->Unix;
 315     return undef unless $unix > 0;
 316
 317     return $unix - $other;
 318 }
 319
 320 =head2 DiffAsString
 321
 322 Takes either an C<RT::Date> object or the date in unixtime format as a string,
 323 if nothing is specified uses the current time.
 324
 325 Returns the differnce between C<$self> and that time as a number of seconds as
 326 a localized string fit for human consumption. Returns empty string if any of
 327 two compared values is incorrect or not set.
 328
 329 =cut
 330
 331 sub DiffAsString {
 332     my $self = shift;
 333     my $diff = $self->Diff( @_ );
 334     return '' unless defined $diff;
 335
 336     return $self->DurationAsString( $diff );
 337 }
 338
 339 =head2 DurationAsString
 340
 341 Takes a number of seconds. Returns a localized string describing
 342 that duration.
 343
 344 Takes optional named arguments:
 345
 346 =over 4
 347
 348 =item * Show
 349
 350 How many elements to show, how precise it should be. Default is 1,
 351 most vague variant.
 352
 353 =item * Short
 354
 355 Turn on short notation with one character units, for example
 356 "3M 2d 1m 10s".
 357
 358 =back
 359
 360 =cut
 361
 362 # loc("[_1]s")
 363 # loc("[_1]m")
 364 # loc("[_1]h")
 365 # loc("[_1]d")
 366 # loc("[_1]W")
 367 # loc("[_1]M")
 368 # loc("[_1]Y")
 369 # loc("[quant,_1,second]")
 370 # loc("[quant,_1,minute]")
 371 # loc("[quant,_1,hour]")
 372 # loc("[quant,_1,day]")
 373 # loc("[quant,_1,week]")
 374 # loc("[quant,_1,month]")
 375 # loc("[quant,_1,year]")
 376
 377 sub DurationAsString {
 378     my $self     = shift;
 379     my $duration = int shift;
 380     my %args = ( Show => 1, Short => 0, @_ );
 381
 382     unless ( $duration ) {
 383         return $args{Short}? $self->loc("0s") : $self->loc("0 seconds");
 384     }
 385
 386     my $negative;
 387     $negative = 1 if $duration < 0;
 388     $duration = abs $duration;
 389
 390     my %units = (
 391         s => 1,
 392         m => $MINUTE,
 393         h => $HOUR,
 394         d => $DAY,
 395         W => $WEEK,
 396         M => $MONTH,
 397         Y => $YEAR,
 398     );
 399     my %long_units = (
 400         s => 'second',
 401         m => 'minute',
 402         h => 'hour',
 403         d => 'day',
 404         W => 'week',
 405         M => 'month',
 406         Y => 'year',
 407     );
 408
 409     my @res;
 410
 411     my $coef = 2;
 412     my $i = 0;
 413     while ( $duration > 0 && ++$i <= $args{'Show'} ) {
 414
 415         my $unit;
 416         if ( $duration < $MINUTE ) {
 417             $unit = 's';
 418         }
 419         elsif ( $duration < ( $coef * $HOUR ) ) {
 420             $unit = 'm';
 421         }
 422         elsif ( $duration < ( $coef * $DAY ) ) {
 423             $unit = 'h';
 424         }
 425         elsif ( $duration < ( $coef * $WEEK ) ) {
 426             $unit = 'd';
 427         }
 428         elsif ( $duration < ( $coef * $MONTH ) ) {
 429             $unit = 'W';
 430         }
 431         elsif ( $duration < $YEAR ) {
 432             $unit = 'M';
 433         }
 434         else {
 435             $unit = 'Y';
 436         }
 437         my $value = int( $duration / $units{$unit}  + ($i < $args{'Show'}? 0 : 0.5) );
 438         $duration -= int( $value * $units{$unit} );
 439
 440         if ( $args{'Short'} ) {
 441             push @res, $self->loc("[_1]$unit", $value);
 442         } else {
 443             push @res, $self->loc("[quant,_1,$long_units{$unit}]", $value);
 444         }
 445
 446         $coef = 1;
 447     }
 448
 449     if ( $negative ) {
 450         return $self->loc( "[_1] ago", join ' ', @res );
 451     }
 452     else {
 453         return join ' ', @res;
 454     }
 455 }
 456
 457 =head2 AgeAsString
 458
 459 Takes nothing. Returns a string that's the differnce between the
 460 time in the object and now.
 461
 462 =cut
 463
 464 sub AgeAsString { return $_[0]->DiffAsString }
 465
 466
 467
 468 =head2 AsString
 469
 470 Returns the object's time as a localized string with curent user's prefered
 471 format and timezone.
 472
 473 If the current user didn't choose prefered format then system wide setting is
 474 used or L</DefaultFormat> if the latter is not specified. See config option
 475 C<DateTimeFormat>.
 476
 477 =cut
 478
 479 sub AsString {
 480     my $self = shift;
 481     my %args = (@_);
 482
 483     return $self->loc("Not set") unless $self->Unix > 0;
 484
 485     my $format = RT->Config->Get( 'DateTimeFormat', $self->CurrentUser ) || 'DefaultFormat';
 486     $format = { Format => $format } unless ref $format;
 487     %args = (%$format, %args);
 488
 489     return $self->Get( Timezone => 'user', %args );
 490 }
 491
 492 =head2 GetWeekday DAY
 493
 494 Takes an integer day of week and returns a localized string for
 495 that day of week. Valid values are from range 0-6, Note that B<0
 496 is sunday>.
 497
 498 =cut
 499
 500 sub GetWeekday {
 501     my $self = shift;
 502     my $dow = shift;
 503
 504     return $self->loc($DAYS_OF_WEEK[$dow])
 505         if $DAYS_OF_WEEK[$dow];
 506     return '';
 507 }
 508
 509 =head2 GetMonth MONTH
 510
 511 Takes an integer month and returns a localized string for that month.
 512 Valid values are from from range 0-11.
 513
 514 =cut
 515
 516 sub GetMonth {
 517     my $self = shift;
 518     my $mon = shift;
 519
 520     return $self->loc($MONTHS[$mon])
 521         if $MONTHS[$mon];
 522     return '';
 523 }
 524
 525 =head2 AddSeconds SECONDS
 526
 527 Takes a number of seconds and returns the new unix time.
 528
 529 Negative value can be used to substract seconds.
 530
 531 =cut
 532
 533 sub AddSeconds {
 534     my $self = shift;
 535     my $delta = shift or return $self->Unix;
 536
 537     $self->Set(Format => 'unix', Value => ($self->Unix + $delta));
 538
 539     return ($self->Unix);
 540 }
 541
 542 =head2 AddDays [DAYS]
 543
 544 Adds C<24 hours * DAYS> to the current time. Adds one day when
 545 no argument is specified. Negative value can be used to substract
 546 days.
 547
 548 Returns new unix time.
 549
 550 =cut
 551
 552 sub AddDays {
 553     my $self = shift;
 554     my $days = shift || 1;
 555     return $self->AddSeconds( $days * $DAY );
 556 }
 557
 558 =head2 AddDay
 559
 560 Adds 24 hours to the current time. Returns new unix time.
 561
 562 =cut
 563
 564 sub AddDay { return $_[0]->AddSeconds($DAY) }
 565
 566 =head2 Unix [unixtime]
 567
 568 Optionally takes a date in unix seconds since the epoch format.
 569 Returns the number of seconds since the epoch
 570
 571 =cut
 572
 573 sub Unix {
 574     my $self = shift;
 575     $self->{'time'} = int(shift || 0) if @_;
 576     return $self->{'time'};
 577 }
 578
 579 =head2 DateTime
 580
 581 Alias for L</Get> method. Arguments C<Date> and <Time>
 582 are fixed to true values, other arguments could be used
 583 as described in L</Get>.
 584
 585 =cut
 586
 587 sub DateTime {
 588     my $self = shift;
 589     unless (defined $self) {
 590         use Carp; Carp::confess("undefined $self");
 591     }
 592     return $self->Get( @_, Date => 1, Time => 1 );
 593 }
 594
 595 =head2 Date
 596
 597 Takes Format argument which allows you choose date formatter.
 598 Pass throught other arguments to the formatter method.
 599
 600 Returns the object's formatted date. Default formatter is ISO.
 601
 602 =cut
 603
 604 sub Date {
 605     my $self = shift;
 606     return $self->Get( @_, Date => 1, Time => 0 );
 607 }
 608
 609 =head2 Time
 610
 611
 612 =cut
 613
 614 sub Time {
 615     my $self = shift;
 616     return $self->Get( @_, Date => 0, Time => 1 );
 617 }
 618
 619 =head2 Get
 620
 621 Returnsa a formatted and localized string that represets time of
 622 the current object.
 623
 624
 625 =cut
 626
 627 sub Get
 628 {
 629     my $self = shift;
 630     my %args = (Format => 'ISO', @_);
 631     my $formatter = $args{'Format'};
 632     unless ( $self->ValidFormatter($formatter) ) {
 633         RT->Logger->warning("Invalid date formatter '$formatter', falling back to ISO");
 634         $formatter = 'ISO';
 635     }
 636     $formatter = 'ISO' unless $self->can($formatter);
 637     return $self->$formatter( %args );
 638 }
 639
 640 =head2 Output formatters
 641
 642 Fomatter is a method that returns date and time in different configurable
 643 format.
 644
 645 Each method takes several arguments:
 646
 647 =over 1
 648
 649 =item Date
 650
 651 =item Time
 652
 653 =item Timezone - Timezone context C<server>, C<user> or C<UTC>
 654
 655 =back
 656
 657 Formatters may also add own arguments to the list, for example
 658 in RFC2822 format day of time in output is optional so it
 659 understand boolean argument C<DayOfTime>.
 660
 661 =head3 Formatters
 662
 663 Returns an array of available formatters.
 664
 665 =cut
 666
 667 sub Formatters
 668 {
 669     my $self = shift;
 670
 671     return @FORMATTERS;
 672 }
 673
 674 =head3 ValidFormatter FORMAT
 675
 676 Returns a true value if C<FORMAT> is a known formatter.  Otherwise returns
 677 false.
 678
 679 =cut
 680
 681 sub ValidFormatter {
 682     my $self   = shift;
 683     my $format = shift;
 684     return (grep { $_ eq $format } $self->Formatters and $self->can($format))
 685                 ? 1 : 0;
 686 }
 687
 688 =head3 DefaultFormat
 689
 690 =cut
 691
 692 sub DefaultFormat
 693 {
 694     my $self = shift;
 695     my %args = ( Date => 1,
 696                  Time => 1,
 697                  Timezone => '',
 698                  Seconds => 1,
 699                  @_,
 700                );
 701
 702        #  0    1    2     3     4    5     6     7      8      9
 703     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 704                             $self->Localtime($args{'Timezone'});
 705     $wday = $self->GetWeekday($wday);
 706     $mon = $self->GetMonth($mon);
 707     $_ = sprintf "%02d", $_ foreach $mday, $hour, $min, $sec;
 708
 709     if( $args{'Date'} && !$args{'Time'} ) {
 710         return $self->loc('[_1] [_2] [_3] [_4]',
 711                           $wday,$mon,$mday,$year);
 712     } elsif( !$args{'Date'} && $args{'Time'} ) {
 713         if( $args{'Seconds'} ) {
 714             return $self->loc('[_1]:[_2]:[_3]',
 715                               $hour,$min,$sec);
 716         } else {
 717             return $self->loc('[_1]:[_2]',
 718                               $hour,$min);
 719         }
 720     } else {
 721         if( $args{'Seconds'} ) {
 722             return $self->loc('[_1] [_2] [_3] [_4]:[_5]:[_6] [_7]',
 723                               $wday,$mon,$mday,$hour,$min,$sec,$year);
 724         } else {
 725             return $self->loc('[_1] [_2] [_3] [_4]:[_5] [_6]',
 726                               $wday,$mon,$mday,$hour,$min,$year);
 727         }
 728     }
 729 }
 730
 731 =head2 LocaleObj
 732
 733 Returns the L<DateTime::Locale> object representing the current user's locale.
 734
 735 =cut
 736
 737 sub LocaleObj {
 738     my $self = shift;
 739
 740     my $lang = $self->CurrentUser->UserObj->Lang;
 741     unless ($lang) {
 742         require I18N::LangTags::Detect;
 743         $lang = ( I18N::LangTags::Detect::detect(), 'en' )[0];
 744     }
 745
 746     return DateTime::Locale->load($lang);
 747 }
 748
 749 =head3 LocalizedDateTime
 750
 751 Returns date and time as string, with user localization.
 752
 753 Supports arguments: C<DateFormat> and C<TimeFormat> which may contains date and
 754 time format as specified in L<DateTime::Locale> (default to C<date_format_full> and
 755 C<time_format_medium>), C<AbbrDay> and C<AbbrMonth> which may be set to 0 if
 756 you want full Day/Month names instead of abbreviated ones.
 757
 758 =cut
 759
 760 sub LocalizedDateTime
 761 {
 762     my $self = shift;
 763     my %args = ( Date => 1,
 764                  Time => 1,
 765                  Timezone => '',
 766                  DateFormat => '',
 767                  TimeFormat => '',
 768                  AbbrDay => 1,
 769                  AbbrMonth => 1,
 770                  @_,
 771                );
 772
 773     # Require valid names for the format methods
 774     my $date_format = $args{DateFormat} =~ /^\w+$/
 775                     ? $args{DateFormat} : 'date_format_full';
 776
 777     my $time_format = $args{TimeFormat} =~ /^\w+$/
 778                     ? $args{TimeFormat} : 'time_format_medium';
 779
 780     my $formatter = $self->LocaleObj;
 781     $date_format = $formatter->$date_format;
 782     $time_format = $formatter->$time_format;
 783     $date_format =~ s/EEEE/EEE/g if ( $args{'AbbrDay'} );
 784     $date_format =~ s/MMMM/MMM/g if ( $args{'AbbrMonth'} );
 785
 786     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 787                             $self->Localtime($args{'Timezone'});
 788     $mon++;
 789     my $tz = $self->Timezone($args{'Timezone'});
 790
 791     # FIXME : another way to call this module without conflict with local
 792     # DateTime method?
 793     my $dt = DateTime::->new( locale => $formatter,
 794                             time_zone => $tz,
 795                             year => $year,
 796                             month => $mon,
 797                             day => $mday,
 798                             hour => $hour,
 799                             minute => $min,
 800                             second => $sec,
 801                             nanosecond => 0,
 802                           );
 803
 804     if ( $args{'Date'} && !$args{'Time'} ) {
 805         return $dt->format_cldr($date_format);
 806     } elsif ( !$args{'Date'} && $args{'Time'} ) {
 807         return $dt->format_cldr($time_format);
 808     } else {
 809         return $dt->format_cldr($date_format) . " " . $dt->format_cldr($time_format);
 810     }
 811 }
 812
 813 =head3 ISO
 814
 815 Returns the object's date in ISO format C<YYYY-MM-DD mm:hh:ss>.
 816 ISO format is locale independant, but adding timezone offset info
 817 is not implemented yet.
 818
 819 Supports arguments: C<Timezone>, C<Date>, C<Time> and C<Seconds>.
 820 See </Output formatters> for description of arguments.
 821
 822 =cut
 823
 824 sub ISO {
 825     my $self = shift;
 826     my %args = ( Date => 1,
 827                  Time => 1,
 828                  Timezone => '',
 829                  Seconds => 1,
 830                  @_,
 831                );
 832        #  0    1    2     3     4    5     6     7      8      9
 833     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 834                             $self->Localtime($args{'Timezone'});
 835
 836     #the month needs incrementing, as gmtime returns 0-11
 837     $mon++;
 838
 839     my $res = '';
 840     $res .= sprintf("%04d-%02d-%02d", $year, $mon, $mday) if $args{'Date'};
 841     $res .= sprintf(' %02d:%02d', $hour, $min) if $args{'Time'};
 842     $res .= sprintf(':%02d', $sec, $min) if $args{'Time'} && $args{'Seconds'};
 843     $res =~ s/^\s+//;
 844
 845     return $res;
 846 }
 847
 848 =head3 W3CDTF
 849
 850 Returns the object's date and time in W3C date time format
 851 (L<http://www.w3.org/TR/NOTE-datetime>).
 852
 853 Format is locale independand and is close enought to ISO, but
 854 note that date part is B<not optional> and output string
 855 has timezone offset mark in C<[+-]hh:mm> format.
 856
 857 Supports arguments: C<Timezone>, C<Time> and C<Seconds>.
 858 See </Output formatters> for description of arguments.
 859
 860 =cut
 861
 862 sub W3CDTF {
 863     my $self = shift;
 864     my %args = (
 865         Time => 1,
 866         Timezone => '',
 867         Seconds => 1,
 868         @_,
 869         Date => 1,
 870     );
 871        #  0    1    2     3     4    5     6     7      8      9
 872     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 873                             $self->Localtime( $args{'Timezone'} );
 874
 875     #the month needs incrementing, as gmtime returns 0-11
 876     $mon++;
 877
 878     my $res = '';
 879     $res .= sprintf("%04d-%02d-%02d", $year, $mon, $mday);
 880     if ( $args{'Time'} ) {
 881         $res .= sprintf('T%02d:%02d', $hour, $min);
 882         $res .= sprintf(':%02d', $sec, $min) if $args{'Seconds'};
 883         if ( $offset ) {
 884             $res .= sprintf "%s%02d:%02d", $self->_SplitOffset( $offset );
 885         } else {
 886             $res .= 'Z';
 887         }
 888     }
 889
 890     return $res;
 891 };
 892
 893
 894 =head3 RFC2822 (MIME)
 895
 896 Returns the object's date and time in RFC2822 format,
 897 for example C<Sun, 06 Nov 1994 08:49:37 +0000>.
 898 Format is locale independand as required by RFC. Time
 899 part always has timezone offset in digits with sign prefix.
 900
 901 Supports arguments: C<Timezone>, C<Date>, C<Time>, C<DayOfWeek>
 902 and C<Seconds>. See </Output formatters> for description of
 903 arguments.
 904
 905 =cut
 906
 907 sub RFC2822 {
 908     my $self = shift;
 909     my %args = ( Date => 1,
 910                  Time => 1,
 911                  Timezone => '',
 912                  DayOfWeek => 1,
 913                  Seconds => 1,
 914                  @_,
 915                );
 916
 917        #  0    1    2     3     4    5     6     7      8     9
 918     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 919                             $self->Localtime($args{'Timezone'});
 920
 921     my ($date, $time) = ('','');
 922     $date .= "$DAYS_OF_WEEK[$wday], " if $args{'DayOfWeek'} && $args{'Date'};
 923     $date .= "$mday $MONTHS[$mon] $year" if $args{'Date'};
 924
 925     if ( $args{'Time'} ) {
 926         $time .= sprintf("%02d:%02d", $hour, $min);
 927         $time .= sprintf(":%02d", $sec) if $args{'Seconds'};
 928         $time .= sprintf " %s%02d%02d", $self->_SplitOffset( $offset );
 929     }
 930
 931     return join ' ', grep $_, ($date, $time);
 932 }
 933
 934 =head3 RFC2616 (HTTP)
 935
 936 Returns the object's date and time in RFC2616 (HTTP/1.1) format,
 937 for example C<Sun, 06 Nov 1994 08:49:37 GMT>. While the RFC describes
 938 version 1.1 of HTTP, but the same form date can be used in version 1.0.
 939
 940 Format is fixed length, locale independand and always represented in GMT
 941 what makes it quite useless for users, but any date in HTTP transfers
 942 must be presented using this format.
 943
 944     HTTP-date = rfc1123 | ...
 945     rfc1123   = wkday "," SP date SP time SP "GMT"
 946     date      = 2DIGIT SP month SP 4DIGIT
 947                 ; day month year (e.g., 02 Jun 1982)
 948     time      = 2DIGIT ":" 2DIGIT ":" 2DIGIT
 949                 ; 00:00:00 - 23:59:59
 950     wkday     = "Mon" | "Tue" | "Wed" | "Thu" | "Fri" | "Sat" | "Sun"
 951     month     = "Jan" | "Feb" | "Mar" | "Apr" | "May" | "Jun"
 952               | "Jul" | "Aug" | "Sep" | "Oct" | "Nov" | "Dec"
 953
 954 Supports arguments: C<Date> and C<Time>, but you should use them only for
 955 some personal reasons, RFC2616 doesn't define any optional parts.
 956 See </Output formatters> for description of arguments.
 957
 958 =cut
 959
 960 sub RFC2616 {
 961     my $self = shift;
 962     my %args = ( Date => 1, Time => 1,
 963                  @_,
 964                  Timezone => 'utc',
 965                  Seconds => 1, DayOfWeek => 1,
 966                );
 967
 968     my $res = $self->RFC2822( %args );
 969     $res =~ s/\s*[+-]\d\d\d\d$/ GMT/ if $args{'Time'};
 970     return $res;
 971 }
 972
 973 =head4 iCal
 974
 975 Returns the object's date and time in iCalendar format.
 976 If only date requested then users timezone is used, otherwise
 977 it's UTC.
 978
 979 Supports arguments: C<Date> and C<Time>.
 980 See </Output formatters> for description of arguments.
 981
 982 =cut
 983
 984 sub iCal {
 985     my $self = shift;
 986     my %args = (
 987         Date => 1, Time => 1,
 988         @_,
 989     );
 990
 991     my $tz;
 992     if ( $args{'Date'} && !$args{'Time'} ) {
 993         $tz = 'user';
 994     } else {
 995         $tz = 'utc';
 996     }
 997
 998     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) =
 999         $self->Localtime( $tz );
1000
1001     #the month needs incrementing, as gmtime returns 0-11
1002     $mon++;
1003
1004     my $res;
1005     if ( $args{'Date'} && !$args{'Time'} ) {
1006         $res = sprintf( '%04d%02d%02d', $year, $mon, $mday );
1007     }
1008     elsif ( !$args{'Date'} && $args{'Time'} ) {
1009         $res = sprintf( 'T%02d%02d%02dZ', $hour, $min, $sec );
1010     }
1011     else {
1012         $res = sprintf( '%04d%02d%02dT%02d%02d%02dZ', $year, $mon, $mday, $hour, $min, $sec );
1013     }
1014     return $res;
1015 }
1016
1017 # it's been added by mistake in 3.8.0
1018 sub iCalDate { return (shift)->iCal( Time => 0, @_ ) }
1019
1020 sub _SplitOffset {
1021     my ($self, $offset) = @_;
1022     my $sign = $offset < 0? '-': '+';
1023     $offset = int( (abs $offset) / 60 + 0.001 );
1024     my $mins = $offset % 60;
1025     my $hours = int( $offset/60 + 0.001 );
1026     return $sign, $hours, $mins;
1027 }
1028
1029 =head2 Timezones handling
1030
1031 =head3 Localtime $context [$time]
1032
1033 Takes one mandatory argument C<$context>, which determines whether
1034 we want "user local", "system" or "UTC" time. Also, takes optional
1035 argument unix C<$time>, default value is the current unix time.
1036
1037 Returns object's date and time in the format provided by perl's
1038 builtin functions C<localtime> and C<gmtime> with two exceptions:
1039
1040 1) "Year" is a four-digit year, rather than "years since 1900"
1041
1042 2) The last element of the array returned is C<offset>, which
1043 represents timezone offset against C<UTC> in seconds.
1044
1045 =cut
1046
1047 sub Localtime
1048 {
1049     my $self = shift;
1050     my $tz = $self->Timezone(shift);
1051
1052     my $unix = shift || $self->Unix;
1053     $unix = 0 unless $unix >= 0;
1054
1055     my @local;
1056     if ($tz eq 'UTC') {
1057         @local = gmtime($unix);
1058     } else {
1059         {
1060             local $ENV{'TZ'} = $tz;
1061             ## Using POSIX::tzset fixes a bug where the TZ environment variable
1062             ## is cached.
1063             POSIX::tzset();
1064             @local = localtime($unix);
1065         }
1066         POSIX::tzset(); # return back previouse value
1067     }
1068     $local[5] += 1900; # change year to 4+ digits format
1069     my $offset = Time::Local::timegm_nocheck(@local) - $unix;
1070     return @local, $offset;
1071 }
1072
1073 =head3 Timelocal $context @time
1074
1075 Takes argument C<$context>, which determines whether we should
1076 treat C<@time> as "user local", "system" or "UTC" time.
1077
1078 C<@time> is array returned by L<Localtime> functions. Only first
1079 six elements are mandatory - $sec, $min, $hour, $mday, $mon and $year.
1080 You may pass $wday, $yday and $isdst, these are ignored.
1081
1082 If you pass C<$offset> as ninth argument, it's used instead of
1083 C<$context>. It's done such way as code
1084 C<$self->Timelocal('utc', $self->Localtime('server'))> doesn't
1085 makes much sense and most probably would produce unexpected
1086 result, so the method ignore 'utc' context and uses offset
1087 returned by L<Localtime> method.
1088
1089 =cut
1090
1091 sub Timelocal {
1092     my $self = shift;
1093     my $tz = shift;
1094     if ( defined $_[9] ) {
1095         return timegm(@_[0..5]) - $_[9];
1096     } else {
1097         $tz = $self->Timezone( $tz );
1098         if ( $tz eq 'UTC' ) {
1099             return Time::Local::timegm(@_[0..5]);
1100         } else {
1101             my $rv;
1102             {
1103                 local $ENV{'TZ'} = $tz;
1104                 ## Using POSIX::tzset fixes a bug where the TZ environment variable
1105                 ## is cached.
1106                 POSIX::tzset();
1107                 $rv = Time::Local::timelocal(@_[0..5]);
1108             };
1109             POSIX::tzset(); # switch back to previouse value
1110             return $rv;
1111         }
1112     }
1113 }
1114
1115
1116 =head3 Timezone $context
1117
1118 Returns the timezone name.
1119
1120 Takes one argument, C<$context> argument which could be C<user>, C<server> or C<utc>.
1121
1122 =over
1123
1124 =item user
1125
1126 Default value is C<user> that mean it returns current user's Timezone value.
1127
1128 =item server
1129
1130 If context is C<server> it returns value of the C<Timezone> RT config option.
1131
1132 =item  utc
1133
1134 If both server's and user's timezone names are undefined returns 'UTC'.
1135
1136 =back
1137
1138 =cut
1139
1140 sub Timezone {
1141     my $self = shift;
1142
1143     if (@_ == 0) {
1144         Carp::carp "RT::Date->Timezone is a setter only";
1145         return undef;
1146     }
1147
1148     my $context = lc(shift);
1149
1150     my $tz;
1151     if( $context eq 'user' ) {
1152         $tz = $self->CurrentUser->UserObj->Timezone;
1153     } elsif( $context eq 'server') {
1154         $tz = RT->Config->Get('Timezone');
1155     } else {
1156         $tz = 'UTC';
1157     }
1158     $tz ||= RT->Config->Get('Timezone') || 'UTC';
1159     $tz = 'UTC' if lc $tz eq 'gmt';
1160     return $tz;
1161 }
1162
1163
1164 RT::Base->_ImportOverlays();
1165
1166 1;