Posted to tcl by kbk at Fri Feb 08 20:44:33 GMT 2008view raw

  1.  
  2. package provide iso8601 0.1
  3. package require Tcl 8.5
  4.  
  5. namespace eval iso8601 {
  6.  
  7. namespace export parse_date parse_time
  8.  
  9. # Enumerate the patterns that we recognize for an ISO8601 date as both
  10. # the regexp patterns that match them and the [clock] patterns that scan
  11. # them.
  12.  
  13. variable DatePatterns {
  14. {\d\d\d\d-\d\d-\d\d} {%Y-%m-%d}
  15. {\d\d\d\d\d\d\d\d} {%Y%m%d}
  16. {\d\d\d\d-\d\d\d} {%Y-%j}
  17. {\d\d\d\d\d\d\d} {%Y%j}
  18. {\d\d-\d\d-\d\d} {%y-%m-%d}
  19. {\d\d\d\d\d\d} {%y%m%d}
  20. {\d\d-\d\d\d} {%y-%j}
  21. {\d\d\d\d\d} {%y%j}
  22. {--\d\d-\d\d} {--%m-%d}
  23. {--\d\d\d\d} {--%m%d}
  24. {--\d\d\d} {--%j}
  25. {---\d\d} {---%d}
  26. {\d\d\d\d-W\d\d-\d} {%G-W%V-%u}
  27. {\d\d\d\dW\d\d\d} {%GW%V%u}
  28. {\d\d-W\d\d-\d} {%g-W%V-%u}
  29. {\d\dW\d\d\d} {%gW%V%u}
  30. {-W\d\d-\d} {-W%V-%u}
  31. {-W\d\d\d} {-W%V%u}
  32. {-W-\d} {%u}
  33. }
  34.  
  35. # MatchTime -- (constructed procedure)
  36. #
  37. # Match an ISO8601 date/time string and indicate how it matched.
  38. #
  39. # Parameters:
  40. # string -- String to match.
  41. # fieldArray -- Name of an array in caller's scope that will receive
  42. # parsed fields of the time.
  43. #
  44. # Results:
  45. # Returns 1 if the time was scanned successfully, 0 otherwise.
  46. #
  47. # Side effects:
  48. # Initializes the field array. The keys that are significant:
  49. # - Any date pattern in 'DatePatterns' indicates that the
  50. # corresponding value, if non-empty, contains a date string
  51. # in the given format.
  52. # - The patterns T, Hcolon, and Mcolon indicate a literal
  53. # T preceding the time, a colon following the hour, or
  54. # a colon following the minute.
  55. # - %H, %M, %S, and %Z indicate the presence of the
  56. # corresponding parts of the time.
  57.  
  58. proc init {} {
  59.  
  60. variable DatePatterns
  61.  
  62. set cmd {regexp -expanded -nocase -- {PATTERN} $timeString ->}
  63. set re \(?:\(?:
  64. set sep {}
  65. foreach {regex interpretation} $DatePatterns {
  66. append re $sep \( $regex \)
  67. append cmd " " [list field($interpretation)]
  68. set sep |
  69. }
  70. append re \) {(T|[[:space:]]+)} \)?
  71. append cmd { field(T)}
  72. append re {(\d\d)(?:(:?)(\d\d)(?:(:?)(\d\d)))}
  73. append cmd { field(%H) field(Hcolon) } \
  74. {field(%M) field(Mcolon) field(%S)}
  75. append re {[[:space:]]*(Z|[-+]\d\d\d\d)?}
  76. append cmd { field(%Z)}
  77. set cmd [string map [list {{PATTERN}} [list $re]] \
  78. $cmd]
  79.  
  80. proc MatchTime { timeString fieldArray } "
  81. upvar 1 \$fieldArray field
  82. $cmd
  83. "
  84. }
  85. init
  86. rename init {}
  87.  
  88. }
  89.  
  90. # iso8601::parse_date --
  91. #
  92. # Parse an ISO8601 date/time string in an unknown variant.
  93. #
  94. # Parameters:
  95. # string -- String to parse
  96. # args -- Arguments as for [clock scan]; may include any of
  97. # the '-base', '-gmt', '-locale' or '-timezone options.
  98. #
  99. # Results:
  100. # Returns the given date in seconds from the Posix epoch.
  101.  
  102. proc iso8601::parse_date { string args } {
  103. variable DatePatterns
  104. foreach { regex interpretation } $DatePatterns {
  105. if { [regexp "^$regex\$" $string] } {
  106. return [eval [linsert $args 0 \
  107. clock scan $string -format $interpretation]]
  108. }
  109. }
  110. return -code error "not an iso8601 date string"
  111. }
  112.  
  113. # iso8601::parse_time --
  114. #
  115. # Parse a point-in-time in ISO8601 format
  116. #
  117. # Parameters:
  118. # string -- String to parse
  119. # args -- Arguments as for [clock scan]; may include any of
  120. # the '-base', '-gmt', '-locale' or '-timezone options.
  121. #
  122. # Results:
  123. # Returns the given time in seconds from the Posix epoch.
  124.  
  125. proc iso8601::parse_time { timeString args } {
  126. variable DatePatterns
  127. MatchTime $timeString field
  128. set pattern {}
  129. foreach {regex interpretation} $DatePatterns {
  130. if { $field($interpretation) ne {} } {
  131. append pattern $interpretation
  132. }
  133. }
  134. append pattern $field(T)
  135. if { $field(%H) ne {} } {
  136. append pattern %H $field(Hcolon)
  137. if { $field(%M) ne {} } {
  138. append pattern %M $field(Mcolon)
  139. if { $field(%S) ne {} } {
  140. append pattern %S
  141. }
  142. }
  143. }
  144. if { $field(%Z) ne {} } {
  145. append pattern %Z
  146. }
  147. return [eval [linsert $args 0 clock scan $timeString -format $pattern]]
  148. }
  149.  
  150. # Usage examples
  151.  
  152. if { [info exists ::argv0] && ( $::argv0 eq [info script] ) } {
  153. puts "iso8601::parse_date"
  154. puts [iso8601::parse_date 1970-01-02 -timezone :UTC]
  155. puts [iso8601::parse_date 1970-W01-5 -timezone :UTC]
  156. puts [time {iso8601::parse_date 1970-01-02 -timezone :UTC} 1000]
  157. puts [time {iso8601::parse_date 1970-W01-5 -timezone :UTC} 1000]
  158. puts "iso8601::parse_time"
  159. puts [clock format [iso8601::parse_time 2004-W33-2T18:52:24Z] \
  160. -format {%X %x %z} -locale system]
  161. puts [clock format [iso8601::parse_time 18:52:24Z] \
  162. -format {%X %x %z} -locale system]
  163. puts [time {iso8601::parse_time 2004-W33-2T18:52:24Z} 1000]
  164. puts [time {iso8601::parse_time 18:52:24Z} 1000]
  165. puts [iso8601::parse_time 18:52:24-04:00]
  166. }
  167.