rants in style

Ok so I've been working on making the rants experience mesh well with the 
alsharpton scheme.  Go to the rants page and check it out, make an adsf rant 
(which I'll delete) and let me know what you think.  After that I'll work on 
converting the old rants to the new style (should be trivial).

Getting php to work in a CGI script is a nightmare.  There was a decent solution:

(define (write-php xexpr)
   (match-let (((in out id err send) (process "php")))
     (fprintf out "<?php ini_set(\"include_path\", \".:/home/bh/www/\"); ?>~n")
     (write-xml/content (xexpr->xml xexpr) out)
     (close-output-port out)
     (copy-port in (current-output-port))))

But calling php (when run as CGI) causes php to interpret the Scheme program 
itself.  The trick is to wrap your PHP-emitting CGI script in a kind of quine 
shell script like this:

#! /usr/local/bin/php
<?php
   ini_set('include_path', '.:/home/bh/www/');
   eval("?>".`/home/bh/local/bin/mzscheme -L 'rant.ss' 'cgi' -mve 
'(cgi-add-rant)'`);
?>

I love PHP.

Here is the entire rants code, in case I delete it tomorrow:

#|                                                              -*- Scheme -*-
    Copyright (c) 2003, 2004 David Van Horn
    Licensed under the Academic Free License version 2.0

    [email protected]

    modified to emit PHP instead of HTML.  output must be run through php
    before being sent to the user.
    Thu Jun 17 10:00:03 EDT 2004

    switched (back?) to using date.ss instead of srfi 19, which fixed a bug.
    Wed Jun 16 11:15:10 EDT 2004

    removed dependency on SSAX, released under AFL 2.0.
    Sun Mar  7 01:31:25 EST 2004

    modified to make latest.html, an HTML fragment for inclusion in BH's
    index.html
    Sat Apr  5 18:15:47 EST 2003

    modified to work as command line program, and cgi program.
    Sat Oct 26 14:47:59 EDT 2002

    original version
    Sun Sep 15 03:31:58 EDT 2002
|#

#cs
(module rant mzscheme
   (require (lib "cgi.ss"          "net")
            (lib "date.ss"         "mzlib")
            (lib "cmdline.ss"      "mzlib")
            ;;(lib "19.ss"           "srfi")
            (lib "xml.ss" "xml")
            ;;(lib "process.ss")  ;; Uncomment for write-php
            ;;(lib "thread.ss")
            (lib "match.ss"))

   (provide cgi-add-rant
            cmdline-add-rant
            add-rant)

   (define base "/home/bh/www/rant/")
   (define url-base "http://ballistichelmet.org/rant/")
   (define (url+ s)
     (format "http://ballistichelmet.org/rant/~a" s))

   ;; Doesn't work in CGI, PHP starts interpreting THIS FILE!!
   #|
   (define (write-php xexpr)
     (match-let (((in out id err send) (process "php")))
       (fprintf out "<?php ini_set(\"include_path\", \".:/home/bh/www/\"); ?>~n")
       (write-xml/content (xexpr->xml xexpr) out)
       (close-output-port out)
       (copy-port in (current-output-port))))
   |#

   ;; this is the CGI interface for adding a rant.
   ;; we extract the rant from the CGI environment variables `rant-subj'
   ;; and `rant-text', add the rant, and then print out an html page to
   ;; report to the user that all is well, and the rant is available for
   ;; viewing.
   (define (cgi-add-rant)
     (display-xml/content
      (xexpr->xml
       ;; add the rant and get the filename of the new rant
      (let ((file (add-rant
                   (extract-binding/single 'rant-subj (get-bindings))
                   (extract-binding/single 'rant-text (get-bindings)))))

        ;; let user know where the new rant is placed.
       `(html
         (head (title "blah")
               ,(make-pi #f #f "php" "include bh_head "))
         (body
          ,(make-pi #f #f "php" "include bh_body_preamble ")
          (div ((class "rant"))
            (p "your rant has been submitted and is available now at "
               (a ((href ,(url+ file))) ,(url+ file)) ".")
            (p "thank you")
            (p (a ((href ,url-base))
                  "back to rant index")))
          ,(make-pi #f #f "php" "include bh_body_postamble ")))))))


   ;; this is the command line interface for adding a rant.
   ;; the rant subject and body may be given to us on the command line,
   ;; otherwise we prompt the user for them.
   (define (cmdline-add-rant)
     (let ((subj null) (text null))
       (command-line "rant" (current-command-line-arguments)
         (once-each
          [("-s" "--subject") s "the subject of your rant"
           (set! subj s)]
          [("-b" "--body") b "the body of your rant"
           (set! text b)]))

       ;; if the subject and text were not specified on the command line
       ;; then prompt for them from the user.
       (when (null? subj) (set! subj (prompt "subj: "  #\newline)))
       (when (null? text) (set! text (prompt "rant:\n" eof)))

       ;; let the user know where the rant has been placed
       (printf "your rant has been submitted and is available now at ~a~n"
               (url+ (add-rant subj text)))))


   ;; reads characters from the current input port until the character is
   ;; equal to the end object.  returns a string of all characters read.
   ;; the end object is trimmed (ie does not get returned at the end of
   ;; the string)
   (define (prompt p end-obj)
     (printf p)
     (if (eqv? end-obj #\newline)
         (let loop () (let ((x (read-line))) (if (string=? "" x) (loop) x)))
         (apply string-append
                (let loop ((lines null))
                  (let ((line (read-line)))
                    (if (eof-object? line)
                        (reverse! lines)
                        (loop (cons (string-append line "\n")
                                    lines))))))))

   ;; add the rant and return the filename of the new rant
   (define (add-rant subj text) ;; -> string
     (let* ((seconds (current-seconds))
            (date    (date->string (seconds->date seconds) #t))
            (file    (string-append (number->string seconds) ".php"))
            (item    `(item ()
                            (title () ,subj)
                            (link () ,file)
                            (pubDate () ,date)
                            (description ()
                                         ,(format "~n<pre>~a</pre>" text)))))

       ;; Insert the new item into the RSS feed file.

       (match (xml->xexpr
               (with-input-from-file (string-append base "rants.xml")
                 read-xml/element))
         (('rss att ('channel '() title link desc . items))
          (begin
            (make-index (cons item items))
            (with-output-to-file (string-append base "rants.xml")
              (lambda ()
                (write-xml/content
                 (xexpr->xml
                  `(rss ,att (channel ,title ,link ,desc ,item ,@items)))))
              'replace))))

       ;; make a file for the rant
       ;; the name of the file is the time (in seconds) plus .php
       (with-output-to-file (string-append base file)
         (lambda ()
           (write-xml/content
            (xexpr->xml
             `(html (head (title ,(format "rant - ~a" subj))
                          ,(make-pi  #f #f "php" "include bh_head"))
                    (body
                     ,(make-pi  #f #f "php" "include bh_body_preamble")
                     (div ((class "rant"))
                       (h1 ,subj)
                       (h2 "created " ,date)
                       (pre (tt ,text))
                       (p (a ((href ,url-base))
                             "back to rant index")))
                    ,(make-pi  #f #f "php" "include bh_body_postamble")))))))

       file)) ;; return the filename of the new rant.

   ; make an index page listing all the rants
   (define (make-index rants)  ;; listof item
     (with-output-to-file (string-append base "index.php")
       (lambda ()
         (display-xml/content
          (xexpr->xml
           `(html
             (head (title "rant index")
                   ,(make-pi  #f #f "php" "include bh_head"))
             (body
              ,(make-pi  #f #f "php" "include bh_body_preamble")
              (img ((src "rant-top.png") (alt "RANTS")))
              ,(with-input-from-file (string-append base "about.txt") read)
              (img ((src "rant-write.png") (alt "write a new goddamn rant")))
              (p "create a new rant "
                 (a ((href ,(url+ "new.php")))
                    "here"))
              (img ((src "rant-read.png") (alt "read a goddamn rant")))
              (table
               ,@(map
                  (match-lambda
                   (('item '() ('title '() t) ('link '() l) ('pubDate '() d)
                           . _)
                    `(tr (td ((style "white-space: nowrap;")) (p ,d))
                         (td (p (a ((href ,l))
                                   ,t))))))
                  rants))
              ,(make-pi  #f #f "php" "include bh_body_postamble"))))))
       'replace))

   ) ;; end of rant.ss