From eeb304015c65ccf593a77058d5db5f5a3e3b45d5 Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Tue, 28 Sep 2004 10:56:39 +0000
Subject: [PATCH] Script for rebuilding the links table from scratch.

---
 cocanwiki.sql                      | 115 ++++++++++++++++++++-----------------
 scripts/.depend                    |   4 ++
 scripts/Makefile                   |   6 +-
 scripts/cocanwiki_links.ml         |  60 +++++++++++++++++++
 scripts/cocanwiki_links.mli        |  22 +++++++
 scripts/edit.ml                    |   4 +-
 scripts/edit_page_css.ml           |   4 +-
 scripts/edit_page_title.ml         |   4 +-
 scripts/rebuild_links.ml           |  96 +++++++++++++++++++++++++++++++
 scripts/restore.ml                 |   4 +-
 templates/host_menu.html           |   6 ++
 templates/rebuild_links.html       |   9 +++
 templates/rebuild_links_done.html  |   8 +++
 templates/rebuild_links_start.html |  35 +++++++++++
 14 files changed, 314 insertions(+), 63 deletions(-)
 create mode 100644 scripts/cocanwiki_links.ml
 create mode 100644 scripts/cocanwiki_links.mli
 create mode 100644 scripts/rebuild_links.ml
 create mode 100644 templates/rebuild_links.html
 create mode 100644 templates/rebuild_links_done.html
 create mode 100644 templates/rebuild_links_start.html

diff --git a/cocanwiki.sql b/cocanwiki.sql
index 15a09af..af3ac70 100644
--- a/cocanwiki.sql
+++ b/cocanwiki.sql
@@ -48,7 +48,7 @@ GRANT ALL ON TABLE pages TO "www-data";
 
 
 --
--- TOC entry 39 (OID 536004)
+-- TOC entry 40 (OID 536004)
 -- Name: pages_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -81,7 +81,7 @@ GRANT ALL ON TABLE contents TO "www-data";
 
 
 --
--- TOC entry 40 (OID 536021)
+-- TOC entry 41 (OID 536021)
 -- Name: contents_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -118,7 +118,7 @@ GRANT ALL ON TABLE hosts TO "www-data";
 
 
 --
--- TOC entry 41 (OID 536371)
+-- TOC entry 42 (OID 536371)
 -- Name: hosts_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -203,7 +203,7 @@ GRANT ALL ON TABLE images TO "www-data";
 
 
 --
--- TOC entry 42 (OID 537151)
+-- TOC entry 43 (OID 537151)
 -- Name: images_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -238,7 +238,7 @@ GRANT ALL ON TABLE files TO "www-data";
 
 
 --
--- TOC entry 43 (OID 537166)
+-- TOC entry 44 (OID 537166)
 -- Name: files_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -277,7 +277,7 @@ GRANT ALL ON TABLE users TO "www-data";
 
 
 --
--- TOC entry 44 (OID 540816)
+-- TOC entry 45 (OID 540816)
 -- Name: users_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -350,7 +350,7 @@ GRANT ALL ON TABLE contacts TO "www-data";
 
 
 --
--- TOC entry 45 (OID 542605)
+-- TOC entry 46 (OID 542605)
 -- Name: contacts_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -481,7 +481,16 @@ CREATE TABLE links (
 
 
 --
--- TOC entry 50 (OID 536388)
+-- TOC entry 39 (OID 544445)
+-- Name: links; Type: ACL; Schema: public; Owner: rich
+--
+
+REVOKE ALL ON TABLE links FROM PUBLIC;
+GRANT ALL ON TABLE links TO "www-data";
+
+
+--
+-- TOC entry 51 (OID 536388)
 -- Name: hostnames_hostid_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -489,7 +498,7 @@ CREATE UNIQUE INDEX hostnames_hostid_name_uq ON hostnames USING btree (hostid, n
 
 
 --
--- TOC entry 51 (OID 536389)
+-- TOC entry 52 (OID 536389)
 -- Name: hostnams_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -497,7 +506,7 @@ CREATE UNIQUE INDEX hostnams_name_uq ON hostnames USING btree (name);
 
 
 --
--- TOC entry 47 (OID 536419)
+-- TOC entry 48 (OID 536419)
 -- Name: pages_url_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -505,7 +514,7 @@ CREATE UNIQUE INDEX pages_url_uq ON pages USING btree (hostid, url);
 
 
 --
--- TOC entry 52 (OID 536924)
+-- TOC entry 53 (OID 536924)
 -- Name: email_notify_email_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -513,7 +522,7 @@ CREATE UNIQUE INDEX email_notify_email_uq ON email_notify USING btree (hostid, e
 
 
 --
--- TOC entry 53 (OID 540251)
+-- TOC entry 54 (OID 540251)
 -- Name: images_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -521,7 +530,7 @@ CREATE UNIQUE INDEX images_name_uq ON images USING btree (hostid, name);
 
 
 --
--- TOC entry 55 (OID 540252)
+-- TOC entry 56 (OID 540252)
 -- Name: files_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -529,7 +538,7 @@ CREATE UNIQUE INDEX files_name_uq ON files USING btree (hostid, name);
 
 
 --
--- TOC entry 58 (OID 540831)
+-- TOC entry 59 (OID 540831)
 -- Name: users_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -537,7 +546,7 @@ CREATE UNIQUE INDEX users_name_uq ON users USING btree (hostid, name);
 
 
 --
--- TOC entry 57 (OID 540946)
+-- TOC entry 58 (OID 540946)
 -- Name: users_id_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -545,7 +554,7 @@ CREATE UNIQUE INDEX users_id_uq ON users USING btree (hostid, id);
 
 
 --
--- TOC entry 60 (OID 540970)
+-- TOC entry 61 (OID 540970)
 -- Name: sitemenu_ordering_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -553,7 +562,7 @@ CREATE UNIQUE INDEX sitemenu_ordering_uq ON sitemenu USING btree (hostid, orderi
 
 
 --
--- TOC entry 61 (OID 540971)
+-- TOC entry 62 (OID 540971)
 -- Name: sitemenu_url_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -561,7 +570,7 @@ CREATE UNIQUE INDEX sitemenu_url_uq ON sitemenu USING btree (hostid, url);
 
 
 --
--- TOC entry 64 (OID 542626)
+-- TOC entry 65 (OID 542626)
 -- Name: contact_emails_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -569,7 +578,7 @@ CREATE UNIQUE INDEX contact_emails_uq ON contact_emails USING btree (contactid,
 
 
 --
--- TOC entry 65 (OID 543505)
+-- TOC entry 66 (OID 543505)
 -- Name: themes_theme_css_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -577,7 +586,7 @@ CREATE UNIQUE INDEX themes_theme_css_uq ON themes USING btree (theme_css);
 
 
 --
--- TOC entry 66 (OID 543763)
+-- TOC entry 67 (OID 543763)
 -- Name: page_emails_email_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -585,7 +594,7 @@ CREATE UNIQUE INDEX page_emails_email_uq ON page_emails USING btree (hostid, url
 
 
 --
--- TOC entry 67 (OID 543795)
+-- TOC entry 68 (OID 543795)
 -- Name: mailing_lists_email_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -593,7 +602,7 @@ CREATE UNIQUE INDEX mailing_lists_email_uq ON mailing_lists USING btree (hostid,
 
 
 --
--- TOC entry 62 (OID 543880)
+-- TOC entry 63 (OID 543880)
 -- Name: contacts_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -601,7 +610,7 @@ CREATE UNIQUE INDEX contacts_name_uq ON contacts USING btree (hostid, name);
 
 
 --
--- TOC entry 68 (OID 544454)
+-- TOC entry 69 (OID 544454)
 -- Name: links_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -609,7 +618,7 @@ CREATE UNIQUE INDEX links_uq ON links USING btree (hostid, from_url, to_url);
 
 
 --
--- TOC entry 46 (OID 536012)
+-- TOC entry 47 (OID 536012)
 -- Name: pages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -618,7 +627,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 48 (OID 536027)
+-- TOC entry 49 (OID 536027)
 -- Name: contents_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -627,7 +636,7 @@ ALTER TABLE ONLY contents
 
 
 --
--- TOC entry 49 (OID 536377)
+-- TOC entry 50 (OID 536377)
 -- Name: hosts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -636,7 +645,7 @@ ALTER TABLE ONLY hosts
 
 
 --
--- TOC entry 54 (OID 537158)
+-- TOC entry 55 (OID 537158)
 -- Name: images_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -645,7 +654,7 @@ ALTER TABLE ONLY images
 
 
 --
--- TOC entry 56 (OID 537173)
+-- TOC entry 57 (OID 537173)
 -- Name: files_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -654,7 +663,7 @@ ALTER TABLE ONLY files
 
 
 --
--- TOC entry 59 (OID 540825)
+-- TOC entry 60 (OID 540825)
 -- Name: users_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -663,7 +672,7 @@ ALTER TABLE ONLY users
 
 
 --
--- TOC entry 63 (OID 542611)
+-- TOC entry 64 (OID 542611)
 -- Name: contacts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -672,7 +681,7 @@ ALTER TABLE ONLY contacts
 
 
 --
--- TOC entry 73 (OID 536029)
+-- TOC entry 74 (OID 536029)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -681,7 +690,7 @@ ALTER TABLE ONLY contents
 
 
 --
--- TOC entry 76 (OID 536384)
+-- TOC entry 77 (OID 536384)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -690,7 +699,7 @@ ALTER TABLE ONLY hostnames
 
 
 --
--- TOC entry 74 (OID 536394)
+-- TOC entry 75 (OID 536394)
 -- Name: hosts_hostname_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -699,7 +708,7 @@ ALTER TABLE ONLY hosts
 
 
 --
--- TOC entry 69 (OID 536404)
+-- TOC entry 70 (OID 536404)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -708,7 +717,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 77 (OID 536920)
+-- TOC entry 78 (OID 536920)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -717,7 +726,7 @@ ALTER TABLE ONLY email_notify
 
 
 --
--- TOC entry 78 (OID 537160)
+-- TOC entry 79 (OID 537160)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -726,7 +735,7 @@ ALTER TABLE ONLY images
 
 
 --
--- TOC entry 79 (OID 537175)
+-- TOC entry 80 (OID 537175)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -735,7 +744,7 @@ ALTER TABLE ONLY files
 
 
 --
--- TOC entry 70 (OID 539155)
+-- TOC entry 71 (OID 539155)
 -- Name: pages_redirect_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -744,7 +753,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 80 (OID 540827)
+-- TOC entry 81 (OID 540827)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -753,7 +762,7 @@ ALTER TABLE ONLY users
 
 
 --
--- TOC entry 81 (OID 540837)
+-- TOC entry 82 (OID 540837)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -762,7 +771,7 @@ ALTER TABLE ONLY usercookies
 
 
 --
--- TOC entry 71 (OID 540942)
+-- TOC entry 72 (OID 540942)
 -- Name: $2; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -771,7 +780,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 72 (OID 540947)
+-- TOC entry 73 (OID 540947)
 -- Name: pages_user_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -780,7 +789,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 82 (OID 540966)
+-- TOC entry 83 (OID 540966)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -789,7 +798,7 @@ ALTER TABLE ONLY sitemenu
 
 
 --
--- TOC entry 83 (OID 540972)
+-- TOC entry 84 (OID 540972)
 -- Name: sitemenu_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -798,7 +807,7 @@ ALTER TABLE ONLY sitemenu
 
 
 --
--- TOC entry 84 (OID 542613)
+-- TOC entry 85 (OID 542613)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -807,7 +816,7 @@ ALTER TABLE ONLY contacts
 
 
 --
--- TOC entry 85 (OID 542622)
+-- TOC entry 86 (OID 542622)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -816,7 +825,7 @@ ALTER TABLE ONLY contact_emails
 
 
 --
--- TOC entry 75 (OID 543506)
+-- TOC entry 76 (OID 543506)
 -- Name: hosts_theme_css_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -825,7 +834,7 @@ ALTER TABLE ONLY hosts
 
 
 --
--- TOC entry 86 (OID 543759)
+-- TOC entry 87 (OID 543759)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -834,7 +843,7 @@ ALTER TABLE ONLY page_emails
 
 
 --
--- TOC entry 87 (OID 543764)
+-- TOC entry 88 (OID 543764)
 -- Name: page_emails_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -843,7 +852,7 @@ ALTER TABLE ONLY page_emails
 
 
 --
--- TOC entry 88 (OID 543791)
+-- TOC entry 89 (OID 543791)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -852,7 +861,7 @@ ALTER TABLE ONLY mailing_lists
 
 
 --
--- TOC entry 89 (OID 544450)
+-- TOC entry 90 (OID 544450)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -861,7 +870,7 @@ ALTER TABLE ONLY links
 
 
 --
--- TOC entry 90 (OID 544455)
+-- TOC entry 91 (OID 544455)
 -- Name: links_from_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -870,7 +879,7 @@ ALTER TABLE ONLY links
 
 
 --
--- TOC entry 91 (OID 544459)
+-- TOC entry 92 (OID 544459)
 -- Name: links_to_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
diff --git a/scripts/.depend b/scripts/.depend
index e9c333a..f840d1e 100644
--- a/scripts/.depend
+++ b/scripts/.depend
@@ -12,6 +12,8 @@ cocanwiki_images.cmo: cocanwiki_files.cmo cocanwiki_strings.cmo \
     cocanwiki_images.cmi 
 cocanwiki_images.cmx: cocanwiki_files.cmx cocanwiki_strings.cmx \
     cocanwiki_images.cmi 
+cocanwiki_links.cmo: wikilib.cmi cocanwiki_links.cmi 
+cocanwiki_links.cmx: wikilib.cmx cocanwiki_links.cmi 
 cocanwiki_ok.cmo: cocanwiki_template.cmi 
 cocanwiki_ok.cmx: cocanwiki_template.cmx 
 cocanwiki_template.cmo: cocanwiki_files.cmo cocanwiki_version.cmo \
@@ -152,6 +154,8 @@ pagestyle.cmo: cocanwiki.cmo
 pagestyle.cmx: cocanwiki.cmx 
 preview.cmo: cocanwiki.cmo wikilib.cmi 
 preview.cmx: cocanwiki.cmx wikilib.cmx 
+rebuild_links.cmo: cocanwiki.cmo cocanwiki_links.cmi cocanwiki_template.cmi 
+rebuild_links.cmx: cocanwiki.cmx cocanwiki_links.cmx cocanwiki_template.cmx 
 recent.cmo: cocanwiki.cmo cocanwiki_date.cmo cocanwiki_template.cmi 
 recent.cmx: cocanwiki.cmx cocanwiki_date.cmx cocanwiki_template.cmx 
 restore.cmo: cocanwiki.cmo cocanwiki_diff.cmo cocanwiki_emailnotify.cmo \
diff --git a/scripts/Makefile b/scripts/Makefile
index 3968181..3c4ca38 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # Makefile for COCANWIKI.
-# $Id: Makefile,v 1.28 2004/09/27 12:37:54 rich Exp $
+# $Id: Makefile,v 1.29 2004/09/28 10:56:39 rich Exp $
 
 include ../Makefile.config
 
@@ -19,7 +19,8 @@ LIB_OBJS := \
 	cocanwiki.cmo \
 	cocanwiki_diff.cmo \
 	cocanwiki_emailnotify.cmo \
-	wikilib.cmo
+	wikilib.cmo \
+	cocanwiki_links.cmo
 
 OBJS := 00-TEMPLATE.cmo \
 	change_password.cmo \
@@ -81,6 +82,7 @@ OBJS := 00-TEMPLATE.cmo \
 	page_email_unsubscribe.cmo \
 	pagestyle.cmo \
 	preview.cmo \
+	rebuild_links.cmo \
 	recent.cmo \
 	restore.cmo \
 	restore_form.cmo \
diff --git a/scripts/cocanwiki_links.ml b/scripts/cocanwiki_links.ml
new file mode 100644
index 0000000..417fe19
--- /dev/null
+++ b/scripts/cocanwiki_links.ml
@@ -0,0 +1,60 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: cocanwiki_links.ml,v 1.1 2004/09/28 10:56:39 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 ExtString
+
+let split_tags_re = Pcre.regexp ~flags:[`DOTALL] "<.*?>|[^<]+"
+let internal_re = Pcre.regexp "class=\"internal\""
+let href_re = Pcre.regexp "href=\"/(.*?)\""
+
+let get_links_from_section dbh hostid content =
+  let html = Wikilib.xhtml_of_content dbh hostid content in
+
+  (* Split into attrs and non-attrs.  We end up with a list like this:
+   * [ "<ul>"; "<li>"; "Some text"; "</li>"; ... ]
+   *)
+  let html =
+    try
+      let html = Pcre.extract_all ~rex:split_tags_re html in
+      let html = Array.to_list html in
+      List.map (function [| a |] -> a | _ -> assert false) html
+    with
+	Not_found -> [] in
+
+  (* Only interested in the <a> tags. *)
+  let html = List.filter (fun str -> String.starts_with str "<a ") html in
+
+  (* Only interested in the tags with class="internal". *)
+  let html =
+    List.filter (fun str ->
+		   Pcre.pmatch ~rex:internal_re str
+		   && Pcre.pmatch ~rex:href_re str)
+      html in
+
+  (* Extract the URL names. *)
+  let links = List.map (fun str ->
+			  let subs =
+			    try Pcre.exec ~rex:href_re str
+			    with Not_found -> assert false in
+			  Pcre.get_substring subs 1) html in
+
+  (* Return the list of links. *)
+  links
diff --git a/scripts/cocanwiki_links.mli b/scripts/cocanwiki_links.mli
new file mode 100644
index 0000000..0970b41
--- /dev/null
+++ b/scripts/cocanwiki_links.mli
@@ -0,0 +1,22 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: cocanwiki_links.mli,v 1.1 2004/09/28 10:56:39 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.
+ *)
+
+val get_links_from_section : Dbi.connection -> int -> string -> string list
diff --git a/scripts/edit.ml b/scripts/edit.ml
index cede68b..e8cc7c5 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 <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.12 2004/09/24 15:53:57 rich Exp $
+ * $Id: edit.ml,v 1.13 2004/09/28 10:56:39 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
@@ -392,7 +392,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
       let sth =
 	dbh#prepare_cached
 	  "set constraints pages_redirect_cn, sitemenu_url_cn,
-               page_emails_url_cn deferred" in
+               page_emails_url_cn, links_from_cn, links_to_cn deferred" in
       sth#execute [];
 
       (* Mark the old page as deleted.  NB. There is a small race
diff --git a/scripts/edit_page_css.ml b/scripts/edit_page_css.ml
index 1d01a7a..e71a195 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 <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css.ml,v 1.9 2004/09/24 15:53:57 rich Exp $
+ * $Id: edit_page_css.ml,v 1.10 2004/09/28 10:56:39 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
@@ -63,7 +63,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
 
   let sth = dbh#prepare_cached
 	      "set constraints pages_redirect_cn, sitemenu_url_cn,
-                   page_emails_url_cn deferred" in
+                   page_emails_url_cn, links_from_cn, links_to_cn deferred" in
   sth#execute [];
 
   let sth = dbh#prepare_cached "update pages set url_deleted = url,
diff --git a/scripts/edit_page_title.ml b/scripts/edit_page_title.ml
index c05d897..d4a7e96 100644
--- a/scripts/edit_page_title.ml
+++ b/scripts/edit_page_title.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_title.ml,v 1.1 2004/09/25 16:05:03 rich Exp $
+ * $Id: edit_page_title.ml,v 1.2 2004/09/28 10:56:40 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
@@ -95,7 +95,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
 
   let sth = dbh#prepare_cached
 	      "set constraints pages_redirect_cn, sitemenu_url_cn,
-                   page_emails_url_cn deferred" in
+                   page_emails_url_cn, links_from_cn, links_to_cn deferred" in
   sth#execute [];
 
   let sth = dbh#prepare_cached "update pages set url_deleted = url,
diff --git a/scripts/rebuild_links.ml b/scripts/rebuild_links.ml
new file mode 100644
index 0000000..df3a707
--- /dev/null
+++ b/scripts/rebuild_links.ml
@@ -0,0 +1,96 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: rebuild_links.ml,v 1.1 2004/09/28 10:56:40 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
+open Cocanwiki_template
+open Cocanwiki_links
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+  let template_start = _get_template "rebuild_links_start.html" in
+  let template = _get_template "rebuild_links.html" in
+  let template_done = _get_template "rebuild_links_done.html" in
+
+  (* Delete entries in the old links table. *)
+  let sth = dbh#prepare_cached "delete from links where hostid = ?" in
+  sth#execute [`Int hostid];
+
+  (* Estimate how many sections we will have to process. *)
+  let sth =
+    dbh#prepare_cached
+      "select count(c.id) from contents c, pages p
+        where c.pageid = p.id
+          and p.hostid = ?
+          and p.url is not null
+          and p.redirect is null" in
+  sth#execute [`Int hostid];
+
+  let total_sections = sth#fetch1int () in
+
+  (* Pull out the list of sections to process. *)
+  let sth =
+    dbh#prepare_cached
+      "select c.content, c.ordering, p.url from contents c, pages p
+        where c.pageid = p.id
+          and p.hostid = ?
+          and p.url is not null
+          and p.redirect is null
+        order by p.url, c.ordering" in
+  sth#execute [`Int hostid];
+
+  q#header ();
+  print_string r template_start#to_string;
+
+  let insert_link =
+    let sth =
+      dbh#prepare_cached "insert into links (hostid, from_url, to_url)
+                          values (?, ?, ?)" in
+    fun from_url to_url ->
+      sth#execute [`Int hostid; `String from_url; `String to_url]
+  in
+
+  (* Process each section ... *)
+  let i = ref 0 in
+
+  sth#iter
+    (function [`String content; `Int ordering; `String url] ->
+       let pc = 100 * !i / total_sections in incr i;
+       template#set "ordering" (string_of_int ordering);
+       template#set "url" url;
+       template#set "pc" (string_of_int pc);
+       print_string r template#to_string;
+
+       let links = get_links_from_section dbh hostid content in
+       List.iter (insert_link url) links
+
+       | _ -> assert false);
+
+  (* Finish off. *)
+  dbh#commit ();
+
+  print_string r template_done#to_string
+
+let () =
+  register_script ~restrict:[CanManageSite] run
diff --git a/scripts/restore.ml b/scripts/restore.ml
index 471b8fc..3b7bd24 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 <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: restore.ml,v 1.9 2004/09/24 15:53:57 rich Exp $
+ * $Id: restore.ml,v 1.10 2004/09/28 10:56:40 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
@@ -61,7 +61,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
     let sth =
       dbh#prepare_cached
 	"set constraints pages_redirect_cn, sitemenu_url_cn,
-             page_emails_url_cn deferred" in
+             page_emails_url_cn, links_from_cn, links_to_cn deferred" in
     sth#execute [];
 
     let sth = dbh#prepare_cached "update pages set url_deleted = url,
diff --git a/templates/host_menu.html b/templates/host_menu.html
index 3a742f8..940b65c 100644
--- a/templates/host_menu.html
+++ b/templates/host_menu.html
@@ -55,6 +55,12 @@
 <a href="/_bin/edit_host_settings_form.cmo">Edit these settings ...</a>
 </p>
 
+<h2>Site maintenance</h2>
+
+<ul>
+<li> <a href="/_bin/rebuild_links.cmo">Rebuild link structure</a>
+</ul>
+
 <ul id="topmenu" class="menu">
 <li class="first"> <a href="/">Home&nbsp;page</a> </li>
 <li> <a href="/_sitemap">Sitemap</a> </li>
diff --git a/templates/rebuild_links.html b/templates/rebuild_links.html
new file mode 100644
index 0000000..12c8cab
--- /dev/null
+++ b/templates/rebuild_links.html
@@ -0,0 +1,9 @@
+<script type="text/javascript">//<!--
+progress_div.setAttribute ("style", "width: ::pc::%");
+name_p.innerHTML = "::url_html:: (::ordering_html::) ::pc::%";
+//--></script>
+<noscript>
+<p> Processing <strong>/::url_html::</strong> section ::ordering_html::,
+approximately ::pc_html::% done. </p>
+</noscript>
+<!-- 4096 blank characters                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                -->
\ No newline at end of file
diff --git a/templates/rebuild_links_done.html b/templates/rebuild_links_done.html
new file mode 100644
index 0000000..424bdc7
--- /dev/null
+++ b/templates/rebuild_links_done.html
@@ -0,0 +1,8 @@
+<script type="text/javascript">//<!--
+progress_div.setAttribute ("style", "width: 100%");
+name_p.innerHTML = "Finished";
+//--></script>
+<br/><br/><br/><br/><br/><br/><br/><br/><br/><br/><br/>
+<p>
+<a href="/_bin/host_menu.cmo">Back to global settings</a>
+</p>
\ No newline at end of file
diff --git a/templates/rebuild_links_start.html b/templates/rebuild_links_start.html
new file mode 100644
index 0000000..ac17dc8
--- /dev/null
+++ b/templates/rebuild_links_start.html
@@ -0,0 +1,35 @@
+<div id="outer"><div id="progress"></div></div>
+<p id="name">This is a test</p>
+<style type="text/css"><!--
+body {
+  font-size: 1.5em;
+  font-family: arial, helvetica, sans-serif;
+}
+div#outer {
+  position: absolute;
+  top: 1em;
+  left: 5%;
+  z-index: 0;
+  width: 90%;
+  border: 1px solid #000;
+}
+div#progress {
+  z-index: 1;
+  width: 50%;
+  height: 2em;
+  background-color: #ccf;
+}
+p#name {
+  position: absolute;
+  top: 0.5em;
+  left: 5%;
+  z-index: 2;
+  width: 90%;
+  text-align: center;
+  font-weight: bold;
+}
+--></style>
+<script type="text/javascript">//<!--
+var progress_div = document.getElementById ("progress");
+var name_p = document.getElementById ("name");
+//--></script>
-- 
1.8.3.1