scripts/lib/cocanwiki_diff.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_diff.ml,v 1.9 2006/08/17 09:11:31 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 Cocanwiki_pages
  28 open Cocanwiki_files
  29 open Cocanwiki
  30
  31 (* Convenience code for generating diffs between versions.  See diff.ml
  32  * and edit.ml which both use this code.
  33  *)
  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
  39    | None -> ""
  40    | Some keywords -> "Keywords: " ^ keywords ^ "\n\n") ^
  41   (match model.redirect with
  42    | None -> ""
  43    | Some redirect -> "Redirect: " ^ redirect ^ "\n\n") ^
  44   "ROBOTS NOODP: " ^
  45   (match model.noodp with
  46    | None -> "inherit sitewide default"
  47    | Some noodp -> string_of_bool noodp) ^ "\n\n" ^
  48   (String.concat ""
  49      (List.map (
  50         fun (sectionname, divname, divclass, jsgo, content) ->
  51           (match sectionname with
  52            | None -> ""
  53            | Some sectionname -> "HEADING: " ^ sectionname ^ "\n\n") ^
  54           content ^ "\n\n" ^
  55           (match divname with
  56            | None -> ""
  57            | Some divname -> "CSS Id: " ^ divname ^ "\n") ^
  58           (match divclass with
  59            | None -> ""
  60            | Some divclass -> "CSS Class: " ^ divclass ^ "\n") ^
  61           (match jsgo with
  62            | None -> ""
  63            | Some jsgo -> "Javascript Onclick: " ^ jsgo ^ "\n") ^
  64           "\n"
  65       ) model.contents_)
  66   ) ^
  67   (match css with
  68    | None -> ""
  69    | Some css -> "CSS:\n\n" ^ css ^ "\n")
  70
  71 let le_re = Pcre.regexp "\r?\n"
  72 let le_subst = Pcre.subst "\n"
  73
  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).
  78    *)
  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
  82
  83   let new_filename = output_tempfile new_page in
  84   let old_filename = output_tempfile old_page in
  85
  86   (* Side-by-side mode was good, but stupidly implemented.  It's
  87    * disabled right now.
  88    *)
  89   let diff_sidebyside = false in
  90
  91   let options =
  92     if not diff_sidebyside then
  93       "-u"
  94     else
  95       "-y --left-column" in
  96   let options = options ^ " -t -b -B" in
  97
  98   let cmd = sprintf "diff %s %s %s ||:" options old_filename new_filename in
  99   let diff = pget cmd in
 100
 101   (* Remove the temporary files. *)
 102   unlink new_filename; unlink old_filename;
 103
 104   let diff =
 105     if not diff_sidebyside then
 106       match diff with
 107           _ :: _ :: diff -> diff
 108         | diff -> diff
 109     else diff in
 110
 111   String.concat "\n" diff
 112
 113 let get_version_for_diff dbh version =
 114   if version = 0l then ""
 115   else (
 116     let title, description, keywords, noodp, redirect, css = List.hd (
 117       PGSQL(dbh)
 118         "select title, description, keywords, noodp, redirect, css from pages
 119           where id = $version"
 120     ) in
 121
 122     let contents_ = PGSQL(dbh)
 123       "select sectionname, divname, divclass, jsgo, content
 124          from contents where pageid = $version
 125         order by ordering" in
 126
 127     let model = { id = version;
 128                   pt = Title title;
 129                   description = description;
 130                   keywords = keywords;
 131                   noodp = noodp;
 132                   redirect = redirect;
 133                   contents_ = contents_ } in
 134
 135     let page = page_for_diff model css in
 136
 137     page
 138   )
 139
 140 let get_diff dbh hostid page ?old_version ~version ()=
 141   let old_version =
 142     match old_version with
 143       | Some version -> version
 144       | None ->
 145           try
 146             List.hd (
 147               PGSQL(dbh)
 148                 "select id from pages
 149                   where hostid = $hostid
 150                     and url_deleted = $page
 151                     and id < $version
 152                   order by 1 desc limit 1"
 153             )
 154           with
 155             Not_found | ExtList.List.Empty_list | Failure "hd" -> 0l in
 156
 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
 160
 161   (* Compute the diff of the two versions. *)
 162   let diff = diff_cmd old_page new_page in
 163   diff, old_version