えんどう

原発震災状況

東日本大震災で緊急停止した原発は11機。

東京電力 福島第一原発 1号機 炉心溶融、水素爆発、海水注入
2号機 炉心溶融、水素爆発?、海水注入、サプレッションプール破損、格納容器破損、電源回復
3号機 炉心溶融、水素爆発、海水注入
4号機 水素爆発?、火災再発生
5号機 冷温停止
6号機 冷温停止
福島第二原発 1号機 冷温停止
2号機 冷温停止
3号機 冷温停止
4号機 冷温停止
東北電力 女川原発 1号機 冷温停止
2号機 起動直後で原子炉温度100℃未満
3号機 冷温停止
日本原子力発電 東海第二原発 冷温停止

「冷温停止」は安全に停止している状態。すべてが冷温停止するまで引き続き警戒を。

※ 福島第一の4号機は緊急停止した11機には入っていないが火災が発生したので追加した。5,6号機は定期点検中で運転していなかったが、3/21報道で冷温停止したので追加した。

福島の全6機についての詳細な表→ http://www.hattori-ryoichi.gr.jp/blog/

ソース

えんどうやすゆき

http://www.javaopen.org/~yasuyuki/

GaucheFest

Gauche:ChatonRadar

Chaton Radar

chaton.client使用版 

#!/usr/bin/env gosh

(use chaton.client)
(use gauche.parameter)
(use gauche.parseopt)
(use gauche.process)
(use gauche.threads)
(use util.list)
(use util.match)

(define-class <chaton-config> ()
   ((client :init-keyword :client
            :accessor client-of :init-value #f)
    (url    :init-keyword :url
            :accessor url-of :init-value #f)
    (npath   :init-keyword :npath
             :accessor npath-of :init-value #f)
    (ipath   :init-keyword :ipath
             :accessor ipath-of :init-value #f)))

(define *chaton-config*
  (make-parameter
   (make <chaton-config> :client "ChatonRadar"
         :url "http://practical-scheme.net/chaton/gauche"
         :npath "/usr/local/bin/growlnotify"
         :ipath "/Users/yasuyuki/Downloads/chaton-room-gauche.gif")))

(define (send-notify npath ipath title message)
  (process-output->string
   (list #?=npath "--image" #?=ipath "-t" #?=title "-m" #?=message)))

(define (radar-handler response)
  (when (pair? response)
    (let1 content (assoc-ref response 'content)
      (match content [((name (sec mil) body) ... )
                      (for-each (cut send-notify
                                     (npath-of (*chaton-config*))
                                     (ipath-of (*chaton-config*)) <> <>)
                                name body)])))
  #f)

(define (show-help progname)
  (print #`",|progname| [-c conf-file]"))

(define (read-config cfile)
  (let* ((sx (and cfile (call-with-input-file cfile (cut read <>))))
         (url (and sx (assoc-ref sx 'url)))
         (npath (and sx (assoc-ref sx 'npath)))
         (ipath (and sx (assoc-ref sx 'ipath)))
         (conf (*chaton-config*)))
    (when url (set! (url-of conf) url))
    (when npath (set! (npath-of conf) npath))
    (when ipath (set! (ipath-of conf) ipath))
    (*chaton-config* conf)))

(define (main args)
  (let-args (cdr args)
      ((cfile "c|conf=s" => (cut read-config <>))
       (help  "h|help" => (cut show-help <>)))
    (let1 client (chaton-connect
                  (url-of (*chaton-config*))
                  (client-of (*chaton-config*))
                  radar-handler)
      (thread-join! (ref client 'observer-thread)))))

初期バージョン 

#!/usr/bin/env gosh

(use gauche.parameter)
(use gauche.parseopt)
(use gauche.process)
(use rfc.http)
(use rfc.uri)
(use srfi-27)
(use text.tree)
(use util.list)
(use util.match)

(define-class <chaton-config> ()
   ((client :init-keyword :client
            :accessor client-of :init-value #f)
    (url    :init-keyword :url
            :accessor url-of :init-value #f)
    (login  :init-keyword :login
            :accessor login-of :init-value #f)
    (npath   :init-keyword :npath
             :accessor npath-of :init-value #f)
    (ipath   :init-keyword :ipath
             :accessor ipath-of :init-value #f)))

(define *chaton-config*
  (make-parameter
   (make <chaton-config> :client "ChatonRader"
         :url "http://practical-scheme.net/chaton/gauche"
         :login "http://practical-scheme.net/chaton/gauche/apilogin"
         :npath "/usr/local/bin/growlnotify"
         :ipath "/Users/yasuyuki/Downloads/chaton-room-gauche.gif")))

(define (make-mime alist)
  (let1 boundary (format "boundary-~a"
                         (number->string (* (random-integer (expt 2 64))
                                            (sys-time) (sys-getpid))
                                         36))
    (values (tree->string
             `(,(map (lambda (k&v)
                       `("\r\n--",boundary"\r\n"
                         "Content-disposition: form-data; name=\"",(car k&v)"\"\r\n\r\n"
                         ,(x->string (cdr k&v))))
                     alist)
               "\r\n--",boundary"--\r\n"))
            boundary)))

(define (POST room-url uri params)
  (receive (host path) (host&path uri)
    (receive (body boundary) (make-mime params)
      (receive (status hdrs body)
          (http-post host path body
                     :mime-version "1.0"
                     :content-type #`"multipart/form-data; boundary=,boundary")
        (unless (equal? status "200")
          (cerrf room-url "POST to ~a failed with ~a" uri status))
        (safe-parse room-url body)))))

(define (host&path uri)
  (receive (scheme specific) (uri-scheme&specific uri)
    (receive (host path q f) (uri-decompose-hierarchical specific)
      (values host path))))

(define (safe-parse room-url text)
  (guard (e [(<read-error> e)
             (cerrf room-url "invalid reply from server: ~s" reply)])
    ;;(print text)
    (read-from-string text)))

(define (cerrf room-url fmt . args)
  (apply errorf <chaton-error> :room-url room-url fmt args))

(define-condition-type <chaton-error> <error>
  (room-url #f))

(define (send-notify config name body)
  (let ((client (client-of config))
        (npath (npath-of config))
        (ipath (ipath-of config)))
    (process-output->string
     (list npath "-t" name "-m" body))))

(define (fetch comet-uri pos cid)
  (receive (host path) (host&path comet-uri)
    (receive (code head body)
        (http-get host #`",|path|?s=1&t=,(sys-time)&p=,|pos|&c=,|cid|")
      (let* ((sx (call-with-input-string body (cut read <>)))
             (pos2 (assoc-ref sx 'pos))
             (cid2 (assoc-ref sx 'cid))
             (text (assoc-ref sx 'text)))
        (match text
               [((name (sec mil) body) ...)
                (for-each
                 (cut send-notify (*chaton-config*) <> <>)
                 name body)])
        (fetch comet-uri pos2 cid2)))))

(define (show-help progname)
  (print #`",|progname| [-c conf-file]"))

(define (read-config cfile)
  (let* ((sx (and cfile (call-with-input-file cfile (cut read <>))))
         (url (and sx (assoc-ref sx 'url)))
         (login (and sx (assoc-ref sx 'login)))
         (npath (and sx (assoc-ref sx 'npath)))
         (ipath (and sx (assoc-ref sx 'ipath)))
         (conf (*chaton-config*)))
    (when url (set! (url-of conf) url))
    (when login (set! (login-of conf) login))
    (when npath (set! (npath-of conf) npath))
    (when ipath (set! (ipath-of conf) ipath))
    (*chaton-config* conf)))

(define (main args)
  (let-args (cdr args)
      ((cfile "c|conf=s" => (cut read-config <>))
       (help  "h|help" => (cut show-help <>)))
    (and-let* ((sx (POST (url-of (*chaton-config*))
                         (login-of (*chaton-config*))
                         (list (cons "who" (client-of (*chaton-config*))))))
               (post-uri #?=(assoc-ref sx 'post-uri))
               (comet-uri #?=(assoc-ref sx 'comet-uri))
               (cid (assoc-ref sx 'cid))
               (pos (assoc-ref sx 'pos)))
      (fetch comet-uri pos cid))))

ex. chaton-chaton.conf 

((url . "http://practical-scheme.net/chaton/chaton")
 (login . "http://practical-scheme.net/chaton/chaton/apilogin"))

Gauche:LLRing2006

LL Ring 2006へのネタ出し

あれこれ

セミナーやります。

セミナー終了後に有志で懇親会を開催します。詳しくは party@kahua.org にお問い合わせください。

アプリケーションサーバフレームワーク Kahua セミナー

Kahuaプロジェクトでは、IPAの「オープンソフトウエア活用基盤整備事業」の 支援を受けて、アプリケーションサーバフレームワークKahuaを開発しています。

当セミナーでは、kahuaの基盤となるオープンソースのScheme処理系Gaucheと Kahuaについて、Kahuaの基本コンセプトである 「継続ベースの Web アプリケーション」を中心に据えて、 デモと解説をご覧いただきます。

日時・場所

2004年2月13日(金) 13:30〜16:30 (受付開始 13:00)

東京都文京区本駒込 文京グリーンコート 16階 IPA 第三 第四会議室 (地図)

最寄駅

定員

50名

参加費

無料

講師

プログラム

申し込み期間

2004年2月12日(木)まで (ただし、定員になり次第締め切ります)

参加申し込み

下記の内容を必ずご記入のうえ、 セミナー告知ページの申込フォームで送信するか、 seminar@kahua.orgまでお送りください。

セミナー告知ページ

http://www.kahua.org/cgi-bin/kahua.cgi/kahua-web/show/news/Seminar

お問い合わせ

Kahuaプロジェクト info@kahua.org

Topics
Sponsored Links
Search
Recent Changes
More ...
Last modified : 2013/04/28 22:26:43 UTC
WiLiKi 0.8.3 running on Gauche 0.9.14