(* 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.5 2006/03/27 16:43:44 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 : int32;				(* Original page ID (0 = none). *)
  pt : pt;				(* Page of title (only used if id=0) *)
  description : string;			(* Description. *)
  redirect : string option;		(* Redirect to. *)
  (* NB. Don't call this 'contents' because that clashes with the
   * Pervasives.contents fields of the ref type.
   *)
  contents_ : (string option * string option * string) list;
					(* (sectionname, divname, content)
					 * for each section. *)
}

exception SaveURLError
exception SaveConflict of int32 * int32 * string * string

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

  let model = { id = 0l;
		pt = pt;
		description = description;
		redirect = None;
		contents_ = [] } in
  model

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

let load_page dbh hostid ~url ?version () =
  (* Pull out the page itself from the database. *)
  let rows =
    match version with
    | None ->
	PGSQL(dbh) "select id, title, description, redirect
                      from pages
                     where hostid = $hostid and url = $url"
    | Some version ->
	PGSQL(dbh) "select id, title, description, redirect
                      from pages
                     where hostid = $hostid and id = $version and
                           (url = $url or url_deleted = $url)" in

  let pageid, title, description, redirect =
    match rows with
    | [row] -> row
    | _ -> raise Not_found in

  (* Get the sections. *)
  let contents = PGSQL(dbh)
    "select sectionname, divname, content
       from contents
      where pageid = $pageid
      order by ordering" in

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

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

  let logged_ip =
    match r with
	None -> None
      | Some r ->
	  try Some (Connection.remote_ip (Request.connection r))
	  with Not_found -> None 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 = 0l 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 description = model.description in
      let redirect = model.redirect in
      PGSQL(dbh) "insert into pages (hostid, url, title,
                                     description, logged_ip, logged_user,
                                     redirect)
                  values ($hostid, $url, $title, $description,
                          $?logged_ip, $?logged_user, $?redirect)";

      let pageid = PGOCaml.serial4 dbh "pages_id_seq" in

      (* Create the page contents. *)
      let ordering = ref 0 in	(* Creating new ordering. *)
      List.iter (
	fun (sectionname, divname, content) ->
	  incr ordering; let ordering = Int32.of_int !ordering in
	  PGSQL(dbh)
	    "insert into contents (pageid, ordering, sectionname, divname,
                                   content)
             values ($pageid, $ordering,
                     $?sectionname, $?divname, $content)"
      ) model.contents_;

      url, pageid
    )
      (* Otherwise it's an old page which we're updating. *)
    else (
      (* Pull out fields from the database. *)
      let model_id = model.id in
      let rows =
	PGSQL(dbh)
	"select creation_date, coalesce (url, url_deleted),
                title, css
           from pages
          where hostid = $hostid and id = $model_id" in

      let creation_date, url, title, css =
	match rows with
	| [ row ] -> row
	| _ -> assert false in
      let url = Option.get url in

      (* Title changed? *)
      let title =
	match model.pt with
	| Title new_title when title <> new_title -> new_title
	| _ -> title in

      (* Has someone else edited this page in the meantime? *)
      let max_id = Option.get (
	List.hd (
	  PGSQL(dbh) "select max(id) from pages
                       where hostid = $hostid and url = $url"
	)
      ) in

      let edited = max_id <> model_id in

      if edited then (
	let css = match css with None -> "" | Some css -> css in
	raise (SaveConflict (max_id, model_id, url, css))
      );

      (* Defer the pages_redirect_cn constraint because that would
       * temporarily fail on the next UPDATE.
       *)
      PGSQL(dbh)
	"set constraints
               pages_redirect_cn, sitemenu_url_cn,
               page_emails_url_cn, links_from_cn, recently_visited_url_cn
             deferred";

      (* 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)
       *)
      PGSQL(dbh) "update pages set url_deleted = url, url = null
                   where hostid = $hostid and id = $model_id";

      let description = model.description in
      let redirect = model.redirect in
      PGSQL(dbh)
	"insert into pages (hostid, url, title,
                            description, creation_date, logged_ip,
                            logged_user, redirect, css)
         values ($hostid, $url, $title, $description, $creation_date,
                 $?logged_ip, $?logged_user, $?redirect, $?css)";

      (* New page ID <> old page ID model.id. *)
      let pageid = PGOCaml.serial4 dbh "pages_id_seq" in

      (* Create the page contents. *)
      let ordering = ref 0 in	(* Creating new ordering. *)
      List.iter (
	fun (sectionname, divname, content) ->
	  incr ordering; let ordering = Int32.of_int !ordering in
	  PGSQL(dbh) "insert into contents (pageid,
                         ordering, sectionname, divname, content)
                      values ($pageid, $ordering, $?sectionname,
                              $?divname, $content)"
      ) model.contents_;

      url, pageid
    ) in

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

  url, pageid