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

 package provide iso8601 0.1
 package require Tcl 8.5
 
 namespace eval iso8601 {
 
     namespace export parse_date parse_time
 
     # 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-%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}
         {-W\d\d-\d}                     {-W%V-%u}
         {-W\d\d\d}                      {-W%V%u}
         {-W-\d}                         {%u}
     }
 
     # 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.
 
     proc init {} {
 
         variable DatePatterns
 
         set cmd {regexp -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
         "
     }
     init
     rename init {}
 
 }
 
 # 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 iso8601::parse_date { string args } {
     variable DatePatterns
     foreach { regex interpretation } $DatePatterns {
         if { [regexp "^$regex\$" $string] } {
             return [eval [linsert $args 0 \
                               clock scan $string -format $interpretation]]
         }
     }
     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 iso8601::parse_time { timeString args } {
     variable DatePatterns
     MatchTime $timeString field
     set pattern {}
     foreach {regex interpretation} $DatePatterns {
         if { $field($interpretation) ne {} } {
             append pattern $interpretation
         }
     }
     append pattern $field(T)
     if { $field(%H) ne {} } {
         append pattern %H $field(Hcolon)
         if { $field(%M) ne {} } {
             append pattern %M $field(Mcolon)
             if { $field(%S) ne {} } {
                 append pattern %S
             }
         }
     }
     if { $field(%Z) ne {} } {
         append pattern %Z
     }
     return [eval [linsert $args 0 clock scan $timeString -format $pattern]]
 }
 
 # Usage examples
 
 if { [info exists ::argv0] && ( $::argv0 eq [info script] ) } {
     puts "iso8601::parse_date"
     puts [iso8601::parse_date 1970-01-02 -timezone :UTC]
     puts [iso8601::parse_date 1970-W01-5 -timezone :UTC]
     puts [time {iso8601::parse_date 1970-01-02 -timezone :UTC} 1000]
     puts [time {iso8601::parse_date 1970-W01-5 -timezone :UTC} 1000]
     puts "iso8601::parse_time"
     puts [clock format [iso8601::parse_time 2004-W33-2T18:52:24Z] \
               -format {%X %x %z} -locale system]
     puts [clock format [iso8601::parse_time 18:52:24Z] \
               -format {%X %x %z} -locale system]
     puts [time {iso8601::parse_time 2004-W33-2T18:52:24Z} 1000]
     puts [time {iso8601::parse_time 18:52:24Z} 1000]
     puts [iso8601::parse_time 18:52:24-04:00]
 }