lib/TWiki/Time.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
     1 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
     2 #
     3 # Copyright (C) 2002 John Talintyre, john.talintyre@btinternet.com
     4 # Copyright (C) 2002-2007 Peter Thoeny, peter@thoeny.org
     5 # and TWiki Contributors. All Rights Reserved. TWiki Contributors
     6 # are listed in the AUTHORS file in the root of this distribution.
     7 # NOTE: Please extend that file, not this notice.
     8 #
     9 # This program is free software; you can redistribute it and/or
    10 # modify it under the terms of the GNU General Public License
    11 # as published by the Free Software Foundation; either version 2
    12 # of the License, or (at your option) any later version. For
    13 # more details read LICENSE in the root of this distribution.
    14 #
    15 # This program is distributed in the hope that it will be useful,
    16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
    17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    18 #
    19 # As per the GPL, removal of this notice is prohibited.
    20 
    21 =pod
    22 
    23 ---+ package TWiki::Time
    24 
    25 Time handling functions.
    26 
    27 =cut
    28 
    29 package TWiki::Time;
    30 
    31 use strict;
    32 
    33 require TWiki;
    34 
    35 # Constants
    36 use vars qw( @ISOMONTH @WEEKDAY @MONTHLENS %MON2NUM );
    37 
    38 @ISOMONTH =
    39   ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
    40     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
    41 
    42 # SMELL: does not account for leap years
    43 @MONTHLENS = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
    44 
    45 @WEEKDAY =
    46   ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun' );
    47 
    48 %MON2NUM =
    49   (
    50    jan => 0,
    51    feb => 1,
    52    mar => 2,
    53    apr => 3,
    54    may => 4,
    55    jun => 5,
    56    jul => 6,
    57    aug => 7,
    58    sep => 8,
    59    oct => 9,
    60    nov => 10,
    61    dec => 11
    62   );
    63 
    64 =pod
    65 
    66 ---++ StaticMethod parseTime( $szDate, $defaultLocal ) -> $iSecs
    67 
    68 Convert string date/time string to seconds since epoch (1970-01-01T00:00:00Z).
    69    * =$sDate= - date/time string
    70 
    71 Handles the following formats:
    72 
    73 Default TWiki format
    74    * 31 Dec 2001 - 23:59
    75 
    76 TWiki format without time (defaults to 00:00)
    77    * 31 Dec 2001
    78 
    79 Date seperated by '/', '.' or '-', time with '.' or ':'
    80 Date and time separated by ' ', '.' and/or '-'
    81    * 2001/12/31 23:59:59
    82    * 2001.12.31.23.59.59
    83    * 2001/12/31 23:59
    84    * 2001.12.31.23.59
    85    * 2001-12-31 23:59
    86    * 2001-12-31 - 23:59
    87 
    88 ISO format
    89    * 2001-12-31T23:59:59
    90 ISO dates may have a timezone specifier, either Z or a signed difference
    91 in hh:mm format. For example:
    92    * 2001-12-31T23:59:59+01:00
    93    * 2001-12-31T23:59Z
    94 The default timezone is Z, unless $defaultLocal is true in which case
    95 the local timezone will be assumed.
    96 
    97 If the date format was not recognised, will return 0.
    98 
    99 =cut
   100 
   101 sub parseTime {
   102     my( $date, $defaultLocal ) = @_;
   103 
   104     require Time::Local;
   105 
   106     # NOTE: This routine *will break* if input is not one of below formats!
   107     my $tzadj = 0; # Zulu
   108     if ($defaultLocal) {
   109         # Local time at midnight on the epoch gives us minus the 
   110         # local difference. e.g. CST is GMT + 1, so midnight Jan 1 1970 CST
   111         # is -01:00Z
   112         $tzadj = -Time::Local::timelocal(0, 0, 0, 1, 0, 70);
   113     }
   114 
   115     # try "31 Dec 2001 - 23:59"  (TWiki date)
   116     # or "31 Dec 2001"
   117     if ($date =~ /(\d+)\s+([a-z]{3})\s+(\d+)(?:[-\s]+(\d+):(\d+))?/i) {
   118         my $year = $3;
   119         $year -= 1900 if( $year > 1900 );
   120         return Time::Local::timegm( 0, $5||0, $4||0, $1, $MON2NUM{lc($2)}, $year ) - $tzadj;
   121     }
   122 
   123     # try "2001/12/31 23:59:59" or "2001.12.31.23.59.59" (RCS date)
   124     # or "2001-12-31 23:59:59" or "2001-12-31 - 23:59:59"
   125     if ($date =~ m!(\d+)[./\-](\d+)[./\-](\d+)[.\s\-]+(\d+)[.:](\d+)[.:](\d+)!) {
   126         my $year = $1;
   127         $year -= 1900 if( $year > 1900 );
   128         return Time::Local::timegm( $6, $5, $4, $3, $2-1, $year ) - $tzadj;
   129     }
   130 
   131     # try "2001/12/31 23:59" or "2001.12.31.23.59" (RCS short date)
   132     # or "2001-12-31 23:59" or "2001-12-31 - 23:59"
   133     if ($date =~ m!(\d+)[./\-](\d+)[./\-](\d+)[.\s\-]+(\d+)[.:](\d+)!) {
   134         my $year = $1;
   135         $year -= 1900 if( $year > 1900 );
   136         return Time::Local::timegm( 0, $5, $4, $3, $2-1, $year ) - $tzadj;
   137     }
   138     
   139     # ISO date
   140     if ($date =~ /(\d\d\d\d)(?:-(\d\d)(?:-(\d\d))?)?(?:T(\d\d)(?::(\d\d)(?::(\d\d(?:\.\d+)?))?)?)?(Z|[-+]\d\d(?::\d\d)?)?/ ) {
   141         my ($Y, $M, $D, $h, $m, $s, $tz) =
   142           ($1, $2||1, $3||1, $4||0, $5||0, $6||0, $7||'');
   143         $M--;
   144         $Y -= 1900 if( $Y > 1900 );
   145         if ($tz eq 'Z') {
   146             $tzadj = 0; # Zulu
   147         } elsif ($tz =~ /([-+])(\d\d)(?::(\d\d))?/) {
   148             $tzadj = ($1||'').((($2 * 60) + ($3||0)) * 60);
   149             $tzadj -= 0;
   150         }
   151         return Time::Local::timegm( $s, $m, $h, $D, $M, $Y ) - $tzadj;
   152     }
   153 
   154     # give up, return start of epoch (01 Jan 1970 GMT)
   155     return 0;
   156 }
   157 
   158 =pod
   159 
   160 ---++ StaticMethod formatTime ($epochSeconds, $formatString, $outputTimeZone) -> $value
   161 
   162    * =$epochSeconds= epochSecs GMT
   163    * =$formatString= twiki time date format, default =$day $month $year - $hour:$min=
   164    * =$outputTimeZone= timezone to display, =gmtime= or =servertime=, default is whatever is set in $TWiki::cfg{DisplayTimeValues}
   165 =$formatString= supports:
   166    | $seconds | secs |
   167    | $minutes | mins |
   168    | $hours | hours |
   169    | $day | date |
   170    | $wday | weekday name |
   171    | $dow | day number (0 = Sunday) |
   172    | $week | week number |
   173    | $month | month name |
   174    | $mo | month number |
   175    | $year | 4-digit year |
   176    | $ye | 2-digit year |
   177    | $http | ful HTTP header format date/time |
   178    | $email | full email format date/time |
   179    | $rcs | full RCS format date/time |
   180    | $epoch | seconds since 1st January 1970 |
   181 
   182 =cut
   183 
   184 # previous known as TWiki::formatTime
   185 
   186 sub formatTime  {
   187     my ($epochSeconds, $formatString, $outputTimeZone) = @_;
   188     my $value = $epochSeconds;
   189 
   190     # use default TWiki format "31 Dec 1999 - 23:59" unless specified
   191     $formatString ||= $TWiki::cfg{DefaultDateFormat} . ' - $hour:$min';
   192     $outputTimeZone ||= $TWiki::cfg{DisplayTimeValues};
   193 
   194     if( $formatString =~ /http|email/i ) {
   195         $outputTimeZone = 'gmtime';
   196     }
   197 
   198     my( $sec, $min, $hour, $day, $mon, $year, $wday, $tz_str);
   199     if( $outputTimeZone eq 'servertime' ) {
   200         ( $sec, $min, $hour, $day, $mon, $year, $wday ) =
   201           localtime( $epochSeconds );
   202         $tz_str = 'Local';
   203     } else {
   204         ( $sec, $min, $hour, $day, $mon, $year, $wday ) =
   205           gmtime( $epochSeconds );
   206         $tz_str = 'GMT';
   207     }
   208 
   209     #standard twiki date time formats
   210     if( $formatString =~ /rcs/i ) {
   211         # RCS format, example: "2001/12/31 23:59:59"
   212         $formatString = '$year/$mo/$day $hour:$min:$sec';
   213     } elsif ( $formatString =~ /http|email/i ) {
   214         # HTTP and email header format, e.g. "Thu, 23 Jul 1998 07:21:56 EST"
   215  	    # RFC 822/2616/1123
   216         $formatString = '$wday, $day $month $year $hour:$min:$sec $tz';
   217     } elsif ( $formatString =~ /iso/i ) {
   218         # ISO Format, see spec at http://www.w3.org/TR/NOTE-datetime
   219         # e.g. "2002-12-31T19:30:12Z"
   220         $formatString = '$year-$mo-$dayT$hour:$min:$sec';
   221         if( $outputTimeZone eq 'gmtime' ) {
   222             $formatString = $formatString.'Z';
   223         } else {
   224             #TODO:            $formatString = $formatString.
   225             # TZD  = time zone designator (Z or +hh:mm or -hh:mm) 
   226         }
   227     }
   228 
   229     $value = $formatString;
   230     $value =~ s/\$seco?n?d?s?/sprintf('%.2u',$sec)/gei;
   231     $value =~ s/\$minu?t?e?s?/sprintf('%.2u',$min)/gei;
   232     $value =~ s/\$hour?s?/sprintf('%.2u',$hour)/gei;
   233     $value =~ s/\$day/sprintf('%.2u',$day)/gei;
   234     $value =~ s/\$wday/$WEEKDAY[$wday]/gi;
   235     $value =~ s/\$dow/$wday/gi;
   236     $value =~ s/\$week/_weekNumber($day,$mon,$year,$wday)/egi;
   237     $value =~ s/\$mont?h?/$ISOMONTH[$mon]/gi;
   238     $value =~ s/\$mo/sprintf('%.2u',$mon+1)/gei;
   239     $value =~ s/\$year?/sprintf('%.4u',$year+1900)/gei;
   240     $value =~ s/\$ye/sprintf('%.2u',$year%100)/gei;
   241     $value =~ s/\$epoch/$epochSeconds/gi;
   242 
   243     # SMELL: how do we get the different timezone strings (and when
   244     # we add usertime, then what?)
   245     $value =~ s/\$tz/$tz_str/geoi;
   246 
   247     return $value;
   248 }
   249 
   250 sub _weekNumber {
   251     my( $day, $mon, $year, $wday ) = @_;
   252     
   253     require Time::Local;
   254 
   255     # calculate the calendar week (ISO 8601)
   256     my $nextThursday = Time::Local::timegm(0, 0, 0, $day, $mon, $year) +
   257       (3 - ($wday + 6) % 7) * 24 * 60 * 60; # nearest thursday
   258     my $firstFourth = Time::Local::timegm(0, 0, 0, 4, 0, $year); # january, 4th
   259     return sprintf('%.0f', ($nextThursday - $firstFourth) / ( 7 * 86400 )) + 1;
   260 }
   261 
   262 =pod
   263 
   264 ---++ StaticMethod formatDelta( $s ) -> $string
   265 
   266 Format a time in seconds as a string. For example,
   267 "1 day, 3 hours, 2 minutes, 6 seconds"
   268 
   269 =cut
   270 
   271 sub formatDelta {
   272     my $secs = shift;
   273     my $language = shift;
   274 
   275     my $rem = $secs % (60 * 60 * 24);
   276     my $days = ($secs - $rem) / (60 * 60 * 24);
   277     $secs = $rem;
   278 
   279     $rem = $secs % (60 * 60);
   280     my $hours = ($secs - $rem) / (60 * 60);
   281     $secs = $rem;
   282 
   283     $rem = $secs % 60;
   284     my $mins = ($secs - $rem) / 60;
   285     $secs = $rem;
   286 
   287     my $str = '';
   288 
   289     if ($language) {
   290         #format as in user's language
   291         if( $days ) {
   292             $str .= $language->maketext('[*,_1,day] ', $days);
   293         }
   294         if( $hours ) {
   295             $str .= $language->maketext('[*,_1,hour] ', $hours);
   296         }
   297         if( $mins ) {
   298             $str .= $language->maketext('[*,_1,minute] ', $mins);
   299         }
   300         if( $secs ) {
   301             $str .= $language->maketext('[*,_1,second] ', $secs);
   302         }
   303     } else {
   304         #original code, harcoded English (BAD)
   305         if( $days ) {
   306             $str .= $days . ' day' .( $days > 1 ? 's ' : ' ' );
   307         }
   308         if( $hours ) {
   309             $str .= $hours . ' hour' .( $hours > 1 ? 's ' : ' ' );
   310         }
   311         if( $mins ) {
   312             $str .= $mins . ' minute' .( $mins > 1 ? 's ' : ' ' );
   313         }
   314         if( $secs ) {
   315             $str .= $secs . ' second' .( $secs > 1 ? 's ' : ' ' );
   316         }
   317     }
   318     $str =~ s/\s+$//;
   319     return $str;
   320 }
   321 
   322 =pod
   323 
   324 ---++ StaticMethod parseInterval( $szInterval ) -> [$iSecs, $iSecs]
   325 
   326 Convert string representing a time interval to a pair of integers
   327 representing the amount of seconds since epoch for the start and end
   328 extremes of the time interval.
   329 
   330    * =$szInterval= - time interval string
   331 
   332 in yacc syntax, grammar and actions:
   333 <verbatim>
   334 interval ::= date                 { $$.start = fillStart($1); $$.end = fillEnd($1); }
   335          | date '/' date          { $$.start = fillStart($1); $$.end = fillEnd($3); }
   336          | 'P' duration '/' date  { $$.start = fillEnd($4)-$2; $$.end = fillEnd($4); }
   337          | date '/' 'P' duration  { $$.start = fillStart($1); $$.end = fillStart($1)+$4; }
   338          ;
   339 </verbatim>
   340 an =interval= may be followed by a timezone specification string (this is not supported yet).
   341 
   342 =duration= has the form (regular expression):
   343 <verbatim>
   344    P(<number><nameOfDuration>)+
   345 </verbatim>
   346 
   347 nameOfDuration may be one of:
   348    * y(year), m(month), w(week), d(day), h(hour), M(minute), S(second)
   349 
   350 =date= follows ISO8601 and must include hypens.  (any amount of trailing
   351        elements may be omitted and will be filled in differently on the
   352        differents ends of the interval as to include the longest possible
   353        interval):
   354 
   355    * 2001-01-01T00:00:00
   356    * 2001-12-31T23:59:59
   357 
   358 timezone is optional. Default is local time.
   359 
   360 If the format is not recognised, will return empty interval [0,0].
   361 
   362 TODO: timezone
   363       testing, especially on non valid strings
   364 
   365 =cut
   366 
   367 sub parseInterval{
   368     my ($theInterval) = @_;
   369 
   370     my @lt = localtime();
   371     my $today = sprintf('%04d-%02d-%02d',$lt[5]+1900, $lt[4]+1, $lt[3]);
   372     my $now = $today . sprintf('T%02d:%02d:%02d',$lt[2], $lt[1], $lt[0]);
   373 
   374     # replace $now and $today shortcuts
   375     $theInterval =~ s/\$today/$today/g;
   376     $theInterval =~ s/\$now/$now/g;
   377 
   378     # if $theDate does not contain a '/': force it to do so.
   379     $theInterval = $theInterval.'/'.$theInterval unless ($theInterval =~ /\// );
   380 
   381     my @ends = split(/\//, $theInterval);
   382 
   383     # first translate dates into seconds from epoch,
   384     # in the second loop we will examine interval durations.
   385 
   386     foreach my $i (0,1) {
   387         #   if not a period of time:
   388         next if ($ends[$i] =~ /^P/);
   389 
   390         #   TODO assert(must include the year)
   391         if($i) {
   392             # fillEnd
   393             #     if ending point, complete with parts from "-12-31T23:59:60"
   394             #     if completing ending point, check last day of month
   395             # TODO: do we do leap years?
   396             if (length($ends[$i]) == 7){
   397                 my $month = substr($ends[$i],5);
   398                 $ends[$i] .= $MONTHLENS[$month-1];
   399             }
   400             $ends[$i] .= substr("0000-12-31T23:59:59",length($ends[$i]));
   401         } else {
   402             # fillStart
   403             #     if starting point, complete with parts from "-01-01T00:00:00"
   404             $ends[$i] .= substr("0000-01-01T00:00:00",length($ends[$i]));
   405         }
   406 
   407         #     convert the string into integer amount of seconds
   408         #     from 1970-01-01T00:00:00.00 UTC
   409 
   410         $ends[$i] = parseTime($ends[$i], 1);
   411     }
   412 
   413     # now we're ready to translate interval durations...
   414     # ... we don't do P<whatever/P<whatever> !!!
   415 
   416     my @oper = ("-","+");
   417     # if any extreme was a time duration, examine it
   418     foreach my $i (0,1) {
   419         next unless ($ends[$i] =~ /^P/);
   420 
   421         #   drop the 'P', substitute each letter with '*<value>+',
   422         #   where <value> is the amount of seconds represented by
   423         #   the unit.  for example: w (week) becomes '*604800+'.
   424         $ends[$i] =~ s/^P//;
   425         $ends[$i] =~ s/y/\*31556925\+/gi; # tropical year
   426         $ends[$i] =~ s/m/\*2592000\+/g;   # 1m = 30 days
   427         $ends[$i] =~ s/w/\*604800\+/gi;   # 1w = 7 days
   428         $ends[$i] =~ s/d/\*86400\+/gi;
   429         $ends[$i] =~ s/h/\*3600\+/gi;
   430         $ends[$i] =~ s/M/\*60\+/g;        # note: m != M
   431         $ends[$i] =~ s/S/\*1\+/gi;
   432         #   possibly append '0' and evaluate numerically the string.  
   433         $ends[$i] =~ s/\+$/+0/;
   434         my $duration = eval($ends[$i]);
   435         #   the value computed, if it specifies the starting point
   436         #   in time, must be subtracted from the previously
   437         #   computed ending point.  if it specifies the ending
   438         #   point, it must be added to the previously computed
   439         #   starting point.
   440         $ends[$i] = eval($ends[1-$i].$oper[$i].$ends[$i]);
   441         # SMELL: if the user specified both start and end as a
   442         # time duration, some kind of error must be reported.
   443     }
   444     return @ends;
   445 }
   446 
   447 1;