X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Flib%2Fcocanwiki_pages.ml;h=948f8a575d0e0ce1f80cd388081073531a6d186e;hb=d303f75eed3a09bbe2516d9a2a9a4aa9b862ceb3;hp=f713277977b3d206aa64381e996595d4c3b970e6;hpb=fb1c781bdbe4a2b296651a051dda11d210c9ad33;p=cocanwiki.git diff --git a/scripts/lib/cocanwiki_pages.ml b/scripts/lib/cocanwiki_pages.ml index f713277..948f8a5 100644 --- a/scripts/lib/cocanwiki_pages.ml +++ b/scripts/lib/cocanwiki_pages.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_pages.ml,v 1.4 2005/11/17 10:14:43 rich Exp $ + * $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 @@ -27,17 +27,20 @@ open Cocanwiki_strings type pt = Page of string | Title of string type model = { - id : int; (* Original page ID (0 = none). *) + id : int32; (* 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; + 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 int * int * string * string +exception SaveConflict of int32 * int32 * string * string let new_page pt = let description = @@ -45,98 +48,78 @@ let new_page pt = Page page -> page | Title title -> title in - let model = { id = 0; + let model = { id = 0l; pt = pt; description = description; - redirect = ""; - contents = [] } in + redirect = None; + contents_ = [] } in model let new_page_with_title title = (* Initial page contents. *) - let contents = [ "", "", "" ^ title ^ " is " ] in - let model = { id = 0; + let contents = [ None, None, "" ^ title ^ " is " ] in + let model = { id = 0l; pt = Title title; description = title; - redirect = ""; - contents = contents } in + redirect = None; + contents_ = contents } in model -let load_page (dbh : Dbi.connection) hostid ~url ?version () = +let load_page dbh hostid ~url ?version () = (* Pull out the page itself from the database. *) - let sth = + let rows = 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 + | 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 sth#fetch1 () with - [`Int pageid; `String title; `String description; `String redirect] -> - pageid, title, description, redirect - | _ -> assert false in + match rows with + | [row] -> row + | _ -> raise Not_found 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 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 + contents_ = contents } in model -let save_page (dbh : Dbi.connection) hostid ?user ?r model = +let save_page dbh hostid ?user ?r model = (* Logging information, if available. *) let logged_user = match user with - None -> `Null + None -> None | Some user -> match user with - | User (id, _, _, _) -> `Int id - | _ -> `Null in + | User (id, _, _, _) -> Some id + | _ -> None in let logged_ip = match r with - None -> `Null + None -> None | 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 + 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 = 0 then ( + if model.id = 0l then ( (* Create the page title or URL. *) let url, title = match model.pt with @@ -147,83 +130,76 @@ let save_page (dbh : Dbi.connection) hostid ?user ?r model = | _ -> 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 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 = Int64.to_int (sth#serial "pages_id_seq") in + let pageid = PGOCaml.serial4 dbh "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; + 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 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 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 sth#fetch1 () with - [ creation_date; `String url; `String title; css ] -> - creation_date, url, title, css - | _ -> assert false in + 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 + | Title new_title when title <> new_title -> new_title + | _ -> title 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 = Option.get ( + List.hd ( + PGSQL(dbh) "select max(id) from pages + where hostid = $hostid and url = $url" + ) + ) in - let max_id = sth#fetch1int () in - let edited = max_id <> model.id 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)) + 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. *) - let sth = - dbh#prepare_cached - "set constraints pages_redirect_cn, sitemenu_url_cn, + PGSQL(dbh) + "set constraints + pages_redirect_cn, sitemenu_url_cn, page_emails_url_cn, links_from_cn, recently_visited_url_cn - deferred" in - sth#execute []; + deferred"; (* Mark the old page as deleted. NB. There is a small race * condition here because PostgreSQL doesn't do isolation @@ -231,41 +207,31 @@ let save_page (dbh : Dbi.connection) hostid ?user ?r model = * 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]; + 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 = Int64.to_int (sth#serial "pages_id_seq") in + let pageid = PGOCaml.serial4 dbh "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; + 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