mime::parsedatetime (public)

 mime::parsedatetime value property

Defined in packages/acs-tcl/tcl/tcllib-doc-procs.tcl

Extract a property from an email date-time value using Tcllib.

Parameters:

value (required)

Email date-time string, or -now for the current time.

property (required)

Requested property, such as clock, proper, year, mon or zone.

Returns:

The requested date-time property.

See Also:

• https://core.tcl-lang.org/tcllib/doc/trunk/embedded/md/tcllib/files/modules/mime/mime.md

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

    if {$value eq "-now"} {
        set clock [clock seconds]
    } elseif {[regexp {^(.*) ([+-])([0-9][0-9])([0-9][0-9])$} $value  -> value zone_sign zone_hour zone_min]} {
        set clock [clock scan $value -gmt 1]
        if {[info exists zone_min]} {
            set zone_min [scan $zone_min %d]
            set zone_hour [scan $zone_hour %d]
            set zone [expr {60 * ($zone_min + 60 * $zone_hour)}]
            if {$zone_sign eq "+"} {
                set zone -$zone
            }
            incr clock $zone
        }
    } else {
        set clock [clock scan $value]
    }

    switch -- $property {
        clock {
            return $clock
        }

        hour {
            set value [clock format $clock -format %H]
        }

        lmonth {
            variable MONTHS_LONG
            return [lindex $MONTHS_LONG  [scan [clock format $clock -format %m] %d]]
        }

        lweekday {
            variable WDAYS_LONG
            return [lindex $WDAYS_LONG [clock format $clock -format %w]]
        }

        mday {
            set value [clock format $clock -format %d]
        }

        min {
            set value [clock format $clock -format %M]
        }

        mon {
            set value [clock format $clock -format %m]
        }

        month {
            variable MONTHS_SHORT
            return [lindex $MONTHS_SHORT  [scan [clock format $clock -format %m] %d]]
        }

        proper {
            set gmt [clock format $clock -format "%Y-%m-%d %H:%M:%S"  -gmt true]
            if {[set diff [expr {($clock-[clock scan $gmt]) / 60}]] < 0} {
                set s -
                set diff [expr {-($diff)}]
            } else {
                set s +
            }
            set zone [format %s%02d%02d $s [
                expr {$diff / 60}] [expr {$diff % 60}]]

            variable WDAYS_SHORT
            set wday [lindex $WDAYS_SHORT [clock format $clock -format %w]]
            variable MONTHS_SHORT
            set mon [lindex $MONTHS_SHORT  [scan [clock format $clock -format %m] %d]]

            return [clock format $clock  -format "$wday, %d $mon %Y %H:%M:%S $zone"]
        }

        rclock {
            #TODO: these paths are not covered by tests
            if {$value eq "-now"} {
                return 0
            } else {
                return [expr {[clock seconds] - $clock}]
            }
        }

        sec {
            set value [clock format $clock -format %S]
        }

        wday {
            return [clock format $clock -format %w]
        }

        weekday {
            variable WDAYS_SHORT
            return [lindex $WDAYS_SHORT [clock format $clock -format %w]]
        }

        yday {
            set value [clock format $clock -format %j]
        }

        year {
            set value [clock format $clock -format %Y]
        }

        zone {
            set value [string trim [string map [list \t { }] $value]]
            if {[set x [string last { } $value]] < 0} {
                return 0
            }
            set value [string range $value [expr {$x + 1}] end]
            switch -- [set s [string index $value 0]] {
                + - - {
                    if {$s eq "+"} {
                        #TODO: This path is not covered by tests
                        set s {}
                    }
                    set value [string trim [string range $value 1 end]]
                    if {([string length $value] != 4)  || ([scan $value %2d%2d h m] != 2)  || ($h > 12)  || ($m > 59)  || (($h == 12) && ($m > 0))} {
                        error "malformed timezone-specification: $value"
                    }
                    set value $s[expr {$h * 60 + $m}]
                }

                default {
                    set value [string toupper $value]
                    set z1 [list  UT GMT EST EDT CST CDT MST MDT PST PDT]
                    set z2 [list   0   0  -5  -4  -6  -5  -7  -6  -8  -7]
                    if {[set x [lsearch -exact $z1 $value]] < 0} {
                        error "unrecognized timezone-mnemonic: $value"
                    }
                    set value [expr {[lindex $z2 $x] * 60}]
                }
            }
        }

        date2gmt
            -
        date2local
            -
        dst
            -
        sday
            -
        szone
            -
        tzone
            -
        default {
            error "unknown property $property"
        }
    }

    if {[set value [string trimleft $value 0]] eq {}} {
        #TODO: this path is not covered by tests
        set value 0
    }
    return $value

XQL Not present:

Generic, PostgreSQL, Oracle