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.9 2006/03/27 18:09:47 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 _ _ _ =
  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 _ | `Int64 _) as page_count;
  59           (`Null | `Int _ | `Int64 _) as total_count;
  60           (`Null | `Timestamp _) as last_modified_date;
  61           (`Null | `Timestamp _) as creation_date ] ->
  62           let page_count = match page_count with
  63               `Null -> 0
  64             | `Int64 n -> Int64.to_int n
  65             | `Int n -> n in
  66           let total_count = match total_count with
  67               `Null -> 0
  68             | `Int64 n -> Int64.to_int n
  69             | `Int n -> n in
  70           let last_modified_date = match last_modified_date with
  71               `Null -> ""
  72             | `Timestamp t -> printable_date t in
  73           let creation_date = match creation_date with
  74               `Null -> ""
  75             | `Timestamp t -> printable_date t in
  76           canonical_hostname, has_css, page_count, total_count,
  77           last_modified_date, creation_date
  78       | xs -> failwith (Dbi.sdebug xs) in
  79
  80   template#set "canonical_hostname" canonical_hostname;
  81   template#conditional "has_css" has_css;
  82   template#set "page_count" (string_of_int page_count);
  83   template#set "total_count" (string_of_int total_count);
  84   template#set "last_modified_date" last_modified_date;
  85   template#set "creation_date" creation_date;
  86
  87   (* Pull out any aliases. *)
  88   let sth = dbh#prepare_cached "select name from hostnames
  89                                  where hostid = ?
  90                                    and name <> ?" in
  91   sth#execute [`Int hostid; `String canonical_hostname];
  92
  93   let table = sth#map (function [`String hostname] ->
  94                          [ "hostname", Template.VarString hostname ]
  95                          | _ -> assert false) in
  96   template#table "hostnames" table;
  97
  98   q#template template
  99
 100 let () =
 101   register_script run