Common Lisp で Amazon Glacier

Common Lisp で Amazon Glacier

https://github.com/quek/info.read-eval-print.aws.glacier

できた気するので、今度バックアップデータをアップロードしてみる。

たぶんアップロード時の description にファイル名とか日時とかサイズとか入れといた方がいい気がする。

(ql:quickload :info.read-eval-print.aws.glacier)

(in-package #:info.read-eval-print.aws.glacier)

(load "~/.info.read-eval-print.aws.glacier.lisp")

(list-vaults)

(create-vault "test-vault")

(describe-vault "test-vault")

(upload-archive "test-vault" "/tmp/a.txt" :description "upload-archive")

(upload-archive-multipart "test-vault" "~/archive/apache-solr-4.0.0-src.tgz" :description "multipart")

(list-jobs "test-vault")

(initiate-job "test-vault" :type :inventory-retrieval)
;⇒ "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_"

(describe-job "test-vault" "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_")

(get-job-output "test-vault" "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_")

;; ファイルに保存する
(with-open-stream (in (get-job-output-stream "test-vault" "JOBID_EXAMPLEQUXFCTf0xdkZJxIri2id7ijxCKvnpBOCQL0mPIdiCkhjphjphjpdq9f0AAOaIcZm_"))
  (with-open-file (out "/tmp/job-out" :direction :output :if-exists :supersede
                                      :element-type '(unsigned-byte 8))
    (alexandria:copy-stream in out :element-type '(unsigned-byte 8))))

ダウンロード時は :element-type '(unsigned-byte 8) を指定すること。

車輪の再発明 〜 HTML の出力

CL-WHO を使えばいいのだけど、デフォルトでエスケープされないのと、 Compojure の tag#id.class という書き方がうらやましかったで作った。

https://github.com/quek/info.read-eval-print.html

(html (:ul#foo.bar.baz
       (loop for i from 1 to 3
             do (html (:ul :data-value i (format nil "<~a>" i))))))

で次の出力になる。

<ul id="foo" class="bar baz">
  <ul data-value="1">
    &lt;1&gt;
  </ul>
  <ul data-value="2">
    &lt;2&gt;
  </ul>
  <ul data-value="3">
    &lt;3&gt;
  </ul>
</ul>

CL-WHO を使っていた会社のブログをこれで書きなおしてやった。

generic な scan

こんな感じ。多値は。。。

(defgeneric scan% (thing &key &allow-other-keys))

(series::defS scan* (thing &rest args)
  "generic scan."
  (cl:let ((scan% `(scan% ,thing ,@args)))
    (series::fragl
     ;; args
     ((thing t)
      (scan% function))
     ;; rets
     ((value t))
     ;; aux
     ((value t)
      (f function))
     ;; alt
     ()
     ;; prolog
     ((setq f scan%))
     ;; body
     ((multiple-value-bind (v p) (funcall f)
        (unless p
          (go series::end))
        (setq value v)))
     ;; epilog
     ()
     ;; wraprs
     ()
     ;; impure
     nil)))

(defmethod scan% ((ting list) &key)
  (let ((x ting))
    (lambda ()
      (if x
          (let ((car (car x)))
            (setf x (cdr x))
            (values car t))
          (values nil nil)))))

(defmethod scan% ((thing array) &key (start 0) end)
  (let ((i start)
        (end (or end (length thing))))
    (lambda ()
      (if (= i end)
          (values nil nil)
          (let ((v (aref thing i)))
            (incf i)
            (values v t))))))

#|
(collect (scan* #(1 2 3)))
;⇒ (1 2 3)

(collect (scan* #(1 2 3) :start 1 :end 2))
;⇒ (2)

(defstruct st
  (value 'a)
  (next nil))

(defmethod scan% ((st st) &key)
  (lambda ()
    (if st
        (let ((x st))
          (setf st (st-next st))
          (values x t))
        (values nil nil))))

(let ((st (make-st :value 1 :next (make-st :value 2 :next (make-st :value 3)))))
  (collect (st-value (scan* st))))
;⇒ (1 2 3)
|#

「星降る草原」グインサーガ外伝23

ひさしぶりに読むグインサーガ。おもしろかった。自分の中の何かが満たされた。グインサーガは中学のころから読んでいて、生活の一部になっていたんだということを、認識した。

これかもずっと読んでいきたい。

標準入力を読むなら

(load "~/quicklisp/setup.lisp")

(let* ((*standard-output* (make-broadcast-stream))
       (*error-output* *standard-output*))
  (ql:quickload :series))

(use-package :series)

(write-string
 (collect 'string (scan-stream *standard-input* #'read-char)))

yarn:~% echo "hello\nworld" | sbcl --script /tmp/a.lisp
hello
world

sbcl --script でやるなら

昨日の Common Lisp から Skype を使う を sbcl —script でやるならこんな感じかな。

(load "~/quicklisp/setup.lisp")

(let* ((*standard-output* (make-broadcast-stream))
       (*error-output* *standard-output*))
  (ql:quickload :dbus))

(use-package :dbus)

(with-open-bus (bus (session-server-addresses))
  (with-introspected-object (skype
                             bus
                             "/com/Skype"
                             "com.Skype.API")
    (flet ((skype (command)
             (skype "com.Skype.API" "Invoke" command)))
      (skype "NAME FromCommonLisp")
      (skype "PROTOCOL 8")
      ;; #xxx... はチャットルームの ID
      (skype (format nil "CHATMESSAGE #xxxxxxx/$yyyyyyy;9999aaaa9999 ~a"
                     (second sb-ext:*posix-argv*))))))

sbcl --script skype.lisp "hello"

Common Lisp から Skype を使う

なんだ。簡単だった。

dbus 経由。

リファレンス http://developer.skype.com/public-api-reference#Linux

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :dbus))

(defpackage :try-dbus
  (:use :cl :dbus))

(in-package :try-dbus)

(with-open-bus (bus (session-server-addresses))
  (with-introspected-object (skype
                             bus
                             "/com/Skype"
                             "com.Skype.API")
    (flet ((skype (command)
             (skype "com.Skype.API" "Invoke" command)))
      (print (skype "NAME FromCommonLisp"))
      (print (skype "PROTOCOL 8"))
      (print (skype "GET USERSTATUS"))
      (print (skype "PING"))
      ;; #xxx... はチャットルームの ID
      (skype "CHATMESSAGE #xxxxxxx/$yyyyyyy;9999aaaa9999 てすとです(f)"))))