From 8fd66f9650d6b3f18854c64b3871ab6c1d5f66cd Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Sat, 9 Oct 2004 16:25:03 +0000
Subject: [PATCH] Added 'broken links' script.

---
 MANIFEST                    |  3 ++
 html/_css/broken_links.css  | 12 +++++++
 scripts/Makefile            |  6 ++--
 scripts/broken_links.ml     | 81 +++++++++++++++++++++++++++++++++++++++++++++
 templates/broken_links.html | 54 ++++++++++++++++++++++++++++++
 templates/page.html         |  1 +
 6 files changed, 155 insertions(+), 2 deletions(-)
 create mode 100644 html/_css/broken_links.css
 create mode 100644 scripts/broken_links.ml
 create mode 100644 templates/broken_links.html

diff --git a/MANIFEST b/MANIFEST
index 6fc02ee..00fe625 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -8,6 +8,7 @@ cocanwiki.sql
 conf/cocanwiki.conf
 html/_bin/.cvsignore
 html/_css/admin.css
+html/_css/broken_links.css
 html/_css/create.css
 html/_css/easyweb.css
 html/_css/editor.css
@@ -52,6 +53,7 @@ scripts/admin/edit_host_css_form.ml
 scripts/admin/edit_hostnames.ml
 scripts/admin/edit_hostnames_form.ml
 scripts/admin/host.ml
+scripts/broken_links.ml
 scripts/change_password.ml
 scripts/change_password_form.ml
 scripts/cocanwiki.ml
@@ -163,6 +165,7 @@ templates/admin/edit_emails_form.html
 templates/admin/edit_host_css_form.html
 templates/admin/edit_hostnames_form.html
 templates/admin/host.html
+templates/broken_links.html
 templates/calendar_day.html
 templates/calendar_month.html
 templates/calendar_year.html
diff --git a/html/_css/broken_links.css b/html/_css/broken_links.css
new file mode 100644
index 0000000..2667501
--- /dev/null
+++ b/html/_css/broken_links.css
@@ -0,0 +1,12 @@
+/* $Id: broken_links.css,v 1.1 2004/10/09 16:25:08 rich Exp $ */
+
+ul.broken_link_refs {
+  margin: 0px;
+  padding: 0px;
+  list-style: none;
+}
+
+ul.broken_link_refs li {
+  display: inline;
+  margin-right: 2em;
+}
\ No newline at end of file
diff --git a/scripts/Makefile b/scripts/Makefile
index be7ad24..fd210a3 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # Makefile for COCANWIKI.
-# $Id: Makefile,v 1.35 2004/10/09 15:01:58 rich Exp $
+# $Id: Makefile,v 1.36 2004/10/09 16:25:08 rich Exp $
 
 include ../Makefile.config
 
@@ -25,7 +25,9 @@ LIB_OBJS := \
 	cocanwiki_create_host.cmo \
 	cocanwiki_ext_calendar.cmo
 
-OBJS := change_password.cmo \
+OBJS := \
+	broken_links.cmo \
+	change_password.cmo \
 	change_password_form.cmo \
 	contact.cmo \
 	contact_show.cmo \
diff --git a/scripts/broken_links.ml b/scripts/broken_links.ml
new file mode 100644
index 0000000..901d555
--- /dev/null
+++ b/scripts/broken_links.ml
@@ -0,0 +1,81 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: broken_links.ml,v 1.1 2004/10/09 16:25:08 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 keys h = Hashtbl.fold (fun key _ xs -> key :: xs) h []
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+  let template = get_template dbh hostid "broken_links.html" in
+
+  (* The links table (to_url) field can now point to a non-existant
+   * page.  It's from this observation that we are able to retrieve
+   * the complete list of broken links.  Links to empty template pages
+   * aren't broken links either because some of the content is
+   * synthesized.
+   *)
+  let sth =
+    dbh#prepare_cached
+      "select l.from_url, p.title, l.to_url
+         from links l, pages p
+        where l.hostid = ?
+          and l.hostid = p.hostid and l.from_url = p.url
+          and p.redirect is null
+          and not exists (select id from pages
+                           where hostid = l.hostid and url = l.to_url)
+          and not exists (select id from templates
+                           where l.to_url ~ url_regexp)
+        order by 3, 1 desc" in
+  sth#execute [`Int hostid];
+
+  (* Group the links together. *)
+  let h = Hashtbl.create 32 in
+  sth#iter (function [`String from_url; `String from_title; `String to_url] ->
+	      let a = try Hashtbl.find h to_url with Not_found -> [] in
+	      let a = (from_url, from_title) :: a in
+	      Hashtbl.replace h to_url a
+	      | _ -> assert false);
+
+  let keys = List.sort compare (keys h) in
+  let table =
+    List.map
+      (fun to_url ->
+	 let values = Hashtbl.find h to_url in
+	 let table =
+	   List.map
+	     (fun (from_url, from_title) ->
+		[ "page", Template.VarString from_url;
+		  "title", Template.VarString from_title ]) values in
+	 [ "url", Template.VarString to_url;
+	   "references", Template.VarTable table ]) keys in
+
+  template#table "links" table;
+
+  q#template template
+
+let () =
+  register_script ~restrict:[CanView] run
diff --git a/templates/broken_links.html b/templates/broken_links.html
new file mode 100644
index 0000000..71d09cd
--- /dev/null
+++ b/templates/broken_links.html
@@ -0,0 +1,54 @@
+<!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>Broken links</title>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+<link rel="stylesheet" href="/_css/broken_links.css" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Broken links</h1>
+
+<table class="top_table">
+<tr>
+  <th> Broken link </th>
+  <th> Referenced from </th>
+</tr>
+::table(links)::
+<tr>
+  <td> ::url_html:: </td>
+  <td>
+    <ul class="broken_link_refs">
+      ::table(references)::<li> <a href="/::page_html_tag::">::title_html::</a> </li>::end::
+    </ul>
+  </td>
+</tr>
+::end::
+</table>
+
+<ul id="topmenu" class="menu">
+<li class="first"> <a href="/">Home&nbsp;page</a> </li>
+<li> <a href="/_sitemap">Sitemap</a> </li>
+<li> <a href="/_recent">Recent&nbsp;changes</a> </li>
+</ul>
+
+<div id="menu_div">
+<ul id="bottommenu" class="menu">
+<li class="first"> <a href="/">Home&nbsp;page</a> </li>
+::table(sitemenu)::<li> <a href="/::url_html_tag::">::label_html::</a> </li>
+::end::
+<li> <a href="/_sitemap">Sitemap</a> </li>
+</ul>
+</div>
+
+<div id="footer_div">
+<hr/>
+
+<ul id="footer" class="menu">
+<li class="first"> <a href="/copyright">Copyright &copy; ::year::</a> </li>
+<li> Powered by <a href="http://sandbox.merjis.com/">::cocanwiki_package_html:: ::cocanwiki_version_html::</a> </li>
+</ul>
+</div>
+
+</body>
+</html>
\ No newline at end of file
diff --git a/templates/page.html b/templates/page.html
index 2755987..7bfca1d 100644
--- a/templates/page.html
+++ b/templates/page.html
@@ -67,6 +67,7 @@
 <li> <a href="/_bin/edit_sitemenu.cmo">Edit site menu</a> </li>
 <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="/_images">Images</a> </li>
 <li> <a href="/_files">Files</a> </li>
 ::if(has_stats)::
-- 
1.8.3.1