You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

280 lines
8.3 KiB

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2004 Kevin Kenny
## Origin http://wiki.tcl.tk/13094
## Modified for Tcl 8.5 only (eval -> {*}).
# # ## ### ##### ######## ############# #####################
## Requisites
package require Tcl 8.5 9
package provide clock::iso8601 0.2
namespace eval ::clock::iso8601 {}
# # ## ### ##### ######## ############# #####################
## API
# iso8601::parse_date --
#
# Parse an ISO8601 date/time string in an unknown variant.
#
# Parameters:
# string -- String to parse
# args -- Arguments as for [clock scan]; may include any of
# the '-base', '-gmt', '-locale' or '-timezone options.
#
# Results:
# Returns the given date in seconds from the Posix epoch.
proc ::clock::iso8601::parse_date { string args } {
variable DatePatterns
variable Repattern
foreach { regex interpretation } $DatePatterns {
if { [regexp "^$regex\$" $string] } {
#puts A|$string|\t|$regex|\t|$interpretation|
# For incomplete dates (month and/or day missing), we have
# to set our own default values to overcome clock scan's
# settings. We do this by switching to a different pattern
# and extending the input properly for that pattern.
if {[dict exists $Repattern $interpretation]} {
lassign [dict get $Repattern $interpretation] interpretation adjust modifier
{*}$modifier
# adjust irrelevant here, see parse_time for use.
}
#puts B|$string|\t|$regex|\t|$interpretation|
return [clock scan $string -format $interpretation {*}$args]
}
}
return -code error "not an iso8601 date string"
}
# iso8601::parse_time --
#
# Parse a point-in-time in ISO8601 format
#
# Parameters:
# string -- String to parse
# args -- Arguments as for [clock scan]; may include any of
# the '-base', '-gmt', '-locale' or '-timezone options.
#
# Results:
# Returns the given time in seconds from the Posix epoch.
proc ::clock::iso8601::parse_time { string args } {
variable DatePatterns
variable Repattern
if {![MatchTime $string field]} {
return -code error "not an iso8601 time string"
}
#parray field
#puts A|$string|
set pattern {}
foreach {regex interpretation} $DatePatterns {
if {[Has $interpretation tstart]} {
append pattern $interpretation
}
}
if {[dict exists $Repattern $pattern]} {
lassign [dict get $Repattern $pattern] interpretation adjust modifier
{*}$modifier
incr tstart $adjust
}
append pattern [Get T len]
incr tstart $len
if {[Has %H tstart]} {
append pattern %H [Get Hcolon len]
incr tstart $len
if {[Has %M tstart]} {
append pattern %M [Get Mcolon len]
incr tstart $len
if {[Has %S tstart]} {
append pattern %S
} else {
# No seconds, default to start of minute.
append pattern %S
Insert string $tstart 00
}
} else {
# No minutes, nor seconds, default to start of hour.
append pattern %M%S
Insert string $tstart 0000
}
} else {
# No time information, default to midnight.
append pattern %H%M%S
Insert string $tstart 000000
}
if {[Has %Z _]} {
append pattern %Z
}
#puts B|$string|\t|$pattern|
return [clock scan $string -format $pattern {*}$args]
}
# # ## ### ##### ######## ############# #####################
proc ::clock::iso8601::Get {x lv} {
upvar 1 field field string string $lv len
lassign $field($x) s e
if {($s >= 0) && ($e >= 0)} {
set len [expr {$e - $s + 1}]
return [string range $string $s $e]
}
set len 0
return ""
}
proc ::clock::iso8601::Has {x nv} {
upvar 1 field field string string $nv next
lassign $field($x) s e
if {($s >= 0) && ($e >= 0)} {
set next $e
incr next
return 1
}
return 0
}
proc ::clock::iso8601::Insert {sv index str} {
upvar 1 $sv string
append r [string range $string 0 ${index}-1]
append r $str
append r [string range $string $index end]
set string $r
return
}
# # ## ### ##### ######## ############# #####################
## State
namespace eval ::clock::iso8601 {
namespace export parse_date parse_time
namespace ensemble create
# Enumerate the patterns that we recognize for an ISO8601 date as both
# the regexp patterns that match them and the [clock] patterns that scan
# them.
variable DatePatterns {
{\d\d\d\d-\d\d-\d\d} {%Y-%m-%d}
{\d\d\d\d\d\d\d\d} {%Y%m%d}
{\d\d\d\d-\d\d\d} {%Y-%j}
{\d\d\d\d\d\d\d} {%Y%j}
{\d\d-\d\d-\d\d} {%y-%m-%d}
{\d\d\d\d-\d\d} {%Y-%m}
{\d\d\d\d\d\d} {%y%m%d}
{\d\d-\d\d\d} {%y-%j}
{\d\d\d\d\d} {%y%j}
{--\d\d-\d\d} {--%m-%d}
{--\d\d\d\d} {--%m%d}
{--\d\d\d} {--%j}
{---\d\d} {---%d}
{\d\d\d\d-W\d\d-\d} {%G-W%V-%u}
{\d\d\d\dW\d\d\d} {%GW%V%u}
{\d\d-W\d\d-\d} {%g-W%V-%u}
{\d\dW\d\d\d} {%gW%V%u}
{\d\d\d\d-W\d\d} {%G-W%V}
{\d\d\d\dW\d\d} {%GW%V}
{-W\d\d-\d} {-W%V-%u}
{-W\d\d\d} {-W%V%u}
{-W-\d} {%u}
{\d\d\d\d} {%Y}
}
# Dictionary of the patterns requiring modifications to the input
# for proper month and/or day defaults.
variable Repattern {
%Y-%m {%Y-%m-%d 3 {Insert string 7 -01}}
%Y {%Y-%m-%d 5 {Insert string 4 -01-01}}
%G-W%V {%G-W%V-%u 1 {Insert string 8 -1}}
%GW%V {%GW%V%u 1 {Insert string 6 1}}
}
}
# # ## ### ##### ######## ############# #####################
## Initialization
apply {{} {
# MatchTime -- (constructed procedure)
#
# Match an ISO8601 date/time string and indicate how it matched.
#
# Parameters:
# string -- String to match.
# fieldArray -- Name of an array in caller's scope that will receive
# parsed fields of the time.
#
# Results:
# Returns 1 if the time was scanned successfully, 0 otherwise.
#
# Side effects:
# Initializes the field array. The keys that are significant:
# - Any date pattern in 'DatePatterns' indicates that the
# corresponding value, if non-empty, contains a date string
# in the given format.
# - The patterns T, Hcolon, and Mcolon indicate a literal
# T preceding the time, a colon following the hour, or
# a colon following the minute.
# - %H, %M, %S, and %Z indicate the presence of the
# corresponding parts of the time.
variable DatePatterns
set cmd {regexp -indices -expanded -nocase -- {PATTERN} $timeString ->}
set re \(?:\(?:
set sep {}
foreach {regex interpretation} $DatePatterns {
append re $sep \( $regex \)
append cmd " " [list field($interpretation)]
set sep |
}
append re \) {(T|[[:space:]]+)} \)?
append cmd { field(T)}
append re {(\d\d)(?:(:?)(\d\d)(?:(:?)(\d\d)?))?}
append cmd { field(%H) field(Hcolon) } {field(%M) field(Mcolon) field(%S)}
append re {[[:space:]]*(Z|[-+]\d\d:?\d\d)?}
append cmd { field(%Z)}
set cmd [string map [list {{PATTERN}} [list $re]] \
$cmd]
proc MatchTime { timeString fieldArray } "
upvar 1 \$fieldArray field
$cmd
"
#puts [info body MatchTime]
} ::clock::iso8601}
# # ## ### ##### ######## ############# #####################
return
# Usage examples, disabled.
if { [info exists ::argv0] && ( $::argv0 eq [info script] ) } {
puts "::clock::iso8601::parse_date"
puts [::clock::iso8601::parse_date 1970-01-02 -timezone :UTC]
puts [::clock::iso8601::parse_date 1970-W01-5 -timezone :UTC]
puts [time {::clock::iso8601::parse_date 1970-01-02 -timezone :UTC} 1000]
puts [time {::clock::iso8601::parse_date 1970-W01-5 -timezone :UTC} 1000]
puts "::clock::iso8601::parse_time"
puts [clock format [::clock::iso8601::parse_time 2004-W33-2T18:52:24Z] \
-format {%X %x %z} -locale system]
puts [clock format [::clock::iso8601::parse_time 18:52:24Z] \
-format {%X %x %z} -locale system]
puts [time {::clock::iso8601::parse_time 2004-W33-2T18:52:24Z} 1000]
puts [time {::clock::iso8601::parse_time 18:52:24Z} 1000]
}