1 (* COCANWIKI - a wiki written in Objective CAML.
2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: cocanwiki_ext_calendar.ml,v 1.6 2006/08/16 15:27:02 rich Exp $
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
16 * You should have received a copy of the GNU General Public License
17 * along with this program; see the file COPYING. If not, write to
18 * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 * Boston, MA 02111-1307, USA.
30 open Cocanwiki_extensions
31 open Cocanwiki_template
32 open Cocanwiki_strings
35 let day_template = _get_template "calendar_day.html"
36 let month_template = _get_template "calendar_month.html"
37 let year_template = _get_template "calendar_year.html"
38 let year_1m_template = _get_template "calendar_year_1m.html"
40 (* Check a date is valid. *)
41 let check_date (y, m, d) =
43 let t = Date.make y m d in
45 && Date.int_of_month (Date.month t) = m
46 && Date.day_of_month t = d
48 Date.Out_of_bounds | Date.Undefined -> false
56 let ascii_isdigit = function '0'..'9' -> true | _ -> false
58 let extension r dbh hostid url =
59 (* Validate a date in the form "yyyy[/mm[/dd]]". Returns a (yyyy, mm, dd)
60 * tuple with missing fields set to 0. If the string doesn't parse or the
61 * date isn't valid, then raises Not_found.
64 if String.length str = 4 &&
65 ascii_isdigit str.[0] && ascii_isdigit str.[1] &&
66 ascii_isdigit str.[2] && ascii_isdigit str.[3] then (
67 let yyyy = int_of_string (String.sub str 0 4) in
70 else if String.length str = 7 &&
71 ascii_isdigit str.[0] && ascii_isdigit str.[1] &&
72 ascii_isdigit str.[2] && ascii_isdigit str.[3] &&
74 ascii_isdigit str.[5] && ascii_isdigit str.[6] then (
75 let yyyy = int_of_string (String.sub str 0 4) in
76 let mm = int_of_string (String.sub str 5 2) in
77 if mm >= 1 && mm <= 12 then (yyyy, mm, 0) else raise Not_found
79 else if String.length str = 10 &&
80 ascii_isdigit str.[0] && ascii_isdigit str.[1] &&
81 ascii_isdigit str.[2] && ascii_isdigit str.[3] &&
83 ascii_isdigit str.[5] && ascii_isdigit str.[6] &&
85 ascii_isdigit str.[8] && ascii_isdigit str.[9] then (
86 let yyyy = int_of_string (String.sub str 0 4) in
87 let mm = int_of_string (String.sub str 5 2) in
88 let dd = int_of_string (String.sub str 8 2) in
89 let date = (yyyy, mm, dd) in
90 if check_date date then date else raise Not_found
96 (* From the links table, find all links to this page, or sub-calendar pages.
97 * This query overselects. We then filter the real pages in OCaml.
100 let patt = url ^ "%" in
102 "select li.from_url, p.title, li.to_url
103 from links li, pages p
104 where li.hostid = $hostid and li.to_url like $patt
105 and li.hostid = p.hostid and li.from_url = p.url" in
109 List.map (fun (from_url, title, to_url) ->
110 from_url, title, to_url) rows in
112 (fun (from_url, title, to_url) ->
113 try let date = valid_date to_url in Some (date, (title, from_url))
114 with Not_found -> None) results in
115 let pages = List.sort pages in
117 (* Validate the date in the URL itself. *)
119 try Some (valid_date url)
120 with Not_found -> None in
123 | None -> (* Not a valid date. *)
124 "<p>" ^ url ^ " is not an actual date.</p>"
125 | Some (yyyy, 0, 0) -> (* Year view. *)
126 let template = year_template in
128 template#set "yyyy" (string_of_int yyyy);
129 template#set "prev_yyyy" (string_of_int (yyyy - 1));
130 template#set "next_yyyy" (string_of_int (yyyy + 1));
132 (* Return true if there are any events on a particular day. *)
133 let has_events date = List.exists (fun (d, _) -> date = d) pages in
135 let int_of_day_of_week = function
136 | Date.Sun -> 0 | Date.Mon -> 1 | Date.Tue -> 2
137 | Date.Wed -> 3 | Date.Thu -> 4 | Date.Fri -> 5
141 (* Generate each month template separately ...
142 * Wow, finally found a place I can use a for loop.
146 let template = year_1m_template in
147 template#set "yyyy" (string_of_int yyyy);
148 template#set "mm" (sprintf "%02d" mm);
149 template#set "month_name"
150 (!Printer.month_name (Date.month_of_int mm));
151 let dow = Date.day_of_week (Date.make yyyy mm 1) in
152 let max_dd = Date.days_in_month (Date.make yyyy mm 1) in
153 let dd = ref (1 - int_of_day_of_week dow) in
155 for r = 0 to 5 do (* up to 5 rows ... *)
157 for c = 0 to 6 do (* 7 columns, Sunday - Saturday *)
158 let is_day = !dd >= 1 && !dd <= max_dd in
162 match Date.day_of_week (Date.make yyyy mm !dd) with
163 Date.Sat | Date.Sun -> true | _ -> false in
164 let date = yyyy, mm, !dd in
165 let events = has_events date in
166 (if is_weekend then "cal_year_1m_weekend " else "") ^
167 (if events then "cal_year_1m_events" else "")
169 "cal_year_1m_empty" in
171 [ "is_day", Template.VarConditional is_day;
172 "dd", Template.VarString (sprintf "%02d" !dd);
173 "class", Template.VarString clasz ] in
174 cols := col :: !cols;
177 rows := [ "cols", Template.VarTable (List.rev !cols) ] :: !rows;
181 template#table "rows" (List.rev !rows);
183 template#to_string in
184 template#set ("month" ^ string_of_int mm) str
189 List.filter (function ((_, 0, 0), _) -> true | _ -> false) pages in
192 List.map (fun (_, (title, page)) ->
193 [ "title", Template.VarString title;
194 "page", Template.VarString page ]) events in
195 template#table "events" table;
199 | Some (yyyy, mm, 0) -> (* Month view. *)
200 let template = month_template in
202 template#set "month_name" (!Printer.month_name (Date.month_of_int mm));
203 template#set "yyyy" (string_of_int yyyy);
204 template#set "mm" (sprintf "%02d" mm);
206 let prev_yyyy, prev_mm =
207 if mm = 1 then yyyy - 1, 12
209 let next_yyyy, next_mm =
210 if mm = 12 then yyyy + 1, 1
212 template#set "prev_yyyy" (string_of_int prev_yyyy);
213 template#set "prev_mm" (sprintf "%02d" prev_mm);
214 template#set "next_yyyy" (string_of_int next_yyyy);
215 template#set "next_mm" (sprintf "%02d" next_mm);
217 (* Get all monthly events and all daily events. *)
218 let monthly_events, daily_events =
219 List.partition (function ((_, _, 0), _) -> true | _ -> false)
222 (* Table of monthly events. *)
224 List.map (fun (_, (title, page)) ->
225 [ "title", Template.VarString title;
226 "page", Template.VarString page ]) monthly_events in
227 template#table "monthly_events" table;
229 (* How many days in this month? *)
230 let max_dd = Date.days_in_month (Date.make yyyy mm 1) in
231 let days = range 1 max_dd in
236 List.filter (fun ((_, _, d), _) -> d = dd)
239 List.map (fun (_, (title, page)) ->
240 [ "title", Template.VarString title;
241 "page", Template.VarString page ])
244 match Date.day_of_week (Date.make yyyy mm dd) with
245 Date.Sat | Date.Sun -> true | _ -> false in
246 [ "dd", Template.VarString (sprintf "%02d" dd);
247 "is_weekend", Template.VarConditional is_weekend;
248 "events", Template.VarTable table ])
250 template#table "days" table;
254 | Some (yyyy, mm, dd) -> (* Single day view. *)
255 let template = day_template in
257 (* XXX This will change once we start doing date and time events.
258 * For now it is very simple indeed.
260 template#set "yyyy" (string_of_int yyyy);
261 template#set "mm" (sprintf "%02d" mm);
262 template#set "dd" (sprintf "%02d" dd);
264 template#set "month_name" (!Printer.month_name (Date.month_of_int mm));
266 let t = Date.make yyyy mm dd in
267 let dow = Date.day_of_week t in
268 template#set "short_weekday" (Printer.short_name_of_day dow);
270 let oneday = Date.Period.day 1 in
271 let prev_t = Date.rem t oneday in
272 let next_t = Date.add t oneday in
273 let prev_yyyy, prev_mm, prev_dd =
274 Date.year prev_t, Date.int_of_month (Date.month prev_t),
275 Date.day_of_month prev_t in
276 let next_yyyy, next_mm, next_dd =
277 Date.year next_t, Date.int_of_month (Date.month next_t),
278 Date.day_of_month next_t in
280 template#set "prev_yyyy" (string_of_int prev_yyyy);
281 template#set "prev_mm" (sprintf "%02d" prev_mm);
282 template#set "prev_dd" (sprintf "%02d" prev_dd);
283 template#set "next_yyyy" (string_of_int next_yyyy);
284 template#set "next_mm" (sprintf "%02d" next_mm);
285 template#set "next_dd" (sprintf "%02d" next_dd);
287 let table = List.map (fun (_, (title, page)) ->
288 [ "title", Template.VarString title;
289 "page", Template.VarString page ]) pages in
290 template#table "events" table;
294 (* Register the extension. *)
296 extensions := ("calendar", extension) :: !extensions