scripts/admin/host.ml

   1 (* COCANWIKI - a wiki written in Objective CAML.
   2  * Written by Richard W.M. Jones <rich@merjis.com>.
   3  * Copyright (C) 2004 Merjis Ltd.
   4  * $Id: host.ml,v 1.6 2004/09/09 12:21:22 rich Exp $
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; see the file COPYING.  If not, write to
  18  * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19  * Boston, MA 02111-1307, USA.
  20  *)
  21
  22 open Apache
  23 open Registry
  24 open Cgi
  25 open Printf
  26
  27 open Cocanwiki
  28 open Cocanwiki_template
  29 open Cocanwiki_date
  30
  31 let template = _get_template "admin/host.html"
  32
  33 let run r (q : cgi) (dbh : Dbi.connection) _ _ _ =
  34   let hostid = int_of_string (q#param "hostid") in
  35
  36   template#set "id" (string_of_int hostid);
  37
  38   (* Pull out some overall details for this host. *)
  39   let sth = dbh#prepare_cached
  40               "select h.canonical_hostname, h.css is not null,
  41                       (select count(*) from pages
  42                         where hostid = h.id and url is not null),
  43                       (select count(*) from pages
  44                         where hostid = h.id),
  45                       (select max(last_modified_date) from pages
  46                         where hostid = h.id and url is not null),
  47                       (select min(last_modified_date) from pages
  48                         where hostid = h.id and url is not null)
  49                  from hosts h
  50                 where h.id = ?" in
  51   sth#execute [`Int hostid];
  52
  53   let canonical_hostname, has_css, page_count, total_count,
  54     last_modified_date, creation_date =
  55     match sth#fetch1 () with
  56         [ `String canonical_hostname;
  57           `Bool has_css;
  58           (`Null | `Int _) as page_count; (`Null | `Int _) as total_count;
  59           (`Null | `Timestamp _) as last_modified_date;
  60           (`Null | `Timestamp _) as creation_date ] ->
  61           let page_count = match page_count with
  62               `Null -> 0
  63             | `Int n -> n in
  64           let total_count = match total_count with
  65               `Null -> 0
  66             | `Int n -> n in
  67           let last_modified_date = match last_modified_date with
  68               `Null -> ""
  69             | `Timestamp t -> printable_date t in
  70           let creation_date = match creation_date with
  71               `Null -> ""
  72             | `Timestamp t -> printable_date t in
  73           canonical_hostname, has_css, page_count, total_count,
  74           last_modified_date, creation_date
  75       | _ -> assert false in
  76
  77   template#set "canonical_hostname" canonical_hostname;
  78   template#conditional "has_css" has_css;
  79   template#set "page_count" (string_of_int page_count);
  80   template#set "total_count" (string_of_int total_count);
  81   template#set "last_modified_date" last_modified_date;
  82   template#set "creation_date" creation_date;
  83
  84   (* Pull out any aliases. *)
  85   let sth = dbh#prepare_cached "select name from hostnames
  86                                  where hostid = ?
  87                                    and name <> ?" in
  88   sth#execute [`Int hostid; `String canonical_hostname];
  89
  90   let table = sth#map (function [`String hostname] ->
  91                          [ "hostname", Template.VarString hostname ]
  92                          | _ -> assert false) in
  93   template#table "hostnames" table;
  94
  95   (* Pull out any email notifications. *)
  96   let sth = dbh#prepare_cached "select email, name from email_notify
  97                                  where hostid = ?" in
  98   sth#execute [`Int hostid];
  99
 100   let table = sth#map (function
 101                            [`String email; `Null] ->
 102                              [ "email", Template.VarString email;
 103                                "name", Template.VarString "" ]
 104                          | [ `String email; `String name] ->
 105                              [ "email", Template.VarString email;
 106                                "name", Template.VarString name ]
 107                          | _ -> assert false) in
 108   template#table "emails" table;
 109
 110   q#template template
 111
 112 let () =
 113   register_script run