scripts/cocanwiki_ext_calendar.ml

   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.1 2004/10/07 16:54:24 rich Exp $
   5  *
   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.
  10  *
  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.
  15  *
  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.
  20  *)
  21
  22 open Apache
  23 open Registry
  24 open Cgi
  25 open Printf
  26
  27 open ExtList
  28
  29 open GregorianDate
  30
  31 open Cocanwiki
  32 open Cocanwiki_template
  33 open Cocanwiki_strings
  34 open Cocanwiki_date
  35
  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
  40 let rec range a b =
  41   if a <= b then
  42     a :: range (a+1) b
  43   else
  44     []
  45
  46 let extension (dbh : Dbi.connection) hostid url =
  47   (* Validate a date in the form "yyyy[/mm[/dd]]".  Returns a (yyyy, mm, dd)
  48    * tuple with missing fields set to 0.  If the string doesn't parse or the
  49    * date isn't valid, then raises Not_found.
  50    *)
  51   let valid_date str =
  52     if String.length str = 4 &&
  53       isdigit str.[0] && isdigit str.[1] &&
  54       isdigit str.[2] && isdigit str.[3] then (
  55         let yyyy = int_of_string (String.sub str 0 4) in
  56         (yyyy, 0, 0)
  57       )
  58     else if String.length str = 7 &&
  59       isdigit str.[0] && isdigit str.[1] &&
  60       isdigit str.[2] && isdigit str.[3] &&
  61       str.[4] = '/' &&
  62       isdigit str.[5] && isdigit str.[6] then (
  63         let yyyy = int_of_string (String.sub str 0 4) in
  64         let mm = int_of_string (String.sub str 5 2) in
  65         if mm >= 1 && mm <= 12 then (yyyy, mm, 0) else raise Not_found
  66       )
  67     else if String.length str = 10 &&
  68       isdigit str.[0] && isdigit str.[1] &&
  69       isdigit str.[2] && isdigit str.[3] &&
  70       str.[4] = '/' &&
  71       isdigit str.[5] && isdigit str.[6] &&
  72       str.[7] = '/' &&
  73       isdigit str.[8] && isdigit str.[9] then (
  74         let yyyy = int_of_string (String.sub str 0 4) in
  75         let mm = int_of_string (String.sub str 5 2) in
  76         let dd = int_of_string (String.sub str 8 2) in
  77         let date = (yyyy, mm, dd) in
  78         if GregorianDate.check_date date then date else raise Not_found
  79       )
  80     else
  81       raise Not_found
  82   in
  83
  84   (* From the links table, find all links to this page, or sub-calendar pages.
  85    * This query overselects.  We then filter the real pages in OCaml.
  86    *)
  87   let sth =
  88     dbh#prepare_cached
  89       "select li.from_url, p.title, li.to_url
  90          from links li, pages p
  91         where li.hostid = ? and li.to_url like ?
  92           and li.hostid = p.hostid and li.from_url = p.url" in
  93   sth#execute [`Int hostid; `String (url ^ "%")];
  94
  95   let pages =
  96     let results =
  97       sth#map (function [`String from_url; `String title; `String to_url] ->
  98                  from_url, title, to_url
  99                  | _ -> assert false) in
 100     List.filter_map
 101       (fun (from_url, title, to_url) ->
 102          try let date = valid_date to_url in Some (date, title, from_url)
 103          with Not_found -> None) results in
 104   let pages = List.sort pages in
 105
 106   (* Validate the date in the URL itself. *)
 107   let date =
 108     try Some (valid_date url)
 109     with Not_found -> None in
 110
 111   match date with
 112     | None ->                           (* Not a valid date. *)
 113         "<p>" ^ url ^ " is not an actual date.</p>"
 114     | Some (yyyy, 0, 0) ->              (* Year view. *)
 115         let template = year_template in
 116         failwith "not impl";
 117
 118
 119
 120
 121
 122
 123
 124         template#to_string
 125
 126     | Some (yyyy, mm, 0) ->             (* Month view. *)
 127         let template = month_template in
 128
 129         template#set "month_name" (long_month mm);
 130         template#set "yyyy" (string_of_int yyyy);
 131         template#set "mm" (sprintf "%02d" mm);
 132
 133         let prev_yyyy, prev_mm =
 134           if mm = 1 then yyyy - 1, 12
 135           else yyyy, mm - 1 in
 136         let next_yyyy, next_mm =
 137           if mm = 12 then yyyy + 1, 1
 138           else yyyy, mm + 1 in
 139         template#set "prev_yyyy" (string_of_int prev_yyyy);
 140         template#set "prev_mm" (sprintf "%02d" prev_mm);
 141         template#set "next_yyyy" (string_of_int next_yyyy);
 142         template#set "next_mm" (sprintf "%02d" next_mm);
 143
 144         (* Get all monthly events and all daily events. *)
 145         let monthly_events, daily_events =
 146           List.partition (function ((_, _, 0), _, _) -> true | _ -> false)
 147             pages in
 148
 149         (* Table of monthly events. *)
 150         let table =
 151           List.map (fun (_, title, page) ->
 152                       [ "title", Template.VarString title;
 153                         "page", Template.VarString page ]) monthly_events in
 154         template#table "monthly_events" table;
 155
 156         (* How many days in this month? *)
 157         let max_dd = GregorianDate.days_in_month yyyy mm in
 158         let days = range 1 max_dd in
 159
 160         let table =
 161           List.map (fun dd ->
 162                       let events =
 163                         List.filter (fun ((_, _, d), _, _) -> d = dd)
 164                           daily_events in
 165                       let table =
 166                         List.map (fun (_, title, page) ->
 167                                     [ "title", Template.VarString title;
 168                                       "page", Template.VarString page ])
 169                           events in
 170                       let is_weekend =
 171                         GregorianDate.day_of_week (yyyy, mm, dd) >= 6 in
 172                       [ "dd", Template.VarString (sprintf "%02d" dd);
 173                         "is_weekend", Template.VarConditional is_weekend;
 174                         "events", Template.VarTable table ])
 175             days in
 176         template#table "days" table;
 177
 178         template#to_string
 179
 180     | Some (yyyy, mm, dd) ->            (* Single day view. *)
 181         let template = day_template in
 182         failwith "not impl";
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195         template#to_string
 196
 197 (* Register the extension. *)
 198 let () =
 199   extensions := ("calendar", extension) :: !extensions