[Java] S2Hibernate-JPA を試してみた

仕事の調査で S2Hibernate-JPA を試してみました。
簡単なケースではエンティティの POJO を作って Entity アノテーション と Id アノテーション をつけるだけでおしまいです。ActiveRecord ほどではありませんが、なかなか簡単です。
Java 的にはクエリのパラメータに ? ではなく :name のように名前を付けられのが嬉しいところです。

カーソルをオープンして1レコードずつフェッチする的な処理をできる Dao がなかなかないのですが、Hibernate のネイティブ ScrollableResults を使ってそれを実現できるのは貴重です。
JPA で足りないところを Hibernate ネイティブの機能でおぎなえる、なかなか使えるような気がします。

create table bano (id int primary key, name varchar(20));
create table ba_bi (ba_id ind primary key, bi_name varchar(20));

package com.ms246.gpy1.dao;

import javax.persistence.Entity;
import javax.persistence.Id;
import javax.persistence.Table;

@Entity
public class Bano {
    @Id
    private int id;
    private String name;
    public int getId() {
        return id;
    }
    public void setId(int id) {
        this.id = id;
    }
    public String getName() {
        return name;
    }
    public void setName(String name) {
        this.name = name;
    }
}

package com.ms246.gpy1.dao;

import javax.persistence.Entity;
import javax.persistence.Id;

@Entity
public class BaBi {
    @Id
    private int baId;
    private String biName;
    public int getBaId() {
        return baId;
    }
    public void setBaId(int baId) {
        this.baId = baId;
    }
    public String getBiName() {
        return biName;
    }
    public void setBiName(String biName) {
        this.biName = biName;
    }
}

package com.ms246.gpy1;

import java.util.List;

import javax.persistence.EntityManager;
import javax.persistence.Query;

import org.hibernate.ScrollableResults;
import org.hibernate.ejb.HibernateQuery;
import org.seasar.extension.unit.S2TestCase;

import com.ms246.gpy1.dao.BaBi;
import com.ms246.gpy1.dao.Bano;

public class Aaa extends S2TestCase {

    private EntityManager em;

    public Aaa(String name) {
        super(name);
    }

    protected void setUp() throws Exception {
        include("jpa.dicon");
    }

    protected void tearDown() throws Exception {
    }

    public void testBanoTx() {
        // インサートとプライマリキーでのセレクト
        for (int i = 0; i < 10; ++i) {
            Bano bano = new Bano();
            String name = "ひつじ" + i + "号";
            bano.setId(i);
            bano.setName(name);
            em.persist(bano);
            bano = em.find(Bano.class, i);
            assertEquals(name, bano.getName());
        }
        // 該当レコードがない場合
        assertNull(em.find(Bano.class, 100));

        // Hibernate ネイティブの ScrollableResults を使う。
        Query query = em.createQuery("select ba from Bano ba order by ba.id");
        ScrollableResults results = ((HibernateQuery) query)
                .getHibernateQuery().scroll();
        for (int i = 0; results.next(); ++i) {
            Bano bano = (Bano) results.get(0);
            assertEquals("ひつじ" + i + "号", bano.getName());
        }
        results.close();

        // EJB-QL
        query = em
                .createQuery("select ba from Bano ba where ba.id > :id order by ba.id");
        query.setParameter("id", 7);
        List<Bano> list = query.getResultList();
        assertEquals(2, list.size());
        assertEquals("ひつじ8号", list.get(0).getName());
        assertEquals("ひつじ9号", list.get(1).getName());

        // ネイティブクエリ
        query = em.createNativeQuery("select * from Bano where name = :name",
                Bano.class);
        query.setParameter("name", "ひつじ2号");
        assertEquals(2, ((Bano)query.getSingleResult()).getId());
    }

    public void testBaBiTx() {
        // アンダーバーのあるテーブル名、カラム名もOK
        BaBi baBi = new BaBi();
        baBi.setBaId(2);
        baBi.setBiName("ばああ");
        em.persist(baBi);
    }
}

その後の感想。
複合主キーの場合、主キー用のクラスが必要になるのがどうにもやっかいです。
S2Jdbc で1件ずつフェッチできれば、それで決定なのになぁ。

[Emacs] howm で Muse を使う設定

Muse を使おうかと思いました。
となると、howm で Muse を使いたくなります。
その設定が次のものです。
ポイントは howm-view-title-header に Muse のディレクティブである "#title" を指定することです。
~/.emacs

;;;;; howm
(setq howm-directory "~/letter/howm/")
(setq howm-menu-lang 'ja)
(setq howm-list-recent-title t)
(setq howm-list-all-title t)
(setq howm-view-title-header "#title")  ; Muse のディレクティブにする
(require 'howm)

;;;; Muse
(require 'muse-mode)
(require 'muse-html)
(require 'muse-latex)
(require 'muse-texinfo)
(require 'muse-docbook)
(require 'muse-project)
(rplacd (assoc "\\.howm$" auto-mode-alist) 'muse-mode)

Trac のインストール

Trac を使ってみようかな、と思いました。
Trac のインストールとセットアップのメモです。一緒に Subversion もセットアップしました。

パッケージのインストール

Debian なので apt-get 等で必要なパッケージをインストールします。

sudo apt-get install trac trac-ja-resource libapache2-mod-python subversion libapache2-svn

Subversion のリポジトリ作成

Apache がアクセスできるようにオーナを www-data に変更します。

cd /var/lib
sudo mkdir svn
sudo chown -R www-data:www-data svn
cd svn
sudo -u www-data svnadmin create test-repo1

dav_svn.conf の設定

sudo vi /etc/apache2/mods-available/dav_svn.conf
基本的のコメントを外すだけ。閲覧にも認証が必要にしておきます。

# dav_svn.conf - Example Subversion/Apache configuration
#
# For details and further options see the Apache user manual and
# the Subversion book.
#
# NOTE: for a setup with multiple vhosts, you will want to do this
# configuration in /etc/apache2/sites-available/*, not here.

# <Location URL> ... </Location>
# URL controls how the repository appears to the outside world.
# In this example clients access the repository as http://hostname/svn/
# Note, a literal /svn should NOT exist in your document root.
<Location /svn>

  # Uncomment this to enable the repository
  DAV svn

  # Set this to the path to your repository
  #SVNPath /var/lib/svn
  # Alternatively, use SVNParentPath if you have multiple repositories under
  # under a single directory (/var/lib/svn/repo1, /var/lib/svn/repo2, ...).
  # You need either SVNPath and SVNParentPath, but not both.
  SVNParentPath /var/lib/svn

  # Access control is done at 3 levels: (1) Apache authentication, via
  # any of several methods.  A "Basic Auth" section is commented out
  # below.  (2) Apache <Limit> and <LimitExcept>, also commented out
  # below.  (3) mod_authz_svn is a svn-specific authorization module
  # which offers fine-grained read/write access control for paths
  # within a repository.  (The first two layers are coarse-grained; you
  # can only enable/disable access to an entire repository.)  Note that
  # mod_authz_svn is noticeably slower than the other two layers, so if
  # you don't need the fine-grained control, don't configure it.

  # Basic Authentication is repository-wide.  It is not secure unless
  # you are using https.  See the 'htpasswd' command to create and
  # manage the password file - and the documentation for the
  # 'auth_basic' and 'authn_file' modules, which you will need for this
  # (enable them with 'a2enmod').
  AuthType Basic
  AuthName "Subversion Repository"
  AuthUserFile /etc/apache2/dav_svn.passwd

  # To enable authorization via mod_authz_svn
  AuthzSVNAccessFile /etc/apache2/dav_svn.authz

  # The following three lines allow anonymous read, but make
  # committers authenticate themselves.  It requires the 'authz_user'
  # module (enable it with 'a2enmod').
  #<LimitExcept GET PROPFIND OPTIONS REPORT>
  Require valid-user
  #</LimitExcept>

</Location>

dav_svn.passwd の作成

Subversion と Trac の両方で使用するユーザとパスワードのファイルを作成します。
sudo htpasswd -bc /etc/apache2/dav_svn.passwd user1 password
sudo htpasswd -b /etc/apache2/dav_svn.passwd user2 password

dav_svn.authz の作成

このファイルにより Subversion のディレクトリ単位でのアクセス制御が可能になります。
sudo vi /etc/apache2/dav_svn.authz

[groups]
group1 = user1,user2

[/]
* =

[test-repo1:/]
@group1 = rw

Trac のプロジェクト作成と設定

プロジェクトを作成します。
sudo mkdir /var/lib/trac
sudo chown www-data:www-data -R trac
sudo -u www-data trac-admin /var/lib/trac/test-proj1 initenv
Templates directory に日本語リソースのパスを指定します。

/var/lib% sudo -u www-data trac-admin /var/lib/trac/test-proj1 initenv
Creating a new Trac environment at /var/lib/trac/test-proj1

Trac will first ask a few questions about your environment 
in order to initalize and prepare the project database.

 Please enter the name of your project.
 This name will be used in page titles and descriptions.

Project Name [My Project]> Test Project1

 Please specify the connection string for the database to use.
 By default, a local SQLite database is created in the environment 
 directory. It is also possible to use an already existing 
 PostgreSQL database (check the Trac documentation for the exact 
 connection string syntax).

Database connection string [sqlite:db/trac.db]> 

 Please specify the type of version control system,
 By default, it will be svn.

 If you don't want to use Trac with version control integration, 
 choose the default here and don't specify a repository directory. 
 in the next question.

Repository type [svn]> 

 Please specify the absolute path to the version control 
 repository, or leave it blank to use Trac without a repository.
 You can also set the repository location later.

Path to repository [/path/to/repos]> /var/lib/svn/test-repo1

 Please enter location of Trac page templates.
 Default is the location of the site-wide templates installed with Trac.

Templates directory [/usr/share/trac/templates]> /usr/share/trac-ja-resource/templates

Creating and Initializing Project
 Installing default wiki pages
 /usr/share/trac/wiki-default/TracInterfaceCustomization => TracInterfaceCustomization
 （中略）
 /usr/share/trac/wiki-default/TracAccessibility => TracAccessibility
 Indexing repository
 [2]
---------------------------------------------------------------------
Project environment for 'Test Project1' created.

You may now configure the environment by editing the file:

  /var/lib/trac/test-proj1/conf/trac.ini

If you'd like to take this new project environment for a test drive,
try running the Trac standalone web server `tracd`:

  tracd --port 8000 /var/lib/trac/test-proj1

Then point your browser to http://localhost:8000/test-proj1.
There you can also browse the documentation for your installed
version of Trac, including information on further setup (such as
deploying Trac to a real web server).

The latest documentation can also always be found on the project
website:

  http://trac.edgewall.org/

Congratulations!

Wiki の日本語リソースの設定を行います。
sudo -u www-data trac-admin /var/lib/trac/test-proj1 wiki load /usr/share/trac-ja-resource/wiki-default

Apache の設定を行います。
sudo vi /etc/apache2/sites-available/trac

<Location /projects>
  SetHandler mod_python
  PythonHandler trac.web.modpython_frontend
  PythonOption TracUriRoot /projects
  PythonOption TracEnvParentDir "/var/lib/trac"
</Location>

<LocationMatch /projects/[^/]+/login>
  AuthType Basic
  AuthName "Trac"
  AuthUserFile /etc/apache2/dav_svn.passwd
  Require valid-user
</LocationMatch>

sudo a2ensite trac
sudo /etc/init.d/apache2 reload

Trac の権限設定

ログイン前は anonymous 権限です。
ログインすると authenticated グループに所属します。
authenticated は anonymous からパーミッションを継承します。
任意のグループを作成することができ、ユーザ単位、グループ単位の権限管理が可能です。
ここでは anonymous から作成・編集の権限を削除し、authenticated に全権限を付与します。

anonymous によるチケットの作成編集、wiki の作成編集を禁止します。
sudo -u www-data trac-admin /var/lib/trac/test-proj1 permission remove anonymous TICKET_CREATE TICKET_MODIFY WIKI_CREATE WIKI_MODIFY

認証済ユーザに管理者権限を付与します。
sudo -u www-data trac-admin /var/lib/trac/test-proj1 permission add authenticated TRAC_ADMIN

チケットのプロパティのカスタマイズ

チケットの種類、プライオリティ、コンポーネント、バージョン をカスタマイズします。
チケット登録時のプルダウンに反映されます。

種類を「defect:不具合」と「task:タスク」に。
sudo -u www-data trac-admin /var/lib/trac/test-proj1 ticket_type remove enhancement
sudo -u www-data trac-admin /var/lib/trac/test-proj1 ticket_type change defect defect:不具合
sudo -u www-data trac-admin /var/lib/trac/test-proj1 ticket_type change task task:タスク

プライオリティに日本語表記を追加
sudo -u www-data trac-admin /var/lib/trac/test-proj1 priority change blocker blocker:最優先
sudo -u www-data trac-admin /var/lib/trac/test-proj1 priority change critical critical:高
sudo -u www-data trac-admin /var/lib/trac/test-proj1 priority change major major:中
sudo -u www-data trac-admin /var/lib/trac/test-proj1 priority change minor minor:低
sudo -u www-data trac-admin /var/lib/trac/test-proj1 priority change trivial trivial:微

コンポーネントを「基本設計」を「プロトタイプ」に
sudo -u www-data trac-admin /var/lib/trac/test-proj1 component remove component1
sudo -u www-data trac-admin /var/lib/trac/test-proj1 component remove component2
sudo -u www-data trac-admin /var/lib/trac/test-proj1 component add 基本設計 somebody
sudo -u www-data trac-admin /var/lib/trac/test-proj1 component add プロトタイプ somebody

バージョンから「2.0」を削除
sudo -u www-data trac-admin /var/lib/trac/test-proj1 version remove 2.0

次のコマンドで対話環境が開始されます。カスタマイズを行うときに便利かもしれません。
sudo -u www-data trac-admin /var/lib/trac/test-proj1

チケット登録のデフォルト値の設定

チケット登録画面のプルダウン項目のデフォルト値の設定と、担当者（Asign to）をプルダウンに変更する設定を行います。
trac.ini の [ticket] セクションでカスタマイズします。
sudo -u www-data vi /var/lib/trac/test-proj1/conf/trac.ini

[ticket]
default_component = 基本設計
default_milestone = 基本設計書
default_priority = major:中
default_type = task:タスク
default_version = 1.0
restrict_owner = true

[components]
trac.ticket.report.* = disabled

あと、メール送信の設定も trac.ini の中で行うことになりますが、今回はここまで。

給与

給与がかわりました。
いつのまにか管理監督者になったということで残業代がつかなくなり、そのかわりに手当が数万つきます。
でも、よくよく確認したら基本給が36,200円も下がっていました。
計算してみると月13時間以上の残業をした場合、前の給与の方が支給額が多くなります。
残業0で増えた金額は33,800円です。
次からこうなるよ、と言われただけで、同意を求めらることはありませんでした。
これって不利益変更じゃないのかしか？
それとも合理性のある賃金制度の改訂？

残業代が出なくなったけど手当が出る、というようなことを説明してくれなかったけど、もうタイムカードはうたなくてもいいんだよね？

なんにしろ話し合う必要がありそうです。

[Common Lisp] Common Lisp で DI コンテナ

仕事で Java の DI コンテナ（Seasar と Spring）を調べています。
DI って悪くない、と思いました。
ということで、ちょっと Common Lisp でも DI をやってみようかと思います。
Java の DI では定義ファイルは XML ですが、Common Lisp ならやはり S 式です。
S 式なら Seasar の定義ファイルの components, component タグ相当をマクロにしてしまえば、S2ContainerFactory.create("app.dicon") は (load "app") とロードするだけでおしまいになります。
簡単な DI コンテナの機能なら、DI コンテナを実装するというより、定義ファイル用のマクロを実装するだけになります。
また 定義ファイル = ソースコード となるのでコンパイルしておくこともできます。
こういうときはマクロは最高です。
とりあえず、コンストラクタインジェクションと、セッターインジェクションのかわりのスロットインジェクションを実装してみました。
自動バインディング等はなし、コンポーネントの取得は name による取得のみです。

DI コンテナの実装、というよりもむしろ定義ファイルのマクロの実装: di.lisp

(defpackage :di
  (:use :cl)
  (:export :components
           :component
           :ref
           :get-component))

(in-package :di)

(defvar *components* (make-hash-table)
  "生成したコンポーネントを登録しておくテーブル。")

(defmacro components (&body body)
  "上から順番にインスタンスを生成し、最後にまとめてスロットインジェクションを行う。"
  `(dolist (f (list ,@body))
     (when f (funcall f))))

(defmacro component (&key class (name class) initargs slots
                     (instance :singleton))
  "make-instance でインスタンスを作成して *components* に登録する。
slot への値設定は他のオブジェクトの参照を含んでいても大丈夫なように lambda でくるんで返し、
後で実行する。"
  (let ((self (gensym)))
    (if (eq instance :singleton)
        `(let ((,self (setf (gethash ',name *components*)
                            (make-instance ',class ,@initargs))))
           #'(lambda ()
               ,@(loop for (name value) on slots by #'cddr
                    collect `(setf (slot-value ,self ',name) ,value))
               ,self))
        `(progn (setf (gethash ',name *components*)
                      #'(lambda ()
                          (let ((,self (make-instance ',class ,@initargs)))
                            ,@(loop for (name value) on slots by #'cddr
                                 collect `(setf (slot-value ,self ',name)
                                                ,value))
                            ,self)))
                nil))))

(defmacro ref (name)
  "他のインスタンスの参照。"
  `(let ((object-or-function (gethash ,name *components*)))
     (typecase object-or-function
       (function (funcall object-or-function))
       (t object-or-function))))

(defun get-component (name)
  "name での取得のみサポート"
  (ref name))

サンプル定義ファイル: app.lisp

(in-package :di-test)

(components
 (component :name :f1 :class foo)
 (component :name :f2 :class foo :initargs (:foo-slot1 "Hello" :foo-slot2 2))
 (component :name :b1 :class bar :initargs (:bar-slot1 "ばあ" :bar-slot2 8))
 (component :name :f3 :class foo :initargs (:foo-slot1 (ref :b1)))
 (component :name :f4 :class foo
            :slots (foo-slot1 "まみむめも"
                    foo-slot2 (ref :b2)))
 (component :name :b2 :class bar
            :slots (bar-slot1 "ばあ2" bar-slot2 2))
 (component :name :f5 :class foo :instance :prototype
            :slots (foo-slot1 :prototype foo-slot2 :singleton))
 )

テストコード: di-test.lisp

(defpackage :di-test
  (:use :cl :di))

(in-package :di-test)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :ptester))

(defclass foo ()
  ((foo-slot1 :accessor foo-slot1 :initarg :foo-slot1)
   (foo-slot2 :accessor foo-slot2 :initarg :foo-slot2)))

(defclass bar ()
  ((bar-slot1 :accessor bar-slot1 :initarg :bar-slot1)
   (bar-slot2 :accessor bar-slot2 :initarg :bar-slot2)))


;; components, component はマクロになっているのでロードしてしまう。
(load "app")

(ptester:with-tests ()
  ;; 単純なオブジェクト生成。
  (let ((f1 (get-component :f1)))
    (ptester:test nil (null f1)))
  ;; コンストラクタインジェクション。
  (let ((f2 (get-component :f2)))
    (ptester:test "Hello" (foo-slot1 f2) :test #'string=)
    (ptester:test 2 (foo-slot2 f2)))
  ;; 他のオブジェクトを引数にしたコンストラクタインジェクション。
  (let ((f3 (get-component :f3)))
    (ptester:test "ばあ" (bar-slot1 (foo-slot1 f3)) :test #'string=))
  ;; プロパティインジェクションではなくスロットインジェクション。
  (let ((f4 (get-component :f4)))
    (ptester:test "まみむめも" (foo-slot1 f4) :test #'string=)
    (ptester:test "ばあ2" (bar-slot1 (foo-slot2 f4)) :test #'string=))
  ;; instance のテスト
  (let ((f1 (get-component :f1))
        (f2 (get-component :f1))
        (f3 (get-component :f5))
        (f4 (get-component :f5)))
    (ptester:test t (eq f1 f2))
    (ptester:test nil (eq f3 f4))
    (ptester:test :prototype (foo-slot1 f3))
    (ptester:test :singleton (foo-slot2 f4)))
  )

Common Lisp のマクロって素敵じゃありませんか？

Debian に VMware Player を インストールする

Debian に VMware Player を インストールしたときのメモです。

sudo apt-get install vmware-package
Download VMware-player-2.0.1-55017.x86_64.tar.gz
make-vmpkg VMware-player-2.0.1-55017.x86_64.tar.gz
cd vmware-player
sudo dpkg -i *.deb
sudo m-a build --force vmware-kernel
sudo m-a install --force vmware-kernel
sudo dpkg -i *.deb

でも Browser Appliance を起動したら OS ごとかたまってしまいました。
何かたりないのかも。。。

[Common Lisp] condition のクラス階層

Common Lisp のコンディションシステムでは全てのコンディションは condition クラスを継承します。
どんなクラスがあらかじめ定義されているか調べてみようと思います。
サブクラスは sb-mop:class-direct-subclasses で取得できます。
今回は common-lisp パッケージのクラスだけに限定します。
表示は cl-dot を使用して condition のクラス階層のグラフを作成してみます。
cl-dot は dot コマンドを使用するため Graphviz をインストールしておく必要があります。
以下のコードで condition クラスを頂点としたクラス階層が表示されます。
表示には evince を使用しています。また後の方は日本語とテストなので気にしないでください。
画像にして表示してみると面白いです。

(require :cl-dot)

(defmethod cl-dot:object-node ((object class))
  (make-instance 'cl-dot:node
                 :attributes (list :label (class-name object)
                                   :shape :box
                                   :fontname "Arial")))

(defmethod cl-dot:object-points-to ((object class))
  (loop for each in (sb-mop:class-direct-subclasses object)
     if (eq (find-package :common-lisp)
            (symbol-package (class-name each)))
     collect each))

(defun my-dot-graph (graph outfile &optional (format (pathname-type outfile)))
  "cl-dot:dot-graph を出力ファイルの拡張子に合せたフォーマットを使うようにしたもの。
データをファイル経由で dot に渡すようにして日本語が出力できるようにした。"
  (let ((dot-file (make-pathname :defaults outfile :type "dot")))
    (with-open-file (out dot-file
                         :direction :output
                         :if-exists :supersede
                         :external-format :utf-8)
      (cl-dot:print-graph graph out))
    (sb-ext:run-program cl-dot:*dot-path*
                        (list (format nil "-T~a" format) "-o" outfile)
                        :input dot-file
                        :output *standard-output*)))

(let ((file "/tmp/condition.png"))
  (my-dot-graph (cl-dot:generate-graph (find-class 'condition)) file)
  (asdf:run-shell-command (format nil "evince ~a" file)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 日本語のテスト
(defclass ばの () ())

(defclass びの (ばの) ())

(defclass がの (ばの) ())

(defclass なの (びの がの) ())

(defmethod cl-dot:object-points-to ((object class))
  (sb-mop:class-direct-subclasses object))

(let ((file "/tmp/jp.pdf"))
  (my-dot-graph (cl-dot:generate-graph (find-class 'ばの)) file)
  (asdf:run-shell-command (format nil "evince ~a" file)))

それにしても、cl-dot の API は Common Lisp らしいです。おもしろい。