Find orphan pages.
authorrich <rich>
Sat, 6 Nov 2004 17:26:08 +0000 (17:26 +0000)
committerrich <rich>
Sat, 6 Nov 2004 17:26:08 +0000 (17:26 +0000)
MANIFEST
scripts/.depend
scripts/orphans.ml [new file with mode: 0644]
templates/host_menu.html
templates/orphans.html [new file with mode: 0644]

index 4a2c344..a74aa3c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -170,6 +170,7 @@ scripts/mailing_list_send.ml
 scripts/mailing_list_unsubscribe.ml
 scripts/mailing_list_view.ml
 scripts/new_page_form.ml
+scripts/orphans.ml
 scripts/page.ml
 scripts/page_email_confirm.ml
 scripts/page_email_form.ml
@@ -267,6 +268,7 @@ templates/mailing_list_view.html
 templates/mailing_list_view.txt
 templates/new_page_form.html
 templates/ok_error.html
+templates/orphans.html
 templates/page.html
 templates/page_404.html
 templates/page_email_form.html
index d45740b..87cd697 100644 (file)
@@ -246,6 +246,8 @@ mailing_list_view.cmx: lib/cocanwiki.cmx lib/cocanwiki_date.cmx \
     lib/cocanwiki_template.cmx 
 new_page_form.cmo: lib/cocanwiki.cmo lib/cocanwiki_template.cmi 
 new_page_form.cmx: lib/cocanwiki.cmx lib/cocanwiki_template.cmx 
+orphans.cmo: lib/cocanwiki.cmo lib/cocanwiki_template.cmi 
+orphans.cmx: lib/cocanwiki.cmx lib/cocanwiki_template.cmx 
 page.cmo: lib/cocanwiki.cmo lib/cocanwiki_date.cmo lib/cocanwiki_links.cmi \
     lib/cocanwiki_ok.cmo lib/cocanwiki_server_settings.cmo \
     lib/cocanwiki_template.cmi lib/wikilib.cmi 
diff --git a/scripts/orphans.ml b/scripts/orphans.ml
new file mode 100644 (file)
index 0000000..0ab5272
--- /dev/null
@@ -0,0 +1,93 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: orphans.ml,v 1.1 2004/11/06 17:26:10 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
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+  let template = get_template dbh hostid "orphans.html" in
+
+  (* Start with the front page, the contents of the site menu and the
+   * special "copyright" page.
+   *)
+  let sth = dbh#prepare_cached "select url from sitemenu where hostid = ?" in
+  sth#execute [`Int hostid];
+
+  let start_pages = sth#map (function [`String s] -> s | _ -> assert false) in
+  let start_pages = "index" :: "copyright" :: start_pages in
+
+  (* The find the list of orphans, we first construct the list of
+   * pages reachable from the front page.  Once this list has been
+   * constructed, any page not on the list is an orphan or part of
+   * a group of orphans.
+   *)
+  let rec loop pages border =
+    (* Preconditions:
+     * pages <> []
+     * border <> []
+     * pages is a list of distinct pages
+     * border is a list of distinct pages
+     * pages @ border is a list of distinct pages
+     *)
+    let pages' = pages @ border in
+    let qs = Dbi.placeholders (List.length border) in
+    let qs' = Dbi.placeholders (List.length pages') in
+    let sth =
+      dbh#prepare_cached ("select distinct to_url from links
+                            where hostid = ? and from_url in " ^ qs ^ "
+                              and to_url not in " ^ qs') in
+    sth#execute (`Int hostid ::
+                  (List.map (fun s -> `String s) border) @
+                  (List.map (fun s -> `String s) pages'));
+    let border' = sth#map (function [`String s] -> s | _ -> assert false) in
+
+    if border' = [] then pages'
+    else loop pages' border'
+  in
+  let non_orphans = loop [] start_pages in
+
+  (* Get the actual orphans, which are pages which do not appear in this list*)
+  let qs = Dbi.placeholders (List.length non_orphans) in
+  let sth = dbh#prepare_cached ("select url, title from pages
+                                  where hostid = ?
+                                    and url is not null
+                                    and redirect is null
+                                    and url not in " ^ qs ^ "
+                                  order by 1") in
+  sth#execute (`Int hostid :: (List.map (fun s -> `String s) non_orphans));
+
+  let table =
+    sth#map (function [`String page; `String title] ->
+              [ "page", Template.VarString page;
+                "title", Template.VarString title ]
+              | _ -> assert false) in
+
+  template#table "pages" table;
+
+  q#template template
+
+let () =
+  register_script ~restrict:[CanView] run
index 229f3f7..322dda0 100644 (file)
@@ -9,11 +9,18 @@
 
 <h1><span>Sitewide settings</span></h1>
 
+<h2>Interesting pages and links</h2>
+
 <ul>
-<li> <a href="/_bin/largest_pages.cmo">Largest pages</a> </li>
-<li> <a href="/_bin/dead_ends.cmo">Dead end pages</a> </li>
-<li> <a href="/_bin/broken_links.cmo">Broken links</a> </li>
+<li> <a href="/_bin/orphans.cmo">Orphan pages</a> <em>(Pages which cannot be reached from the front page just by clicking links, but which still appear in the <a href="/_sitemap">sitemap</a>)</em> </li>
+<li> <a href="/_bin/broken_links.cmo">Broken links</a> <em>(Links to pages which don't exist, and the pages where they appear)</em> </li>
+<li> <a href="/_bin/largest_pages.cmo">Largest pages</a> <em>(Pages ordered by size)</em> </li>
+<li> <a href="/_bin/dead_ends.cmo">Dead end pages</a> <em>(Pages which don't link to any other page inside the site)</em> </li>
+</ul>
+
+<h2>Site management</h2>
 
+<ul>
 <li> <a href="/_bin/edit_sitemenu.cmo">Edit site menu</a> </li>
 
 ::if(can_manage_users)::
@@ -32,7 +39,7 @@
 
 ::if(can_manage_site)::
 
-<h2>Site management</h2>
+<h2>Site settings</h2>
 
 <table class="left_table">
 <tr>
diff --git a/templates/orphans.html b/templates/orphans.html
new file mode 100644 (file)
index 0000000..b4c0a3e
--- /dev/null
@@ -0,0 +1,20 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Orphan pages</title>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+<link rel="alternate stylesheet" href="/_css/easytoread.css" type="text/css" title="High contrast, big fonts"/>
+</head><body>
+
+<h1><span>Orphan pages</span></h1>
+
+<ul>
+::table(pages)::
+<li> <a href="/::page_html_tag::">::title_html::</a> </li>
+::end::
+</ul>
+
+::include(footer.html)::
+</body>
+</html>
\ No newline at end of file