Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-02-28

LISP引きこもり生活 (3) はてな日記をCLから更新する

| 18:30 | LISP引きこもり生活 (3) はてな日記をCLから更新する - わだばLisperになる を含むブックマーク はてなブックマーク - LISP引きこもり生活 (3) はてな日記をCLから更新する - わだばLisperになる

ログインシェルをGaucheに変更したら、普通のシェルを呼び出すことが前提の今の自分のEmacsの設定では、Emacs上からのgrepとか色々支障を来たすようになりました。

はてなの日記はSimple Hatenaモードからはてダラを呼び出して更新しているのですが、これもどうやら上手く動かなくなった様子。

ということで、原因を追及するのも良いのですが、CLから日記を更新することにしてみました。

はてな日記用のAPIは公開されていないようなので、適当にHTMLから情報を切り出し。

今のところ投稿することしかできませんが、まあ良しとします。

適当過ぎる作りなので野生味溢れる使用感ですが、いつの日かSimple Hatena Modeから呼び出して更新できるようにしたいところです。

(defpackage :hw
  (:use :cl :drakma :kmrcl))
(in-package :hd)

(declaim (inline sconc))
(defun sconc (&rest args)
  (apply #'concatenate 'string args))

(defun read-password-file (&optional (path (merge-pathnames ".hatena" (user-homedir-pathname))))
  (aif (probe-file path)
       (with-open-file (str it :direction :input)
	 (let ((user-alist (read str nil nil)))
	   (values (cdr (assoc :username user-alist))
		   (cdr (assoc :password user-alist)))))
       (error "初期化ファイル:~~/.hatenaが存在していません。:~A" path)))

(defun login ()
  (let ((cj (make-instance 'cookie-jar)))
    (multiple-value-bind (user password)
	(read-password-file)
      (values cj 
	      (http-request "https://www.hatena.ne.jp/login" 
			    :external-format-in :utf-8 
			    :external-format-out :utf-8
			    :method :post
			    :cookie-jar cj
			    :parameters `(("name" . ,user) 
					  ("password" . ,password)))))))

(defun rkm (cj base-url)        ;rkmってなんだか分からないけど、rkmを取得する
  (aand (nth-value 1
	  (ppcre:scan-to-strings 
	   "rkm.*'(.*)'"
	   (http-request (sconc base-url "/edit") 
			 :external-format-in :utf-8 
			 :external-format-out :utf-8
			 :method :post
			 :cookie-jar cj)))
	(aref it 0)))

(defun today-string ()
  (multiple-value-bind (ig no re d mo y)
      (decode-universal-time (get-universal-time))
    (declare (ignore ig no re))
    (format nil "~D~2,'0D~2,'0D" y mo d)))

(defun post (base-url text cj &optional date)
  (let* ((date (or date (today-string))))
    (ppcre:register-groups-bind (y m d) ("(....)(..)(..)" date)
      (http-request (sconc base-url "/edit") 
		    :external-format-in :utf-8 
		    :external-format-out :utf-8
		    :method :post
		    :cookie-jar cj
		    :parameters 
		    `(("mode" . "enter")
		      ("rkm" . ,(rkm cj base-url))
		      ("date" . ,d)
		      ("trivial" . "0")
		      ("year" . ,y)
		      ("month" . ,m)
		      ("day" . ,d)
		      ("title" . "")
		      ("body" . ,text))))))

(defun file-to-string (file)
  (format nil "~{~A~^~%~}" 
	  (series:collect 
	    (series:scan-file file #'read-line))))

;; 使い方
(setq base-url "http://cadr.g.hatena.ne.jp/g000001")
(setq *cj* (login))			;ログインして、cookie jarにクッキー保存

; ポスト
(post base-url (file-to-string "/home/g000001/hatena/g000001/group/cadr/2008-02-28.txt")
      *cj*)