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