Tcl Library Source Code

2013-01-24  Andreas Kupries  <[email protected]>

	* New module and packages: clock (rfc2822, iso8601).
	  Tcl 8.5 only.

2013-01-08  Andreas Kupries  <[email protected]>

	* configure.in: [Bug 3593146]: Extended with CYGPATH usage to
	  allow building under cygwin.
	* configure: Regenerated (autoconf 2.67).

2012-08-07  Andreas Kupries  <[email protected]>

2013-01-24  Andreas Kupries  <[email protected]>

	* New module, 2 packages.
	* rfc2822.tcl: Parsing rfc2822 dates (mail, news)
	* iso8601.tcl: Parsing iso8601 dates and times.
	* pkgIndex.tcl:

[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]

# -*- 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 <VERSION> <NAME> <RULE>

# 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

## -*- 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]
}

# -------------------------------------------------------------------------
# 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:

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]]

[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]

# -*- 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 <VERSION> <NAME> <RULE>

# 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

## -*- 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"]]

# -------------------------------------------------------------------------
# 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:

Module  base64      _tcl  _man  _null
Module  bee         _tcl  _man  _null
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
Module  crc         _tcl  _man  _null
Module  csv         _tcl  _man _exa