Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,10 @@ +2013-01-24 Andreas Kupries + + * New module and packages: clock (rfc2822, iso8601). + Tcl 8.5 only. + 2013-01-08 Andreas Kupries * configure.in: [Bug 3593146]: Extended with CYGPATH usage to allow building under cygwin. * configure: Regenerated (autoconf 2.67). ADDED modules/clock/ChangeLog Index: modules/clock/ChangeLog ================================================================== --- /dev/null +++ modules/clock/ChangeLog @@ -0,0 +1,6 @@ +2013-01-24 Andreas Kupries + + * New module, 2 packages. + * rfc2822.tcl: Parsing rfc2822 dates (mail, news) + * iso8601.tcl: Parsing iso8601 dates and times. + * pkgIndex.tcl: ADDED modules/clock/iso8601.man Index: modules/clock/iso8601.man ================================================================== --- /dev/null +++ modules/clock/iso8601.man @@ -0,0 +1,57 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin clock_iso8601 n 0.1] +[moddesc {Date/Time Utilities}] +[titledesc {Parsing ISO 8601 dates/times}] +[category {Text processing}] +[require Tcl 8.5] +[require clock::iso8601 [opt 0.1]] +[description] + +This package provides functionality to parse dates and times in +ISO 8601 format. + +[para] + +[list_begin definitions] + +[call [cmd {::clock::iso8601 parse_date}] \ + [arg date] [arg options...]] + +This command parses an ISO8601 date string in an unknown variant and +returns the given date/time in seconds since epoch. + +[para] The acceptable options are +[option -base], +[option -gmt], +[option -locale], and +[option -timezone] +of the builtin command [cmd {clock scan}]. + +[call [cmd {::clock::iso8601 parse_time}] \ + [arg time] [arg options...]] + +This command parses a full ISO8601 timestamp string (date and time) in +an unknown variant and returns the given time in seconds since epoch. + +[para] The acceptable options are +[option -base], +[option -gmt], +[option -locale], and +[option -timezone] +of the builtin command [cmd {clock scan}]. + +[list_end] + +[section {BUGS, IDEAS, FEEDBACK}] + +This document, and the package it describes, will undoubtedly contain +bugs and other problems. + +Please report such in the category [emph clock::iso8601] of the +[uri {http://sourceforge.net/tracker/?group_id=12883} {Tcllib SF Trackers}]. + +Please also report any ideas for enhancements you may have for either +package and/or documentation. + + +[manpage_end] ADDED modules/clock/iso8601.pcx Index: modules/clock/iso8601.pcx ================================================================== --- /dev/null +++ modules/clock/iso8601.pcx @@ -0,0 +1,43 @@ +# -*- tcl -*- iso8601.pcx +# Syntax of the commands provided by package iso8601. + +# For use by TclDevKit's static syntax checker. +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the documentation describing the format of the code contained in this file +# + +package require pcx +pcx::register clock::iso8601 +pcx::tcldep 0.1 needs tcl 8.5 + +namespace eval ::clock::iso8601 {} + +#pcx::message FOO {... text ...} type +#pcx::scan + +# Switches are per clock scan (Tcl 8.5), restricted subset. +pcx::check 0.1 std ::clock::iso8601::parse_date \ + {checkSimpleArgs 1 -1 { + checkWord + {checkSwitches 0 { + {-locale checkWord} + {-timezone checkWord} + {-base checkInt} + {-gmt checkBoolean} + } {}} + }} +pcx::check 0.1 std ::clock::iso8601::parse_time \ + {checkSimpleArgs 1 -1 { + checkWord + {checkSwitches 0 { + {-locale checkWord} + {-timezone checkWord} + {-base checkInt} + {-gmt checkBoolean} + } {}} + }} + +# Initialization via pcx::init. +# Use a ::iso8601::init procedure for non-standard initialization. +pcx::complete ADDED modules/clock/iso8601.tcl Index: modules/clock/iso8601.tcl ================================================================== --- /dev/null +++ modules/clock/iso8601.tcl @@ -0,0 +1,280 @@ +## -*- 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 +package provide clock::iso8601 0.1 +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] +} ADDED modules/clock/iso8601.test Index: modules/clock/iso8601.test ================================================================== --- /dev/null +++ modules/clock/iso8601.test @@ -0,0 +1,217 @@ +# ------------------------------------------------------------------------- +# iso8601.test -*- tcl -*- +# (C) 2013 Andreas Kupries. BSD licensed. +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.5 +testsNeedTcltest 2.0 + +testing { + useLocal iso8601.tcl clock::iso8601 +} + +# ------------------------------------------------------------------------- + +test clock-iso8601-1.0.0 {parse_date wrong\#args} -constraints {tcl8.5plus tcl8.5minus} -body { + clock::iso8601 parse_date +} -returnCodes error -result {wrong # args: should be "clock::iso8601 parse_date string ..."} + +test clock-iso8601-1.0.1 {parse_date wrong\#args} -constraints {tcl8.6plus} -body { + clock::iso8601 parse_date +} -returnCodes error -result {wrong # args: should be "clock::iso8601 parse_date string ?arg ...?"} + +test clock-iso8601-1.1 {parse_date, bad option} -body { + clock::iso8601 parse_date 1994-11-05 -foo x +} -returnCodes error -result {bad switch "-foo", must be -base, -format, -gmt, -locale or -timezone} + +# NOTE: While listed as legal, -format is NOT. This is because the +# command simply hands off to clock scan, and we are seeing its error +# message. Either we do our own argument check first, or we capture +# and rewrite the error. + +# ------------------------------------------------------------------------- + +test clock-iso8601-2.0 {parse_date, bad input} -body { + clock::iso8601 parse_date A +} -returnCodes error -result {not an iso8601 date string} + +test clock-iso8601-2.1 {parse_date} -body { + clock::iso8601 parse_date 1994-11-05 + # It is unclear if this is influenced by TZ. +} -result 784022400 + +# ------------------------------------------------------------------------- + +test clock-iso8601-2.0.0 {parse_date, format: 19700102, reformatted with clock format -format {%D}} -body { + clock format [clock::iso8601 parse_date {19700102}] -format {%D} +} -result {01/02/1970} + +test clock-iso8601-2.0.1 {parse_date, format: 1970-W01-5, reformatted with clock format -format {%D}} -body { + clock format [clock::iso8601 parse_date {1970-W01-5}] -format {%D} +} -result {01/02/1970} + +test clock-iso8601-2.1.0 {parse_date, format: 19700102, using -timezone :UTC} -body { + clock::iso8601 parse_date {19700102} -timezone :UTC +} -result {86400} + +test clock-iso8601-2.1.1 {parse_date, format: 1970-W01-5, using -timezone :UTC} -body { + clock::iso8601 parse_date {1970-W01-5} -timezone :UTC +} -result {86400} + +test clock-iso8601-2.2.0 {parse_date, format: 970701 (yymmdd), reformatted with clock format -format {%D}} -body { + clock format [clock::iso8601 parse_date {970701}] -format {%D} +} -result {07/01/1997} + +test clock-iso8601-2.2.1 {parse_date, format: 1997-07, reformatted with clock format -format {%D}} -body { + clock format [clock::iso8601 parse_date {1997-07}] -format {%D} +} -result {07/01/1997} + +test clock-iso8601-2.3.0 {parse_date, format: 970701 (yymmdd), using -timezone :UTC} -body { + clock::iso8601 parse_date {970701} -timezone :UTC +} -result {867715200} + +test clock-iso8601-2.3.1 {parse_date, format: 1997-07, using -timezone :UTC} -body { + clock::iso8601 parse_date {1997-07} -timezone :UTC +} -result {867715200} + +test clock-iso8601-2.4.0 {parse_date, format: 1997, reformatted with clock format -format {%D}} -body { + clock format [clock::iso8601 parse_date {1997}] -format {%D} +} -result {01/01/1997} + +test clock-iso8601-2.4.1 {parse_date, format: 1997, reformatted with clock format -format {%D}} -body { + clock format [clock::iso8601 parse_date {1997}] -format {%D} +} -result {01/01/1997} + +test clock-iso8601-2.5.0 {parse_date, format: 1997, using -timezone :UTC} -body { + clock::iso8601 parse_date {1997} -timezone :UTC +} -result {852076800} + +test clock-iso8601-2.5.1 {parse_date, format: 1997-, using -timezone :UTC} -body { + clock::iso8601 parse_date {1997} -timezone :UTC +} -result {852076800} + +# ------------------------------------------------------------------------- + +foreach {n iso week} { + 00 01/01/2005 2004-W53-6 + 01 01/02/2005 2004-W53-7 + 02 12/31/2005 2005-W52-6 + 03 01/01/2007 2007-W01-1 + 04 12/30/2007 2007-W52-7 + 05 12/31/2007 2008-W01-1 + 06 01/01/2008 2008-W01-2 + 07 12/28/2008 2008-W52-7 + 08 12/29/2008 2009-W01-1 + 09 12/30/2008 2009-W01-2 + 10 12/31/2008 2009-W01-3 + 11 01/01/2009 2009-W01-4 + 12 12/31/2009 2009-W53-4 + 13 01/01/2010 2009-W53-5 + 14 01/02/2010 2009-W53-6 + 15 01/03/2010 2009-W53-7 +} { + test clock-iso8601-2.6.$n {parse_date, format: YYYY-Www-D into %D} -body { + clock format [clock::iso8601 parse_date $week] -format {%D} + } -result $iso + + test clock-iso8601-2.7.$n {parse_date, format: YYYYWwwD into %D} -body { + clock format [clock::iso8601 parse_date [string map {- {}} $week]] -format {%D} + } -result $iso +} + +foreach {n iso week} { + 00 01/01/2007 2007-W01 + 01 12/31/2007 2008-W01 + 02 12/29/2008 2009-W01 +} { + test clock-iso8601-2.8.$n {parse_date, format: YYYY-Www into %D} -body { + clock format [clock::iso8601 parse_date $week] -format {%D} + } -result $iso + + test clock-iso8601-2.9.$n {parse_date, format: YYYYWww into %D} -body { + clock format [clock::iso8601 parse_date [string map {- {}} $week]] -format {%D} + } -result $iso +} + +# ------------------------------------------------------------------------- + +test clock-iso8601-5.0.0 {parse_time wrong\#args} -constraints {tcl8.5plus tcl8.5minus} -body { + clock::iso8601 parse_time +} -returnCodes error -result {wrong # args: should be "clock::iso8601 parse_time string ..."} + +test clock-iso8601-5.0.1 {parse_time wrong\#args} -constraints {tcl8.6plus} -body { + clock::iso8601 parse_time +} -returnCodes error -result {wrong # args: should be "clock::iso8601 parse_time string ?arg ...?"} + +test clock-iso8601-5.1 {parse_time, bad option} -body { + clock::iso8601 parse_time A -foo x +} -returnCodes error -result {not an iso8601 time string} + +# ------------------------------------------------------------------------- + +test clock-iso8601-6.0.0 {parse_time, full date time} -body { + clock::iso8601 parse_time 2004-W33-2T18:52:24Z +} -result {1092163944} + +test clock-iso8601-6.0.1 {parse_time, full time} -body { + clock format [clock::iso8601 parse_time 18:52:24Z] -format {%X %z} -timezone :UTC +} -result {18:52:24 +0000} + +test clock-iso8601-6.1.0 {parse_time, full date time to minute and offset as +/-hh:mm} -body { + clock::iso8601 parse_time 1997-07-16T19:20+01:00 +} -result {869077200} + +test clock-iso8601-6.1.1 {parse_time, full date time to minute and offset as +/-hhmm} -body { + clock::iso8601 parse_time 1997-07-16T19:20+0100 +} -result {869077200} + +test clock-iso8601-6.2.0 {parse_time, full date time to hour and offset as +/-hh:mm} -body { + clock::iso8601 parse_time 1997-07-16T19+01:00 +} -result {869076000} + +test clock-iso8601-6.2.1 {parse_time, full date time to hour and offset as +/-hhmm} -body { + clock::iso8601 parse_time 1997-07-16T19+0100 +} -result {869076000} + +test clock-iso8601-6.3.0 {parse_time, full date time to second and offset as +/-hh:mm} -body { + clock::iso8601 parse_time 1997-07-16T19:20:30+01:00 +} -result {869077230} + +test clock-iso8601-6.3.1 {parse_time, full date time to second and offset as +/-hhmm} -body { + clock::iso8601 parse_time 1997-07-16T19:20:30+0100 +} -result {869077230} + +test clock-iso8601-6.4.0 {parse_time, full date time to minute and offset as +/-hh:mm} -body { + clock::iso8601 parse_time 1997-07-16T19:20:30.45+01:00 +} -returnCodes error -result {input string does not match supplied format} + +test clock-iso8601-6.4.1 {parse_time, full date time to minute and offset as +/-hhmm} -body { + clock::iso8601 parse_time 1997-07-16T19:20:30.45+0100 +} -returnCodes error -result {input string does not match supplied format} + +# ------------------------------------------------------------------------- + +test clock-iso8601-7.0 {parse_time, bad input} -body { + clock::iso8601 parse_time A +} -returnCodes error -result {not an iso8601 time string} + +test clock-iso8601-7.1 {parse_time} -body { + # The difference to midnight is constant. + # The day part is not, and there is TZ. + expr {[clock::iso8601 parse_time 08:15:30] - + [clock::iso8601 parse_time 00:00:00]} +} -result 29730 + +# ------------------------------------------------------------------------- + +testsuiteCleanup +return + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: ADDED modules/clock/pkgIndex.tcl Index: modules/clock/pkgIndex.tcl ================================================================== --- /dev/null +++ modules/clock/pkgIndex.tcl @@ -0,0 +1,3 @@ +if {![package vsatisfies [package provide Tcl] 8.5]} {return} +package ifneeded clock::rfc2822 0.1 [list source [file join $dir rfc2822.tcl]] +package ifneeded clock::iso8601 0.1 [list source [file join $dir iso8601.tcl]] ADDED modules/clock/rfc2822.man Index: modules/clock/rfc2822.man ================================================================== --- /dev/null +++ modules/clock/rfc2822.man @@ -0,0 +1,36 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin clock_rfc2822 n 0.1] +[moddesc {Date/Time Utilities}] +[titledesc {Parsing ISO 8601 dates/times}] +[category {Text processing}] +[require Tcl 8.5] +[require clock::rfc2822 [opt 0.1]] +[description] + +This package provides functionality to parse dates in +RFC 2822 format. + +[para] + +[list_begin definitions] + +[call [cmd {::clock::rfc2822 parse_date}] [arg date]] + +This command parses an RFC2822 date string and returns +the given date in seconds since epoch. An error is thrown +if the command is unable to parse the date. + +[list_end] + +[section {BUGS, IDEAS, FEEDBACK}] + +This document, and the package it describes, will undoubtedly contain +bugs and other problems. + +Please report such in the category [emph clock::rfc2822] of the +[uri {http://sourceforge.net/tracker/?group_id=12883} {Tcllib SF Trackers}]. + +Please also report any ideas for enhancements you may have for either +package and/or documentation. + +[manpage_end] ADDED modules/clock/rfc2822.pcx Index: modules/clock/rfc2822.pcx ================================================================== --- /dev/null +++ modules/clock/rfc2822.pcx @@ -0,0 +1,27 @@ +# -*- tcl -*- rfc2822.pcx +# Syntax of the commands provided by package rfc2822. + +# For use by TclDevKit's static syntax checker. +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the documentation describing the format of the code contained in this file +# + +package require pcx +pcx::register clock::rfc2822 +pcx::tcldep 0.1 needs tcl 8.5 + +namespace eval ::clock::rfc2822 {} + +#pcx::message FOO {... text ...} type +#pcx::scan + +# Switches are per clock scan (Tcl 8.5), restricted subset. +pcx::check 0.1 std ::clock::rfc2822::parse_date \ + {checkSimpleArgs 1 1 { + checkWord + }} + +# Initialization via pcx::init. +# Use a ::rfc2822::init procedure for non-standard initialization. +pcx::complete ADDED modules/clock/rfc2822.tcl Index: modules/clock/rfc2822.tcl ================================================================== --- /dev/null +++ modules/clock/rfc2822.tcl @@ -0,0 +1,214 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ##################### +## Copyright (c) 2004 Kevin Kenny +## Origin http://wiki.tcl.tk/24074 + +# # ## ### ##### ######## ############# ##################### +## Requisites + +package require Tcl 8.5 +package provide clock::rfc2822 0.1 +namespace eval ::clock::rfc2822 {} + +# # ## ### ##### ######## ############# ##################### +## API + +# ::clock::rfc2822::parse_date -- +# +# Parses a date expressed in RFC2822 format +# +# Parameters: +# date - The date to parse +# +# Results: +# Returns the date expressed in seconds from the Epoch, or throws +# an error if the date could not be parsed. + +proc ::clock::rfc2822::parse_date { date } { + variable datepats + + # Strip comments and excess whitespace from the date field + + regsub -all -expanded { + \( # open parenthesis + (:? + [^()[.\.]] # character other than ()\ + |\\. # or backslash escape + )* # any number of times + \) # close paren + } $date {} date + set date [string trim $date] + + # Match the patterns in order of preference, returning the first success + + foreach {regexp pat} $datepats { + if { [regexp -nocase $regexp $date] } { + return [clock scan $date -format $pat] + } + } + + return -code error -errorcode {CLOCK RFC2822 BADDATE} \ + "expected an RFC2822 date, got \"$date\"" +} + + +# # ## ### ##### ######## ############# ##################### +## Internals, transient, removed after initialization. + +# AddDatePat -- +# +# Internal procedure that adds a date pattern to the pattern list +# +# Parameters: +# wpat - Regexp pattern that matches the weekday +# wgrp - Format group that matches the weekday +# ypat - Regexp pattern that matches the year +# ygrp - Format group that matches the year +# mdpat - Regexp pattern that matches month and day +# mdgrp - Format group that matches month and day +# spat - Regexp pattern that matches the seconds of the minute +# sgrp - Format group that matches the seconds of the minute +# zpat - Regexp pattern that matches the time zone +# zgrp - Format group that matches the time zone +# +# Results: +# None +# +# Side effects: +# Adds a complete regexp and a complete [clock scan] pattern to +# 'datepats' + +proc ::clock::rfc2822::AddDatePat { wpat wgrp ypat ygrp mdpat mdgrp + spat sgrp zpat zgrp } { + variable datepats + + set regexp {^[[:space:]]*} + set pat {} + append regexp $wpat $mdpat {[[:space:]]+} $ypat + append pat $wgrp $mdgrp $ygrp + append regexp {[[:space:]]+\d\d?:\d\d} $spat + append pat { %H:%M} $sgrp + append regexp $zpat + append pat $zgrp + append regexp {[[:space:]]*$} + lappend datepats $regexp $pat + return +} + +# InitDatePats -- +# +# Internal procedure that initializes the set of date patterns +# allowed in an RFC2822 date +# +# Parameters: +# permissible - 1 if erroneous (but common) time zones are to be +# allowed, 0 if they are to be rejected +# +# Results: +# None. +# +# Side effects: + +proc ::clock::rfc2822::InitDatePats { permissible } { + # Produce formats for the observed variants of ISO2822 dates. + # Permissible variants come first in the list; impermissible ones + # come later. + + # The month and day may be "%b %d" or "%d %b" + + foreach mdpat {{[[:alpha:]]+[[:space:]]+\d\d?} + {\d\d?[[:space:]]+[[:alpha:]]+}} \ + mdgrp {{%b %d} {%d %b}} \ + mdperm {0 1} { + # The year may be two digits, or four. Four digit year is + # done first. + + foreach ypat {{\d\d\d\d} {\d\d}} ygrp {%Y %y} { + # The seconds of the minute may be provided, or + # omitted. + + foreach spat {{:\d\d} {}} sgrp {:%S {}} { + # The weekday may be provided or omitted. It is + # common but impermissible to omit the comma after + # the weekday name. + + foreach wpat { + {(?:Mon|T(?:ue|hu)|Wed|Fri|S(?:at|un)),[[:space:]]+} + {(?:Mon|T(?:ue|hu)|Wed|Fri|S(?:at|un))[[:space:]]+} + {} + } wgrp { + {%a, } + {%a } + {} + } wperm { + 1 + 0 + 1 + } { + # Time zone is defined as +/- hhmm, or as a + # named time zone. Other common but buggy + # formats are GMT+-hh:mm, a time zone name in + # quotation marks, and complete omission of + # the time zone. + + foreach zpat { + {[[:space:]]+(?:[-+]\d\d\d\d|[[:alpha:]]+)} + {[[:space:]]+GMT[-+]\d\d:?\d\d} + {[[:space:]]+"[[:alpha:]]+"} + {} + } zgrp { + { %Z} + { GMT%Z} + { "%Z"} + {} + } zperm { + 1 + 0 + 0 + 0 + } { + if { ($zperm && $wperm && $mdperm) + == $permissible } { + AddDatePat $wpat $wgrp $ypat $ygrp \ + $mdpat $mdgrp \ + $spat $sgrp $zpat $zgrp + } + } + } + } + } + } + return +} + +# # ## ### ##### ######## ############# ##################### +## State + +namespace eval ::clock::rfc2822 { + namespace export parse_date + namespace ensemble create + + variable datepats {} +} + +# # ## ### ##### ######## ############# ##################### +# Initialize the date patterns + +namespace eval ::clock::rfc2822 { + InitDatePats 1 + InitDatePats 0 + rename AddDatePat {} + rename InitDatePats {} + #puts [join $datepats \n] +} + +# # ## ### ##### ######## ############# ##################### + +return +# Usage example, disabled + +if {![info exists ::argv0] || [info script] ne $::argv0} return +puts [clock format \ + [::clock::rfc2822::parse_date {Mon(day), 23 Aug(ust) 2004 01:23:45 UT}]] +puts [clock format \ + [::clock::rfc2822::parse_date "Tue, Jul 21 2009 19:37:47 GMT-0400"]] ADDED modules/clock/rfc2822.test Index: modules/clock/rfc2822.test ================================================================== --- /dev/null +++ modules/clock/rfc2822.test @@ -0,0 +1,44 @@ +# ------------------------------------------------------------------------- +# rfc2822.test -*- tcl -*- +# (C) 2013 Andreas Kupries. BSD licensed. +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.5 +testsNeedTcltest 2.0 + +testing { + useLocal rfc2822.tcl clock::rfc2822 +} + +# ------------------------------------------------------------------------- + +test clock-rfc2822-1.0 {parse_date wrong\#args} -body { + clock::rfc2822 parse_date +} -returnCodes error -result {wrong # args: should be "clock::rfc2822 parse_date date"} + +test clock-rfc2822-1.1 {parse_date wrong\#args} -body { + clock::rfc2822 parse_date D X +} -returnCodes error -result {wrong # args: should be "clock::rfc2822 parse_date date"} + +# ------------------------------------------------------------------------- + +test clock-rfc2822-2.0 {parse_date, bad input} -body { + clock::rfc2822 parse_date D +} -returnCodes error -result {expected an RFC2822 date, got "D"} + +test clock-rfc2822-2.1 {parse_date} -body { + clock::rfc2822 parse_date {Fri, 09 Sep 2005 13:51:39 -0700} +} -result 1126299099 + +# ------------------------------------------------------------------------- +testsuiteCleanup +return + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: Index: support/installation/modules.tcl ================================================================== --- support/installation/modules.tcl +++ support/installation/modules.tcl @@ -43,10 +43,11 @@ Module bench _tcl _null _null Module bibtex _tcl _man _exa Module blowfish _tcl _man _null Module cache _tcl _man _null Module calendar _tci _man _null +Module clock _tcl _null _null Module cmdline _tcl _man _null Module comm _tcl _man _null Module control _tci _man _null Module coroutine _tcl _null _null Module counter _tcl _man _null