(* COCANWIKI - a wiki written in Objective CAML.
 * Written by Richard W.M. Jones <rich@merjis.com>.
 * Copyright (C) 2004 Merjis Ltd.
 * $Id: cocanwiki_pages.ml,v 1.1 2004/10/11 14:13:04 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 Cocanwiki
open Cocanwiki_strings

type pt = Page of string | Title of string

type model = {
  id : int;				(* Original page ID (0 = none). *)
  pt : pt;				(* Page of title (only used if id=0) *)
  description : string;			(* Description. *)
  redirect : string;			(* Redirect to ("" = none). *)
  contents : (string * string * string) list;
					(* (sectionname, divname, content)
					 * for each section. *)
}

exception SaveURLError
exception SaveConflict of int * int * string * string

let new_page pt =
  let description =
    match pt with
	Page page -> page
      | Title title -> title in

  let model = { id = 0;
		pt = pt;
		description = description;
		redirect = "";
		contents = [] } in
  model

let new_page_with_title title =
  (* Initial page contents. *)
  let contents = [ "", "", "<b>" ^ title ^ "</b> is " ] in
  let model = { id = 0;
		pt = Title title;
		description = title;
		redirect = "";
		contents = contents } in
  model

let load_page (dbh : Dbi.connection) hostid ~url ?version () =
  (* Pull out the page itself from the database. *)
  let sth =
    match version with
	None ->
	  let sth = dbh#prepare_cached "select id, title, description,
                                               coalesce (redirect, '')
                                          from pages
                                         where hostid = ? and url = ?" in
	  sth#execute [`Int hostid; `String url];
	  sth
      | Some version ->
	  let sth = dbh#prepare_cached "select id, title, description,
                                               coalesce (redirect, '')
                                          from pages
                                         where hostid = ? and id = ? and
                                               (url = ? or url_deleted = ?)" in
	  sth#execute [`Int hostid; `String url; `String url];
	  sth in

  let pageid, title, description, redirect =
    match sth#fetch1 () with
	[`Int pageid; `String title; `String description; `String redirect] ->
	  pageid, title, description, redirect
      | _ -> assert false in

  (* Get the sections. *)
  let sth = dbh#prepare_cached "select coalesce (sectionname, ''),
                                       content,
                                       coalesce (divname, '')
                                  from contents
                                 where pageid = ?
                                 order by ordering" in
  sth#execute [`Int pageid];

  let contents =
    sth#map (function
	       | [`String sectionname; `String content; `String divname] ->
		   sectionname, divname, content
	       | _ -> assert false) in

  let model = { id = pageid;
		pt = Page url;
		description = description;
		redirect = redirect;
		contents = contents; } in
  model

let save_page (dbh : Dbi.connection) hostid ?user ?r model =
  (* Logging information, if available. *)
  let logged_user =
    match user with
	None -> `Null
      | Some user ->
	  match user with
	    | User (id, _, _) -> `Int id
	    | _ -> `Null in

  let logged_ip =
    match r with
	None -> `Null
      | Some r ->
	  try `String (Connection.remote_ip (Request.connection r))
	  with Not_found -> `Null in

  (* Get redirect. *)
  let redirect =
    if model.redirect = "" then `Null
    else `String model.redirect in

  let url, pageid =
    (* Creating a new page (id = 0)?  If so, we're just going to insert
     * a new row, which is easy.
     *)
    if model.id = 0 then (
      (* Create the page title or URL. *)
      let url, title =
	match model.pt with
	    Page url -> url, url
	  | Title title ->
	      match Wikilib.generate_url_of_title dbh hostid title with
		  Wikilib.GenURL_OK url -> url, title
		| _ ->
		    raise SaveURLError in

      let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
                                      description, logged_ip, logged_user,
                                      redirect)
                                      values (?, ?, ?, ?, ?, ?, ?)" in
      sth#execute [`Int hostid; `String url; `String title;
		   `String model.description; logged_ip; logged_user;
		   redirect];

      let pageid = sth#serial "pages_id_seq" in

      (* Create the page contents. *)
      let sth = dbh#prepare_cached "insert into contents (pageid,
                                      ordering, sectionname, divname,
                                      content)
                                      values (?, ?, ?, ?, ?)" in
      let ordering = ref 0 in	(* Creating new ordering. *)
      List.iter (fun (sectionname, divname, content) ->
		   let divname =
		     if string_is_whitespace divname then `Null
		     else `String divname in
		   let sectionname =
		     if string_is_whitespace sectionname then `Null
		     else `String sectionname in
		   incr ordering; let ordering = !ordering in
		   sth#execute [`Int pageid; `Int ordering;
				sectionname; divname;
				`String content])
	model.contents;

      url, pageid
    )
      (* Otherwise it's an old page which we're updating. *)
    else (
      (* Pull out fields from the database. *)
      let sth = dbh#prepare_cached "select creation_date,
                                           coalesce (url, url_deleted),
                                           title, css
                                      from pages
                                     where hostid = ? and id = ?" in
      sth#execute [`Int hostid; `Int model.id];

      let creation_date, url, title, css =
	match sth#fetch1 () with
	    [ creation_date; `String url; `String title; css ] ->
	      creation_date, url, title, css
	  | _ -> assert false in

      (* Has someone else edited this page in the meantime? *)
      let sth = dbh#prepare_cached "select max(id) from pages
                                     where hostid = ? and url = ?" in
      sth#execute [`Int hostid; `String url];

      let max_id = sth#fetch1int () in
      let edited = max_id <> model.id in

      if edited then (
	let css = match css with
	    `Null -> "" | `String css -> css
	  | _ -> assert false in
	raise (SaveConflict (max_id, model.id, url, css))
      );

      (* Defer the pages_redirect_cn constraint because that would
       * temporarily fail on the next UPDATE.
       *)
      let sth =
	dbh#prepare_cached
	  "set constraints pages_redirect_cn, sitemenu_url_cn,
               page_emails_url_cn, links_from_cn, recently_visited_url_cn
               deferred" in
      sth#execute [];

      (* Mark the old page as deleted.  NB. There is a small race
       * condition here because PostgreSQL doesn't do isolation
       * properly.  If a user tries to visit this page between the
       * delete and the creation of the new page, then they'll get
       * a page not found error. (XXX)
       *)
      let sth = dbh#prepare_cached "update pages set url_deleted = url,
                                                     url = null
                                     where hostid = ? and id = ?" in
      sth#execute [`Int hostid; `Int model.id];

      (* Create the new page. *)
      let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
                                    description, creation_date, logged_ip,
                                    logged_user, redirect, css)
                                    values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
      sth#execute [`Int hostid; `String url; `String title;
		   `String model.description; creation_date; logged_ip;
		   logged_user; redirect; css];

      (* New page ID <> old page ID model.id. *)
      let pageid = sth#serial "pages_id_seq" in

      (* Create the page contents. *)
      let sth = dbh#prepare_cached "insert into contents (pageid,
                                    ordering, sectionname, divname,
                                    content)
                                    values (?, ?, ?, ?, ?)" in
      let ordering = ref 0 in	(* Creating new ordering. *)
      List.iter (fun (sectionname, divname, content) ->
		   let divname =
		     if string_is_whitespace divname then `Null
		     else `String divname in
		   let sectionname =
		     if string_is_whitespace sectionname then `Null
		     else `String sectionname in
		   incr ordering; let ordering = !ordering in
		   sth#execute [`Int pageid; `Int ordering;
				sectionname; divname;
				`String content])
	model.contents;

      url, pageid
    ) in

  (* Keep the links table in synch. *)
  Cocanwiki_links.update_links_for_page dbh hostid url;

  url, pageid