::namespace eval qw::date {} ::proc ::qw::date::nv1_keystroke_to_ymdhms {Src} { /* { We are taking a date in NV1 keystroke format and converting it to a ymdhms format. A zero date becomes a null date. */ } ::qw::try { ::if {$Src eq "" || $Src == 0} {::return "";} ::if {[::string length $Src]!=8} {::qw::throw "The date should have eight characters.";} ::if {![::string is digit $Src]} {::qw::throw "Non-digit characters encountered.";} ::return [::string range $Src 4 7][::string range $Src 2 3][::string range $Src 0 1]; } catch Exception { ::qw::throw [::qw::exception::nest .sub $Exception .super "Could not convert \"$Src\" from NewViews 1 keystroke format to YYYYMMDDHHMMSS format."]; } } /* { ::proc ::qw::date::ymdhms_to_tcl_date {Src} { puts "Deprecated: ymdhms_to_tcl_date, Use ::qw::date::get $Date second_number" return [::qw::date::get $Src second_number]; } ::proc ::qw::date::tcl_date_to_ymdhms {Src} { ::puts "Deprecated: tcl_date_to_ymdhms, Use ::qw::date::set \$Date second_number \$TclDate" return [::qw::date::set "" second_number $Src]; } */ } /* { ::proc ::qw::date::nv1DateToNv2Date {Nv1Date} { #::foreach {D M Y} [::scan $Nv1Date "%2d%2d%4d"] {}; # Can't use - scan strips leading zeros ::if {$Nv1Date==""||$Nv1Date==0} {::return "";} ::if {[::string length $Nv1Date] != 8} {::qw::throw "Invalid Nv1 date \"$Nv1Date\", date is not 8 digits."} ::if {![::string is digit $Nv1Date]} {::qw::throw "Invalid Nv1 date \"$Nv1Date\", date contains non-numeric characters."} ::set D [::string range $Nv1Date 0 1]; ::set M [::string range $Nv1Date 2 3]; ::set Y [::string range $Nv1Date 4 7]; ::set Result $Y$M$D; ::return [::append Result "000000"]; } */ } ::proc ::qw::date::tclDateToNv2Date {Seconds} { ::return [::clock format $Seconds -format "%Y%m%d%H%M%S"]; } /* { 2.28.3 Moved date procs here in one place. Some was in odb and was not available until package qw::odb required. Scripts should not have to load qw::odb just to get date functionality. */ } ::namespace eval ::qw::date {} ::proc ::qw::date {Command args} { ::qw::s_args_marshal; ::switch -- $Command { format { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618102653 "::qw::date $Command expected a .date argument."; } } ::set Format [::sargs::get $s_args .format]; ::return [::qw::date::format $Date $Format]; } scan { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080805122609 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::scan $Date]; } check { } day_get { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618134111 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date day]; } month_get { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224015641 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date month]; } year_get { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224015642 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date year]; } day_set { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618175353 "::qw::date $Command expected a .date argument."; } } ::set Value [::sargs::get $s_args .day]; ::if {$Value eq ""} { ::qw::bug 314120081224103638 "::qw::date $Command expected a .day argument."; } ::return [::qw::date::set $Date day $Value]; } month_set { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224103639 "::qw::date $Command expected a .date argument."; } } ::set Value [::sargs::get $s_args .month]; ::if {$Value eq ""} { ::qw::bug 314120081224103640 "::qw::date $Command expected a .month argument."; } ::return [::qw::date::set $Date month $Value]; } year_set { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224103641 "::qw::date $Command expected a .date argument."; } } ::set Value [::sargs::get $s_args .year]; ::if {$Value eq ""} { ::qw::bug 314120081224103642 "::qw::date $Command expected a .year argument."; } ::return [::qw::date::set $Date year $Value]; } get { ::qw::bug 314120090109170310 "::qw::date get invalid, args==$args"; ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618134111 "::qw::date $Command expected a .date argument."; } } ::set Resolution [::sargs::get $s_args .resolution]; ::if {$Resolution eq ""} { ::if {![::sargs::exists $s_args .resolution]} { ::qw::bug 314120080618134112 "::qw::date $Command expected a .resolution argument."; } } ::return [::qw::date::get $Date $Resolution]; } set { ::qw::bug 314120090109170310 "::qw::date set invalid, args==$args"; ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618175353 "::qw::date $Command expected a .date argument."; } } ::set Resolution [::sargs::get $s_args .resolution]; ::if {$Resolution eq ""} { ::if {![::sargs::exists $s_args .resolution]} { ::qw::bug 314120080618175354 "::qw::date $Command expected a .resolution argument."; } } ::set Number [::sargs::get $s_args .number]; ::if {$Number eq ""} { ::if {![::sargs::exists $s_args .number]} { ::qw::bug 314120080618175355 "::qw::date $Command expected a .number argument."; } } ::return [::qw::date::set $Date $Resolution $Number]; } to_number { # ::qw::bug 314120090109170310 "::qw::date to_number invalid, args==$args"; ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618180631 "::qw::date $Command expected a .date argument."; } } ::set Resolution [::sargs::get $s_args .resolution]; ::if {$Resolution eq ""} { ::if {![::sargs::exists $s_args .resolution]} { ::qw::bug 314120080618180632 "::qw::date $Command expected a .resolution argument."; } } ::return [::qw::date::to_number $Resolution $Date]; } from_number { # ::qw::bug 314120090109170310 "::qw::date from_number invalid, args==$args"; ::set Resolution [::sargs::get $s_args .resolution]; ::if {$Resolution eq ""} { ::if {![::sargs::exists $s_args .resolution]} { ::qw::bug 314120080618180633 "::qw::date $Command expected a .resolution argument."; } } ::set Number [::sargs::get $s_args .number]; ::if {$Number eq ""} { ::if {![::sargs::exists $s_args .number]} { ::qw::bug 314120080618180634 "::qw::date $Command expected a .number argument."; } } ::return [::qw::date::from_number $Resolution $Number]; } day_add { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224103740 "::qw::date $Command expected a .date argument."; } } ::set Delta [::sargs::get $s_args .delta]; ::if {$Delta eq ""} { ::if {![::sargs::exists $s_args .delta]} { ::qw::bug 314120081224103741 "::qw::date $Command expected a .delta argument."; } } ::return [::qw::date::add $Date day $Delta]; } month_add { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224103742 "::qw::date $Command expected a .date argument."; } } ::set Delta [::sargs::get $s_args .delta]; ::if {$Delta eq ""} { ::if {![::sargs::exists $s_args .delta]} { ::qw::bug 314120081224103743 "::qw::date $Command expected a .delta argument."; } } ::return [::qw::date::add $Date month $Delta]; } year_add { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224103744 "::qw::date $Command expected a .date argument."; } } ::set Delta [::sargs::get $s_args .delta]; ::if {$Delta eq ""} { ::if {![::sargs::exists $s_args .delta]} { ::qw::bug 314120081224103745 "::qw::date $Command expected a .delta argument."; } } ::return [::qw::date::add $Date year $Delta]; } second_add { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120090415134518 "::qw::date $Command expected a .date argument."; } } ::set Delta [::sargs::get $s_args .delta]; ::if {$Delta eq ""} { ::if {![::sargs::exists $s_args .delta]} { ::qw::bug 314120081224103745 "::qw::date $Command expected a .delta argument."; } } ::return [::qw::date::add $Date seconds $Delta]; } add { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618130710 "::qw::date $Command expected a .date argument."; } } ::set Resolution [::sargs::get $s_args .resolution]; ::if {$Resolution eq ""} { ::if {![::sargs::exists $s_args .resolution]} { ::qw::bug 314120080618130711 "::qw::date $Command expected a .resolution argument."; } } ::set Delta [::sargs::get $s_args .delta]; ::if {$Delta eq ""} { ::if {![::sargs::exists $s_args .delta]} { ::qw::bug 314120080618130712 "::qw::date $Command expected a .delta argument."; } } ::return [::qw::date::add $Date $Resolution $Delta]; } day_subtract { ::set Date1 [::sargs::get $s_args .date1]; ::if {$Date1 eq ""} { ::qw::bug 314120081224105443 "::qw::date $Command expected a .date1 argument."; } ::set Date2 [::sargs::get $s_args .date2]; ::if {$Date2 eq ""} { ::qw::bug 314120081224105444 "::qw::date $Command expected a .date2 argument."; } ::return [::qw::date::difference $Date1 $Date2 day]; } month_subtract { ::set Date1 [::sargs::get $s_args .date1]; ::if {$Date1 eq ""} { ::qw::bug 314120081224105445 "::qw::date $Command expected a .date1 argument."; } ::set Date2 [::sargs::get $s_args .date2]; ::if {$Date2 eq ""} { ::qw::bug 314120081224105446"::qw::date $Command expected a .date2 argument."; } ::return [::qw::date::difference $Date1 $Date2 month]; } year_subtract { ::set Date1 [::sargs::get $s_args .date1]; ::if {$Date1 eq ""} { ::qw::bug 314120081224105447 "::qw::date $Command expected a .date1 argument."; } ::set Date2 [::sargs::get $s_args .date2]; ::if {$Date2 eq ""} { ::qw::bug 31412008122410548 "::qw::date $Command expected a .date2 argument."; } ::return [::qw::date::difference $Date1 $Date2 year]; } difference { ::set Date1 [::sargs::get $s_args .date1]; ::if {$Date1 eq ""} { ::if {![::sargs::exists $s_args .date1]} { ::qw::bug 314120080618180145 "::qw::date $Command expected a .date1 argument."; } } ::set Date2 [::sargs::get $s_args .date2]; ::if {$Date2 eq ""} { ::if {![::sargs::exists $s_args .date2]} { ::qw::bug 314120080618180146 "::qw::date $Command expected a .date2 argument."; } } ::set Resolution [::sargs::get $s_args .resolution]; ::if {$Resolution eq ""} { ::if {![::sargs::exists $s_args .resolution]} { ::qw::bug 314120080618180147 "::qw::date $Command expected a .resolution argument."; } } ::return [::qw::date::difference $Date1 $Date2 $Resolution]; } compare { ::set Date1 [::sargs::get $s_args .date1]; ::if {$Date1 eq ""} { ::if {![::sargs::exists $s_args .date1]} { ::qw::bug 314120090812080425 "::qw::date $Command expected a .date1 argument."; } } ::set Date2 [::sargs::get $s_args .date2]; ::if {$Date2 eq ""} { ::if {![::sargs::exists $s_args .date2]} { ::qw::bug 314120090812080426 "::qw::date $Command expected a .date2 argument."; } } ::set Result [::qw::date::difference $Date1 $Date2 seconds]; ::if {$Result<0} { ::return -1; } ::if {$Result>0} { ::return 1; } ::return Result; } extend_begin { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618102654 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::extend_begin $Date]; } extend_end { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120080618102655 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::extend_end $Date]; } extend_end_infinity { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120090416151242 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::extend_end_infinity $Date]; } days_in_month { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224075401 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date days_in_month]; } days_in_year { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224075402 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date days_in_year]; } day_of_week { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224075403 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date day_of_week]; } day_of_year { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224075404 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date day_of_year]; } week_of_year { ::set Date [::sargs::get $s_args .date]; ::if {$Date eq ""} { ::if {![::sargs::exists $s_args .date]} { ::qw::bug 314120081224075405 "::qw::date $Command expected a .date argument."; } } ::return [::qw::date::get $Date week_of_year]; } default { ::qw::bug 314120080618102158 "::qw::date did not recognize \"$Command\" with args \"$args\"."; } } } /* { ::proc ::qw::date::to_number {args} { ::if {[::eval ::qw::s_args_marshal_is_legacy $args]} { ::return [::eval ::qw::date::cpp_to_number $args]; } ::qw::s_args_marshal; ::set Resolution [::qw::string tolower [::sargs::get $s_args .resolution]]; ::set Date [::sargs::get $s_args .date]; ::switch -glob -- { year* { ::return [::qw::date::cpp_to_number years $Date]; } month* { ::return [::qw::date::cpp_to_number months $Date]; } day* { ::return [::qw::date::cpp_to_number days $Date]; } hour* { ::return [::qw::date::cpp_to_number hours $Date]; } min* { ::return [::qw::date::cpp_to_number minutes $Date]; } sec* { ::return [::qw::date::cpp_to_number seconds $Date]; } clock_seconds* { ::return [::qw::date::cpp_to_number clock_seconds $Date]; } } ::qw::throw "::qw::date::to_number encountered invalid resolution \"$Resolution\"."; } ::proc ::qw::date::from_number {args} { ::if {[::eval ::qw::s_args_marshal_is_legacy $args]} { ::return [::eval ::qw::date::cpp_from_number $args]; } ::qw::s_args_marshal; ::set Resolution [::qw::string tolower [::sargs::get $s_args .resolution]]; ::set Number [::sargs::get $s_args .number]; ::switch -glob -- { year* { ::return [::qw::date::cpp_from_number years $Number]; } month* { ::return [::qw::date::cpp_from_number months $Number]; } day* { ::return [::qw::date::cpp_from_number days $Number]; } hour* { ::return [::qw::date::cpp_from_number hours $Number]; } min* { ::return [::qw::date::cpp_from_number minutes $Number]; } sec* { ::return [::qw::date::cpp_from_number seconds $Number]; } clock_seconds* { ::return [::qw::date::cpp_from_number clock_seconds $Number]; } } ::qw::throw "::qw::date::from_number encountered invalid resolution \"$Resolution\"."; } ::proc ::qw::date::get {args} { ::if {[::eval ::qw::s_args_marshal_is_legacy $args]} { ::return [::eval ::qw::date::cpp_get $args]; } ::qw::s_args_marshal; ::set Resolution [::qw::string tolower [::sargs::get $s_args .resolution]]; ::set Date [::sargs::get $s_args .date]; ::switch -glob -- { year* { ::return [::qw::date::cpp_get $Date years]; } month* { ::return [::qw::date::cpp_get $Date months]; } day* { ::return [::qw::date::cpp_get $Date days]; } hour* { ::return [::qw::date::cpp_get $Date hours]; } min* { ::return [::qw::date::cpp_get $Date minutes]; } sec* { ::return [::qw::date::cpp_get $Date seconds]; } days_in_month { ::return [::qw::date::cpp_get $Date $Resolution]; } days_in_year { ::return [::qw::date::cpp_get $Date $Resolution]; } day_of_week { ::return [::qw::date::cpp_get $Date $Resolution]; } day_of_year { ::return [::qw::date::cpp_get $Date $Resolution]; } week_of_year { ::return [::qw::date::cpp_get $Date $Resolution]; } } ::qw::throw "::qw::date::get encountered invalid resolution \"$Resolution\"."; } ::proc ::qw::date::set {args} { ::if {[::eval ::qw::s_args_marshal_is_legacy $args]} { ::return [::eval ::qw::date::cpp_set $args]; } ::qw::s_args_marshal; ::set Resolution [::qw::string tolower [::sargs::get $s_args .resolution]]; ::set Date [::sargs::get $s_args .date]; ::set Value [::sargs::get $s_args .value]; ::switch -glob -- { year* { ::return [::qw::date::cpp_set $Date years $Value]; } month* { ::return [::qw::date::cpp_set $Date months $Value]; } day* { ::return [::qw::date::cpp_set $Date days $Value]; } hour* { ::return [::qw::date::cpp_set $Date hours $Value]; } min* { ::return [::qw::date::cpp_set $Date minutes $Value]; } sec* { ::return [::qw::date::cpp_set $Date seconds $Value]; } } ::qw::throw "::qw::date::set encountered invalid resolution \"$Resolution\"."; } */ } ::proc ::qw::date::minimum {} { ::switch -- $::tcl_platform(pointerSize) { 4 { ::if {$::qw::control(date_restricted_to_2037)} { ::switch -- $::tcl_patchLevel { "8.6.9" { /* { 2.37.0 Tcl 8.6.9 had a bug in clock scan when called with a string that would translate into a negative number, i.e. anything before Jan 01,1970. It seems that 8.6.6 and 8.6.12 do not have this bug so it was problably intoduced in tcl 8.6.8 and fixed in tcl 8.6.11. ::qw::date::minimum is called from setup_account_aging.qw_script and setup_account_aging_orders.qw_script and from little else so we are working around the bug by changing the value of ::qw::date::minimum to 19700101000000. When we move to 64-bit this is all moot. */ } ::return 19700101000000; } default { ::return 19030101000000; } } } ::return "00000101000000"; } 8 { ::if {$::qw::control(date_restricted_to_2037)} { ::return 20371231235959; } ::return 19030101000000; } } } ::proc ::qw::date::maximum {} { ::if {$::qw::control(date_restricted_to_2037)} { ::return 20371231235959; } ::return "99991231235959"; } ::proc ::qw::date::null {} { ::return ""; ::return "00000101"; } ::proc ::qw::date::is_null {Date} { ::if {$Date eq ""} {::return 1;} ::return 0; } ::proc ::qw::date::range_check {args} { /* { Checks a date to see if it is in a date range. If the date is empty it is deemed to be in any range. If the end date is less than the begin date then no non-empty date is in the range. (-1) returned. Returns -1, 0 or 1 if less than, in, or greater than. */ } /* { This proc checks for a date which is out of the user's transaction edit date range. It builds an exception structure but returns it, i.e. does not throw it. Empty is returned on success. Empty begin/end dates are deemed +/- infinity. */ } ::qw::s_args_marshal; ::set Date [::sargs::get $s_args .date]; ::set Begin [::sargs::get $s_args .range.begin]; ::set End [::sargs::get $s_args .range.end]; ::if {$Date eq ""} { ::return 0; } ::if {$Begin ne ""} { ::if {[::qw::date::difference $Date $Begin day]<0} { ::return -1; } } ::if {$End ne ""} { ::if {[::qw::date::difference $Date $End day]>0} { ::return 1; } } ::return 0; } ::proc ::qw::date::nv1_date_format_to_nv2 {Src} { #// # NOTICE #// #// Some of the DOS date formats don't scan properly, so we have to substitute #// date formats that do. /* { ::switch -- $Src { "0" {::return "mm/dd/yy";} "1" {::return "mm/dd";} "2" {::return "dd-mm-yy";} "3" {::return "dd-mm";} "4" {::return "month dd, yy";} "5" {::return "month dd";} "6" {::return "dd month yy";} "7" {::return "dd month";} "8" {::return "mmddyy";} "9" {::return "mmdd";} "10" {::return "ddmmyy";} "11" {::return "ddmm";} "12" {::return "monthddyy";} "13" {::return "monthdd";} "14" {::return "ddmonthyy";} "15" {::return "ddmonth";} "16" {::return "ddmonthyyyy";} default {::qw::throw "Encountered invalid NV1 date format number \"$Src\"";} } */} ::switch -- $Src { "0" {::return "mm/dd/yy";} "1" {::return "mm/dd/yy";} "2" {::return "mm/dd/yy";} "3" {::return "mm/dd/yy";} "4" {::return "month dd, yy";} "5" {::return "month dd, yy";} "6" {::return "dd month yy";} "7" {::return "dd month yy";} "8" {::return "mm/dd/yy";} "9" {::return "mm/dd/yy";} "10" {::return "mm/dd/yy";} "11" {::return "mm/dd/yy";} "12" {::return "month dd, yy";} "13" {::return "month dd, yy";} "14" {::return "ddmonthyy";} "15" {::return "ddmonthyy";} "16" {::return "ddmonthyyyy";} default {::qw::throw "Encountered invalid NV1 date format number \"$Src\"";} } } # # ------------------------------------------------------------ # A Note on Date Formats (RTH Sep 21,2004) # ------------------------------------------------------------ # With Tcl's clock format command, we can offer an unlimited number # of date display formats. This is good. # # We can and want to allow users to change a date by editing the formatted # version. eg: Change "Nov 30,04" to "Dec 30,04" by editing "Nov" to "Dec". # Underneath, we rely on Tcl's clock scan command to convert the text # date for us. In early tests with one date format, this worked. # # Then we added a whole bunch of 'canned' date formats and the wheels came off # because there were many date formats that clock scan can't handle. The # result was bizarre errors about not being able to convert a date-time string. # # So, we've pruned the date format list to those formats that clock scan can # reliably interpret. The following code is what I (RTH) used to determine which # date formats we could use. # /* { ::set StartYear 1980; ::set EndYear 2037; # ::set GoodList "" ::set Names [::lsort [::array names ::qw::date::formats]]; ::foreach FormatName $Names { ::set Day 1; ::set Month 1; ::set Year $StartYear; ::while {1} { ::set DateString "$Month/$Day/$Year"; ::set DateSeconds [::clock scan $DateString]; ::set Error ""; ::set FormatString $::qw::date::formats($FormatName); ::if {[::string first "%d" [::string tolower $FormatString]]<0} { ::set Error "ERROR\t\"$FormatName\"\t- no day in format"; } else { ::set TestFormatted [::clock format $DateSeconds -format $FormatString]; ::if {[::catch {::set TestSeconds [::clock scan $TestFormatted]} ErrorMsg]} { ::set Error "ERROR\t\"$FormatName\"\tformat doesn't scan: $ErrorMsg"; } else { ::if {$TestSeconds!=$DateSeconds} { ::set Error "ERROR:\t\"$FormatName\"\t\"$TestFormatted\" scan returns $TestSeconds ([::clock format $TestSeconds]) instead of $DateSeconds ([::clock format $DateSeconds])"; } } } ::if {$Error ne ""} { ::puts $Error; ::update; ::break; } ::incr Day; ::switch -- $Month { 1 - 3 - 5 - 7 - 8 - 10 - 12 {::if {$Day>31} {::incr Month;::set Day 1;}} 2 { ::if {[::expr $Year%4]} { ::if {$Day>28} {::incr Month;::set Day 1;} } else { ::if {$Day>29} {::incr Month;::set Day 1;} } } default {::if {$Day>30} {::incr Month;::set Day 1;}} } ::if {$Month>12} { ::incr Year; ::set Month 1; ::if {$Year>$EndYear} { ::puts "OK\t\"$FormatName\" works for years $StartYear to $EndYear"; ::lappend GoodList $FormatName; ::update; ::break; } } } } ::puts "\n[::llength $GoodList] good date formats:"; ::foreach FormatName $GoodList { ::set FormatString $::qw::date::formats($FormatName); ::puts "\t\"$FormatName\" \"$FormatString\""; ::update; } */} /* { Test run from 1980 to 2037 (limit of Tcl's date scan): ERROR "day month dd yy" format doesn't scan: unable to convert date-time string "Tuesday Jan 01 80" ERROR "day month dd yyyy" format doesn't scan: unable to convert date-time string "Tuesday Jan 01 1980" OK "day month dd,yy" works for years 1980 to 2037 OK "day month dd,yyyy" works for years 1980 to 2037 ERROR: "dd month" "01 Jan" scan returns 1072933200 (Thu Jan 01 12:00:00 AM Eastern Standard Time 2004) instead of 315550800 (Tue Jan 01 12:00:00 AM Eastern Standard Time 1980) OK "dd month yy" works for years 1980 to 2037 OK "dd month yy hh:mm:ss" works for years 1980 to 2037 OK "dd month yy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "dd month yy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "01 Jan 80 12:00:00 AM Eastern Standard Time" OK "dd month yyyy" works for years 1980 to 2037 OK "dd month yyyy hh:mm:ss" works for years 1980 to 2037 OK "dd month yyyy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "dd month yyyy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "01 Jan 1980 12:00:00 AM Eastern Standard Time" ERROR "dd-mm" format doesn't scan: unable to convert date-time string "01-01" ERROR "dd-mm-yy" format doesn't scan: unable to convert date-time string "01-01-80" ERROR "dd-mm-yyyy" format doesn't scan: unable to convert date-time string "01-01-1980" OK "dd-month-yy" works for years 1980 to 2037 OK "dd-month-yy hh:mm:ss" works for years 1980 to 2037 OK "dd-month-yy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "dd-month-yy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "01-Jan-80 12:00:00 AM Eastern Standard Time" OK "dd-month-yyyy" works for years 1980 to 2037 OK "dd-month-yyyy hh:mm:ss" works for years 1980 to 2037 OK "dd-month-yyyy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "dd-month-yyyy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "01-Jan-1980 12:00:00 AM Eastern Standard Time" ERROR: "ddmm" "0101" scan returns 1095742860 (Tue Sep 21 1:01:00 AM Eastern Daylight Time 2004) instead of 315550800 (Tue Jan 01 12:00:00 AM Eastern Standard Time 1980) ERROR "ddmmyy" format doesn't scan: unable to convert date-time string "010180" ERROR "ddmmyyyy" format doesn't scan: unable to convert date-time string "01011980" ERROR: "ddmonth" "01Jan" scan returns 1072933200 (Thu Jan 01 12:00:00 AM Eastern Standard Time 2004) instead of 315550800 (Tue Jan 01 12:00:00 AM Eastern Standard Time 1980) OK "ddmonthyy" works for years 1980 to 2037 OK "ddmonthyyyy" works for years 1980 to 2037 ERROR "dy month dd yy" format doesn't scan: unable to convert date-time string "Tue Jan 01 80" ERROR "dy month dd yyyy" format doesn't scan: unable to convert date-time string "Tue Jan 01 1980" OK "dy month dd,yy" works for years 1980 to 2037 OK "dy month dd,yyyy" works for years 1980 to 2037 ERROR "hh:mm:ss" - no day in format ERROR: "mm/dd" "01/01" scan returns 1072933200 (Thu Jan 01 12:00:00 AM Eastern Standard Time 2004) instead of 315550800 (Tue Jan 01 12:00:00 AM Eastern Standard Time 1980) OK "mm/dd/yy" works for years 1980 to 2037 OK "mm/dd/yy hh:mm:ss" works for years 1980 to 2037 OK "mm/dd/yy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "mm/dd/yy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "01/01/80 12:00:00 AM Eastern Standard Time" OK "mm/dd/yyyy" works for years 1980 to 2037 OK "mm/dd/yyyy hh:mm:ss" works for years 1980 to 2037 OK "mm/dd/yyyy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "mm/dd/yyyy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "01/01/1980 12:00:00 AM Eastern Standard Time" ERROR: "mmdd" "0101" scan returns 1095742860 (Tue Sep 21 1:01:00 AM Eastern Daylight Time 2004) instead of 315550800 (Tue Jan 01 12:00:00 AM Eastern Standard Time 1980) ERROR "mmddyy" format doesn't scan: unable to convert date-time string "010180" ERROR "mmddyyyy" format doesn't scan: unable to convert date-time string "01011980" ERROR: "month dd" "Jan 01" scan returns 1072933200 (Thu Jan 01 12:00:00 AM Eastern Standard Time 2004) instead of 315550800 (Tue Jan 01 12:00:00 AM Eastern Standard Time 1980) OK "month dd, yy" works for years 1980 to 2037 OK "month dd, yy hh:mm:ss" works for years 1980 to 2037 OK "month dd, yy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "month dd, yy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "Jan 01, 80 12:00:00 AM Eastern Standard Time" OK "month dd, yyyy" works for years 1980 to 2037 OK "month dd, yyyy hh:mm:ss" works for years 1980 to 2037 OK "month dd, yyyy hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "month dd, yyyy hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "Jan 01, 1980 12:00:00 AM Eastern Standard Time" ERROR: "monthdd" "Jan01" scan returns 1072933200 (Thu Jan 01 12:00:00 AM Eastern Standard Time 2004) instead of 315550800 (Tue Jan 01 12:00:00 AM Eastern Standard Time 1980) ERROR "monthddyy" format doesn't scan: unable to convert date-time string "Jan0180" ERROR "monthddyyyy" format doesn't scan: unable to convert date-time string "Jan011980" OK "yy-mm-dd" works for years 1980 to 2037 OK "yy-mm-dd hh:mm:ss" works for years 1980 to 2037 OK "yy-mm-dd hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "yy-mm-dd hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "80-01-01 12:00:00 AM Eastern Standard Time" OK "yymmdd" works for years 1980 to 2037 OK "yymmdd hh:mm:ss" works for years 1980 to 2037 OK "yymmdd hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "yymmdd hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "800101 12:00:00 AM Eastern Standard Time" OK "yyyy-mm-dd" works for years 1980 to 2037 OK "yyyy-mm-dd hh:mm:ss" works for years 1980 to 2037 OK "yyyy-mm-dd hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "yyyy-mm-dd hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "1980-01-01 12:00:00 AM Eastern Standard Time" OK "yyyymmdd" works for years 1980 to 2037 OK "yyyymmdd hh:mm:ss" works for years 1980 to 2037 OK "yyyymmdd hh:mm:ss am/pm" works for years 1980 to 2037 ERROR "yyyymmdd hh:mm:ss am/pm timezone" format doesn't scan: unable to convert date-time string "19800101 12:00:00 AM Eastern Standard Time" OK "yyyymmdd hhmmss" works for years 1980 to 2037 OK "yyyymmddThh:mm:ss" works for years 1980 to 2037 OK "yyyymmddThhmmss" works for years 1980 to 2037 45 good date formats: "day month dd,yy" "%A %b %d,%y" "day month dd,yyyy" "%A %b %d,%Y" "dd month yy" "%d %b %y" "dd month yy hh:mm:ss" "%d %b %y %H:%M:%S" "dd month yy hh:mm:ss am/pm" "%d %b %y %I:%M:%S %p" "dd month yyyy" "%d %b %Y" "dd month yyyy hh:mm:ss" "%d %b %Y %H:%M:%S" "dd month yyyy hh:mm:ss am/pm" "%d %b %Y %I:%M:%S %p" "dd-month-yy" "%d-%b-%y" "dd-month-yy hh:mm:ss" "%d-%b-%y %H:%M:%S" "dd-month-yy hh:mm:ss am/pm" "%d-%b-%y %I:%M:%S %p" "dd-month-yyyy" "%d-%b-%Y" "dd-month-yyyy hh:mm:ss" "%d-%b-%Y %H:%M:%S" "dd-month-yyyy hh:mm:ss am/pm" "%d-%b-%Y %I:%M:%S %p" "ddmonthyy" "%d%b%y" "ddmonthyyyy" "%d%b%Y" "dy month dd,yy" "%a %b %d,%y" "dy month dd,yyyy" "%a %b %d,%Y" "mm/dd/yy" "%m/%d/%y" "mm/dd/yy hh:mm:ss" "%m/%d/%y %H:%M:%S" "mm/dd/yy hh:mm:ss am/pm" "%m/%d/%y %I:%M:%S %p" "mm/dd/yyyy" "%m/%d/%Y" "mm/dd/yyyy hh:mm:ss" "%m/%d/%Y %H:%M:%S" "mm/dd/yyyy hh:mm:ss am/pm" "%m/%d/%Y %I:%M:%S %p" "month dd, yy" "%b %d, %y" "month dd, yy hh:mm:ss" "%b %d, %y %H:%M:%S" "month dd, yy hh:mm:ss am/pm" "%b %d, %y %I:%M:%S %p" "month dd, yyyy" "%b %d, %Y" "month dd, yyyy hh:mm:ss" "%b %d, %Y %H:%M:%S" "month dd, yyyy hh:mm:ss am/pm" "%b %d, %Y %I:%M:%S %p" "yy-mm-dd" "%y-%m-%d" "yy-mm-dd hh:mm:ss" "%y-%m-%d %H:%M:%S" "yy-mm-dd hh:mm:ss am/pm" "%y-%m-%d %I:%M:%S %p" "yymmdd" "%y%m%d" "yymmdd hh:mm:ss" "%y%m%d %H:%M:%S" "yymmdd hh:mm:ss am/pm" "%y%m%d %I:%M:%S %p" "yyyy-mm-dd" "%Y-%m-%d" "yyyy-mm-dd hh:mm:ss" "%Y-%m-%d %H:%M:%S" "yyyy-mm-dd hh:mm:ss am/pm" "%Y-%m-%d %I:%M:%S %p" "yyyymmdd" "%Y%m%d" "yyyymmdd hh:mm:ss" "%Y%m%d %H:%M:%S" "yyyymmdd hh:mm:ss am/pm" "%Y%m%d %I:%M:%S %p" "yyyymmdd hhmmss" "%Y%m%d %H%M%S" "yyyymmddThh:mm:ss" "%Y%m%dT%H:%M:%S" "yyyymmddThhmmss" "%Y%m%dT%H%M%S" Take out the ones with time (useless at present) and you have: "day month dd,yy" "%A %b %d,%y" "day month dd,yyyy" "%A %b %d,%Y" "dd month yy" "%d %b %y" "dd month yyyy" "%d %b %Y" "dd-month-yy" "%d-%b-%y" "dd-month-yyyy" "%d-%b-%Y" "ddmonthyy" "%d%b%y" "ddmonthyyyy" "%d%b%Y" "dy month dd,yy" "%a %b %d,%y" "dy month dd,yyyy" "%a %b %d,%Y" "mm/dd/yy" "%m/%d/%y" "mm/dd/yyyy" "%m/%d/%Y" "month dd, yy" "%b %d, %y" "month dd, yyyy" "%b %d, %Y" "yy-mm-dd" "%y-%m-%d" "yymmdd" "%y%m%d" "yyyy-mm-dd" "%Y-%m-%d" "yyyymmdd" "%Y%m%d" Yikes! Found these in various source files, so they will have to be included (All scan OK) dd month yyyy hh:mm:ss am/pm dd-month-yyyy hh:mm:ss dd month yyyy hh:mm:ss yyyy-mm-dd hh:mm:ss am/pm */} #nv2.29.0 - added "yyyymmdd hh:mm:ss" and with hyphens ::set ::qw::date::formats_list { "yyyy month dd" "%Y %b %d" "yyyy monthdd" "%Y %b%d" "yyyymonthdd" "%Y%b%d" "longday month dd,yy" "%A %b %d,%y" "longday month dd,yyyy" "%A %b %d,%Y" "dd month yy" "%d %b %y" "dd month yyyy" "%d %b %Y" "dd-month-yy" "%d-%b-%y" "dd-month-yyyy" "%d-%b-%Y" "ddmonthyy" "%d%b%y" "ddmonthyyyy" "%d%b%Y" "shortday month dd,yy" "%a %b %d,%y" "shortday month dd,yyyy" "%a %b %d,%Y" "mm/dd/yy" "%m/%d/%y" "mm/dd/yyyy" "%m/%d/%Y" "month dd, yy" "%b %d, %y" "month dd, yyyy" "%b %d, %Y" "yy-mm-dd" "%y-%m-%d" "yymmdd" "%y%m%d" "yyyy-mm-dd" "%Y-%m-%d" "yyyymmdd" "%Y%m%d" "dd month yyyy hh:mm:ss am/pm" "%d %b %Y %I:%M:%S %p" "dd month yyyy hh:mm:ss" "%d %b %Y %H:%M:%S" "dd-month-yyyy hh:mm:ss" "%d-%b-%Y %H:%M:%S" "dd month yyyy hh:mm:ss" "%d %b %Y %H:%M:%S" "yyyy-mm-dd hh:mm:ss am/pm" "%Y-%m-%d %I:%M:%S %p" "yyyymmdd hh:mm:ss" "%Y%m%d %H:%M:%S" "yyyy-mm-dd hh:mm:ss" "%Y-%m-%d %H:%M:%S" } /* { # this was just temporary to get all the display formats for documentation ::puts "Date Formats==" ::set Date 20050226132515 ::foreach {Name Format} $::qw::date::formats_list { ::puts "$Name" ::puts "[::qw::date::format $Date $Format]" ::puts "" } */ } ::array set ::qw::date::formats $::qw::date::formats_list; ::namespace eval ::qw::time {}; ::set ::qw::time::formats_list { "hh:mm:ss" "%H:%M:%S" "hh:mm:ss am/pm" "%I:%M:%S %p" } ::array set ::qw::time::formats $::qw::time::formats_list; ::proc ::qw::date::scan {args} { /* { Kludge alert: We are piggy-backing on the tcl clock scan command. This means that the dates are restricted to the 100-year range 1970 to 2069. But on many systems this in turn will work only to 2038 because of the clock second problem. A solution to this is to somehow sneak in, find the year, and replace the year with something acceptable to tcl, and then again sneak in and adjust the resulting year after the scan. (cpp20) 61 % clock scan 20040723 1090555200 (cpp20) 62 % clock format [clock scan 20040723] Fri Jul 23 12:00:00 AM Eastern Daylight Time 2004 (cpp20) 63 % clock format [clock scan 20040723] -gmt 1 Fri Jul 23 4:00:00 AM GMT 2004 (cpp20) 64 % clock format [clock scan "23 Jul 2004"] Fri Jul 23 12:00:00 AM Eastern Daylight Time 2004 (cpp20) 65 % clock scan "23 Jul 2004" 1090555200 (cpp20) 66 % clock scan "01 Apr 1004" unable to convert date-time string "01 Apr 1004" (cpp20) 67 % clock scan "01 Apr 2004" 1080795600 (cpp20) 68 % clock scan "08 Apr 2004" 1081396800 (cpp20) 69 % clock scan "01 Apr 2004" -gmt 1 1080777600 (cpp20) 70 % clock scan "08 Apr 2004" -gmt 1 1081382400 (cpp20) 71 % clock format 1081382400 Wed Apr 07 8:00:00 PM Eastern Daylight Time 2004 (cpp20) 72 % clock format 1081382400 -gmt wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean?" (cpp20) 73 % clock format 1081382400 -gmt 1 Thu Apr 08 12:00:00 AM GMT 2004 (cpp20) 74 % clock format [clock seconds] -gmt 1 Mon Jul 19 6:25:02 PM GMT 2004 (cpp20) 75 % We take a date and scan it with -gmt 1. Converting between qw seconds and tcl seconds always assumes we are gmt. Then we shift it by the gmt. When we scan a date we lose the ability to know whether fields such as hours, minutes, and seconds were entered or not. */ } ::if {[::eval ::qw::s_args_marshal_is_legacy $args]} { ::switch -- [::llength $args] { 1 { ::set Date [::lindex $args 0]; ::set Format ""; } 2 { ::set Date [::lindex $args 0]; ::set Format [::lindex $args 1]; } default { ::qw::throw "::qw::date::scan expected a date and optional format."; } } ::qw::try { ::qw::try { ::set Date [::string trim $Date]; if {$Date eq ""} { ::return $Date; } ::set TclSeconds [::clock scan $Date]; } catch Exception { ::qw::throw "The tcl interpreter reported \"[::sargs::get [::qw::exception $Exception] .text]\"."; } ::set Result [::qw::date::from_number clock_seconds $TclSeconds]; ::return $Result; } catch Exception { ::qw::throw [::qw::exception::parent $Exception "Encountered invalid date \"$Date\"."]; } } ::qw::s_args_marshal; ::qw::try { ::qw::try { ::set Date [::string trim [::sargs::get $s_args .date]]; if {$Date eq ""} { ::return $Date; } ::set TclSeconds [::clock scan $Date]; } catch Exception { ::qw::throw "The tcl interpreter reported \"[::sargs::get [::qw::exception $Exception] .text]\"."; } ::set Result [::qw::date::from_number clock_seconds $TclSeconds]; return $Result; /* { date scan Date==20040723 date scan TclSeconds==1090555200 date scan Result==20040722230000 */ } } catch Exception { ::qw::throw [::qw::exception::parent $Exception "Encountered invalid date \"$Date\"."]; } } /* { ::proc ::qw::date::gui_edit_pre_226_1 {Before After EntryFormat} { #//::puts "pgq,debug602::qw::date::gui_edit enter Before==$Before After==$After EntryFormat==$EntryFormat"; ::if {$After eq ""} {::return $After;} # ::set Letter ""; ::if {[::regexp {(^[+|-])([0-9]+)(D|W|M|Y)*$} [::string toupper $After] match Sign Number Letter]} { #//::puts "pgq,debug602::qw::date::gui_edit match==$match Sign==\"$Sign\" Number==\"$Number\" Letter==\"$Letter\""; # After== "+/-#X" # +/- Sign - Increment/decrement the date # # Integer - units to increment/decrement # X Duration; "" and "D"==day, "W"==week, "M"==month, "Y"==year (case insensitive) ::switch -- $Letter { "W" {::return [::qw::date::add $Before "day" [::expr $Number*${Sign}7]];} "M" {::return [::qw::date::add $Before "month" $Sign$Number];} "Y" {::return [::qw::date::add $Before "year" $Sign$Number];} "D" - "" - default {::return [::qw::date::add $Before "day" $Sign$Number];} } } ::switch -- $EntryFormat { "scan" {::return [::qw::date::scan $After];} "ddmmyyyy" { ::if {[::regexp {^([0-9]+)$} [::string trim $After]]&&[::string length $After]<=8} { # After is <= 8 chars, all digits ::return [::qw::date::dos_edit $After $Before]; } #//::puts "pgq,debug602::qw::date::gui_edit enter After==$After ::qw::date::scan==[::qw::date::scan $After]"; ::return [::qw::date::scan $After]; } } ::qw::throw "Encountered unknown date entry format \"$EntryFormat\"."; } */} ::proc ::qw::date::gui_edit {args} { #//::puts "pgq,debug::qw::date::gui_edit enter Before==$Before After==$After EntryFormat==$EntryFormat"; #nv2.26.1a (bug fix) - ::qw::date::gui_edit calls ::qw::date::scan - which calls ::qw::date::from_number clock_seconds $TclSeconds - which returns a 6 zeros extended 14 digit result # NOTICE #// this method calls ::qw::date::scan #// which calls ::qw::date::from_number clock_seconds $TclSeconds #// which returns a 6 zeros extended 14 digit result #// so string range back to 8 digit yyyymmdd ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.0";} ::if {[::eval ::sargs::marshal_is_legacy $args]} { ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.1";} ::if {[::llength $args]!=3} { ::qw::throw "[::qw::procname] - invalid arguments \"$args\"."; } ::set Before [::lindex $args 0]; ::set After [::lindex $args 1]; ::set EntryFormat [::lindex $args 2]; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.2";} } else { ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.3";} ::sargs::marshal; ::set Before [::sargs::get $sargs .before]; ::set After [::sargs::get $sargs .after]; ::set EntryFormat [::sargs::get $sargs .entry_format]; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.4";} } ::if {$After eq ""} { ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.5";} ::return $After; } ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.6";} ::set Letter ""; ::if {[::regexp {(^[+|-])([0-9]+)(D|W|M|Y)*$} [::string toupper $After] match Sign Number Letter]} { #//::puts "pgq,debug::qw::date::gui_edit match==$match Sign==\"$Sign\" Number==\"$Number\" Letter==\"$Letter\""; # After== "+/-#X" # +/- Sign - Increment/decrement the date # # Integer - units to increment/decrement # X Duration; "" and "D"==day, "W"==week, "M"==month, "Y"==year (case insensitive) ::switch -- $Letter { "W" {::set Result [::qw::date::add $Before "day" [::expr $Number*${Sign}7]];} "M" {::set Result [::qw::date::add $Before "month" $Sign$Number];} "Y" {::set Result [::qw::date::add $Before "year" $Sign$Number];} "D" - "" - default {::set Result [::qw::date::add $Before "day" $Sign$Number];} } #//::puts "pgq,debug::qw::date::gui_edit 000 return Result==$Result"; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.7";} ::return [::string range $Result 0 7]; } ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.8";} ::switch -- $EntryFormat { "scan" { ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.9";} ::set Result [::qw::date::scan $After]; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.10";} } "ddmmyyyy" { ::if {[::regexp {^([0-9]+)$} [::string trim $After]]&&[::string length $After]<=8} { # After is <= 8 chars, all digits ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.11";} ::set Result [::qw::date::dos_edit $After $Before]; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.12";} } else { #//::puts "pgq,debug::qw::date::gui_edit enter After==$After ::qw::date::scan==[::qw::date::scan $After]"; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.13";} ::set Result [::qw::date::scan $After]; ::if {$rwb1_debug} {::puts "rwb1_debug,gui_edit,1000.14";} } } default { ::qw::throw "Unknown date entry format \"$EntryFormat\"."; } } #//::puts "pgq,debug::qw::date::gui_edit 111 return Result==$Result"; #nv2.27.0 (bug fix) - time entry killed by trimming ::qw::date::gui_edit result to first 8 characters - now trim only if last 6 are all zeros ::if {[::string range $Result 8 end] eq "000000"} { ::return [::string range $Result 0 7]; } ::return $Result; } # ------------------------------------------------------------ # QW::ODB::DATE class # ------------------------------------------------------------ ::proc ::qw::date::dos_edit {UserEntry OriginalDate} { #//::puts "pgq,debug602::qw::date::dos_edit enter UserEntry==$UserEntry OriginalDate==$OriginalDate"; # UserEntry: # 0-8 digits in the NV1 form of date entry, ddmmyyyy # OriginalDate: # A date in the form yyyymmdd # Result: # A yymmdddd date after applying the NV1 date editing rules. ::if {$UserEntry eq ""} { ::return $OriginalDate; } ::if {[::expr [::string length $UserEntry]%2]} { ::if {[::string index $UserEntry 0] eq "0"} { ::set UserEntry [::string range $UserEntry 1 end]; } else { ::set UserEntry "0$UserEntry"; } } ::if {$OriginalDate eq ""} { /* { If we start with an empty date and the user enters only a partial date, i.e. without the year, then an appropriate invalid date exception will be thrown. */ } #nv2.33.1 (new feature) - ddmmyyy date entry "autocompletes" with today's date #::set OriginalDate "00000101"; ::set OriginalDate [::clock format [::clock seconds] -format "%Y%m%d"]; } ::set OriginalDate [::string range $OriginalDate 6 7][::string range $OriginalDate 4 5][::string range $OriginalDate 0 3]; ::set UserEntry $UserEntry[::string range $OriginalDate [::string length $UserEntry] end]; # NOTICE #// this next statement can only produce an 8 digit date ::set Result [::string range $UserEntry 4 7][::string range $UserEntry 2 3][::string range $UserEntry 0 1]; #//::puts "pgq,debug602::qw::date::dos_edit Result==$Result return ::qw::date::check Result==[::qw::date::check $Result]"; ::return [::qw::date::check $Result]; }