blurb.lisp

   1 ;;; PHOROS -- Photogrammetric Road Survey
   2 ;;; Copyright (C) 2011, 2012 Bert Burgemeister
   3 ;;;
   4 ;;; This program is free software; you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation; either version 2 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License along
  15 ;;; with this program; if not, write to the Free Software Foundation, Inc.,
  16 ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17
  18 (in-package :phoros)
  19
  20 (hunchentoot:define-easy-handler
  21     (blurb :uri "/phoros/lib/blurb")
  22     (openlayers-version)
  23   (assert-authentication)
  24   (who:with-html-output-to-string (s nil :indent t)
  25     (:html
  26      :xmlns "http://www.w3.org/1999/xhtml"
  27      (:head
  28       (:title "Phoros")
  29       (:link :rel "stylesheet"
  30              :href (format nil "/~A/lib/css-~A/style.css"
  31                            *proxy-root*
  32                            (phoros-version))
  33              :type "text/css"))
  34      (:body
  35       (:h1 :id "title" "Phoros: A Tool for Photogrammetric Road Survey")
  36       (:button :type "button"
  37                :style "float:right"
  38                :onclick (ps-inline (chain self (close)))
  39                "close")
  40       (:p "This is "
  41           (:a :href "http://phoros.boundp.org"
  42               (:img :src (format nil
  43                                  "/~A/lib/public_html/phoros-logo-plain.png"
  44                                  *proxy-root*)
  45                     :height 30 :style "vertical-align:middle"
  46                     :alt "Phoros"))
  47           (who:fmt "Phoros version ~A," (phoros-version))
  48           " a means for photogrammetric road survey written by"
  49           (:a :href "mailto:Bert Burgemeister <trebbu@googlemail.com>"
  50               "Bert Burgemeister."))
  51       (:p "Its photogrammetric workhorse is "
  52           (:a :href "mailto:Steffen.Scheller.home@gmail.com" "Steffen Scheller's")
  53           (who:fmt " library PhoML (version ~A)." (phoml:get-version-number)))
  54       (:a :style "float:left" :href "http://en.wikipedia.org/wiki/Common_Lisp"
  55           (:img :src "http://www.lisperati.com/lisplogo_128.png"
  56                 :alt "Common Lisp"))
  57       (:p (who:fmt
  58            "Phoros is implemented using Steel Bank Common Lisp (version ~A)"
  59            (lisp-implementation-version))
  60           ", an implementation of Common Lisp."
  61           (:a :href "http://www.sbcl.org"
  62               (:img :src "http://www.sbcl.org/sbclbutton.png"
  63                     :height 30 :style "vertical-align:middle"
  64                     :alt "SBCL")))
  65       (:p "You are communicating with "
  66           (:a :href "http://weitz.de/hunchentoot"
  67               (:img :src "http://www.htg1.de/hunchentoot/hunchentoot11.png"
  68                     :height 30 :style "vertical-align:middle"
  69                     :alt "Hunchentoot"))
  70           ", a Common Lisp web server.")
  71       (:p "Most of the client code running in your browser is or uses"
  72           (:a :href "http://openlayers.org"
  73               (:img :src "http://www.openlayers.org/images/OpenLayers.trac.png"
  74                     :height 30 :style "vertical-align:middle"
  75                     :alt "OpenLayers"))
  76           (who:fmt " ~A." (string-trim " " (remove #\$ openlayers-version))))
  77       (:p "Phoros stores data in a"
  78           (:a :href "http://postgresql.org"
  79               (:img :src "http://www.postgresql.org/files/community/propaganda/32x32_1.gif"
  80                     :height 30 :style "vertical-align:middle"
  81                     :alt "PostgreSQL"))
  82           (who:fmt " ~{~A (v~A)~}"
  83                    (with-restarting-connection *postgresql-credentials*
  84                      (cl-utilities:split-sequence
  85                       #\Space
  86                       (query (:select (:version)) :single)
  87                       :count 2)))
  88           " database that is spatially enabled by "
  89           (:a :href "http://postgis.refractions.net"
  90               (:img :src "http://postgis.refractions.net/download/logo_suite/stock_text/stock_text_180.gif"
  91                     :height 30 :style "vertical-align:middle"
  92                     :alt "PostGIS"))
  93           (who:fmt "version ~A"
  94                    (car (cl-utilities:split-sequence
  95                          #\Space
  96                          (with-restarting-connection *postgresql-credentials*
  97                            (query
  98                             (:select (:postgis_version))
  99                             :single)))))
 100           "."
 101           )
 102       (:h2 "Command Line Interface")
 103       (:p "Most of the administrative tasks are done through the
 104         command line interface. The output of")
 105       (:code "./phoros --help")
 106       (:p "is given below for reference.")
 107       (:pre (who:str (who:escape-string-minimal
 108                       (cli:with-options () ()
 109                         ;; KLUDGE: It should be possible for Phoros to
 110                         ;; see its own --help message without any
 111                         ;; involvement of the file system.
 112                         (multiple-value-bind (fd name)
 113                             (sb-posix:mkstemp "/tmp/phoros-XXXXXX")
 114                           (prog1
 115                               (with-open-file (s name :direction :io
 116                                                  :if-exists :append
 117                                                  :if-does-not-exist :error)
 118                                 (sb-posix:close fd)
 119                                 (cli:help :output-stream s
 120                                           :line-width 100
 121                                           :theme "etc/phoros.cth")
 122                                 (file-position s :start)
 123                                 (loop
 124                                    with help-string = ""
 125                                    for i = (read-line s nil)
 126                                    while i
 127                                    do (setf help-string
 128                                             (concatenate 'string
 129                                                          help-string
 130                                                          i
 131                                                          (string #\Newline)))
 132                                    finally (return help-string)))
 133                             (delete-file name)))))))))))