From 03c84f3c8e3ed31fd4026cab659ff274ef157212 Mon Sep 17 00:00:00 2001 From: rich Date: Fri, 4 Aug 2006 12:45:29 +0000 Subject: [PATCH] Added on pages. Tidied up redirect box. --- schema/cocanwiki.sql | 3 ++- scripts/edit.ml | 15 ++++++++--- scripts/edit_page_css.ml | 14 +++++------ scripts/lib/cocanwiki_create_host.ml | 7 +++--- scripts/lib/cocanwiki_diff.ml | 10 +++++--- scripts/lib/cocanwiki_pages.ml | 29 +++++++++++++-------- scripts/lib/cocanwiki_pages.mli | 3 ++- scripts/page.ml | 49 +++++++++++++++++++++--------------- scripts/rename_page.ml | 6 +++-- scripts/restore.ml | 12 +++++---- templates/edit.html | 31 +++++++++++++++++------ templates/page_header.html | 1 + tools/copy_page.ml | 7 +++--- 13 files changed, 121 insertions(+), 66 deletions(-) diff --git a/schema/cocanwiki.sql b/schema/cocanwiki.sql index 99b0290..4a62e68 100644 --- a/schema/cocanwiki.sql +++ b/schema/cocanwiki.sql @@ -1077,7 +1077,8 @@ CREATE TABLE pages ( redirect text, css text, logged_user integer, - title_description_fti tsvector NOT NULL + title_description_fti tsvector NOT NULL, + keywords text ); diff --git a/scripts/edit.ml b/scripts/edit.ml index 8b0a755..f28ba2d 100644 --- a/scripts/edit.ml +++ b/scripts/edit.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit.ml,v 1.34 2006/08/04 12:20:06 rich Exp $ + * $Id: edit.ml,v 1.35 2006/08/04 12:45: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 @@ -55,10 +55,12 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = let build_internal_model () = let id = Int32.of_string (q#param "id") in let description = q#param "description" in + let keywords = q#param "keywords" in + let keywords = + if string_is_whitespace keywords then None else Some keywords in let redirect = q#param "redirect" in let redirect = - if string_is_whitespace redirect then - None else Some redirect in + if string_is_whitespace redirect then None else Some redirect in let pt = match q#param "pt_type" with | "page" -> Page (q#param "pt_value") | "title" -> Title (q#param "pt_value") @@ -84,6 +86,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = { id = id; pt = pt; description = description; + keywords = keywords; redirect = redirect; contents_ = contents; } in @@ -221,6 +224,8 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = let model_to_template model template = template#set "id" (Int32.to_string model.id); template#set "description" model.description; + template#set "keywords" + (match model.keywords with None -> "" | Some keywords -> keywords); (match model.pt with Page page -> @@ -242,10 +247,12 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = let table = List.map ( fun (url, title) -> let url = Option.get url in + let is_index = url = "index" in let selected = model.redirect = Some url in [ "url", Template.VarString url; "title", Template.VarString title; - "selected", Template.VarConditional selected ] + "selected", Template.VarConditional selected; + "is_index", Template.VarConditional is_index ] ) rows in template#table "redirects" table; diff --git a/scripts/edit_page_css.ml b/scripts/edit_page_css.ml index aafbf63..a79b65f 100644 --- a/scripts/edit_page_css.ml +++ b/scripts/edit_page_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_page_css.ml,v 1.21 2006/07/26 13:41:37 rich Exp $ + * $Id: edit_page_css.ml,v 1.22 2006/08/04 12:45: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 @@ -50,14 +50,13 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = * us to revert changes to the CSS easily. *) let rows = PGSQL(dbh) - "select id, title, description, creation_date, redirect + "select id, title, description, keywords, creation_date, redirect from pages where hostid = $hostid and url = $page" in - let oldpageid, title, description, creation_date, redirect = + let oldpageid, title, description, keywords, creation_date, redirect = match rows with - | [id, title, description, creation_date, redirect ] -> - id, title, description, creation_date, redirect + | [row] -> row | _ -> assert false in PGSQL(dbh) @@ -69,9 +68,10 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = where hostid = $hostid and id = $oldpageid"; PGSQL(dbh) "insert into pages (hostid, url, title, - description, creation_date, logged_ip, + description, keywords, + creation_date, logged_ip, logged_user, redirect, css) - values ($hostid, $page, $title, $description, + values ($hostid, $page, $title, $description, $?keywords, $creation_date, $?logged_ip, $?logged_user, $?redirect, $?css)"; diff --git a/scripts/lib/cocanwiki_create_host.ml b/scripts/lib/cocanwiki_create_host.ml index 31c8a0d..e898811 100644 --- a/scripts/lib/cocanwiki_create_host.ml +++ b/scripts/lib/cocanwiki_create_host.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_create_host.ml,v 1.4 2006/07/26 13:41:40 rich Exp $ + * $Id: cocanwiki_create_host.ml,v 1.5 2006/08/04 12:45:33 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 @@ -73,8 +73,9 @@ let create_host dbh canonical_hostname hostnames template (* Copy pages. *) PGSQL(dbh) - "insert into pages (hostid, url, title, description, redirect, css) - select $hostid, url, title, description, redirect, css + "insert into pages (hostid, url, title, description, keywords, + redirect, css) + select $hostid, url, title, description, keywords, redirect, css from pages where hostid = $template and url is not null"; diff --git a/scripts/lib/cocanwiki_diff.ml b/scripts/lib/cocanwiki_diff.ml index 9b8a7f0..e44e8ae 100644 --- a/scripts/lib/cocanwiki_diff.ml +++ b/scripts/lib/cocanwiki_diff.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_diff.ml,v 1.6 2006/08/04 12:20:07 rich Exp $ + * $Id: cocanwiki_diff.ml,v 1.7 2006/08/04 12:45:33 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 @@ -35,6 +35,9 @@ 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") ^ @@ -103,9 +106,9 @@ let diff_cmd old_page new_page = let get_version_for_diff dbh version = if version = 0l then "" else ( - let title, description, redirect, css = List.hd ( + let title, description, keywords, redirect, css = List.hd ( PGSQL(dbh) - "select title, description, redirect, css from pages + "select title, description, keywords, redirect, css from pages where id = $version" ) in @@ -117,6 +120,7 @@ let get_version_for_diff dbh version = let model = { id = version; pt = Title title; description = description; + keywords = keywords; redirect = redirect; contents_ = contents_ } in diff --git a/scripts/lib/cocanwiki_pages.ml b/scripts/lib/cocanwiki_pages.ml index 70eb525..d0d3285 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.8 2006/08/04 12:20:07 rich Exp $ + * $Id: cocanwiki_pages.ml,v 1.9 2006/08/04 12:45:33 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 @@ -34,6 +34,7 @@ type model = { id : int32; (* Original page ID (0 = none). *) pt : pt; (* Page of title (only used if id=0) *) description : string; (* Description. *) + keywords : string option; (* Keywords. *) redirect : string option; (* Redirect to. *) (* NB. Don't call this 'contents' because that clashes with the * Pervasives.contents fields of the ref type. @@ -47,12 +48,13 @@ exception SaveConflict of int32 * int32 * string * string option let new_page pt = let description = match pt with - Page page -> page - | Title title -> title in + | Page page -> page + | Title title -> title in let model = { id = 0l; pt = pt; description = description; + keywords = None; redirect = None; contents_ = [] } in model @@ -63,6 +65,7 @@ let new_page_with_title title = let model = { id = 0l; pt = Title title; description = title; + keywords = None; redirect = None; contents_ = contents } in model @@ -72,16 +75,16 @@ let load_page dbh hostid ~url ?version () = let rows = match version with | None -> - PGSQL(dbh) "select id, title, description, redirect + PGSQL(dbh) "select id, title, description, keywords, redirect from pages where hostid = $hostid and url = $url" | Some version -> - PGSQL(dbh) "select id, title, description, redirect + PGSQL(dbh) "select id, title, description, keywords, redirect from pages where hostid = $hostid and id = $version and (url = $url or url_deleted = $url)" in - let pageid, title, description, redirect = + let pageid, title, description, keywords, redirect = match rows with | [row] -> row | _ -> raise Not_found in @@ -96,6 +99,7 @@ let load_page dbh hostid ~url ?version () = let model = { id = pageid; pt = Page url; description = description; + keywords = keywords; redirect = redirect; contents_ = contents } in model @@ -130,11 +134,13 @@ let save_page r dbh hostid ?user model = raise SaveURLError in let description = model.description in + let keywords = model.keywords in let redirect = model.redirect in PGSQL(dbh) "insert into pages (hostid, url, title, - description, logged_ip, logged_user, + description, keywords, + logged_ip, logged_user, redirect) - values ($hostid, $url, $title, $description, + values ($hostid, $url, $title, $description, $?keywords, $?logged_ip, $?logged_user, $?redirect)"; let pageid = PGOCaml.serial4 dbh "pages_id_seq" in @@ -208,12 +214,15 @@ let save_page r dbh hostid ?user model = where hostid = $hostid and id = $model_id"; let description = model.description in + let keywords = model.keywords in let redirect = model.redirect in PGSQL(dbh) "insert into pages (hostid, url, title, - description, creation_date, logged_ip, + description, keywords, + creation_date, logged_ip, logged_user, redirect, css) - values ($hostid, $url, $title, $description, $creation_date, + values ($hostid, $url, $title, $description, $?keywords, + $creation_date, $?logged_ip, $?logged_user, $?redirect, $?css)"; (* New page ID <> old page ID model.id. *) diff --git a/scripts/lib/cocanwiki_pages.mli b/scripts/lib/cocanwiki_pages.mli index 6503141..41151bb 100644 --- a/scripts/lib/cocanwiki_pages.mli +++ b/scripts/lib/cocanwiki_pages.mli @@ -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.mli,v 1.5 2006/08/04 12:20:07 rich Exp $ + * $Id: cocanwiki_pages.mli,v 1.6 2006/08/04 12:45:33 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 @@ -32,6 +32,7 @@ type model = { id : int32; (* Original page ID (0 = none). *) pt : pt; (* Page of title (only used if id=0) *) description : string; (* Description. *) + keywords : string option; (* Keywords. *) redirect : string option; (* Redirect to. *) contents_ : section list; (* List of sections. *) } diff --git a/scripts/page.ml b/scripts/page.ml index 30b72b6..9521fe0 100644 --- a/scripts/page.ml +++ b/scripts/page.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: page.ml,v 1.51 2006/08/03 13:52:58 rich Exp $ + * $Id: page.ml,v 1.52 2006/08/04 12:45: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 @@ -36,10 +36,11 @@ open Cocanwiki_links open Cocanwiki_extensions open Cocanwiki_strings -type fp_status = FPOK of int32 * string * string * Calendar.t * bool - | FPInternalRedirect of string - | FPExternalRedirect of string - | FPNotFound +type fp_status = + | FPOK of int32 * string * string * string option * Calendar.t * bool + | FPInternalRedirect of string + | FPExternalRedirect of string + | FPNotFound (* Referer strings which help us decide if the user came from * a search engine and highlight terms in the page appropriately. @@ -183,7 +184,8 @@ let run r (q : cgi) dbh hostid in (* This code generates ordinary pages. *) - let make_page title description pageid last_modified_date has_page_css + let make_page title description keywords + pageid last_modified_date has_page_css version page page' extension = let t = template_page in let th = template_page_header in @@ -197,6 +199,12 @@ let run r (q : cgi) dbh hostid th#conditional "has_description" true; th#set "description" description); + (match keywords with + None -> th#conditional "has_keywords" false + | Some keywords -> + th#conditional "has_keywords" true; + th#set "keywords" keywords); + if page <> page' then (* redirection *) ( t#set "page" page'; th#set "page" page'; @@ -552,49 +560,49 @@ let run r (q : cgi) dbh hostid | None -> if allow_redirect then ( let rows = PGSQL(dbh) - "select url, redirect, id, title, description, + "select url, redirect, id, title, description, keywords, last_modified_date, css is not null from pages where hostid = $hostid and lower (url) = lower ($page)" in match rows with - | [Some page', _, _, _, _, _, _] + | [Some page', _, _, _, _, _, _, _] when page <> page' -> (* different case *) FPExternalRedirect page' - | [ _, None, id, title, description, + | [ _, None, id, title, description, keywords, last_modified_date, has_page_css ] -> let has_page_css = Option.get has_page_css in - FPOK (id, title, description, last_modified_date, + FPOK (id, title, description, keywords, last_modified_date, has_page_css) - | [_, Some redirect, _, _, _, _, _] -> + | [_, Some redirect, _, _, _, _, _, _] -> FPInternalRedirect redirect | [] -> FPNotFound | _ -> assert false ) else (* redirects not allowed ... *) ( let rows = PGSQL(dbh) - "select id, title, description, last_modified_date, + "select id, title, description, keywords, last_modified_date, css is not null from pages where hostid = $hostid and url = $page" in match rows with - | [ id, title, description, + | [ id, title, description, keywords, last_modified_date, has_page_css ] -> let has_page_css = Option.get has_page_css in - FPOK (id, title, description, last_modified_date, + FPOK (id, title, description, keywords, last_modified_date, has_page_css) | [] -> FPNotFound | _ -> assert false ) | Some version -> let rows = PGSQL(dbh) - "select id, title, description, last_modified_date, + "select id, title, description, keywords, last_modified_date, css is not null from pages where hostid = $hostid and id = $version and (url = $page or url_deleted = $page)" in match rows with - | [ id, title, description, + | [ id, title, description, keywords, last_modified_date, has_page_css ] -> let has_page_css = Option.get has_page_css in - FPOK (id, title, description, last_modified_date, + FPOK (id, title, description, keywords, last_modified_date, has_page_css) | [] -> FPNotFound | _ -> assert false @@ -618,10 +626,11 @@ let run r (q : cgi) dbh hostid return () ) else match fetch_page page' version allow_redirect with - | FPOK (pageid, title, description, last_modified_date, has_page_css)-> + | FPOK (pageid, title, description, keywords, + last_modified_date, has_page_css)-> (* Check if the page is also a template. *) let extension = get_extension page' in - make_page title (Some description) (Some pageid) + make_page title (Some description) keywords (Some pageid) (printable_date last_modified_date) has_page_css version page page' extension | FPInternalRedirect page' -> @@ -637,7 +646,7 @@ let run r (q : cgi) dbh hostid (match extension with | (Some _) as extension -> let title = page' in - make_page title None None + make_page title None None None "Now" false None page page' extension | None -> diff --git a/scripts/rename_page.ml b/scripts/rename_page.ml index 8c0b0ed..b7ad181 100644 --- a/scripts/rename_page.ml +++ b/scripts/rename_page.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: rename_page.ml,v 1.7 2006/07/27 16:46:55 rich Exp $ + * $Id: rename_page.ml,v 1.8 2006/08/04 12:45: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 @@ -78,7 +78,9 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = *) let old_model = load_page dbh hostid ~url:page () in let new_model = new_page_with_title new_title in - let new_model = { new_model with description = old_model.description; + let new_model = { new_model with + description = old_model.description; + keywords = old_model.keywords; contents_ = old_model.contents_ } in let old_model = { old_model with redirect = Some new_page } in ignore (save_page r dbh hostid ~user old_model); diff --git a/scripts/restore.ml b/scripts/restore.ml index e41d364..01e505f 100644 --- a/scripts/restore.ml +++ b/scripts/restore.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: restore.ml,v 1.23 2006/07/27 16:46:55 rich Exp $ + * $Id: restore.ml,v 1.24 2006/08/04 12:45: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 @@ -46,13 +46,13 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = (* Copy the old version of the page to be live. *) let rows = PGSQL(dbh) - "select title, description, creation_date, + "select title, description, keywords, creation_date, redirect, css from pages where hostid = $hostid and url_deleted = $page and id = $version" in - let title, description, creation_date, redirect, css = + let title, description, keywords, creation_date, redirect, css = match rows with | [row] -> row | _ -> assert false in @@ -64,9 +64,11 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = PGSQL(dbh) "update pages set url_deleted = url, url = null where hostid = $hostid and url = $page"; PGSQL(dbh) "insert into pages (hostid, url, title, - description, creation_date, logged_ip, + description, keywords, + creation_date, logged_ip, logged_user, redirect, css) - values ($hostid, $page, $title, $description, $creation_date, + values ($hostid, $page, $title, $description, $?keywords, + $creation_date, $?logged_ip, $?logged_user, $?redirect, $?css)"; let pageid = PGOCaml.serial4 dbh "pages_id_seq" in diff --git a/templates/edit.html b/templates/edit.html index 7121355..e033ab7 100644 --- a/templates/edit.html +++ b/templates/edit.html @@ -16,18 +16,35 @@ -

-Description: + + + + + + + + + + -

-Redirect to (if given, page contents are ignored): +

+ + + +
Description: -

+
Keywords: + +
+Redirect to:
+(if given, page contents are ignored) +		 -

+
::if(has_errors)::

diff --git a/templates/page_header.html b/templates/page_header.html index 2e06e52..b424edf 100644 --- a/templates/page_header.html +++ b/templates/page_header.html @@ -4,6 +4,7 @@ ::title_html:: ::if(is_old_version)::::end:: ::if(has_description)::::end:: +::if(has_keywords)::::end:: diff --git a/tools/copy_page.ml b/tools/copy_page.ml index 178065f..5689e5d 100644 --- a/tools/copy_page.ml +++ b/tools/copy_page.ml @@ -1,6 +1,6 @@ (* Copy a page from one host to another. Note that this only copies * the text, not any images which may be present. - * $Id: copy_page.ml,v 1.2 2006/07/26 13:41:46 rich Exp $ + * $Id: copy_page.ml,v 1.3 2006/08/04 12:45:35 rich Exp $ * * Usage: copy_page hostid url new_hostid new_url *) @@ -21,8 +21,9 @@ let () = let old_pageid = sth#fetch1int () in let sth = dbh#prepare_cached - "insert into pages (url, title, description, hostid, redirect, css) - select ? as url, title, description, ? as hostid, redirect, css + "insert into pages (url, title, description, keywords, + hostid, redirect, css) + select ? as url, title, description, keywords, ? as hostid, redirect, css from pages where id = ?" in sth#execute [`String new_url; `Int new_hostid; `Int old_pageid]; -- 1.8.3.1