convert.lisp

I rewrote convert.rb in Common Lisp; [basically it allows you to convert files from one format to another -- say, PostScript files to PDF; I need this as I sometimes work on Windows machines but want read a online papers -- this runs as a CGI program on my personal server] you can get the whole thing here. It works under CMUCL version 19d. I had forgotten how much fun it is to write programs in Common Lisp! First, some HTML macros:

(progn
  (defmacro html-tag (tag attributes end-tag-p &body body)
    `(progn
       ,(if end-tag-p
            `(format t "<~A~{ ~A=~S~}>" ',tag  (list ,@attributes))
            `(format t "<~A~{ ~A=~S~}/>" ',tag (list ,@attributes)))
       (let ((result (multiple-value-list (progn ,@body))))
         (when (and (null (rest result)) (stringp (first result)))
           (princ (first result)))
         ,(when end-tag-p `(format t "</~A>" ',tag))
         (values))))
         
  (defmacro do-tag (tag &optional end-tag-p)
    `(defmacro ,tag (attributes &body body)
       `(html-tag ,',tag ,attributes ,',end-tag-p ,@body)))


  (do-tag html t)
  (do-tag head t)
  (do-tag title t)
  (do-tag h3 t)
  (do-tag form t)
  (do-tag input)
  (do-tag b t)
  (do-tag i t)
  (do-tag br)
  (do-tag a t)
  (do-tag hr)

  )

Next, we need to decode URLs:

(defvar *url-decoders*
  '(("24" . #\$)
    ("26" . #\&)
    ("2B" . #\+)
    ("2C" . #\,)
    ("2F" . #\/)
    ("3A" . #\:)
    ("3B" . #\;)
    ("3D" . #\=)
    ("3F" . #\?)
    ("40" . #\@)
    ("20" . #\Space)
    ("22" . #\")
    ("3C" . #\<)
    ("3E" . #\>)
    ("23" . #\#)
    ("25" . #\%)
    ("7B" . #\{)
    ("7D" . #\})
    ("7C" . #\|)
    ("5C" . #\\)
    ("5E" . #\^)
    ("7E" . #\~)
    ("5B" . #\[)
    ("5D" . #\])
    ("60" . #\`)
    ))


(defun decode-url (url)
  (flet ((quit () (return-from decode-url nil)))
    (with-output-to-string (out)
      (with-input-from-string (in url)
        (loop (let ((char (or (read-char in nil nil) (return))))
                (if (not (char= char #\%))
                    (princ char out)
                    (let ((next (or (read-char in nil nil) (quit))))
                      (if (char= next #\%)
                          (princ #\% out)
                          (let ((next2 (or (read-char in nil nil) (quit))))
                            (princ (or (cdr (assoc (concatenate 'string
                                                                (string next)
                                                                (string next2))
                                                   *url-decoders*
                                                   :test #'string-equal))
                                       (quit))
                                   out)))))))))))

Here is CGI-WELCOME & CGI-MAIN; they use the HTML macros defined above:

(defun cgi-main ()
  (flet ((get-params ()
           (let* ((qs (cdr (assoc :query_string ext::*environment-list*)))
                  (ps (and qs (position #\& qs)))
                  (parts (if ps
                             (list (subseq qs 0 ps) (subseq qs (1+ ps)))
                             (list qs)))
                  (params (mapcan (lambda (x)
                                    (let ((p (position #\= x)))
                                      (and p (list (cons (subseq x 0 p)
                                                         (subseq x (1+ p)))))))
                                  parts))
                  (url (cdr (assoc :url params :test #'string-equal)))
                  (zip-only (cdr (assoc :zip_only params :test #'string-equal))))
             (values (and url (plusp (length url)) (decode-url url))
                     (string-equal zip-only :on))))
         (print-cmds (cmd)
           ;; force-output to show user this info in their browser
           ;; while the command is still running -- works under Apache
           (princ "Running: ") (b () cmd) (br ()) (force-output))
         (print-cgi-header ()
           (let ((newline (coerce '(#\Return #\Newline) 'string)))
             (format t "Content-Type: text/html~A~A" newline newline))))

    (let ((original-dir (default-directory))
          (*shell-before* #'print-cmds)
          (url)
          (zip-only))
      (multiple-value-setq (url zip-only) (get-params))
      (print-cgi-header)
      (if (not url)
          (cgi-welcome)
          (letf (((default-directory) (tmpdir)))
            (html ()
              (head () (title () "convert.lisp"))
              (shell "wget -q '~A'" url)
              (multiple-value-bind (name error)
                  (ignore-errors (convert (or (newest)
                                              (error "couldn't download ~S" url))
                                          zip-only))
                (cond (error (princ "An error occurred: ")
                             (br ())
                             (b () (apply #'format nil
                                          (simple-condition-format-control
                                           error)
                                          (simple-condition-format-arguments
                                           error))))
                      (t (hr ())
                         (let ((base (subseq name
                                             (1+ (position #\/ name :from-end t)))))
                           (shell "cp ~A ~A/data/" base (namestring original-dir))
                           (data-file-link base)))))))))))

(defun cgi-welcome ()
  (html ()
    (head () (title () "convert.lisp"))
    (h3 () "convert.lisp -- convert files to different formats")
    (form (:method "get" :action "convert.sh")
      (princ "url: ")
      (input (:type "textfield" :name "url" :size 100))
      (princ " ")
      (input (:type "checkbox" :name "zip_only"))
      (princ "[zip only] ")
      (input (:type "submit" :value "Convert")))
    (h3 () "available converters [they are searched in order]:")
    (dolist (x *all-converter*)
      (multiple-value-bind (name cp exts doc cmds)
          (decode-converter x)
        (declare (ignore cp cmds))
        (b () (string-downcase name))
        (princ " -- ")
        (i () doc)
        (princ " [exts: ")
        (format t "~{~A~^, ~}" exts)
        (princ "]")
        (br ())))
    (h3 () "converted files [newest first]:")
    (let ((converted-files (mapcar (lambda (x) (cons (or (file-write-date x) 0) x))
                                   (ignore-errors (directory  "data/")))))
      (dolist (x (sort converted-files #'> :key #'car))
        (data-file-link (cdr x))
        (br ())))
    (br ())
    (br ())
    (a (:href "convert.lisp-txt") "{mysrc}")))
    

And finally, the SHELL function that executes the different programs needed to convert files:

(defvar *shell-before*)

(defun shell (cmd &rest args)
  (let ((cmd (apply #'format nil cmd args)))
    (when (boundp '*shell-before*) (funcall *shell-before* cmd))
    (ext:run-program "/bin/bash"
                     (list "-c" cmd))))