適当な書き捨て仕事 2011/02/27 — #:g1

Posted 2011-02-26 15:04:00 GMT

やりたいこと

今の職場ではどういうわけか日報的なものがWordPressのブログになっておりここに書くとWordPressのプラグインの機能で社内にメールが飛んでいます。
日報に書いてある研究開発時間の今年度分を纏められないかと言われたのですが、集計すると思ってなかったので、このブログにしかデータがなく、このブログからデータを引っ張ってこなければなりません。
ということで、適当な書き捨て仕事のお題がみつかったのでCommon Lispでやってみます。

使うもの

- CLSQL
-- とりあえす、WordPressは、MySQLにデータが格納されているので、CLSQLでデータを抜き出すことにします。
--- (ql:quickload :clsql)
- Series
-- 今年はLOOPマクロ使用禁止で頑張ってみているので、SeriesかIterateを使うことになります。ということでSeriesです。
--- (ql:quickload :series)
- cl-ppcre
-- もはや常に必須です
--- (ql:quickload :cl-ppcre)
- aprogn
-- オレオレマクロです。

下準備

CLSQLは、リーダーマクロを使うとS式な感じで書けるので、リーダーマクロを使ってみます。とはいえ自分的にCLSQLのリーダーマクロを使うのは初めてだったりします。
Seriesもリーダーマクロを使うと色々良い感じになります
(progn
  (series::set-dispatch-macro-character
   #\# #\Z (cl:function series::series-reader))
  (series::set-dispatch-macro-character
   #\# #\M (cl:function series::abbreviated-map-fn-reader))
  (clsql-sys:enable-sql-reader-syntax))

DBに接続

(progn
  (clsql-sys:connect '("localhost" "log" "***" "***")
                     :database-type :mysql)
  (clsql-sys:execute-command "set character_set_client='utf8'")
  (clsql-sys:execute-command "set character_set_connection='utf8'")
  (clsql-sys:execute-command "set character_set_results='utf8'")  )
文字コードを合せたりなんやり。
(defun foo-all ()
  (aprogn
    (clsql:select [post_date] [post_content] :from [log_wp_posts]
                  :where [= 2 [post_author]])
    ;;
    (mapping (((date text) (#2Mvalues-list (scan it))))
      (let ((date (ppcre:regex-replace " ..:..:.." date ""))
            (rh (ppcre:register-groups-bind ((#'parse-integer hs))
                                            (".*研究開発時間\\D*(\\d+).*" text)
                  hs)))
        (list date rh)))
    ;;
    (collect it)))
適当にREPLで、CLSQLを使って目当てのテーブルを探して該当のものをずらっと抜き出します。
マニュアルのとおりに[post_date]のような記述をしてもさっぱり拾ってこないのですが、中の文字列がシンボルの扱いになっていて、大文字になっているのが原因のようです。
ということで、["post_data"]とか[|post_data|]と書けば回避できるのですが、横道に逸れてCLSQL側を変更します。
眺めてみたところSQL-READER-OPENの中で、READ-DELIMITED-LISTが読み込んでいるようなのでこの関数が読み込みに使うリードテーブルはシンボルを大文字に揃えないように変更。
(defun sql-reader-open (stream char)
  (declare (ignore char))
  (let ((*readtable* (copy-readtable)))
    (setf (readtable-case *readtable*) :preserve)
    (let ((sqllist (read-delimited-list #\] stream t)))
      (unless *read-suppress*
        (handler-case
            (cond ((string= (write-to-string (car sqllist)) "||")
                   (cons (sql-operator 'concat-op) (cdr sqllist)))
                  ((and (= (length sqllist) 1) (eql (car sqllist) '*))
                   (apply #'generate-sql-reference sqllist))
                  ((sql-operator (car sqllist))
                   (cons (sql-operator (car sqllist)) (cdr sqllist)))
                  (t (apply #'generate-sql-reference sqllist)))
          (sql-user-error (c)
            (error 'sql-user-error
                   :message (format nil "Error ~A occured while attempting to parse '~A' at file position ~A"
                                    (sql-user-error-message c) sqllist (file-position stream)))))))))
あまりマニュアルも読んでないし、こういう対策はやっぱりまずいのかなと色々と調べようと思いはじめましたが、仕事が終わらないので引き返し。
とりあえず、ブログの中身に目的の文字列があるのでCL-PPCREで適当に抜き出します。
どんな関数名にして良いのか分からないので名前は適当です。
ここで動作確認
(subseq (foo-all) 100 110)
;=> (("2010-04-16" 3) ("2010-04-19" 2) ("2010-04-19" 3) ("2010-04-19" 3)
;    ("2010-04-20" 3) ("2010-04-20" 2) ("2010-04-20" 3) ("2010-04-21" 4)
;    ("2010-04-21" 3) ("2010-04-21" 2))
まあ良いんではないかと。
次に月ごとに集計する必要があるようなので、上記のデータを月毎に纏めるものを書くことにしました
(defun mtotal (yyyy m)
  (let ((mon1 (format nil "~D-~2,'0D" yyyy m))
        (mon2 (format nil "~D-~2,'0D" yyyy (1+ m))))
    (aprogn
      (scan (foo-all))
      ;;
      (choose-if (f_ (and (string< mon1 (car _))
                          (string> mon2 (car _))))
                 it)
      ;;
      (#Msecond it)
      ;;
      (choose it)
      ;;
      (collect-sum it))))
string<で比較するというかなり強引な方法です。
動作確認
(mtotal 2010 04)
;=> 71
できた後で、これ明かにSQLでやるべきだろうと思いましたが、まあ、もう良いやと。
意味なく表示用の関数を作成
(defun pp-mtotal (yyyy mm)
  (format 'T
          "~&~A-~A月~%研究開発時間: ~A時間~2%"
          yyyy
          mm
          (mtotal yyyy mm)))
(pp-mtotal 2010 4)
;-> 2010-4月
;   研究開発時間: 71時間
;
;=> NIL
いや、CSVでデータを提出した方が良いんじゃないかと。まあ、とりあえず良し。
次に年度を全て表示するものを作成
(defun foo-total (start)
  (format t "~&~V@{~A~:*~}~*~%" 40 "=")
  (aprogn
    (scan-range :from 0 :upto 11)
    ;;
    (#M(lambda (x)
         (let ((m (+ 3 x)))
           (list (if (< 11 m)
                     (1+ start)
                     start)
                 (1+ (mod (+ 3 x) 12)))))
      it)
    ;;
    (#M(lambda (x) (apply #'pp-mtotal x)) it)))
ここで、
(#M(curry #'apply #'pp-mtotal) it)
のように書きたいのに、リーダーマクロの展開で、#'(curry ...)となってしまうために、こういう記述ができないことを発見。
まったく仕事と関係ないですが、Seriesの定義を確認しに行きます。
#Mの次にくるものがコンスだった場合(おそらくlambda式を期待)はfunctionで囲む、となっていました。
Seriesは、CLtL1の時代のものなのでこれはこれで正しいですが、ANSIでは、lambdaマクロにより#'を補えるのと、今回のようなこともあるのでここはfunctionは補わなくても良いだろうということで、改造。
(cl:defun mapit (type fn args)
  (if (not (symbolp fn))
      `(map-fn ',type ,fn ,@ args)      ;シンボルでない場合はfunctionを付けない
    (cl:let ((vars (do ((a args (cdr a))
                        (l nil (cons (gensym "V-") l)))
                       ((null a) (return l)))))
      `(map-fn ',type (function (lambda ,vars (,fn ,@ vars))) ,@ args))))
でも、(#M(setf foo)...)とかには、#'が付かないとまずいよなあ、などと思ったりしましたが、setf関数など使いそうにもないし、横道に逸れすぎるので切り上げます。
(defun foo-total (start)
  (format t "~&~V@{~A~:*~}~*~%" 40 "=")
  (aprogn
    (scan-range :from 0 :upto 11)
    ;;
    (#M(lambda (x)
         (let ((m (+ 3 x)))
           (list (if (< 11 m)
                     (1+ start)
                     start)
                 (1+ (mod (+ 3 x) 12)))))
      it)
    (#M(curry #'apply #'pp-mtotal) it)))
のように書けるようになり、めでたしめでたし。
また、年を跨ぐ処理が面倒だったので適当にやっつけています。SQLで処理してればこんなことないのに。
というように、自分がCommon Lispで書く場合、いかに横道に逸れないかが重要である気がしつつあります。

comments powered by Disqus