Создать тему  Создать ответ 
Common Lisp: мысли о скриптовании и cl-launch
29-06-2014, 17:24    
Сообщение: #1
Quasus

Гоф-фурьер
Сообщений: 625
Зарегистрирован: 17.06.12

Common Lisp: мысли о скриптовании и cl-launch
Если б я знал толком, я рассказал бы чётко и ясно. Был бы туториал. А я в первый раз разбираюсь, поэтому будет мноого-мноого букаф. Размышления, соображения, предложения для обсуждения... В конце есть пара примеров, но сначала - большое словоблудное вступление.

Если говорить о скриптовании, то чего мы хотим:

Х1) исполняемый файл, который при необходимости может рабтать с аргументами командной строки и стандартным вводом/выводом, может возвращать код выхода;

Х2) быстрый запуск скрипта и, как написано в Википедии, маленький отпечаток памяти (не знаю, что это такое). При этом мы в принципе непротив "курирующей" программы-интерпретатора и малого размера файла;

Х3) работа с системой (файлы, переменные, внешние программы...);

Х4) переносимость - между ОС с минимальными требованиями к администрированию (желательно обходиться установкой пакетов из репов), а также переносимость между лисперами и нелисперами;

Х5) чтобы Х1-Х4 было просто и удобно.

Что мы при этом имеем:

И1) реализации с быстрым запуском и малым размером отпечатка памяти - SBCL, CLISP;

И2) возможность использования кода в виде чтения из файла, сохранения образа лиспа или создания самодостаточного приложения;

И3) ASDF 3 с UIOP и quicklisp;

И4) cl-launch.

Подумаем, что из Х1-Х5 можно осуществить И1-И4 (заодно разберёмся, что такое И2-И4). Начнём с самого простого.

Х3) В моде UIOP. По-другому не надо (в частности, cl-fad отправляется на заслуженный отдых). Потому что ASDF 3 - это не только легкоусвояемое мясо менеджер исходников (ASDF 2 был заново переписан для избавления от фундаментальных багов), но и UIOP - большая система утилит в том числе для работы с ОС, работающая с разными реализациями лиспа и операционными системами.

Подвох: ASDF три. Проверить его наличие можно в *features*, и свежие дистрибутивы должны его содержать. И если так, то всё нормально. А если у вас Debian Wheezy, будем грызть кактус вместе. Попозже.

Ещё подвох: документация к UIOP в основном существует в виде докстрингов... Но зато там очень много докстрингов.

Х2) Согласно И1, CLISP и SBCL вполне годятся. Поэтому я буду рассматривать именно их, когда речь о вещах, зависящих от реализации.

Подвох: при загрузке библиотек время запуска проседает на порядок.

Естественное решение - не грузить каждый раз библиотеки, а просто не выгружать их. Это стандартный и классический приём: сохранить образ лиспа и грузить его на следующем старте. Это быстро.

Вообще, образы довольно большие (мой дебиан: у SBCL - мегабайт на тридцать, у CLISPа поменьше, около шести), но сейчас мы говорим о создании одного образа для скриптования (и вообще для жизни). Насчёт свободного места в образе беспокоиться не надо, его хватит. Это под быстрый запуск лисп (исходно) не затачивался, а под серьёзную работу с большими системами - очень даже.

Пример создания образа для CLISPа:

Код:
#!/usr/bin/clisp --quiet -norc

#|

Dump a CLISP memory image with ASDF3, cl-launch, quicklisp and selected
librares.  All the locations are specified as parameters.

The script defines the BUILD-MAIN-CLISP-IMAGE package and a dummy ASDF system "build-main-clisp-image", the only purpose of which is to list and load dependencies.

For scripting purposes the package SCRIPT is defined.  It inherits symbols from CL-USER and a few selected packages.

|#

(in-package #:cl-user)

(defpackage #:build-main-clisp-image
  (:use #:cl))
(in-package #:build-main-clisp-image)

(defparameter *asdf-path* (merge-pathnames #p".local/share/common-lisp/asdf/asdf.lisp"
                                           (user-homedir-pathname)))

(defparameter *launcher-path*
  (merge-pathnames #p".local/share/common-lisp/cl-launch/cl-launch/launcher.lisp"
                   (user-homedir-pathname)))

(defparameter *quicklisp-path*
  (merge-pathnames #p"quicklisp/setup.lisp" (user-homedir-pathname)))

(defparameter *image-path*
  (merge-pathnames #p".local/share/common-lisp/images/clisp/main"
                   (user-homedir-pathname)))


(load *asdf-path*)
(load *launcher-path*)
(load *quicklisp-path*)

(asdf:defsystem "build-main-clisp-image"
  :depends-on ("cl-ppcre" "inferior-shell" "iterate"))

(ql:quickload "build-main-clisp-image")

(defpackage #:script
  (:use #:cl #:cl-ppcre #:uiop #:inferior-shell #:iterate))

(ext:saveinitmem *image-path* :start-package "CL-USER" :norc t)
Файл, как видим, даже исполняемый. Первым делом грузится ASDF 3, который я вручную скачал, потом грузится лисповая часть cl-launch (тогда она не будет загружаться при запуске скриптов) и quicklisp. Потом хочу загрузить сколько-то систем. Для этого ставлю их зависимостями от "метасистемы", и пускай quicklisp разбирается, что в каком порядке ставить. Также в интересах скриптования определяю пакет SCRIPT, наследующий от регулярных выражений, двух пакетов для работы с системой и библиотеки циклов. Потом ещё чего-нибудь накидаю... Принцип ясен, менять и добавлять легко.

Про SBCL потом напишу.

Х1) Загрузить файл - это на самом деле дёшево и сердито. Если же хочется многофайлового проекта с зависимостями, можно сохранить его в образ. Короче, при скриптовании я за загрузку файлов. Сохранение отдельного образа для скрипта - это из пушки по воробьям, учитывая калибр, то бишь размер образа. Сохранение же самодостаточного бинарника - вообще непонятно, из каких соображений (а размер будет ещё больше, чем у образа, потому что в бинарник зашит весь лисп).

Единственное "но" - при использовании сохранённых образов шебанг теряет всю ценность. В него же надо прописывать полный путь образа, который лежит (надо полагать) в пользовательской директории. Другому пользователю придётся всё править.

Выход: использовать обёртки на sh. Их можно генерировать с помощью cl-launch.

Также cl-launch замечательно работает с аргументами скрипта.

Ещё cl-launch можно указывать в шебанге! Я пока не пробовал, потому что не устанавливал пакет.

Х4) Между собственными компами переносить несложно. Из репозиториев можно обойтись минимумом - лиспом. Можно и cl-launch поставить, если он четвёртый. Локально ставится quicklisp и можно что-нибудь написать в .cl-launchrc. При желании ASDF 3 и cl-launch можно установить и в своей директории. Пример создания образа CLISPа с нужным ASDF был выше. cl-launch я себе скачал в ~/.local/share/common-lisp/cl-launch/ и создал линки  ~/bin/cl-launch и ~/bin/cl. Написал простой скриптик, который проверяет наличие cl-launch.tar.gz в текущей директории, скачивает, если не нашёл, распаковывает куда надо и создаёт симлинки.
Код:
#!/bin/bash

CL_LAUNCH_DIR="$HOME/.local/share/common-lisp/cl-launch"
SYMLINK_DIR="$HOME/bin"
ARCHIVE="cl-launch.tar.gz"
ARCHIVE_URL="http://common-lisp.net/project/xcvb/cl-launch/cl-launch.tar.gz"

# If cl-launch.tar.gz is not in cwd, try and download it or exit in the case of
# failure.
[ -a "$ARCHIVE" ] \
    || wget "$ARCHIVE_URL" \
    || { echo "ERROR: cannot get $ARCHIVE"; exit 1; }

# Get the name of the real directory containing cl-launch (includes version)
CL_LAUNCH_DIRNAME=$(tar -tf $ARCHIVE | head -n 1)
CL_LAUNCH_DIRNAME="${CL_LAUNCH_DIRNAME%?}"

# Create directories, untar, and create symlinks
mkdir -p "$CL_LAUNCH_DIR"
rm -f "$SYMLINK_DIR/cl-launch" "$SYMLINK_DIR/cl" "$CL_LAUNCH_DIR/cl-launch"
tar -zxf "$ARCHIVE" -C "$CL_LAUNCH_DIR"
ln -s "$CL_LAUNCH_DIR/$CL_LAUNCH_DIRNAME" "$CL_LAUNCH_DIR/cl-launch"
ln -s "$CL_LAUNCH_DIR/$CL_LAUNCH_DIRNAME/cl-launch.sh" "$SYMLINK_DIR/cl-launch"
ln -s "$CL_LAUNCH_DIR/$CL_LAUNCH_DIRNAME/cl-launch.sh" "$SYMLINK_DIR/cl"

Насчёт переноса от лиспера к нелисперу - надо думать.

Во-первых, библиотеки. В первый-то раз нужный образ сохранить можно. А если потом другой скрипт потребует новых библиотек, надо образ как-то заменять... Или, к примеру, обновлять. Хорошо хоть quicklisp всё ставить без проблем и можно закопать его в недрах ~/.local. Со скриптом на питоне хлопот было бы меньше, наверно, даже при использовании нестандартных библиотек.

Во-вторых, скрипт "на экспорт" нехорошо оформлять в виде куска кода с шапкой (in-package #:script). Наверно, лучше завернуть в ASDF-систему ну или по крайней мере назвать пакет более развёрнуто и выписать его определение.
Найти все сообщения
Цитировать это сообщение
29-06-2014, 17:29    
Сообщение: #2
Quasus

Гоф-фурьер
Сообщений: 625
Зарегистрирован: 17.06.12

RE: Common Lisp: мысли о скриптовании и cl-launch
Х5) Ну вот мы дошли до cl-launch.

Это скрипт на shell с задачей сделать так, чтобы софт, написанный на лиспе, можно было бы использовать из командной строки. Здесь "софт" - от вычисления явно заданной формы до большой программы. Задача большая, возможностей у cl-launch много, соответственно, много опций и большая справка cl-launch --more-help .

Насчёт справки это был намёк. :D Однако кое-что напишу.

Замечание номер один. Основной инструмент cl-launch - оборачивающие скрипты, представляющие ацкую смесь shell и лиспа. Размер довольно большой: к коду из загружаемого лиспофайла добавляется около тысячи строк. Однако эта тысяча строк - бойлерплейт, и имеется возможность (опция --include) не копипастить его, а вставлять из образцов, лежащих раз навсегда определённых местах. Мне кажется, для скриптования это имеет смысл. Например, если я положу текущую версию в ~/.local/share/common-lisp/cl-launch/cl-launch/ и пропишу это путь в .cl-launchrc, всё должно быть нормально.

Нюанс: если указана директория для инклуда, то образ лиспа для конкретного скрипта (если он зачем-то вам нужен) будет сохраняться в ту же директорию.

Как я писал, можно попробовать шебанг #!/usr/bin/cl, но туда тоже много опций
надо писать.

Замечание номер два. cl-launch настраивается. Например, можно поковыряться в самом скрипте и поменять, например, DEFAULT_INCLUDE_PATH (однако при обновлении надо будет не забыть ковыряться в следующей версии). Также можно использовать .cl-launchrc (язык - shell). Я его себе сделал, написал следующее:
Код:
WRAPPER_CODE='CLISP_OPTIONS=" -norc --quiet -M $HOME/.local/share/common-lisp/images/clisp/main.mem"'
INCLUDE_PATH="$HOME/.local/share/common-lisp/cl-launch/cl-launch"
WRAPPER_CODE - это код, который будет обёртывать запуск лиспа. В частности, в нём можно изменять значения переменных типа CLISP_OPTIONS, определяемых в cl-launch.sh. Здесь я указал, какой надо грузить образ.
INCLUDE_PATH - это откуда брать бойлерплейт.

Продолжим рассмотрение на паре примеров.
Код:
;;;; hello-world.lisp

(in-package #:script)

(defun main ()
  (write-line "hello, world"))
В лиспе, которым я буду загружать этот скрипт, пакет SCRIPT уже определён и мне сразу доступны символы из uiop и др. без префиксов.

Теперь создаём обёртку:
Код:
$ cl -l clisp -R -f hello-world.lisp -o helloworld -p script -r main
Лисп указываю явно, потому что у меня два.
-R - читать .cl-launchrc (умолчания по умолчанию не предусматривают его
чтения).
-r main - какую функцию вызвать при запуске скрипта.
-p script - в каком пакете живёт имя main (CL-USER можно было бы не указывать).

Вместо указания начальной функции можно было бы написать начальную форму -i '(main)'.

В папке появляется небольшой исполняемый скрипт helloworld.
Код:
$ ./helloworld
hello, world
Великолепно.

Теперь попробуем скрипт с аргументами - чтобы приветствовал задаваемых людей.
Код:
;;;; hello.lisp

(in-package #:script)

(defun main (argv)
  (format t "Hello~{~#[~;, ~A~;, ~A and ~A~:;~@{~#[~; and~] ~A~^,~}~]~}.~%" argv))

Обожаю format. (Правда, в этот раз я его в основе своей спёр из CLHS.) Оборачиваем теперь вот так:

Код:
$ cl -l clisp -R -f hello.lisp -o hello -p script -E main

-E main - при запуске скрипта вызывать main, дав ей в качестве аргументов список аргументов скрипта (без имени скрипта).

Этот список аргументов всегда доступен через uiop:*command-line-arguments*, а имя скрипта - через uiop:argv0. Однако наличие опции -E облегчает интерактивную разработку.

Пробуем:
Код:
$ ./hello
Hello.
$ ./hello John
Hello, John.
$ ./hello John Mary
Hello, John and Mary.
$ ./hello John Mary Jane
Hello John, Mary, and Jane.

Теперь почти настоящий пример: клон скрипта для konversation (клиент для IRC) из туториала
http://userbase.kde.org/Konversation/Scr...ting_guide
У нас он будет таким:
Код:
#|
lispmood.lisp - a Konversation script to display a witty remark based on the user's mood.

Usage: /exec lispmood mood [mood_string]
|#

(in-package #:script)

(defparameter *moods*
  '(("hungry" "Hungry!  Anyone got a horse?")
    ("sleepy" "I yawn, therefore I am.")
    ("gloomy" "Roses are red.  Violets are blue, and so am I ...")
    ("happy" "Thinking happy thoughts (with a dash of pixie dust).")
    ("hyper" "Just a spoonful of sugar?  I think I took a whole jar! *cartwheels*")
    ("excited" "Are we there yet?  Are we there yet?  Are we there yet?")))

(defparameter *default-mood* "What were we talking about again?")

(defun main (argv)
  (let ((server (first argv))
        (target (second argv))
        (mood (third argv)))
    (multiple-value-bind (command text)
      (cond ((null server) (values '(error) "Server required"))
            ((null target) (values '(error) "Target required"))
            ((null mood) (values '(error) "No mood given"))
            (t (values `(say ,server ,target)
                       (or (second (assoc mood *moods* :test #'equal))
                           *default-mood*))))
      (run/nil `(qdbus org.kde.konversation /irc ,@command ,text)))))
На что обратить внимание: run/nil - из библиотеки inferior-shell, запускает программу и возвращает nil. Команду можно задавать списком. Символы в этом списке интерпретируются как строки, получается красиво (foo эквивалентно "foo", а :foo эквивалентно "--foo"). Кажется, inferior-shell - хорошая библиотека, но документации мало.

Эта красота кидается в ~/.kde/share/apps/konversation/scripts/. Собирается как
выше:
Код:
$ cl -l clisp -R -f lispmood.lisp -o lispmood -p script -E main
и запускаем в клиенте командой /exec lispmood <mood>. Провено, работает.

В справке по cl-launch я порылся основательно, так что если что интересно по его употреблению - может быть, смогу сказать. Пока не забыл всё. :D
Найти все сообщения
Цитировать это сообщение
02-07-2014, 08:37    
Сообщение: #3
Quasus

Гоф-фурьер
Сообщений: 625
Зарегистрирован: 17.06.12

RE: Common Lisp: мысли о скриптовании и cl-launch
Для SBCL скрипт, создающий ядро, получился такой:
Код:
#!/usr/bin/sbcl --script

#|

Dump a SBCL memory image with ASDF3, cl-launch, quicklisp and selected
librares.  All the locations are specified as parameters.

The script defines the BUILD-MAIN-CLISP-IMAGE package and a dummy ASDF system "build-main-sbcl-image", the only purpose of which is to list and load dependencies.

For scripting purposes the package SCRIPT is defined.  It inherits symbols from CL-USER and a few selected packages.

|#

(in-package #:cl-user)

(defpackage #:build-main-sbcl-image
  (:use #:cl))
(in-package #:build-main-sbcl-image)

(defparameter *asdf-path* (merge-pathnames #p".local/share/common-lisp/asdf/asdf.lisp"
                                           (user-homedir-pathname)))

(defparameter *launcher-path*
  (merge-pathnames #p".local/share/common-lisp/cl-launch/cl-launch/launcher.lisp"
                   (user-homedir-pathname)))

(defparameter *quicklisp-path*
  (merge-pathnames #p"quicklisp/setup.lisp" (user-homedir-pathname)))

(defparameter *image-path*
  (merge-pathnames #p".local/share/common-lisp/images/sbcl/main.core"
                   (user-homedir-pathname)))

(load *asdf-path*)
(load *launcher-path*)
(load *quicklisp-path*)

(asdf:defsystem "build-main-sbcl-image"
  :depends-on ("cl-ppcre" "inferior-shell" "iterate"))

(in-package #:cl-user)

(handler-bind ((simple-error #'(lambda (c)
                                 (declare (ignore c))
                                 (invoke-restart 'asdf/lisp-action:try-recompiling))))
  (ql:quickload "build-main-sbcl-image"))

(defpackage #:script
  (:use #:cl #:cl-ppcre #:uiop #:inferior-shell #:iterate))

(sb-ext:save-lisp-and-die build-main-sbcl-image::*image-path* :purify t)

Его иногда глючит при загрузке систем (точнее, конфликт чего-то скомпилированного с чем-то скомпилированным, не разбирался, поэтому тут handler-bind с рестартом. (Вы ведь знали, что когда в дебаггере появляется сообщение об ошибке с рестартами, то эти рестарты можно не только вручную выбирать, но и из программы? В этом соль!)

Пришёл к такой мысли. Лисп - язык общего назначения, а SBCL и CLISP - компиляторы языка общего назначения. Так вышло, что их можно использовать в скриптовых целях. Однако в принципе нет ничего удивительного, что для этих целей их нужно немного настроить. Однако дело в том, что не существует единого общепризнанного способа их настройки для скриптования (например, библиотеки), то есть "скриптовальщики" будут кто во что горазд. Поэтому у "природных" скриптовых языков (перл, питон) естественная фора - там все делают одинаково. Ну да ничего.
Найти все сообщения
Цитировать это сообщение
05-07-2014, 17:40    
Сообщение: #4
Quasus

Гоф-фурьер
Сообщений: 625
Зарегистрирован: 17.06.12

RE: Common Lisp: мысли о скриптовании и cl-launch
Нда. Пробный скрипт: переписанный на лиспе sys_info_page из The Linux Command Line. Что делает: собирает некую системную информацию (аптайм, использование дискового пространства и пространства в домашних папках) и делает отчёт в HTML. Файл можно задать опцией -f или задать интерактивно, если опция -i.

Код:
#!/bin/bash

# sys_info_page: program to output a system information page

PROGNAME=$(basename $0)
TITLE="System Information Report For $HOSTNAME"
CURRENT_TIME=$(date +"%x %r %Z")
TIMESTAMP="Generated $CURRENT_TIME, by $USER"

report_uptime () {
    cat <<- _EOF_
        <H2>System Uptime</H2>
        <PRE>$(uptime)</PRE>
_EOF_
    return
}

report_disk_space () {
    cat <<- _EOF_
        <H2>Disc Space Utilization</H2>
        <PRE>$(df -h)</PRE>
_EOF_
    return
}

report_home_space () {
    local format="%8s%10s%10s\n"
    local i dir_list total_files total_dirs total_size user_name

    if [[ $(id -u) -eq 0 ]]; then
        dir_list=/home/*
        user_name="All Users"
    else
        dir_list=$HOME
        user_name=$USER
    fi

    echo "<H2>Home Space Utilization ($user_name)</H2>"

    for i in $dir_list; do

        total_files=$(find $i -type f | wc -l)
        total_dirs=$(find $i -type d | wc -l)
        total_size=$(du -sh $i | cut -f 1)

        echo "<H3>$i</H3>"
        echo "<PRE>"
        printf "$format" "Dirs" "Files" "Size"
        printf "$format" "—-" "—--" "—-"
        printf "$format" $total_dirs $total_files $total_size
        echo "</PRE>"
    done
    return
}

usage () {
    echo "$PROGNAME: usage $PROGNAME [-f file | -i]"
    return
}

write_html_page () {
    cat <<- _EOF_
    <HTML>
        <HEAD>
            <TITLE>$TITLE</TITLE>
        </HEAD>
        <BODY>
            <H1>$TITLE</H1>
            <P>$TIMESTAMP</P>
            $(report_uptime)
            $(report_disk_space)
            $(report_home_space)
        </BODY>
    </HTML>
_EOF_
    return
}

# process command line options

interactive=
filename=

while [[ -n $1 ]]; do
    case $1 in
        -f | --file)            shift
                                filename=$1
                                ;;
        -i | --interactive)     interactive=1
                                ;;
        -h | --help)            usage
                                exit
                                ;;
        *)                      usage >&2
                                exit 1
                                ;;
    esac
    shift
done

# interactive mode

if [[ -n $interactive ]]; then
    while true; do
        read -p "Enter name of output file: " filename
        if [[ -e $filename ]]; then
            read -p "'$filename' exists.  Overwrite? [y/n/q] > "
            case $REPLY in
                Y|y)    break
                        ;;
                Q|q)    echo "Program terminated."
                        exit
                        ;;
                *)      continue
                        ;;
            esac
        else
            break
        fi
    done
fi

# output html page

if [[ -n $filename ]]; then
    if touch $filename && [[ -f $filename ]]; then
        write_html_page > $filename
    else
        echo "$PROGNAME: Cannot write file '$filename'" >&2
        exit 1
    fi
else
    write_html_page
fi
Код:
(defpackage #:sys-info-page
  (:use #:cl #:uiop #:inferior-shell #:iterate))

(in-package #:sys-info-page)

(defparameter *program-name* "sys-info-page")

(defparameter *title* (format nil "System Information Report For ~A"
                          (run/ss "bash -c 'echo $HOSTNAME'")))

(defun print-usage (&optional (stream *standard-output*))
  (format stream "~A: usage ~A [-f file | -i]" *program-name* *program-name*))

(defun timestamp ()
  (multiple-value-bind (s m h d mth y d-of-w dst-p tz) (get-decoded-time)
    (declare (ignorable s m h d mth y d-of-w dst-p tz))
    (format nil "Generated ~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D (GMT + ~A:00), by ~A" y mth d h m s tz (getenv "USER"))))

(defun html-report (section title &rest strings)
  (format nil "~&<~A>~A</~A>~%<pre>~{~A~}</pre>~%" section title section strings))

(defun report-uptime ()
  (html-report "H2" "System Uptime" (run/ss '(uptime))))

(defun report-disk-space ()
  (html-report "H2" "Disk Space" (run/ss '(df -h))))

(defun report-one-home-space (dir)
  (let ((dirname (native-namestring dir))
        (fmt "~&~8A~10A~10A~%"))
    (let ((total-files (run/ss `(pipe (find ,dirname -type f) (wc -l))))
          (total-dirs (run/ss `(pipe (find ,dirname -type d) (wc -l))))
          (total-size (run/ss `(pipe (du -sh ,dirname) (cut -f 1)))))
      (html-report "H3"
                   dirname
                   (format nil fmt "Dirs" "Files" "Size")
                   (format nil fmt "—-" "—--" "—-")
                   (format nil fmt total-dirs total-files total-size)))))

(defun report-home-space ()
  (multiple-value-bind (dir-list user-name) (if (equal (run/ss '(id -u)) "0")
                                                (values (subdirectories #p"/home/")
                                                        "All Users")
                                                (values (list (user-homedir-pathname))
                                                        (getenv "USER")))
    (let ((clauses (iter (for dir in dir-list)
                         (collecting (report-one-home-space dir)))))
      (format nil "<H2>Home Space Utilization (~A)</H2>~%~{~A~%~}" user-name clauses))))

(defun write-html-page (&optional (stream *standard-output*))
 (format stream
     "<HTML>
    <HEAD>
        <TITLE>~A</TITLE>
    </HEAD>
    <BODY>
        <H1>~A</H1>
        <P>~A</P>
        ~A
        ~A
        ~A
    </BODY>
</HTML>"
     *title*
     *title*
     (timestamp)
     (report-uptime)
     (report-disk-space)
     (report-home-space)))

(defun to-file (file)
  (handler-case
    (with-open-file (out file :direction :output
                         :if-exists :overwrite)
      (write-html-page out)
      t)
    (error (c) (format *error-output* "~A: cannot write to file ~A. ~A" *program-name* file c))))

(defun file-query ()
  (loop
    (write-string "Enter name of output file: " *query-io*)
    (finish-output *query-io*)
    (let ((file (read-line *query-io* nil)))
      (if (probe-file* file)
          (progn
            (format t "~A exists.  Overwrite? [y/n/q] > " file)
            (finish-output *query-io*)
            (let ((reply (read-line *query-io* nil)))
              (cond ((equalp reply "y") (return file))
                    ((equalp reply "q") (return nil))
                    ((eq reply nil) (return nil)))))
          (return file)))))

(defun do-stuff (interactivep file helpp errorp)
  (cond (errorp (print-usage *error-output*))
        (helpp (print-usage))
        (interactivep (let ((file (file-query)))
                        (if file
                            (to-file file)
                            (progn
                              (write-line "Program terminated.")
                              (force-output)))))
        (file (to-file file))
        (t (write-html-page))))

(defun main ()
  (setf *program-name* (argv0))
  (let ((options (apply-argv:parse-argv *command-line-arguments*)))
    (if (consp (first options))
        (do-stuff nil nil nil t)
        (let (interactivep file helpp errorp)
          (iter (for key in options by #'cddr)
                (for val in (rest options) by #'cddr)
                (case key
                  ((:h :help) (setf helpp val))
                  ((:i :interactive) (setf interactivep val))
                  ((:f :file) (setf file val))
                  (otherwise (setf errorp t) (return))))
          (do-stuff interactivep file helpp errorp)))))

Лисповая версия довольно убога. Правда, я не старался далеко отходить оригинала, но тем не менее.

Работает и на CLISP и на SBCL, причём на первом немного быстрее; проигрыш в быстродействии по сравнению с башем около 20%, но в пересчёте на абсолютное время получается около 100 мс, вроде некритично. Оборачивание:
Код:
cl -R -l clisp -f sys_info_page.lisp -o sys_info_page -p sys-info-page -r main

Библиотек для порождения HTML я решил для простоты не использовать. Чтобы парсить аргументы скрипта, воспользовался библиотекой apply-argv, которая список аргументов-строк превращает в симпатичный plist. Есть и другие подобные библиотеки.

Чем скрипт плох.

Фейл № 1.
Средствами UIOP я не могу посчитать число поддиректорий домашней директории. Единственная подходящая функция - вроде, это collect-sub*directories. Бог с ней, что неудобная, - главное, она игнорирует симлинки и успешно циклится. Поэтому считал поддиректории и файлы через find, ну и чтобы два раза не вставать, как говорится, пайпнул результат в wc.

Фейл № 2.
HOSTNAME - переменная bash, а UIOP обращается, надо полагать, к sh. Поэтому вместо getenv пришлось писать (run/ss "bash -c 'echo $HOSTNAME'"). Кто знает, сколько ещё башевых плющек недоступно. :(

Фейл № 3.
Приведением аргументов командной строки к удобоваримому виду (plist в данном случае) занимается внешняя библиотека. Однако вычленение опций (в функции main) какое-то корявое.

Фейл № 4.
Гляньте функцию file-query: немудрёный интерактивный ввод имени файла. Это ужас. Вместо одного read -p "Enter name of output file: " filename пишу три строчки с finish-output и *query-io*. (*query-io* - специальный двунаправленный поток для общения с пользователем. Если его в данном случае не использовать, лисп имеет право глючить и действительно глючит.) Если бы я знал, как написать лучше, я бы написал. Конечно, можно завернуть в функцию, но лучше бы такая функция уже существовала бы в какой-то библиотеке. Не нашёл.

Вообще, у кого как, а у меня окказиональное общение программы с пользователем имеет тенденцию вносить путаницу. Собственно, лисп ненавязчиво предлагает способ организации взаимодействия - REPL (например, создание пользовательского REPLа рассматривается в Land of Lisp). Было бы неплохо иметь средства для простого и удобного создания REPLов. Но, кажется, нету.

Фейл № 4.
Программа в целом ужасна. Строк лишь немногим меньше, зато строки более набитые. Нет в помине кристальной ясности и сверхдекларативности. (Зато есть finish-output, даааа.) Короче, я недоволен. Надо переделывать.
Найти все сообщения
Цитировать это сообщение
Создать ответ 


Переход:


Пользователи просматривают эту тему: 1 Гость(ей)