SKK の人名辞書ファイルから架空の氏名を生成する fake-full-name.el

fake-full-name.el

;;; fake-full-name.el -- SKK の人名辞書ファイルから架空の氏名を生成する

;; MAHALO License (based on MIT License)
;;
;; Copyright (c) 2012 Wataru MIYAGUNI (gonngo _at_ gmail.com)
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; 1. The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;; 2. Shall be grateful for something (including, but not limited this software).
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;; THE SOFTWARE.

;;; Usage:
;;
;; (require 'fake-full-name)
;;
;; 人名を生成します
;;
;; (ffn:generate)
;;
;; ffn:generate を実行する度に次の人名を生成します
;;
;;  ※ 初回実行時に人名リストを構築するため、少し時間がかかります。
;;     二回目以降はキャッシュを利用するので速いです多分。
;;
;; (ffn:generate) ;; => "中渓 文我"
;; (ffn:kana)     ;; => "なかたに ぶんが"
;; (ffn:kanji)    ;; => "中渓 文我"
;;
;; (ffn:generate)    ;; => "栃本 奈美江"
;; (ffn:kana)        ;; => "とちもと なみえ"
;; (ffn:kanji)       ;; => "栃本 奈美江"
;; (ffn:last-kana)   ;; => "とちもと"
;; (ffn:first-kana)  ;; => "なみえ"
;; (ffn:last-kanji)  ;; => "栃本"
;; (ffn:first-kanji) ;; => "奈美江"
;;

(eval-when-compile (require 'cl))

(defconst ffn:dic-uri "http://openlab.jp/skk/skk/dic/SKK-JISYO.jinmei"
  "人名辞書 for SKK の URI")

(defconst ffn:dic-buffer "*FakeFullName*"
  "`ffn:dic-uri' のバッファ")

(defconst ffn:idx-last-kanji  0)
(defconst ffn:idx-first-kanji 1)
(defconst ffn:idx-last-kana   2)
(defconst ffn:idx-first-kana  3)

(defvar ffn:cache [nil nil nil nil]
  "生成した人名オブジェクト")

(defvar ffn:first-cache '()
  "名オブジェクト")

(defvar ffn:last-cache '()
  "姓オブジェクト")

(defun ffn:http-get (url buffer)
  (ignore-errors (kill-buffer buffer))
  (let ((coding-system-for-read 'euc-japan))
    (call-process "curl" nil `(,buffer nil) nil
                  "-f"
                  "-X" "GET"
                  url)))

(defun ffn:http-get-response (func)
  (let ((buffer ffn:dic-buffer))
    (ffn:http-get ffn:dic-uri buffer)
    (save-current-buffer
      (set-buffer buffer)
      (goto-char (point-min))
      (funcall func))))

(defun ffn:make-kanji-list (str)
  (mapcar
   (lambda (info)
     (let ((info-list (split-string info ";"))
           ret)
       (setq ret (list :class (cadr info-list) :kanji (car info-list)))))
   (split-string str "/")))

(defun ffn:make-cache ()
  (setq ffn:first-cache '()
        ffn:last-cache  '())
  (ffn:http-get-response
   (lambda ()
     (dolist (line (split-string (buffer-string) "\n"))
       (when (string-match "^\\(.*\\) /\\(.*\\)/$" line)
         (let (kana kanji)
           (setq kana (match-string 1 line))
           (dolist (info (ffn:make-kanji-list (match-string 2 line)))
             (cond ((string= (plist-get info :class) "名")
                    (push (cons kana (plist-get info :kanji)) ffn:first-cache))
                   ((string= (plist-get info :class) "姓")
                    (push (cons kana (plist-get info :kanji)) ffn:last-cache))
                   ))
           ))
     ))))

(defun ffn:generate ()
  (unless (> (length ffn:first-cache) 0)
    (ffn:make-cache))
  (let (first last)
    (setq first (nth (random (length ffn:first-cache)) ffn:first-cache))
    (setq last (nth (random (length ffn:last-cache)) ffn:last-cache))
    (aset ffn:cache ffn:idx-last-kana (car last))
    (aset ffn:cache ffn:idx-last-kanji (cdr last))
    (aset ffn:cache ffn:idx-first-kana (car first))
    (aset ffn:cache ffn:idx-first-kanji (cdr first)))
  (ffn:kanji))

(defun ffn:kanji ()
  "漢字氏名を返す"
  (concat (ffn:last-kanji) " " (ffn:first-kanji)))

(defun ffn:kana ()
  "かな氏名を返す"
  (concat (ffn:last-kana) " " (ffn:first-kana)))

(defun ffn:first-kanji ()
  "漢字名を返す"
  (aref ffn:cache ffn:idx-first-kanji))

(defun ffn:last-kanji ()
  "漢字姓を返す"
  (aref ffn:cache ffn:idx-last-kanji))

(defun ffn:first-kana ()
  "かな名を返す"
  (aref ffn:cache ffn:idx-first-kana))

(defun ffn:last-kana ()
  "かな姓を返す"
  (aref ffn:cache ffn:idx-last-kana))

(provide 'fake-full-name)