← Back to branch summary

~kosova/+junk/tuxfamily-twiki

« back to all changes in this revision

Viewing changes to foswiki/lib/Foswiki/Time.pm

  • Committer: James Michael DuPont
  • Date: 2009-07-18 19:58:49 UTC
  • Revision ID: jamesmikedupont@gmail.com-20090718195849-vgbmaht2ys791uo2
added foswiki

Show diffs side-by-side

added added

removed removed

Lines of Context:
foswiki/lib/Foswiki/Time.pm
 
1
# See bottom of file for license and copyright information
 
2
 
 
3
=begin TML
 
4
 
 
5
---+ package Foswiki::Time
 
6
 
 
7
Time handling functions.
 
8
 
 
9
API version $Date: 2009-06-04 10:27:07 +0200 (Thu, 04 Jun 2009) $ (revision $Rev: 4272 (2009-06-21) $)
 
10
 
 
11
*Since* _date_ indicates where functions or parameters have been added since
 
12
the baseline of the API (TWiki release 4.2.3). The _date_ indicates the
 
13
earliest date of a Foswiki release that will support that function or
 
14
parameter.
 
15
 
 
16
*Deprecated* _date_ indicates where a function or parameters has been
 
17
[[http://en.wikipedia.org/wiki/Deprecation][deprecated]]. Deprecated
 
18
functions will still work, though they should
 
19
_not_ be called in new plugins and should be replaced in older plugins
 
20
as soon as possible. Deprecated parameters are simply ignored in Foswiki
 
21
releases after _date_.
 
22
 
 
23
*Until* _date_ indicates where a function or parameter has been removed.
 
24
The _date_ indicates the latest date at which Foswiki releases still supported
 
25
the function or parameter.
 
26
 
 
27
=cut
 
28
 
 
29
# THIS PACKAGE IS PART OF THE PUBLISHED API USED BY EXTENSION AUTHORS.
 
30
# DO NOT CHANGE THE EXISTING APIS (well thought out extensions are OK)
 
31
# AND ENSURE ALL POD DOCUMENTATION IS COMPLETE AND ACCURATE.
 
32
 
 
33
package Foswiki::Time;
 
34
 
 
35
use strict;
 
36
 
 
37
require Foswiki;
 
38
 
 
39
our $VERSION = '$Rev: 4272 (2009-06-21) $'; # Subversion rev number
 
40
 
 
41
# Constants
 
42
our @ISOMONTH = (
 
43
    'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
 
44
    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'
 
45
);
 
46
 
 
47
# SMELL: does not account for leap years
 
48
our @MONTHLENS = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
 
49
 
 
50
our @WEEKDAY = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun' );
 
51
 
 
52
our %MON2NUM = (
 
53
    jan => 0,
 
54
    feb => 1,
 
55
    mar => 2,
 
56
    apr => 3,
 
57
    may => 4,
 
58
    jun => 5,
 
59
    jul => 6,
 
60
    aug => 7,
 
61
    sep => 8,
 
62
    oct => 9,
 
63
    nov => 10,
 
64
    dec => 11
 
65
);
 
66
 
 
67
our $TZSTRING; # timezone string for servertime; "Z" or "+01:00" etc.
 
68
 
 
69
=begin TML
 
70
 
 
71
---++ StaticMethod parseTime( $szDate, $defaultLocal ) -> $iSecs
 
72
 
 
73
Convert string date/time string to seconds since epoch (1970-01-01T00:00:00Z).
 
74
   * =$sDate= - date/time string
 
75
 
 
76
Handles the following formats:
 
77
 
 
78
Default Foswiki format
 
79
   * 31 Dec 2001 - 23:59
 
80
 
 
81
Foswiki format without time (defaults to 00:00)
 
82
   * 31 Dec 2001
 
83
 
 
84
Date separated by '/', '.' or '-', time with '.' or ':'
 
85
Date and time separated by ' ', '.' and/or '-'
 
86
   * 2001/12/31 23:59:59
 
87
   * 2001.12.31.23.59.59
 
88
   * 2001/12/31 23:59
 
89
   * 2001.12.31.23.59
 
90
   * 2001-12-31 23:59
 
91
   * 2001-12-31 - 23:59
 
92
   * 2009-1-12
 
93
   * 2009-1
 
94
   * 2009
 
95
 
 
96
ISO format
 
97
   * 2001-12-31T23:59:59
 
98
   * 2001-12-31T
 
99
 
 
100
ISO dates may have a timezone specifier, either Z or a signed difference
 
101
in hh:mm format. For example:
 
102
   * 2001-12-31T23:59:59+01:00
 
103
   * 2001-12-31T23:59Z
 
104
The default timezone is Z, unless $defaultLocal is true in which case
 
105
the local timezone will be assumed.
 
106
 
 
107
If the date format was not recognised, will return 0.
 
108
 
 
109
=cut
 
110
 
 
111
sub parseTime {
 
112
    my ( $date, $defaultLocal ) = @_;
 
113
 
 
114
    $date =~ s/^\s*//;  #remove leading spaces without de-tainting.
 
115
    $date =~ s/\s*$//;
 
116
 
 
117
    require Time::Local;
 
118
 
 
119
    # NOTE: This routine *will break* if input is not one of below formats!
 
120
    my $tzadj = 0;    # Zulu
 
121
    if ($defaultLocal) {
 
122
 
 
123
        # Local time at midnight on the epoch gives us minus the
 
124
        # local difference. e.g. CST is GMT + 1, so midnight Jan 1 1970 CST
 
125
        # is -01:00Z
 
126
        $tzadj = -Time::Local::timelocal( 0, 0, 0, 1, 0, 70 );
 
127
    }
 
128
 
 
129
    # try "31 Dec 2001 - 23:59"  (Foswiki date)
 
130
    # or "31 Dec 2001"
 
131
    #TODO: allow /.: too
 
132
    if ( $date =~ /(\d+)\s+([a-z]{3})\s+(\d+)(?:[-\s]+(\d+):(\d+))?/i ) {
 
133
        my $year = $3;
 
134
        $year -= 1900 if ( $year > 1900 );
 
135
        #TODO: %MON2NUM needs to be updated to use i8n
 
136
        #TODO: and should really work for long form of the month name too.
 
137
        return Time::Local::timegm( 0, $5 || 0, $4 || 0, $1, $MON2NUM{ lc($2) },
 
138
            $year ) - $tzadj;
 
139
    }
 
140
 
 
141
    # ISO date 2001-12-31T23:59:59+01:00
 
142
    # Sven is going to presume that _all_ ISO dated must have a 'T' in them.
 
143
    if (($date =~ /T/) && ( $date =~
 
144
/(\d\d\d\d)(?:-(\d\d)(?:-(\d\d))?)?(?:T(\d\d)(?::(\d\d)(?::(\d\d(?:\.\d+)?))?)?)?(Z|[-+]\d\d(?::\d\d)?)?/
 
145
      ) )
 
146
    {
 
147
        my ( $Y, $M, $D, $h, $m, $s, $tz ) =
 
148
          ( $1, $2 || 1, $3 || 1, $4 || 0, $5 || 0, $6 || 0, $7 || '' );
 
149
        $M--;
 
150
        $Y -= 1900 if ( $Y > 1900 );
 
151
        if ( $tz eq 'Z' ) {
 
152
            $tzadj = 0;    # Zulu
 
153
        }
 
154
        elsif ( $tz =~ /([-+])(\d\d)(?::(\d\d))?/ ) {
 
155
            $tzadj = ( $1 || '' ) . ( ( ( $2 * 60 ) + ( $3 || 0 ) ) * 60 );
 
156
            $tzadj -= 0;
 
157
        }
 
158
        return Time::Local::timegm( $s, $m, $h, $D, $M, $Y ) - $tzadj;
 
159
    }
 
160
 
 
161
    #any date that leads with a year (2 digit years too)
 
162
    if ($date =~ m|^
 
163
                    (\d\d+)                                 #year
 
164
                    (?:\s*[/\s.-]\s*                        #datesep
 
165
                        (\d\d?)                             #month
 
166
                        (?:\s*[/\s.-]\s*                    #datesep
 
167
                            (\d\d?)                         #day
 
168
                            (?:\s*[/\s.-]\s*                #datetimesep
 
169
                                (\d\d?)                     #hour
 
170
                                (?:\s*[:.]\s*               #timesep
 
171
                                    (\d\d?)                 #min
 
172
                                    (?:\s*[:.]\s*           #timesep
 
173
                                        (\d\d?)
 
174
                                    )?
 
175
                                )?
 
176
                            )?
 
177
                        )?
 
178
                    )?
 
179
                    $|x) {
 
180
        #no defaulting yet so we can detect the 2009--12 error
 
181
        my ( $year, $M, $D, $h, $m, $s ) =
 
182
          ( $1, $2 , $3, $4, $5, $6 );
 
183
 
 
184
        #without range checking on the 12 Jan 2009 case above, there is abmiguity - what is 14 Jan 12 ?
 
185
        #similarly, how would you decide what Jan 02 and 02 Jan are?
 
186
        #$month_p = $MON2NUM{ lc($month_p) } if (defined($MON2NUM{ lc($month_p) }));
 
187
 
 
188
        #TODO: unhappily, this means 09 == 1909 not 2009
 
189
        $year -= 1900 if ( $year > 1900 );
 
190
 
 
191
        #range checks
 
192
        return 0 if (defined($M) && ($M < 1 || $M > 12));
 
193
        my $month = ($M || 1)-1;
 
194
        return 0 if (defined($D) && ($D < 0 || $D > $MONTHLENS[$month]));
 
195
        return 0 if (defined($h) && ($h < 0 || $h > 24));
 
196
        return 0 if (defined($m) && ($m < 0 || $m > 60));
 
197
        return 0 if (defined($s) && ($s < 0 || $s > 60));
 
198
        return 0 if ( defined($year) && $year < 60 ); 
 
199
 
 
200
        my $day = $D || 1;
 
201
        my $hour = $h || 0;
 
202
        my $min = $m || 0;
 
203
        my $sec = $s || 0;
 
204
 
 
205
        return Time::Local::timegm( $sec, $min, $hour, $day, $month, $year ) - $tzadj;
 
206
    }
 
207
 
 
208
    #TODO: returning  0 makes it very hard to detect parse errors :(
 
209
    # give up, return start of epoch (01 Jan 1970 GMT)
 
210
    return 0;
 
211
}
 
212
 
 
213
=begin TML
 
214
 
 
215
---++ StaticMethod formatTime ($epochSeconds, $formatString, $outputTimeZone) -> $value
 
216
 
 
217
   * =$epochSeconds= epochSecs GMT
 
218
   * =$formatString= twiki time date format, default =$day $month $year - $hour:$min=
 
219
   * =$outputTimeZone= timezone to display, =gmtime= or =servertime=, default is whatever is set in $Foswiki::cfg{DisplayTimeValues}
 
220
 
 
221
=$formatString= supports:
 
222
   | $seconds | secs |
 
223
   | $minutes | mins |
 
224
   | $hours | hours |
 
225
   | $day | date |
 
226
   | $wday | weekday name |
 
227
   | $dow | day number (0 = Sunday) |
 
228
   | $week | week number (ISO 8601) |
 
229
   | $month | month name |
 
230
   | $mo | month number |
 
231
   | $year | 4-digit year |
 
232
   | $ye | 2-digit year |
 
233
   | $http | ful HTTP header format date/time |
 
234
   | $email | full email format date/time |
 
235
   | $rcs | full RCS format date/time |
 
236
   | $epoch | seconds since 1st January 1970 |
 
237
   | $tz | Timezone name (GMT or Local) |
 
238
   | $isotz | ISO 8601 timezone specifier e.g. 'Z, '+07:15' |
 
239
 
 
240
=cut
 
241
 
 
242
# previous known as Foswiki::formatTime
 
243
 
 
244
sub formatTime {
 
245
    my ( $epochSeconds, $formatString, $outputTimeZone ) = @_;
 
246
    my $value = $epochSeconds;
 
247
 
 
248
    # use default Foswiki format "31 Dec 1999 - 23:59" unless specified
 
249
    $formatString   ||= $Foswiki::cfg{DefaultDateFormat} . ' - $hour:$min';
 
250
    $outputTimeZone ||= $Foswiki::cfg{DisplayTimeValues};
 
251
 
 
252
    if ( $formatString =~ /http|email/i ) {
 
253
        $outputTimeZone = 'gmtime';
 
254
    }
 
255
 
 
256
    my ( $sec, $min, $hour, $day, $mon, $year, $wday, $yday );
 
257
    if ( $outputTimeZone eq 'servertime' ) {
 
258
        ( $sec, $min, $hour, $day, $mon, $year, $wday, $yday ) =
 
259
          localtime($epochSeconds);
 
260
    }
 
261
    else {
 
262
        ( $sec, $min, $hour, $day, $mon, $year, $wday, $yday ) =
 
263
          gmtime($epochSeconds);
 
264
    }
 
265
 
 
266
    #standard twiki date time formats
 
267
    if ( $formatString =~ /rcs/i ) {
 
268
 
 
269
        # RCS format, example: "2001/12/31 23:59:59"
 
270
        $formatString = '$year/$mo/$day $hour:$min:$sec';
 
271
    }
 
272
    elsif ( $formatString =~ /http|email/i ) {
 
273
 
 
274
        # HTTP and email header format, e.g. "Thu, 23 Jul 1998 07:21:56 EST"
 
275
        # RFC 822/2616/1123
 
276
        $formatString = '$wday, $day $month $year $hour:$min:$sec $tz';
 
277
    }
 
278
    elsif ( $formatString =~ /iso/i ) {
 
279
 
 
280
        # ISO Format, see spec at http://www.w3.org/TR/NOTE-datetime
 
281
        # e.g. "2002-12-31T19:30:12Z"
 
282
        $formatString = '$year-$mo-$dayT$hour:$min:$sec$isotz';
 
283
    }
 
284
 
 
285
    $value = $formatString;
 
286
    $value =~ s/\$seco?n?d?s?/sprintf('%.2u',$sec)/gei;
 
287
    $value =~ s/\$minu?t?e?s?/sprintf('%.2u',$min)/gei;
 
288
    $value =~ s/\$hour?s?/sprintf('%.2u',$hour)/gei;
 
289
    $value =~ s/\$day/sprintf('%.2u',$day)/gei;
 
290
    $value =~ s/\$wday/$WEEKDAY[$wday]/gi;
 
291
    $value =~ s/\$dow/$wday/gi;
 
292
    $value =~ s/\$week/_weekNumber($wday, $yday, $year + 1900)/egi;
 
293
    $value =~ s/\$mont?h?/$ISOMONTH[$mon]/gi;
 
294
    $value =~ s/\$mo/sprintf('%.2u',$mon+1)/gei;
 
295
    $value =~ s/\$year?/sprintf('%.4u',$year + 1900)/gei;
 
296
    $value =~ s/\$ye/sprintf('%.2u',$year%100)/gei;
 
297
    $value =~ s/\$epoch/$epochSeconds/gi;
 
298
 
 
299
    if ($value =~ /\$tz/) {
 
300
        my $tz_str;
 
301
        if ( $outputTimeZone eq 'servertime' ) {
 
302
            ( $sec, $min, $hour, $day, $mon, $year, $wday ) =
 
303
              localtime($epochSeconds);
 
304
            # SMELL: how do we get the different timezone strings (and when
 
305
            # we add usertime, then what?)
 
306
            $tz_str = 'Local';
 
307
        }
 
308
        else {
 
309
            ( $sec, $min, $hour, $day, $mon, $year, $wday ) =
 
310
              gmtime($epochSeconds);
 
311
            $tz_str = 'GMT';
 
312
        }
 
313
        $value =~ s/\$tz/$tz_str/gei;
 
314
    }
 
315
    if ($value =~ /\$isotz/) {
 
316
        my $tz_str = 'Z';
 
317
        if ( $outputTimeZone ne 'gmtime' ) {
 
318
            # servertime
 
319
            # time zone designator (+hh:mm or -hh:mm)
 
320
            # cached.
 
321
            unless (defined $TZSTRING) {
 
322
                my $offset = _tzOffset();
 
323
                my $sign = ($offset < 0) ? '-' : '+';
 
324
                $offset = abs($offset);
 
325
                my $hours = int($offset / 3600);
 
326
                my $mins = int(($offset - $hours * 3600) / 60);
 
327
                if ($hours || $mins) {
 
328
                    $TZSTRING = sprintf("$sign%02d:%02d", $hours, $mins);
 
329
                } else {
 
330
                    $TZSTRING = 'Z';
 
331
                }
 
332
            }
 
333
            $tz_str = $TZSTRING;
 
334
        }
 
335
        $value =~ s/\$isotz/$tz_str/gei;
 
336
    }
 
337
 
 
338
    return $value;
 
339
}
 
340
 
 
341
# Get timezone offset from GMT in seconds
 
342
# Code taken from CPAN module 'Time' - "David Muir Sharnoff disclaims
 
343
# any copyright and puts his contribution to this module in the public
 
344
# domain."
 
345
# Note that unit tests rely on this function being here.
 
346
sub _tzOffset {
 
347
        my $time = time();
 
348
        my @l = localtime($time);
 
349
        my @g = gmtime($time);
 
350
 
 
351
        my $off =
 
352
      $l[0] - $g[0]
 
353
        + ($l[1] - $g[1]) * 60
 
354
          + ($l[2] - $g[2]) * 3600;
 
355
 
 
356
        # subscript 7 is yday.
 
357
 
 
358
        if ($l[7] == $g[7]) {
 
359
                # done
 
360
        } elsif ($l[7] == $g[7] + 1) {
 
361
                $off += 86400;
 
362
        } elsif ($l[7] == $g[7] - 1) {
 
363
                $off -= 86400;
 
364
        } elsif ($l[7] < $g[7]) {
 
365
                # crossed over a year boundary.
 
366
                # localtime is beginning of year, gmt is end
 
367
                # therefore local is ahead
 
368
                $off += 86400;
 
369
        } else {
 
370
                $off -= 86400;
 
371
        }
 
372
 
 
373
        return $off;
 
374
}
 
375
 
 
376
# Returns the ISO8601 week number for a date.
 
377
# Year is the real year
 
378
# Day of week is 0..6 where 0==Sunday
 
379
# Day of year is 0..364 (or 365) where 0==Jan1
 
380
# From http://www.perlmonks.org/?node_id=710571
 
381
sub _weekNumber {
 
382
    my( $dayOfWeek, $dayOfYear, $year ) = @_;
 
383
    # rebase dow to Monday==0
 
384
    $dayOfWeek = ($dayOfWeek + 6) % 7;
 
385
 
 
386
    # Locate the nearest Thursday, by locating the Monday at
 
387
    # or before and going forwards 3 days)
 
388
    my $dayOfNearestThurs = $dayOfYear - $dayOfWeek + 3;
 
389
 
 
390
    my $daysInThisYear = _daysInYear($year);
 
391
    #print STDERR "dow:$dayOfWeek, doy:$dayOfYear, $year = thu:$dayOfNearestThurs ($daysInThisYear)\n";
 
392
 
 
393
    # Is nearest thursday in last year or next year?
 
394
    if ($dayOfNearestThurs < 0) {
 
395
        # Nearest Thurs is last year
 
396
        # We are at the start of the year
 
397
        # Adjust by the number of days in LAST year
 
398
        $dayOfNearestThurs += _daysInYear($year - 1);
 
399
    }
 
400
    if ($dayOfNearestThurs >= $daysInThisYear) {
 
401
        # Nearest Thurs is next year
 
402
        # We are at the end of the year
 
403
        # Adjust by the number of days in THIS year
 
404
        $dayOfNearestThurs -= $daysInThisYear;
 
405
    }
 
406
 
 
407
    # Which week does the Thurs fall into?
 
408
    return int ($dayOfNearestThurs / 7) + 1;
 
409
}
 
410
 
 
411
# Returns the number of...
 
412
sub _daysInYear {
 
413
    return 366 unless $_[0] % 400;
 
414
    return 365 unless $_[0] % 100;
 
415
    return 366 unless $_[0] % 4;
 
416
    return 365;
 
417
}
 
418
 
 
419
=begin TML
 
420
 
 
421
---++ StaticMethod formatDelta( $s ) -> $string
 
422
 
 
423
Format a time in seconds as a string. For example,
 
424
"1 day, 3 hours, 2 minutes, 6 seconds"
 
425
 
 
426
=cut
 
427
 
 
428
sub formatDelta {
 
429
    my $secs     = shift;
 
430
    my $language = shift;
 
431
 
 
432
    my $rem = $secs % ( 60 * 60 * 24 );
 
433
    my $days = ( $secs - $rem ) / ( 60 * 60 * 24 );
 
434
    $secs = $rem;
 
435
 
 
436
    $rem = $secs % ( 60 * 60 );
 
437
    my $hours = ( $secs - $rem ) / ( 60 * 60 );
 
438
    $secs = $rem;
 
439
 
 
440
    $rem = $secs % 60;
 
441
    my $mins = ( $secs - $rem ) / 60;
 
442
    $secs = $rem;
 
443
 
 
444
    my $str = '';
 
445
 
 
446
    if ($language) {
 
447
 
 
448
        #format as in user's language
 
449
        if ($days) {
 
450
            $str .= $language->maketext( '[*,_1,day] ', $days );
 
451
        }
 
452
        if ($hours) {
 
453
            $str .= $language->maketext( '[*,_1,hour] ', $hours );
 
454
        }
 
455
        if ($mins) {
 
456
            $str .= $language->maketext( '[*,_1,minute] ', $mins );
 
457
        }
 
458
        if ($secs) {
 
459
            $str .= $language->maketext( '[*,_1,second] ', $secs );
 
460
        }
 
461
    }
 
462
    else {
 
463
 
 
464
        #original code, harcoded English (BAD)
 
465
        if ($days) {
 
466
            $str .= $days . ' day' . ( $days > 1 ? 's ' : ' ' );
 
467
        }
 
468
        if ($hours) {
 
469
            $str .= $hours . ' hour' . ( $hours > 1 ? 's ' : ' ' );
 
470
        }
 
471
        if ($mins) {
 
472
            $str .= $mins . ' minute' . ( $mins > 1 ? 's ' : ' ' );
 
473
        }
 
474
        if ($secs) {
 
475
            $str .= $secs . ' second' . ( $secs > 1 ? 's ' : ' ' );
 
476
        }
 
477
    }
 
478
    $str =~ s/\s+$//;
 
479
    return $str;
 
480
}
 
481
 
 
482
=begin TML
 
483
 
 
484
---++ StaticMethod parseInterval( $szInterval ) -> [$iSecs, $iSecs]
 
485
 
 
486
Convert string representing a time interval to a pair of integers
 
487
representing the amount of seconds since epoch for the start and end
 
488
extremes of the time interval.
 
489
 
 
490
   * =$szInterval= - time interval string
 
491
 
 
492
in yacc syntax, grammar and actions:
 
493
<verbatim>
 
494
interval ::= date                 { $$.start = fillStart($1); $$.end = fillEnd($1); }
 
495
         | date '/' date          { $$.start = fillStart($1); $$.end = fillEnd($3); }
 
496
         | 'P' duration '/' date  { $$.start = fillEnd($4)-$2; $$.end = fillEnd($4); }
 
497
         | date '/' 'P' duration  { $$.start = fillStart($1); $$.end = fillStart($1)+$4; }
 
498
         ;
 
499
</verbatim>
 
500
an =interval= may be followed by a timezone specification string (this is not supported yet).
 
501
 
 
502
=duration= has the form (regular expression):
 
503
<verbatim>
 
504
   P(<number><nameOfDuration>)+
 
505
</verbatim>
 
506
 
 
507
nameOfDuration may be one of:
 
508
   * y(year), m(month), w(week), d(day), h(hour), M(minute), S(second)
 
509
 
 
510
=date= follows ISO8601 and must include hyphens.  (any amount of trailing
 
511
       elements may be omitted and will be filled in differently on the
 
512
       differents ends of the interval as to include the longest possible
 
513
       interval):
 
514
 
 
515
   * 2001-01-01T00:00:00
 
516
   * 2001-12-31T23:59:59
 
517
 
 
518
timezone is optional. Default is local time.
 
519
 
 
520
If the format is not recognised, will return empty interval [0,0].
 
521
 
 
522
=cut
 
523
 
 
524
# TODO: timezone testing, especially on non valid strings
 
525
 
 
526
sub parseInterval {
 
527
    my ($interval) = @_;
 
528
    my @lt    = localtime();
 
529
    my $today = sprintf( '%04d-%02d-%02d', $lt[5] + 1900, $lt[4] + 1, $lt[3] );
 
530
    my $now   = $today . sprintf( 'T%02d:%02d:%02d', $lt[2], $lt[1], $lt[0] );
 
531
 
 
532
    # replace $now and $today shortcuts
 
533
    $interval =~ s/\$today/$today/g;
 
534
    $interval =~ s/\$now/$now/g;
 
535
 
 
536
    # if $theDate does not contain a '/': force it to do so.
 
537
    $interval = $interval . '/' . $interval
 
538
      unless ( $interval =~ /\// );
 
539
 
 
540
    my ($first, $last) = split( /\//, $interval, 2 );
 
541
    my ( $start, $end );
 
542
 
 
543
    # first translate dates into seconds from epoch,
 
544
    # in the second loop we will examine interval durations.
 
545
 
 
546
    if ( $first !~ /^P/ ) {
 
547
        # complete with parts from "-01-01T00:00:00"
 
548
        if ( length($first) < length('0000-01-01T00:00:00')) {
 
549
            $first .= substr( '0000-01-01T00:00:00', length( $first ) );
 
550
        }
 
551
        $start = parseTime( $first, 1 );
 
552
    }
 
553
 
 
554
    if ($last !~ /^P/) {
 
555
        # complete with parts from "-12-31T23:59:60"
 
556
        # check last day of month
 
557
        # TODO: do we do leap years?
 
558
        if ( length( $last ) == 7 ) {
 
559
            my $month = substr( $last, 5 );
 
560
            $last .= '-'.$MONTHLENS[ $month - 1 ];
 
561
        }
 
562
        if ( length($last) < length('0000-12-31T23:59:59')) {
 
563
            $last .= substr( '0000-12-31T23:59:59', length( $last ) );
 
564
        }
 
565
        $end = parseTime( $last, 1 );
 
566
    }
 
567
 
 
568
    if (!defined($start)) {
 
569
        $start = ($end || 0) - _parseDuration( $first );
 
570
    }
 
571
    if (!defined($end)) {
 
572
        $end = $start + _parseDuration( $last );
 
573
    }
 
574
    return ( $start || 0, $end || 0);
 
575
}
 
576
 
 
577
sub _parseDuration {
 
578
    my $s = shift;
 
579
    my $d = 0;
 
580
    $s =~ s/(\d+)y/$d += $1 * 31556925;''/gei;    # tropical year
 
581
    $s =~ s/(\d+)m/$d += $1 * 2592000; ''/ge;     # 1m = 30 days
 
582
    $s =~ s/(\d+)w/$d += $1 * 604800;  ''/gei;    # 1w = 7 days
 
583
    $s =~ s/(\d+)d/$d += $1 * 86400;   ''/gei;    # 1d = 24 hours
 
584
    $s =~ s/(\d+)h/$d += $1 * 3600;    ''/gei;    # 1 hour = 60 mins
 
585
    $s =~ s/(\d+)M/$d += $1 * 60;      ''/ge;     # note: m != M
 
586
    $s =~ s/(\d+)S/$d += $1 * 1;       ''/gei;
 
587
    return $d;
 
588
}
 
589
 
 
590
1;
 
591
__DATA__
 
592
# Module of Foswiki - The Free and Open Source Wiki, http://foswiki.org/
 
593
#
 
594
# Copyright (C) 2008-2009 Foswiki Contributors. Foswiki Contributors
 
595
# are listed in the AUTHORS file in the root of this distribution.
 
596
# NOTE: Please extend that file, not this notice.
 
597
#
 
598
# Additional copyrights apply to some or all of the code in this
 
599
# file as follows:
 
600
#
 
601
# Copyright (C) 2002 John Talintyre, john.talintyre@btinternet.com
 
602
# Copyright (C) 2002-2007  TWiki Contributors. All Rights Reserved.
 
603
# TWiki Contributors are listed in the AUTHORS file in the root of
 
604
# this distribution.
 
605
#
 
606
# This program is free software; you can redistribute it and/or
 
607
# modify it under the terms of the GNU General Public License
 
608
# as published by the Free Software Foundation; either version 2
 
609
# of the License, or (at your option) any later version. For
 
610
# more details read LICENSE in the root of this distribution.
 
611
#
 
612
# This program is distributed in the hope that it will be useful,
 
613
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
614
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
615
#
 
616
# As per the GPL, removal of this notice is prohibited.