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.2 2004/10/07 18:56:53 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.
32 open Cocanwiki_template
33 open Cocanwiki_strings
36 let day_template = _get_template "calendar_day.html"
37 let month_template = _get_template "calendar_month.html"
38 let year_template = _get_template "calendar_year.html"
39 let year_1m_template = _get_template "calendar_year_1m.html"
47 let extension (dbh : Dbi.connection) hostid url =
48 (* Validate a date in the form "yyyy[/mm[/dd]]". Returns a (yyyy, mm, dd)
49 * tuple with missing fields set to 0. If the string doesn't parse or the
50 * date isn't valid, then raises Not_found.
53 if String.length str = 4 &&
54 isdigit str.[0] && isdigit str.[1] &&
55 isdigit str.[2] && isdigit str.[3] then (
56 let yyyy = int_of_string (String.sub str 0 4) in
59 else if String.length str = 7 &&
60 isdigit str.[0] && isdigit str.[1] &&
61 isdigit str.[2] && isdigit str.[3] &&
63 isdigit str.[5] && isdigit str.[6] then (
64 let yyyy = int_of_string (String.sub str 0 4) in
65 let mm = int_of_string (String.sub str 5 2) in
66 if mm >= 1 && mm <= 12 then (yyyy, mm, 0) else raise Not_found
68 else if String.length str = 10 &&
69 isdigit str.[0] && isdigit str.[1] &&
70 isdigit str.[2] && isdigit str.[3] &&
72 isdigit str.[5] && isdigit str.[6] &&
74 isdigit str.[8] && isdigit str.[9] 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 let dd = int_of_string (String.sub str 8 2) in
78 let date = (yyyy, mm, dd) in
79 if GregorianDate.check_date date then date else raise Not_found
85 (* From the links table, find all links to this page, or sub-calendar pages.
86 * This query overselects. We then filter the real pages in OCaml.
90 "select li.from_url, p.title, li.to_url
91 from links li, pages p
92 where li.hostid = ? and li.to_url like ?
93 and li.hostid = p.hostid and li.from_url = p.url" in
94 sth#execute [`Int hostid; `String (url ^ "%")];
98 sth#map (function [`String from_url; `String title; `String to_url] ->
99 from_url, title, to_url
100 | _ -> assert false) in
102 (fun (from_url, title, to_url) ->
103 try let date = valid_date to_url in Some (date, (title, from_url))
104 with Not_found -> None) results in
105 let pages = List.sort pages in
107 (* Validate the date in the URL itself. *)
109 try Some (valid_date url)
110 with Not_found -> None in
113 | None -> (* Not a valid date. *)
114 "<p>" ^ url ^ " is not an actual date.</p>"
115 | Some (yyyy, 0, 0) -> (* Year view. *)
116 let template = year_template in
118 template#set "yyyy" (string_of_int yyyy);
119 template#set "prev_yyyy" (string_of_int (yyyy - 1));
120 template#set "next_yyyy" (string_of_int (yyyy + 1));
122 (* Return true if there are any events on a particular day. *)
123 let has_events date = List.exists (fun (d, _) -> date = d) pages in
125 (* Generate each month template separately ...
126 * Wow, finally found a place I can use a for loop.
130 let template = year_1m_template in
131 template#set "yyyy" (string_of_int yyyy);
132 template#set "mm" (sprintf "%02d" mm);
133 template#set "month_name" (long_month mm);
134 let dow = GregorianDate.day_of_week (yyyy, mm, 1) in
135 let dow = if dow = 7 then 0 else dow in
136 let max_dd = GregorianDate.days_in_month yyyy mm in
137 let dd = ref (1-dow) in
139 for r = 0 to 5 do (* up to 5 rows ... *)
141 for c = 0 to 6 do (* 7 columns, Sunday - Saturday *)
142 let is_day = !dd >= 1 && !dd <= max_dd in
145 let date = yyyy, mm, !dd in
146 let is_weekend = GregorianDate.day_of_week date >= 6 in
147 let events = has_events date in
148 (if is_weekend then "cal_year_1m_weekend " else "") ^
149 (if events then "cal_year_1m_events" else "")
151 "cal_year_1m_empty" in
153 [ "is_day", Template.VarConditional is_day;
154 "dd", Template.VarString (sprintf "%02d" !dd);
155 "class", Template.VarString clasz ] in
156 cols := col :: !cols;
159 rows := [ "cols", Template.VarTable (List.rev !cols) ] :: !rows;
163 template#table "rows" (List.rev !rows);
165 template#to_string in
166 template#set ("month" ^ string_of_int mm) str
171 List.filter (function ((_, 0, 0), _) -> true | _ -> false) pages in
174 List.map (fun (_, (title, page)) ->
175 [ "title", Template.VarString title;
176 "page", Template.VarString page ]) events in
177 template#table "events" table;
181 | Some (yyyy, mm, 0) -> (* Month view. *)
182 let template = month_template in
184 template#set "month_name" (long_month mm);
185 template#set "yyyy" (string_of_int yyyy);
186 template#set "mm" (sprintf "%02d" mm);
188 let prev_yyyy, prev_mm =
189 if mm = 1 then yyyy - 1, 12
191 let next_yyyy, next_mm =
192 if mm = 12 then yyyy + 1, 1
194 template#set "prev_yyyy" (string_of_int prev_yyyy);
195 template#set "prev_mm" (sprintf "%02d" prev_mm);
196 template#set "next_yyyy" (string_of_int next_yyyy);
197 template#set "next_mm" (sprintf "%02d" next_mm);
199 (* Get all monthly events and all daily events. *)
200 let monthly_events, daily_events =
201 List.partition (function ((_, _, 0), _) -> true | _ -> false)
204 (* Table of monthly events. *)
206 List.map (fun (_, (title, page)) ->
207 [ "title", Template.VarString title;
208 "page", Template.VarString page ]) monthly_events in
209 template#table "monthly_events" table;
211 (* How many days in this month? *)
212 let max_dd = GregorianDate.days_in_month yyyy mm in
213 let days = range 1 max_dd in
218 List.filter (fun ((_, _, d), _) -> d = dd)
221 List.map (fun (_, (title, page)) ->
222 [ "title", Template.VarString title;
223 "page", Template.VarString page ])
226 GregorianDate.day_of_week (yyyy, mm, dd) >= 6 in
227 [ "dd", Template.VarString (sprintf "%02d" dd);
228 "is_weekend", Template.VarConditional is_weekend;
229 "events", Template.VarTable table ])
231 template#table "days" table;
235 | Some (yyyy, mm, dd) -> (* Single day view. *)
236 let template = day_template in
252 (* Register the extension. *)
254 extensions := ("calendar", extension) :: !extensions