DouKaku?

(defpackage #:doukaku-122 (:use #:cl))
(in-package #:doukaku-122)

(defconstant +meiji-end+     396802800)
(defconstant +taisho-start+  +meiji-end+)
(defconstant +taisho-end+    851353200)
(defconstant +showa-start+   +taisho-end+)
(defconstant +showa-end+     2809090800)
(defconstant +heisei-start+  2809177200)
(defconstant +meiji-offset+  1867)
(defconstant +taisho-offset+ 1911)
(defconstant +showa-offset+  1925)
(defconstant +heisei-offset+ 1988)

(defun to-japanese-date (date-string)
  (or (ppcre:register-groups-bind (y m d)
          ("([0-9]{4})/([01]*[0-9])/([0-3]*[0-9])$" date-string)
        (destructuring-bind (y m d) (mapcar #'parse-integer `(,y ,m ,d))
          (when (and (<= y 1868) (<= m 1) (< d 25))
            (return-from to-japanese-date (princ "範囲外")))
          (let ((utime (if (>= y 1900)
                           (encode-universal-time 0 0 0 d m y -9)
                           0))
                gengo toshi)
            (when (<= +heisei-start+ utime)
              (push "平成" gengo)
              (push (- y +heisei-offset+) toshi))
            (when (<= +showa-start+ utime +showa-end+)
              (push "昭和" gengo)
              (push (- y +showa-offset+) toshi))
            (when (<= +taisho-start+ utime +taisho-end+)
              (push "大正" gengo)
              (push (- y +taisho-offset+) toshi))
            (when (<= 0 utime +meiji-end+)
              (push "明治" gengo)
              (push (- y +meiji-offset+) toshi))
            (format nil #'multiple-gengo-print gengo toshi m d))))
      (princ "範囲外")))   ;日付のパターンにマッチしない場合は範囲外

(defun multiple-gengo-print (stream gengo y &rest args)
  (do ((yy y (cdr yy)) (g gengo (cdr g)))
      ((endp g))
    (apply #'format stream "~A~D年~D月~D日" (car g) (car yy) args)
    (and (cdr g) (princ " " stream))))