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