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