scripts/business_days.tcl

   1 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   2
   3 class tlc::Businessdays {
   4         inherit tlc::Baselog
   5
   6         constructor {args} {}
   7
   8         public {
   9                 variable workday_start  "08:00am"
  10                 variable workday_end    "05:00pm"
  11
  12                 variable is_holiday     {}              ;# called with epoch secs of day, return 1 if holiday
  13
  14                 method offset {interval {from "now"}}
  15         }
  16
  17         private {
  18                 variable workday_start_offset
  19                 variable workday_end_offset
  20         }
  21 }
  22
  23
  24 configbody tlc::Businessdays::workday_start { #<<<
  25         set workday_start_offset        [expr {[clock scan $workday_start] - [clock scan "00:00am"}]
  26 }
  27
  28 #>>>
  29 configbody tlc::Businessdays::workday_end { #<<<
  30         set workday_end_offset  [expr {[clock scan $workday_end] - [clock scan "00:00am"}]
  31 }
  32
  33 #>>>
  34 body tlc::Businessdays::constructor {args} { #<<<
  35         configure {*}$args
  36 }
  37
  38 #>>>
  39 body tlc::Businessdays::offset {interval {from "now"}} { #<<<
  40         if {$from eq "now"} {
  41                 set from        [clock seconds]
  42         } else {
  43                 if {![string is digit -strict $from]} {
  44                         set from        [clock scan $from]
  45                 }
  46         }
  47
  48         set month       [clock format $from -format "%b %Y"]
  49         set daystart    [clock scan "1 $month"]
  50         set workday_start_offset        [expr {[clock scan "1 $month $workday_start"] - $daystart}]
  51         set workday_end_offset          [expr {[clock scan "1 $month $workday_end"] - $daystart}]
  52
  53         set initial     [clock add $from {*}$interval]
  54         set remaining   [expr {$initial - $from}]
  55         if {$remaining < 0} {
  56                 error "Negative intervals not allowed"
  57         }
  58
  59         set pointer     $from
  60         set daystart    [clock scan [clock format $pointer -format "%Y-%m-%d"] -format "%Y-%m-%d"]
  61         while {1} {
  62                 while {$daystart <= $pointer - 86400} {
  63                         incr daystart 86400
  64                 }
  65                 if {$is_holiday ne ""} {
  66                         if {[uplevel #0 $is_holiday [list $daystart]]} {
  67                                 incr pointer 86400
  68                                 continue
  69                         }
  70                 }
  71                 set dow [clock format $pointer -format "%a"]
  72                 set gaps        {}
  73                 switch -- $dow {
  74                         "Mon" -
  75                         "Tue" -
  76                         "Wed" -
  77                         "Thu" -
  78                         "Fri" {
  79                                 lappend gaps    [list \
  80                                                 $daystart \
  81                                                 [expr {$daystart + $workday_start_offset - 1}] \
  82                                 ]
  83                                 lappend gaps    [list \
  84                                                 [expr {$daystart + $workday_end_offset + 1}] \
  85                                                 [expr {$daystart + 86400 - 1}] \
  86                                 ]
  87                         }
  88
  89                         "Sat" -
  90                         "Sun" {
  91                                 lappend gaps    [list \
  92                                                 $daystart \
  93                                                 [expr {$daystart + 86400 - 1}] \
  94                                 ]
  95                         }
  96                 }
  97
  98                 foreach gap $gaps {
  99                         lassign $gap gap_start gap_end
 100                         if {$pointer >= $gap_start && $pointer <= $gap_end} {
 101                                 set pointer     [expr {$gap_end + 1}]
 102                         }
 103                 }
 104
 105                 set last_gap_end        [lindex $gaps end 1]
 106                 if {$pointer == $last_gap_end + 1} continue
 107
 108                 if {$remaining <= 0} break
 109
 110                 if {[info exists last_end]} {
 111                         unset last_end
 112                 }
 113                 foreach gap $gaps {
 114                         lassign $gap gap_start gap_end
 115                         if {[info exists last_end] && $gap_start > $pointer} {
 116                                 set chunk               [expr {$gap_start - $pointer - 1}]
 117                                 if {$remaining >= $chunk} {
 118                                         set pointer             $gap_start
 119                                         set remaining   [expr {$remaining - $chunk}]
 120                                 } else {
 121                                         set pointer             [expr {$pointer + $remaining}]
 122                                         set remaining   0
 123                                 }
 124                                 break
 125                         } else {
 126                                 set last_end    $gap_end
 127                         }
 128                 }
 129         }
 130
 131         return $pointer
 132 }
 133
 134 #>>>