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