OpenACS

antoniop
committed
oacs-5-10:antoniop:20230127132955
on 27 Jan 23
Reimplement conversion to and from Julian dates using modern Tcl api
/tcl/acs-datetime-procs.tcl (+12 -66)
76 76
77 77     @return the ANSI date as Julian
78 78
79 79     @see dt_ansi_to_julian
80 80 } {
81 81     set date_list [dt_ansi_to_list $ansi]
82 82
83 83     set year [util::trim_leading_zeros [lindex $date_list 0]]
84 84     set month [util::trim_leading_zeros [lindex $date_list 1]]
85 85     set day [util::trim_leading_zeros [lindex $date_list 2]]
86 86
87 87     return [dt_ansi_to_julian $year $month $day $era]
88 88 }
89 89
90 90 ad_proc -public dt_ansi_to_julian {
91 91     year
92 92     month
93 93     day
94 94     {era ""}
95 95 } {
  96     @param era this argument is obsolete and passing it to the proc
  97                will generate a warning.
  98
96 99     @return the ANSI date as Julian or -1 in the case
97 100             of an invalid ANSI date argument (year less than
98 101             4713 BCE, greater than 9999 CE, or equal to 0)
99 102 } {
100       if {$era eq ""} {
101           set era CE
  103     if {$era ne ""} {
  104         ad_log warning "'era' argument is obsolete"
102 105     }
103 106
104       if {$year == 0} {
105           set julian_date -1
106       } elseif {$year == 1582 && $month == 10 && $day > 4 && $day < 15} {
107           # mimic the functionality of Oracle for these non-existent
108           # gregorian dates (returns the julian date of the day following
109           # 1582-10-04; 1582-10-15)
110           set julian_date [dt_ansi_to_julian 1582 10 15 CE]
111       } else {
112           set year [util::trim_leading_zeros $year]
113  
114           if {$era eq "BCE"} {
115               set year [expr {-$year + 1}]
  107     try {
  108         return [clock format [clock scan ${year}-${month}-${day} -format %Y-%m-%d] -format %J]
  109     } on error {errmsg} {
  110         ad_log warning "Cannot convert ${year}-${month}-${day} to Julian date: $errmsg"
  111         return -1
116 112     }
117  
118           if {$month > 2} {
119               set year_n $year
120               set month_n [expr {$month + 1}]
121           } else {
122               set year_n  [expr {$year - 1}]
123               set month_n [expr {$month + 13}]
124 113 }
125 114
126           set julian_date [expr {floor(floor(365.25 * $year_n) + floor(30.6001 * $month_n) + ($day + 1720995))}]
127  
128           # check for change to the Gregorian Calendar
129           set gregorian [expr {15 + 31 * (10 + 12 * 1582)}]
130           if {$day + 31 * ($month + 12 * $year) >= $gregorian} {
131               set julian_date [expr {$julian_date + (2 - floor(0.01 * $year_n) + floor(0.25 * floor(0.01 * $year_n)))}]
132           }
133       }
134  
135       return [expr {int($julian_date)}]
136   }
137  
138 115 ad_proc -public dt_julian_to_ansi {
139 116     julian_date
140 117 } {
141 118     @return julian_date formatted as "yyyy-mm-dd"
142 119 } {
143       # Gregorian calendar correction
144       set gregorian 2299161
145  
146       if {$julian_date >= $gregorian} {
147           set calc [expr {floor((($julian_date - 1867216) - 0.25) / 36524.25)}]
148           set calc [expr {$julian_date + 1 + $calc - floor(0.25 * $calc)}]
149       } else {
150           set calc $julian_date
  120     return [clock format [clock scan $julian_date -format %J] -format %Y-%m-%d]
151 121 }
152 122
153       # get initial calculations to set year, month, day
154       set calc [expr {$calc + 1524}]
155       set calc2 [expr {floor(6680 + (($calc - 2439870) - 122.1) / 365.25)}]
156       set calc3 [expr {floor($calc2 * 365.25)}]
157       set calc4 [expr {floor(($calc - $calc3) / 30.6001)}]
158  
159       # set year, month, day
160       set year [expr {floor($calc2 - 4715)}]
161       set month [expr {floor($calc4 - 1)}]
162       if {$month > 12} {
163           set month [expr {$month - 12}]
164       }
165       if {$month > 2 || $year <= 0} {
166           set year [expr {$year - 1}]
167       }
168       set day [expr {floor($calc - $calc3 - floor($calc4 * 30.6001))}]
169  
170       set year  [expr {int($year)}]
171       set month [expr {int($month)}]
172       set day   [expr {int($day)}]
173  
174       return [format %.4d $year]-[format %.2d $month]-[format %.2d $day]
175   }
176  
177 123 ad_proc -public dt_ansi_to_pretty {
178 124     {ansi_date ""}
179 125 } {
180 126     Converts an ANSI date into a localzed one.
181 127
182 128     With no argument, it returns the current date based on server time.
183 129
184 130     Works for both date and date-time strings.
185 131
186 132     @param ansi_date    Date in ANSI format (for example, 1998-09-05)
187 133     @return             Localized date (for example, on 'en_US', 05/09/98)
188 134 } {
189 135     if {$ansi_date eq ""} {
190 136         set ansi_date [dt_sysdate]
191 137     }
192 138
193 139     return [lc_time_fmt $ansi_date "%x"]
194 140 }
195 141
196 142 ad_proc -public dt_ansi_to_list {