Upgrade to 4.2.2
[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 # 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 .= sprintf("%02d %s %04d", $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 $res;
992     if ( $args{'Date'} && !$args{'Time'} ) {
993         my (undef, undef, undef, $mday, $mon, $year) =
994             $self->Localtime( 'user' );
995         $res = sprintf( '%04d%02d%02d', $year, $mon+1, $mday );
996     } elsif ( !$args{'Date'} && $args{'Time'} ) {
997         my ($sec, $min, $hour) =
998             $self->Localtime( 'utc' );
999         $res = sprintf( 'T%02d%02d%02dZ', $hour, $min, $sec );
1000     } else {
1001         my ($sec, $min, $hour, $mday, $mon, $year) =
1002             $self->Localtime( 'utc' );
1003         $res = sprintf( '%04d%02d%02dT%02d%02d%02dZ', $year, $mon+1, $mday, $hour, $min, $sec );
1004     }
1005     return $res;
1006 }
1007
1008 # it's been added by mistake in 3.8.0
1009 sub iCalDate { return (shift)->iCal( Time => 0, @_ ) }
1010
1011 sub _SplitOffset {
1012     my ($self, $offset) = @_;
1013     my $sign = $offset < 0? '-': '+';
1014     $offset = int( (abs $offset) / 60 + 0.001 );
1015     my $mins = $offset % 60;
1016     my $hours = int( $offset/60 + 0.001 );
1017     return $sign, $hours, $mins; 
1018 }
1019
1020 =head2 Timezones handling
1021
1022 =head3 Localtime $context [$time]
1023
1024 Takes one mandatory argument C<$context>, which determines whether
1025 we want "user local", "system" or "UTC" time. Also, takes optional
1026 argument unix C<$time>, default value is the current unix time.
1027
1028 Returns object's date and time in the format provided by perl's
1029 builtin functions C<localtime> and C<gmtime> with two exceptions:
1030
1031 1) "Year" is a four-digit year, rather than "years since 1900"
1032
1033 2) The last element of the array returned is C<offset>, which
1034 represents timezone offset against C<UTC> in seconds.
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 previouse 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 makes much sense and most probably would produce unexpected
1077 result, so the method ignore 'utc' context and uses offset
1078 returned by 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.
1110
1111 Takes one argument, C<$context> argument which could be C<user>, C<server> or C<utc>.
1112
1113 =over
1114
1115 =item user
1116
1117 Default value is C<user> that mean it returns current user's Timezone value.
1118
1119 =item server
1120
1121 If context is C<server> it returns value of the C<Timezone> RT config option.
1122
1123 =item  utc
1124
1125 If both server's and user's timezone names are undefined returns 'UTC'.
1126
1127 =back
1128
1129 =cut
1130
1131 sub Timezone {
1132     my $self = shift;
1133
1134     if (@_ == 0) {
1135         Carp::carp "RT::Date->Timezone is a setter only";
1136         return undef;
1137     }
1138
1139     my $context = lc(shift);
1140
1141     my $tz;
1142     if( $context eq 'user' ) {
1143         $tz = $self->CurrentUser->UserObj->Timezone;
1144     } elsif( $context eq 'server') {
1145         $tz = RT->Config->Get('Timezone');
1146     } else {
1147         $tz = 'UTC';
1148     }
1149     $tz ||= RT->Config->Get('Timezone') || 'UTC';
1150     $tz = 'UTC' if lc $tz eq 'gmt';
1151     return $tz;
1152 }
1153
1154
1155 RT::Base->_ImportOverlays();
1156
1157 1;