Attachment "clock.tcl.patch" to
ticket [3475995fff]
added by
sebres
2012-01-19 17:58:42.
Index: clock.tcl
===================================================================
--- clock.tcl (revision 78)
+++ clock.tcl (working copy)
@@ -740,7 +740,7 @@
# Return either the error or the proc name
if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
+ if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
return -code error $result
} else {
return -options $opts $result
@@ -1213,7 +1213,7 @@
\"$cmdName string\
?-base seconds?\
?-format string? ?-gmt boolean?\
- ?-locale LOCALE? ?-timezone ZONE?\""
+ ?-locale LOCALE? ?-timezone ZONE? ?-valid 1|0?\""
}
# Set defaults
@@ -1224,6 +1224,7 @@
set gmt 0
set locale c
set timezone [GetSystemTimeZone]
+ set validate 1
# Pick up command line options.
@@ -1245,6 +1246,9 @@
-t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
set timezone $value
}
+ -v - -valid {
+ set validate $value
+ }
default {
return -code error \
-errorcode [list CLOCK badSwitch $flag] \
@@ -1283,7 +1287,7 @@
"legacy \[clock scan\] does not support -locale"
}
- return [FreeScan $string $base $timezone $locale]
+ return [FreeScan $string $base $timezone $locale $validate]
}
# Change locale if a fresh locale has been given on the command line.
@@ -1295,7 +1299,7 @@
# Map away the locale-dependent composite format groups
set scanner [ParseClockScanFormat $format $locale]
- $scanner $string $base $timezone
+ $scanner $string $base $timezone $validate
} result opts]
@@ -1306,11 +1310,10 @@
}
if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
- return -code error $result
- } else {
- return -options $opts $result
+ if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
+ dict unset opts -errorinfo
}
+ return -options $opts -code error -level 1 $result
} else {
return $result
}
@@ -1335,7 +1338,7 @@
#
#----------------------------------------------------------------------
-proc ::tcl::clock::FreeScan { string base timezone locale } {
+proc ::tcl::clock::FreeScan { string base timezone locale {validate 1} } {
variable TZData
@@ -1422,6 +1425,16 @@
dict set date secondOfDay 0
}
+ if {$validate} {
+ if {[catch {
+ ValidDate $date $string
+ } result opts]} {
+ if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
+ dict unset opts -errorinfo
+ }
+ return -options $opts -code error -level 2 $result
+ }
+ }
dict set date localSeconds \
[expr { -210866803200
+ ( 86400 * wide([dict get $date julianDay]) )
@@ -2034,6 +2047,10 @@
set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
$TZData($timeZone) \
$changeover]
+
+ if {$validate} {
+ ValidDate $date $string
+ }
}
}
@@ -2041,7 +2058,7 @@
append procBody {return [dict get $date seconds]} \n
- proc $procName { string baseTime timeZone } $procBody
+ proc $procName { string baseTime timeZone {validate 1} } $procBody
# puts [list proc $procName [list string baseTime timeZone] $procBody]
@@ -3068,8 +3085,13 @@
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemTimeZone {} {
-
variable CachedSystemTimeZone
+ if { [info exists CachedSystemTimeZone] } {
+ ## if not switched to another time zone (simply check cached every 10 minutes) :
+ if {abs([clock seconds] - [lindex $CachedSystemTimeZone 1]) < 600} {
+ return [lindex $CachedSystemTimeZone 0]
+ }
+ }
variable TimeZoneBad
if {[set result [getenv TCL_TZ]] ne {}} {
@@ -3080,28 +3102,25 @@
if {![info exists timezone]} {
# Cache the time zone only if it was detected by one of the
# expensive methods.
- if { [info exists CachedSystemTimeZone] } {
- set timezone $CachedSystemTimeZone
- } elseif { $::tcl_platform(platform) eq {windows} } {
- set timezone [GuessWindowsTimeZone]
- } elseif { [file exists /etc/localtime]
- && ![catch {ReadZoneinfoFile \
- Tcl/Localtime /etc/localtime}] } {
- set timezone :Tcl/Localtime
- } else {
- set timezone :localtime
- }
- set CachedSystemTimeZone $timezone
+ if { $::tcl_platform(platform) eq {windows} } {
+ set timezone [GuessWindowsTimeZone]
+ } elseif { [file exists /etc/localtime]
+ && ![catch {ReadZoneinfoFile \
+ Tcl/Localtime /etc/localtime}] } {
+ set timezone :Tcl/Localtime
+ } else {
+ set timezone :localtime
+ }
}
if { ![dict exists $TimeZoneBad $timezone] } {
dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
}
if { [dict get $TimeZoneBad $timezone] } {
- return :localtime
- } else {
- return $timezone
+ set timezone :localtime
}
-
+ ## cache (simply check cached every 10 minutes (rounded to 00:10:00)):
+ set CachedSystemTimeZone [list $timezone [expr {[set switchtime [clock seconds]] - $switchtime % 600}]]
+ return $timezone
}
#----------------------------------------------------------------------
@@ -4691,3 +4710,206 @@
InitTZData
}
+
+
+#----------------------------------------------------------------------
+# [SEBRES] extension:
+# - validate :
+# - create date direct from args (without parsing string) :
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::ValidDate {date string} {
+ ## check date :
+ if {[dict exists $date month] && [dict exists $date dayOfMonth]} {
+ ## first - month :
+ if { [set month [dict get $date month]] > 12 || $month < 1 } {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid month"
+ }
+ ## by february check leap year :
+ if {$month == 2} {
+ # Todo: correct this for not grigorian:
+ if {![dict exists $date gregorian]} {
+ dict set date gregorian 1
+ }
+ if { [IsGregorianLeapYear $date] } {
+ variable DaysInRomanMonthInLeapYear
+ set hath [lindex $DaysInRomanMonthInLeapYear [expr {$month - 1}]]
+ } else {
+ variable DaysInRomanMonthInCommonYear
+ set hath [lindex $DaysInRomanMonthInCommonYear [expr {$month - 1}]]
+ }
+ } else {
+ variable DaysInRomanMonthInCommonYear
+ set hath [lindex $DaysInRomanMonthInCommonYear [expr {$month - 1}]]
+ }
+ ## check day in month :
+ if { [set day [dict get $date dayOfMonth]] > $hath || $day < 1 } {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid day"
+ }
+ }
+ ## Oldscan could returns secondOfDay (parsedTime) -1 by invalid time (ex.: 25:00:00) :
+ if {[dict exists $date secondOfDay] && [dict get $date secondOfDay] == -1} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time"
+ }
+ ## check time (00:00:00 - 23:59:59 or 00:00:00[ap]m - 12:00:00[ap]m) :
+ if {[dict exists $date hour]} {
+ if {[set v [dict get $date hour]] < 0 || $v > 23} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (hour)"
+ }
+ if {[dict exists $date amPmIndicator] && $v > 12} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (hour/am:pm)"
+ }
+ }
+ if {[dict exists $date minute] && ([set v [dict get $date minute]] < 0 || $v > 59)} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (minute)"
+ }
+ if {[dict exists $date second] && ([set v [dict get $date second]] < 0 || $v > 59)} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (second)"
+ }
+}
+
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::MakeDate {args} {
+ set date $args[set args {}]
+
+ if {![dict exists $date baseTime]} {
+ set baseTime [clock seconds]
+ } else {
+ set baseTime [dict get $date baseTime]
+ }
+
+ set changeover 2361222; #[tcl::clock::mc GREGORIAN_CHANGE_DATE]
+ set tz {}
+ if {[dict exists $date tzName]} {
+ set tz [dict get $date tzName]
+ if {$tz == {}} {
+ set tz [::tcl::clock::GetSystemTimeZone]
+ } elseif {$tz in {:UTC :GMT}} {
+ set tz {}
+ }
+ if {$tz != {}} {
+ variable TZData
+ if {![info exists TZData($tz)]} {
+ ::tcl::clock::SetupTimeZone $tz
+ }
+ }
+ }
+
+ dict set date era CE
+ # Julian Day Number from the fields.
+ if {![dict exists $date year]} {
+ if {![dict exists $date yearOfCentury]} {
+ set date [AssignBaseYear $date[set date {}] \
+ $baseTime $tz $changeover]
+ } else {
+ set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
+ }
+ }
+ if {![dict exists $date month]} {
+ set date [AssignBaseMonth $date[set date {}] \
+ $baseTime $tz $changeover]
+ }
+ if {![dict exists $date dayOfMonth]} {
+ variable TZData
+ set date2 [GetDateFields $baseTime $TZData($tz) $changeover]
+ dict set date dayOfMonth [dict get $date2 dayOfMonth]
+ }
+ if {[catch {
+ set date [::tcl::clock::GetJulianDayFromEraYearMonthDay $date[set date {}] $changeover]
+ } msg]} {
+ return -code error -errorcode [list CLOCK invalidArgs] $msg
+ }
+ # Get time of day
+ dict set date secondOfDay [::tcl::clock::InterpretHMS $date]
+ # Assemble seconds, and convert local nominal time to UTC.
+ if { [dict get $date julianDay] > 5373484 } {
+ return -code error -errorcode [list CLOCK dateTooLarge] "requested date too large to represent"
+ }
+ dict set date localSeconds [set secs [expr { -210866803200
+ + ( 86400 * wide([dict get $date julianDay]) )
+ + [dict get $date secondOfDay] }]]
+ if {$tz != {}} {
+ set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] $TZData($tz) $changeover]
+ return $date
+ }
+ # set seconds to localSeconds
+ dict set date seconds $secs
+ return $date
+}
+
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::ConvertToSeconds {Y m d H M S {tz {}}} {
+ set date [list \
+ year $Y \
+ month $m \
+ dayOfMonth $d \
+ hour $H \
+ minute $M \
+ second $S \
+ ]
+
+ set changeover 2361222; #[tcl::clock::mc GREGORIAN_CHANGE_DATE]
+ if {$tz == {}} {
+ set tz [GetSystemTimeZone]
+ } elseif {$tz ni {:UTC :GMT}} {
+ variable TZData
+ if {![info exists TZData($tz)]} {
+ SetupTimeZone $tz
+ }
+ } else {
+ ## don't convert in local :
+ set tz {}
+ }
+
+ dict set date era CE
+ # Julian Day Number from the fields.
+ if {[catch {
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] $changeover]
+ } msg]} {
+ return -code error -errorcode [list CLOCK invalidArgs] $msg
+ }
+ # Get time of day
+ dict set date secondOfDay [InterpretHMS $date]
+ # Assemble seconds, and convert local nominal time to UTC.
+ if { [dict get $date julianDay] > 5373484 } {
+ return -code error -errorcode [list CLOCK dateTooLarge] "requested date too large to represent"
+ }
+ set secs [expr { -210866803200
+ + ( 86400 * wide([dict get $date julianDay]) )
+ + [dict get $date secondOfDay] }]
+ if {$tz != {}} {
+ variable TZData
+ dict set date localSeconds $secs
+ set date [ConvertLocalToUTC $date[set date {}] $TZData($tz) $changeover]
+ # return utc :
+ return [dict get $date seconds]
+ }
+ # return localSeconds (already utc)
+ return $secs
+}
+
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::ConvertFromSeconds {clock {tz {}}} {
+ variable TZData
+
+ set changeover 2361222; #[tcl::clock::mc GREGORIAN_CHANGE_DATE]
+ if {$tz == {}} {
+ set tz [GetSystemTimeZone]
+ } elseif {$tz ni {:UTC :GMT}} {
+ if {![info exists TZData($tz)]} {
+ SetupTimeZone $tz
+ }
+ }
+ ## get date var :
+ set date [GetDateFields $clock $TZData($tz) $changeover]
+ set time [dict get $date localSeconds]
+ ## return list Y m d H M S
+ list \
+ [dict get $date year] [dict get $date month] [dict get $date dayOfMonth] \
+ [expr {$time / 3600 % 24}] [expr {$time / 60 % 60}] [expr {$time % 60}]
+}
+
+#----------------------------------------------------------------------
