--
--- TOC entry 39 (OID 536004)
+-- TOC entry 40 (OID 536004)
-- Name: pages_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 40 (OID 536021)
+-- TOC entry 41 (OID 536021)
-- Name: contents_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 41 (OID 536371)
+-- TOC entry 42 (OID 536371)
-- Name: hosts_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 42 (OID 537151)
+-- TOC entry 43 (OID 537151)
-- Name: images_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 43 (OID 537166)
+-- TOC entry 44 (OID 537166)
-- Name: files_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 44 (OID 540816)
+-- TOC entry 45 (OID 540816)
-- Name: users_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 45 (OID 542605)
+-- TOC entry 46 (OID 542605)
-- Name: contacts_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- 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
--
--
--- TOC entry 51 (OID 536389)
+-- TOC entry 52 (OID 536389)
-- Name: hostnams_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 47 (OID 536419)
+-- TOC entry 48 (OID 536419)
-- Name: pages_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 52 (OID 536924)
+-- TOC entry 53 (OID 536924)
-- Name: email_notify_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 53 (OID 540251)
+-- TOC entry 54 (OID 540251)
-- Name: images_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 55 (OID 540252)
+-- TOC entry 56 (OID 540252)
-- Name: files_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 58 (OID 540831)
+-- TOC entry 59 (OID 540831)
-- Name: users_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 57 (OID 540946)
+-- TOC entry 58 (OID 540946)
-- Name: users_id_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 60 (OID 540970)
+-- TOC entry 61 (OID 540970)
-- Name: sitemenu_ordering_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 61 (OID 540971)
+-- TOC entry 62 (OID 540971)
-- Name: sitemenu_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 64 (OID 542626)
+-- TOC entry 65 (OID 542626)
-- Name: contact_emails_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 65 (OID 543505)
+-- TOC entry 66 (OID 543505)
-- Name: themes_theme_css_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 66 (OID 543763)
+-- TOC entry 67 (OID 543763)
-- Name: page_emails_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 67 (OID 543795)
+-- TOC entry 68 (OID 543795)
-- Name: mailing_lists_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 62 (OID 543880)
+-- TOC entry 63 (OID 543880)
-- Name: contacts_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 68 (OID 544454)
+-- TOC entry 69 (OID 544454)
-- Name: links_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 46 (OID 536012)
+-- TOC entry 47 (OID 536012)
-- Name: pages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 48 (OID 536027)
+-- TOC entry 49 (OID 536027)
-- Name: contents_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 49 (OID 536377)
+-- TOC entry 50 (OID 536377)
-- Name: hosts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 54 (OID 537158)
+-- TOC entry 55 (OID 537158)
-- Name: images_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 56 (OID 537173)
+-- TOC entry 57 (OID 537173)
-- Name: files_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 59 (OID 540825)
+-- TOC entry 60 (OID 540825)
-- Name: users_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 63 (OID 542611)
+-- TOC entry 64 (OID 542611)
-- Name: contacts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 73 (OID 536029)
+-- TOC entry 74 (OID 536029)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 76 (OID 536384)
+-- TOC entry 77 (OID 536384)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 74 (OID 536394)
+-- TOC entry 75 (OID 536394)
-- Name: hosts_hostname_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 69 (OID 536404)
+-- TOC entry 70 (OID 536404)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 77 (OID 536920)
+-- TOC entry 78 (OID 536920)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 78 (OID 537160)
+-- TOC entry 79 (OID 537160)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 79 (OID 537175)
+-- TOC entry 80 (OID 537175)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 70 (OID 539155)
+-- TOC entry 71 (OID 539155)
-- Name: pages_redirect_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 80 (OID 540827)
+-- TOC entry 81 (OID 540827)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 81 (OID 540837)
+-- TOC entry 82 (OID 540837)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 71 (OID 540942)
+-- TOC entry 72 (OID 540942)
-- Name: $2; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 72 (OID 540947)
+-- TOC entry 73 (OID 540947)
-- Name: pages_user_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 82 (OID 540966)
+-- TOC entry 83 (OID 540966)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 83 (OID 540972)
+-- TOC entry 84 (OID 540972)
-- Name: sitemenu_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 84 (OID 542613)
+-- TOC entry 85 (OID 542613)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 85 (OID 542622)
+-- TOC entry 86 (OID 542622)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 75 (OID 543506)
+-- TOC entry 76 (OID 543506)
-- Name: hosts_theme_css_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 86 (OID 543759)
+-- TOC entry 87 (OID 543759)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 87 (OID 543764)
+-- TOC entry 88 (OID 543764)
-- Name: page_emails_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 88 (OID 543791)
+-- TOC entry 89 (OID 543791)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 89 (OID 544450)
+-- TOC entry 90 (OID 544450)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 90 (OID 544455)
+-- TOC entry 91 (OID 544455)
-- Name: links_from_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 91 (OID 544459)
+-- TOC entry 92 (OID 544459)
-- Name: links_to_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
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 \
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 \
# 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
cocanwiki.cmo \
cocanwiki_diff.cmo \
cocanwiki_emailnotify.cmo \
- wikilib.cmo
+ wikilib.cmo \
+ cocanwiki_links.cmo
OBJS := 00-TEMPLATE.cmo \
change_password.cmo \
page_email_unsubscribe.cmo \
pagestyle.cmo \
preview.cmo \
+ rebuild_links.cmo \
recent.cmo \
restore.cmo \
restore_form.cmo \
--- /dev/null
+(* 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
--- /dev/null
+(* 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
(* 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
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
(* 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
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,
(* 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
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,
--- /dev/null
+(* 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
(* 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
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,
<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 page</a> </li>
<li> <a href="/_sitemap">Sitemap</a> </li>
--- /dev/null
+<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
--- /dev/null
+<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
--- /dev/null
+<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>
git.annexia.org / cocanwiki.git / commitdiff