Index: openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl,v
diff -u -N -r1.1 -r1.2
--- openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl 20 Apr 2001 20:51:09 -0000 1.1
+++ openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl 23 Aug 2001 19:10:51 -0000 1.2
@@ -1,4 +1,4 @@
-# /packages/acs-datetime/tcl/acs-calendar-widgets.tcl
+# /packages/acs-datetime/tcl/acs-calendar-procs.tcl
ad_library {
@@ -41,7 +41,7 @@
Julian date of the day, and the value is a string (possibly with
HTML formatting) that represents the details.
} {
- dt_get_info_from_db $date
+ dt_get_info $date
if [empty_string_p $calendar_details] {
set calendar_details [ns_set create calendar_details]
@@ -264,7 +264,7 @@
} {
set output ""
- dt_get_info_from_db $date
+ dt_get_info $date
append output "
@@ -319,7 +319,7 @@
set current_width 0
for { set n 1 } { $n <= 12 } { incr n } {
- dt_get_info_from_db $date
+ dt_get_info $date
append output "
@@ -364,7 +364,7 @@
Returns a calendar year of small calendars for the year of the
passed in date. Defaults to this year.
} {
- dt_get_info_from_db $date
+ dt_get_info $date
return [dt_widget_year \
-calendar_details $calendar_details \
@@ -549,7 +549,7 @@
# Get the current month, day, and the first day of the month
- dt_get_info_from_db $date
+ dt_get_info $date
set output "
@@ -736,7 +736,7 @@
return $output
}
-ad_proc -private dt_get_info_from_db {
+ad_proc -private dt_get_info {
{the_date ""}
} {
Calculates various dates required by the dt_widget_month
@@ -745,7 +745,7 @@
Returns the following (example for the_date = 2000-12-08):
- julian_date_today 2451889
+ julian_date_today 2451887
month December
year 2000
first_julian_date 2451875
@@ -763,49 +763,55 @@
next_month_name January
prev_month_name November
- Input:
+ Input:
the_day ANSI formatted date string (yyyy-mm-dd). If not
specified this procedure will default to today's
- date.
+ date.
} {
# If no date was passed in, let's set it to today
if [empty_string_p $the_date] {
- set the_date [dt_sysdate]
+ set the_date [dt_sysdate]
}
- # We put all the columns into dt_info_set and return it later
+ # get year, month, day
+ set date_list [dt_ansi_to_list $the_date]
+ set year [dt_trim_leading_zeros [lindex $date_list 0]]
+ set month [dt_trim_leading_zeros [lindex $date_list 1]]
+ set day [dt_trim_leading_zeros [lindex $date_list 2]]
+
+ # We put all the data into dt_info_set and return it later
set dt_info_set [ns_set create]
- set bind_vars [ad_tcl_vars_to_ns_set the_date]
- # This query gets us all of the date information we need to
- # calculate the calendar, including the name of the month, the
- # year, the julian date of the first of the month, the day of the
- # week of the first day of the month, the day number of the last
- # day (28, 29, 30 ,31) and a month string of the next and previous
- # months
+ ns_set put $dt_info_set julian_date_today \
+ [dt_ansi_to_julian $year $month $day]
+ ns_set put $dt_info_set month \
+ [clock format [clock scan $the_date] -format %B]
+ ns_set put $dt_info_set year \
+ [clock format [clock scan $the_date] -format %Y]
+ ns_set put $dt_info_set first_julian_date_of_month \
+ [dt_ansi_to_julian $year $month 1]
+ ns_set put $dt_info_set num_days_in_month \
+ [dt_num_days_in_month $year $month]
+ ns_set put $dt_info_set first_day_of_month \
+ [dt_first_day_of_month $year $month]
+ ns_set put $dt_info_set last_day \
+ [dt_num_days_in_month $year $month]
+ ns_set put $dt_info_set next_month \
+ [dt_next_month $year $month $day]
+ ns_set put $dt_info_set prev_month \
+ [dt_prev_month $year $month $day]
+ ns_set put $dt_info_set beginning_of_year \
+ $year-01-01
+ ns_set put $dt_info_set days_in_last_month \
+ [dt_num_days_in_month $year [expr $month - 1]]
+ ns_set put $dt_info_set next_month_name \
+ [dt_next_month_name $year $month]
+ ns_set put $dt_info_set prev_month_name \
+ [dt_prev_month_name $year $month]
- db_1row dt_get_information "
- select to_char(to_date(:the_date,'yyyy-mm-dd'),'J') as julian_date_today,
- to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'fmMonth') as month,
- to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'YYYY') as year,
- to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'J') as first_julian_date_of_month,
- to_char(last_day(to_date(:the_date, 'yyyy-mm-dd')), 'DD') as num_days_in_month,
- to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'D') as first_day_of_month,
- to_char(last_day(to_date(:the_date, 'yyyy-mm-dd')), 'DD') as last_day,
- trunc(add_months(to_date(:the_date, 'yyyy-mm-dd'), 1)) as next_month,
- trunc(add_months(to_date(:the_date, 'yyyy-mm-dd'), -1)) as prev_month,
- trunc(to_date(:the_date, 'yyyy-mm-dd'), 'yyyy') as beginning_of_year,
- to_char(last_day(add_months(to_date(:the_date, 'yyyy-mm-dd'), -1)), 'DD') as days_in_last_month,
- to_char(add_months(to_date(:the_date, 'yyyy-mm-dd'), 1), 'fmMonth') as next_month_name,
- to_char(add_months(to_date(:the_date, 'yyyy-mm-dd'), -1), 'fmMonth') as prev_month_name
- from dual
- " -bind $bind_vars -column_set dt_info_set
-
- ns_set free $bind_vars
-
- # We need the variables from the select query here as well
+ # We need the variables from the ns_set
ad_ns_set_to_tcl_vars $dt_info_set
ns_set put $dt_info_set first_julian_date \
@@ -816,15 +822,14 @@
[expr $first_julian_date_of_month + $num_days_in_month - 1]
set days_in_next_month \
- [expr (7-(($num_days_in_month + $first_day_of_month - 1) % 7)) % 7]
+ [expr (7-(($num_days_in_month + $first_day_of_month - 1) % 7)) % 7]
ns_set put $dt_info_set last_julian_date \
- [expr $first_julian_date_of_month + $num_days_in_month - 1 + $days_in_next_month]
+ [expr $first_julian_date_of_month + $num_days_in_month - 1 + $days_in_next_month]
# Now, set the variables in the caller's environment
ad_ns_set_to_tcl_vars -level 2 $dt_info_set
ns_set free $dt_info_set
}
-
Index: openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl,v
diff -u -N -r1.1 -r1.2
--- openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl 20 Apr 2001 20:51:09 -0000 1.1
+++ openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl 23 Aug 2001 19:10:30 -0000 1.2
@@ -70,16 +70,99 @@
return $month_names
}
+ad_proc dt_ansi_to_julian {
+ year
+ month
+ day
+ {era ""}
+} {
+ Returns the ANSI date as Julian or -1 in the case
+ of an invalid ANSI date argument (year less than
+ 4713 BCE, greater than 9999 CE, or equal to 0)
+} {
+ if [empty_string_p $era] {
+ set era CE
+ }
+
+ if {$year == 0} {
+ set julian_date -1
+ } elseif {$year == 1582 && $month == 10 && $day > 4 && $day < 15} {
+ # mimic the functionality of Oracle for these non-existent
+ # gregorian dates (returns the julian date of the day following
+ # 1582-10-04; 1582-10-15)
+ set julian_date [dt_ansi_to_julian 1582 10 15 CE]
+ } else {
+ if {$era == "BCE"} {
+ set year [expr -$year + 1]
+ }
+
+ if {$month > 2} {
+ set year_n $year
+ set month_n [expr $month + 1]
+ } else {
+ set year_n [expr $year - 1]
+ set month_n [expr $month + 13]
+ }
+
+ set julian_date [expr floor(floor(365.25 * $year_n) + floor(30.6001 * $month_n) + ($day + 1720995))]
+
+ # check for change to the Gregorian Calendar
+ set gregorian [expr 15 + 31 * (10 + 12 * 1582)]
+ if {$day + 31 * ($month + 12 * $year) >= $gregorian} {
+ set julian_date [expr $julian_date + (2 - floor(0.01 * $year_n) + floor(0.25 * floor(0.01 * $year_n)))]
+ }
+ }
+
+ return [expr int($julian_date)]
+}
+
ad_proc dt_julian_to_ansi {
julian_date
} {
Returns julian_date formatted as "yyyy-mm-dd"
} {
- return [db_string julian_to_ansi "
- select to_char(to_date(:julian_date,'J'),'yyyy-mm-dd') from dual"]
+ # Gregorian calendar correction
+ set gregorian 2299161
+
+ if {$julian_date >= $gregorian} {
+ set calc [expr floor((($julian_date - 1867216) - 0.25) / 36524.25)]
+ set calc [expr $julian_date + 1 + $calc - floor(0.25 * $calc)]
+ } else {
+ set calc $julian_date
+ }
+
+ # get initial calculations to set year, month, day
+ set calc [expr $calc + 1524]
+ set calc2 [expr floor(6680 + (($calc - 2439870) - 122.1) / 365.25)]
+ set calc3 [expr floor($calc2 * 365.25)]
+ set calc4 [expr floor(($calc - $calc3) / 30.6001)]
+
+ # set year, month, day
+ set year [expr floor($calc2 - 4715)]
+ set month [expr floor($calc4 - 1)]
+ if {$month > 12} {
+ set month [expr $month - 12]
+ }
+ if {$month > 2 || $year <= 0} {
+ set year [expr $year - 1]
+ }
+ set day [expr floor($calc - $calc3 - floor($calc4 * 30.6001))]
+
+ set year [expr int($year)]
+ set month [expr int($month)]
+ set day [expr int($day)]
+
+ if {$month < 10} {
+ set month 0$month
+ }
+
+ if {$day < 10} {
+ set day 0$day
+ }
+
+ return $year-$month-$day
}
-
ad_proc dt_ansi_to_pretty {
{ansi_date ""}
} {
@@ -115,6 +198,103 @@
return $date_info
}
+ad_proc dt_num_days_in_month {
+ year
+ month
+} {
+ Returns the numbers of days for the given month/year
+} {
+ if {$month == 0} {
+ set month 01
+ } elseif {$month == 12} {
+ set year [expr $year + 1]
+ set month 01
+ } elseif {$month == 13} {
+ set year [expr $year + 1]
+ set month 02
+ } else {
+ set month [expr $month + 1]
+ }
+
+ return [clock format [clock scan "last day" -base [clock scan $year-$month-01]] -format %d]
+}
+
+ad_proc dt_first_day_of_month {
+ year
+ month
+} {
+ Returns the weekday number of the first day for the given month/year
+} {
+ # calendar widgets are expecting integers 1-7, so we must adjust
+ return [expr [clock format [clock scan $year-$month-01] -format %w] + 1]
+}
+
+ad_proc dt_next_month {
+ year
+ month
+ day
+} {
+ Returns the ANSI date for the next month
+} {
+ if {$month == 12} {
+ set year [expr $year + 1]
+ set month 01
+ } else {
+ set month [expr $month + 1]
+ }
+
+ return [clock format [clock scan $year-$month-$day] -format %Y-%m-%d]
+}
+
+ad_proc dt_prev_month {
+ year
+ month
+ day
+} {
+ Returns the ANSI date for the previous month
+} {
+ if {$month == 1} {
+ set year [expr $year - 1]
+ set month 12
+ } else {
+ set month [expr $month - 1]
+ }
+
+ return [clock format [clock scan $year-$month-$day] -format %Y-%m-%d]
+}
+
+ad_proc dt_next_month_name {
+ year
+ month
+} {
+ Returns the ANSI date for the next month
+} {
+ if {$month == 12} {
+ set year [expr $year + 1]
+ set month 01
+ } else {
+ set month [expr $month + 1]
+ }
+
+ return [clock format [clock scan $year-$month-01] -format %B]
+}
+
+ad_proc dt_prev_month_name {
+ year
+ month
+} {
+ Returns the ANSI date for the previous month
+} {
+ if {$month == 12} {
+ set year [expr $year + 1]
+ set month 01
+ } else {
+ set month [expr $month + 1]
+ }
+
+ return [clock format [clock scan $year-$month-01] -format %B]
+}
+
ad_proc -public dt_widget_datetime {
{-show_date 1 -date_time_sep " " -use_am_pm 0 -default none}
{name}
|