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