(* COCANWIKI - a wiki written in Objective CAML.
 * Written by Richard W.M. Jones <rich@merjis.com>.
 * Copyright (C) 2004 Merjis Ltd.
 * $Id: cocanwiki_diff.ml,v 1.9 2006/08/17 09:11:31 rich Exp $
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 * Boston, MA 02111-1307, USA.
 *)

open Apache
open Registry
open Cgi
open Printf

open Cocanwiki_pages
open Cocanwiki_files
open Cocanwiki

(* Convenience code for generating diffs between versions.  See diff.ml
 * and edit.ml which both use this code.
 *)
let page_for_diff model css =
  let title_or_url = match model.pt with Page t -> t | Title t -> t in
  "Title or URL: " ^ title_or_url ^ "\n" ^
  "Description: " ^ model.description ^ "\n\n" ^
  (match model.keywords with
   | None -> ""
   | Some keywords -> "Keywords: " ^ keywords ^ "\n\n") ^
  (match model.redirect with
   | None -> ""
   | Some redirect -> "Redirect: " ^ redirect ^ "\n\n") ^
  "ROBOTS NOODP: " ^
  (match model.noodp with
   | None -> "inherit sitewide default"
   | Some noodp -> string_of_bool noodp) ^ "\n\n" ^
  (String.concat ""
     (List.map (
	fun (sectionname, divname, divclass, jsgo, content) ->
	  (match sectionname with
	   | None -> ""
	   | Some sectionname -> "HEADING: " ^ sectionname ^ "\n\n") ^
	  content ^ "\n\n" ^
	  (match divname with
	   | None -> ""
	   | Some divname -> "CSS Id: " ^ divname ^ "\n") ^
	  (match divclass with
	   | None -> ""
	   | Some divclass -> "CSS Class: " ^ divclass ^ "\n") ^
	  (match jsgo with
	   | None -> ""
	   | Some jsgo -> "Javascript Onclick: " ^ jsgo ^ "\n") ^
	  "\n"
      ) model.contents_)
  ) ^
  (match css with
   | None -> ""
   | Some css -> "CSS:\n\n" ^ css ^ "\n")

let le_re = Pcre.regexp "\r?\n"
let le_subst = Pcre.subst "\n"

let diff_cmd old_page new_page =
  (* Convert line-endings in the input files from \r\n to \n.  Diff
   * can get confused by the \r characters, particularly in side-by-side
   * mode when asked to expand tabs (-y -t).
   *)
  let f = Pcre.replace ~rex:le_re ~itempl:le_subst in
  let new_page = f new_page in
  let old_page = f old_page in

  let new_filename = output_tempfile new_page in
  let old_filename = output_tempfile old_page in

  (* Side-by-side mode was good, but stupidly implemented.  It's
   * disabled right now.
   *)
  let diff_sidebyside = false in

  let options =
    if not diff_sidebyside then
      "-u"
    else
      "-y --left-column" in
  let options = options ^ " -t -b -B" in

  let cmd = sprintf "diff %s %s %s ||:" options old_filename new_filename in
  let diff = pget cmd in

  (* Remove the temporary files. *)
  unlink new_filename; unlink old_filename;

  let diff =
    if not diff_sidebyside then
      match diff with
	  _ :: _ :: diff -> diff
	| diff -> diff
    else diff in

  String.concat "\n" diff

let get_version_for_diff dbh version =
  if version = 0l then ""
  else (
    let title, description, keywords, noodp, redirect, css = List.hd (
      PGSQL(dbh)
	"select title, description, keywords, noodp, redirect, css from pages
          where id = $version"
    ) in

    let contents_ = PGSQL(dbh)
      "select sectionname, divname, divclass, jsgo, content
         from contents where pageid = $version
        order by ordering" in

    let model = { id = version;
		  pt = Title title;
		  description = description;
		  keywords = keywords;
		  noodp = noodp;
		  redirect = redirect;
		  contents_ = contents_ } in

    let page = page_for_diff model css in

    page
  )

let get_diff dbh hostid page ?old_version ~version ()=
  let old_version =
    match old_version with
      | Some version -> version
      | None ->
	  try
	    List.hd (
	      PGSQL(dbh)
		"select id from pages
                  where hostid = $hostid
                    and url_deleted = $page
                    and id < $version
                  order by 1 desc limit 1"
	    )
	  with
	    Not_found | ExtList.List.Empty_list | Failure "hd" -> 0l in

  (* Get the two versions. *)
  let new_page = get_version_for_diff dbh version in
  let old_page = get_version_for_diff dbh old_version in

  (* Compute the diff of the two versions. *)
  let diff = diff_cmd old_page new_page in
  diff, old_version