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_diff.ml,v 1.9 2006/08/17 09:11:31 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.
31 (* Convenience code for generating diffs between versions. See diff.ml
32 * and edit.ml which both use this code.
34 let page_for_diff model css =
35 let title_or_url = match model.pt with Page t -> t | Title t -> t in
36 "Title or URL: " ^ title_or_url ^ "\n" ^
37 "Description: " ^ model.description ^ "\n\n" ^
38 (match model.keywords with
40 | Some keywords -> "Keywords: " ^ keywords ^ "\n\n") ^
41 (match model.redirect with
43 | Some redirect -> "Redirect: " ^ redirect ^ "\n\n") ^
45 (match model.noodp with
46 | None -> "inherit sitewide default"
47 | Some noodp -> string_of_bool noodp) ^ "\n\n" ^
50 fun (sectionname, divname, divclass, jsgo, content) ->
51 (match sectionname with
53 | Some sectionname -> "HEADING: " ^ sectionname ^ "\n\n") ^
57 | Some divname -> "CSS Id: " ^ divname ^ "\n") ^
60 | Some divclass -> "CSS Class: " ^ divclass ^ "\n") ^
63 | Some jsgo -> "Javascript Onclick: " ^ jsgo ^ "\n") ^
69 | Some css -> "CSS:\n\n" ^ css ^ "\n")
71 let le_re = Pcre.regexp "\r?\n"
72 let le_subst = Pcre.subst "\n"
74 let diff_cmd old_page new_page =
75 (* Convert line-endings in the input files from \r\n to \n. Diff
76 * can get confused by the \r characters, particularly in side-by-side
77 * mode when asked to expand tabs (-y -t).
79 let f = Pcre.replace ~rex:le_re ~itempl:le_subst in
80 let new_page = f new_page in
81 let old_page = f old_page in
83 let new_filename = output_tempfile new_page in
84 let old_filename = output_tempfile old_page in
86 (* Side-by-side mode was good, but stupidly implemented. It's
89 let diff_sidebyside = false in
92 if not diff_sidebyside then
96 let options = options ^ " -t -b -B" in
98 let cmd = sprintf "diff %s %s %s ||:" options old_filename new_filename in
99 let diff = pget cmd in
101 (* Remove the temporary files. *)
102 unlink new_filename; unlink old_filename;
105 if not diff_sidebyside then
107 _ :: _ :: diff -> diff
111 String.concat "\n" diff
113 let get_version_for_diff dbh version =
114 if version = 0l then ""
116 let title, description, keywords, noodp, redirect, css = List.hd (
118 "select title, description, keywords, noodp, redirect, css from pages
122 let contents_ = PGSQL(dbh)
123 "select sectionname, divname, divclass, jsgo, content
124 from contents where pageid = $version
125 order by ordering" in
127 let model = { id = version;
129 description = description;
133 contents_ = contents_ } in
135 let page = page_for_diff model css in
140 let get_diff dbh hostid page ?old_version ~version ()=
142 match old_version with
143 | Some version -> version
148 "select id from pages
149 where hostid = $hostid
150 and url_deleted = $page
152 order by 1 desc limit 1"
155 Not_found | ExtList.List.Empty_list | Failure "hd" -> 0l in
157 (* Get the two versions. *)
158 let new_page = get_version_for_diff dbh version in
159 let old_page = get_version_for_diff dbh old_version in
161 (* Compute the diff of the two versions. *)
162 let diff = diff_cmd old_page new_page in