Top > MyPage
 

Visitorパターン、再帰、そしてTree::SimpleとTree::Simple::Visitor

Visitorパターン

Visitorパターンは、なかなか理解できませんでした(今も危ないかもしれません。したがって、何か間違っていることも書いているかもしれませんので、その場合はすみません)。

このVisitorパターンは複雑なデータ構造の時に威力を発揮するためか、どうしてもディレクトリー構造などの例が多く、Visitorパターンの本質とは関係のない「再帰」などと一緒に出てくるので、理解しづらいのだと思います。

なので、思いっきりシンプルに言い切ってしまうと、

データを保持しているクラスにそのデータなどの加工などをするメソッドをそのクラス自身に書くのではなく、別のクラスを用意して、それにさせてしまおう!

というのがVisitorパターンと言えそうです。

また、型が存在したり、Interfaceで実装を強要したり、或いは多重定義が可能なJavaなどでは、クラスが複雑になりがちですが、Perlでは単純にいきそうです

下の例を見てみましょう。

package DUM::App::BBS::Datum;
use warnings;
use strict;
use Carp;
use Class::Std;
use version; our $VERSION = qv('0.0.1');
{
    my %content : ATTR( :set<content> :get<content> :init_arg<content>);
    sub accept {
        my $this    = shift;
        my $visitor = shift;
        $visitor->visit($this);

    }
}

package DUM::App::BBS::VisitorEnglish;
use warnings;
use strict;
use Carp;
use Class::Std;
use version;
our $VERSION = qv('0.0.1');
{

    sub visit {
        my $this    = shift;
        my $element = shift;
        my $content = $element->get_content();
        print "Hello ${content}!\n";
    }
}

package DUM::App::BBS::VisitorJapanese;
use warnings;
use strict;
use Carp;
use Class::Std;
use version;
our $VERSION = qv('0.0.1');
{

    sub visit {
        my $this    = shift;
        my $element = shift;
        my $content = $element->get_content();
        print "こんにちは、${content}!\n";
    }
}

package main;

my $c = DUM::App::BBS::Datum->new( { content => 'Sakai' } );
my $visitorE = DUM::App::BBS::VisitorEnglish->new();
$c->accept($visitorE);
my $visitorJ = DUM::App::BBS::VisitorJapanese->new();
$c->accept($visitorJ);

1;

これを実行すると

Hello Sakai!
こんにちは、Sakai!

と表示されます。

この例では、DUM::App::BBS::Datumというデータを保持するクラスは、単純にcontentという(実際には名前を格納していますが)データを保持するクラスが、入れ物(単純なデータ構造で通常Elementと言われる)で、残りのDUM::App::BBS::VisitorEnglishDUM::App::BBS::VisitorJapaneseがVisitorクラスです。

普通だったら、DUM::App::BBS::Datumにメソッドを作って、

Hello Sakai!
こんにちは、Sakai!

と表示させようというのが人情ですが、今回はそのメソッドを別のクラスが受け持ちます。もちろん、それがDUM::App::BBS::VisitorEnglishDUM::App::BBS::VisitorJapanesevisitというメソッドです。

もう少し詳しく述べると、DUM::App::BBS::Datumのソースの

$visitor->visit($this);

が、大事なポイントです。訪れてきたVisitor、つまりmainの

$c->accept($visitorE);

でデータ保持クラスであるDUM::App::BBS::Datumに訪問者(Visitor)を受け入れさせるのですが、そこで、その訪問者に対して自分を引数にvisitというメソッドを実行するところがミソなわけです。

つまり、Visitorはデータのインスタンスをもらって、そのデータを元になんらかの処理をするというわけです(ここでは単にHelloとprintするだけ)。

シーケンス図にすると(合ってないかも?)

単純なvisitorパターン

という感じでしょうか。

じゃあ、「そんな面倒なことをやる必要があるの?」と言われれば、ケースバイケースとしか言いようがありません。少なくとも、上記のような単純な例では導入する必要は全くないですね。

だから、デザインパターンの本ではもう少し複雑なデータ構造のデータクラスを扱っているわけですが、その複雑なデータ構造は、Visitorパターンの本質ではなく、繰り返しですがデータを保持するクラスに処理をさせるのではなく、別のクラスにさせるというのがことの本質です。

じゃあ、どんなメリットが得られるかというと、同じデータ構造に対して、処理を色々と変えていきたい(或いは処理を変更する可能性や、追加する可能性がある)場合、データクラスの方は変更せず、Visitorクラスの方を変えればよいということでしょう。

さて、じゃあ、もう少しメリットが享受できそうな例を見ましょう。

BBSのスレッド表示

具体的な例として、BBSのスレッド表示について考え見ましょう。

木構造

木構造は次の図のようなものを言います。

一般的な木構造

BBSのスレッドでは、ルートがあって、それから枝葉が出ているというのとちょっと違いますが、ルートを仮想のものとして(発展性としてはBBSの種類を表すとすれば)、その最初の子供が通常の「最初の発言」で、それにレスが付いて、さらにそのレスにレスが付いて・・・・というようになっていくので、一種の木構造をしたデータ構造ということにすると考えやすいと思うので、これで考えていって見ましょう。

BBSのデータ

「発言番号,発言のタイトル,発言」という3つのデータを持つ単純な発言データを想定します。データ自体を作成するクラスもいずれ各必要がありますが、話が複雑になるので、まずはそのようなデータを格納するクラスを作り、そのデータ自体は手動で作成することにします。

さて、まずはデータを保持するクラスです。

DUM::App::BBS::Data

package DUM::App::BBS::Data;

use warnings;
use strict;
use Carp;
use Class::Std;
use version; our $VERSION = qv('0.0.1');
use constant ROOT => 0;

{
    my %content : ATTR( :name<content>);
    my %title : ATTR( :name<title>);
    my %key : ATTR( :name<key>);
    my %hierarchy : ATTR( :set<hierarchy> :get<hierarchy>);
    my %children : ATTR( :set<children> :get<children>);

    sub BUILD {
        my ( $self, $id, $arg_ref ) = @_;
        if ( $arg_ref->{key} == 0 ) {
            $hierarchy{$id} = 0;
        }
    }

    sub add {
        my $this  = shift;
        my $id    = ident($this);
        my $child = shift;
        my $hi    = $hierarchy{$id};
        $hi++;
        $child->set_hierarchy($hi);
        push( @{ $children{$id} }, $child );
    }

}

1;

前回のとどこが違うかというと、BBSのデータに併せてタイトルとキーを追加したのと、階層を表すhierarchyを追加し、さらに、自分の発言に対するレス(子供)を追加するメソッドを増やしました。また子供を追加するときに階層をインクリメントしています。さらにまだVisitorパターンにしていないのでacceptメソッドが実装されていません。

これを利用してデータ構造を作っていくと

package main;
use Data::Dumper;
my $root = DUM::App::BBS::Data->new(
    {   key     => DUM::App::BBS::Data->ROOT,
        title   => "実験BBS",
        content => "実験BBS開催",
    }
);

my $remark = DUM::App::BBS::Data->new(
    {   key   => 1,
        title => "おばんです。",
        content =>
            "いやあ、最近は忙しくてかなわんですね。\nでも、頑張っていきましょう。",
    }
);

$root->add($remark);

my $remark2 = DUM::App::BBS::Data->new(
    {   key     => 2,
        title   => "ブラッド+は面白い!",
        content => "小夜は悩みすぎだけど、一途な感じがとっても良いなあ。",
    }
);

$root->add($remark2);

my $remark3 = DUM::App::BBS::Data->new(
    {   key     => 3,
        title   => "Re おばんです。",
        content => "了解しました。",
    }
);

$remark->add($remark3);

my $remark4 = DUM::App::BBS::Data->new(
    {   key     => 4,
        title   => "Re おばんです。",
        content => "でもね、時には休まなきゃ。",
    }
);

$remark->add($remark4);

my $remark5 = DUM::App::BBS::Data->new(
    {   key   => 5,
        title => "Re Re おばんです。",
        content =>
            "そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・",
    }
);

$remark4->add($remark5);

my $children = $root->get_children();

foreach my $c (@$children) {
    print $c->get_title, "\n";
    if ( my $cs = $c->get_children ) {
        foreach my $cc (@$cs) {
            print "  --", $cc->get_title, "\n";
        }
    }
}

という感じでしょうか。出力は

おばんです。
  --Re おばんです。
  --Re おばんです。
ブラッド+は面白い!

と出力されます。相当冗長にやっていますが、上の例で言えば、基本的には

  • まずはルートのインスタンス
    • 最初の発言(おばんです。)
      • 3番目の発言(Re おばんです。)
      • 4番目の発言(Re おばんです。)
        • 5番目の発言(Re Re おばんです。)
    • 2番目の発言(ブラッド+は面白い!)

とうように組み立てています。

さて、しかし実際の上記の出力では3階層目の5番目の発言(Re Re おばんです。)が出力されていません。それは

foreach my $c (@$children) {
    print $c->get_title, "\n";
    if ( my $cs = $c->get_children ) {
        foreach my $cc (@$cs) {
            print "  --", $cc->get_title, "\n";
        }
    }
}

というコードで2階層までしか出力していないからです。もう1階層増やすことは可能ですが、発言が4階層まであったらそれでもダメです。このような方法で出力では限界があります。

さあて、ここで僕がもっとも苦手とする「再帰」の登場になってきます

苦手な再帰

実行クラスで、全ての階層を表示することは出来ません。なので、データクラスにタイトルをprintするメソッドを追加しましょう。

package DUM::App::BBS::Data;

use warnings;
use strict;
use Carp;
use Class::Std;
use version; our $VERSION = qv('0.0.1');
use constant ROOT => 0;

{
    my %content : ATTR( :name<content>);
    my %title : ATTR( :name<title>);
    my %key : ATTR( :name<key>);
    my %hierarchy : ATTR( :set<hierarchy> :get<hierarchy>);
    my %children : ATTR( :set<children> :get<children>);

   sub BUILD {
       my ( $self, $id, $arg_ref ) = @_;
       if ( $arg_ref->{key} == 0 ) {
            $hierarchy{$id} = 0;
       }
       $children{$id} = [];
   }

    sub add {
        my $this  = shift;
        my $id    = ident($this);
        my $child = shift;
        my $hi    = $hierarchy{$id};
        $hi++;
        $child->set_hierarchy($hi);
        push( @{ $children{$id} }, $child );
    }

    sub print_title {
        my $this    = shift;
        my $id      = ident($this);
        my $title   = $title{$id};
        my $space   = '';
        my $hi      = $hierarchy{$id};
        for my $i (0..$hi) {
            $space .= "  ";
        }
        print $space . "--" . $title,"\n";
        my $children = $children{$id};
        foreach my $c (@$children) {
            $c->print_title;
        }
    }

}

package main;
use Data::Dumper;
my $root = DUM::App::BBS::Data->new(
    {   key     => DUM::App::BBS::Data->ROOT,
        title   => "実験BBS",
        content => "実験BBS開催",
    }
);

my $remark = DUM::App::BBS::Data->new(
    {   key   => 1,
        title => "おばんです。",
        content =>
            "いやあ、最近は忙しくてかなわんですね。\nでも、頑張っていきましょう。",
    }
);

$root->add($remark);

my $remark2 = DUM::App::BBS::Data->new(
    {   key     => 2,
        title   => "ブラッド+は面白い!",
        content => "小夜は悩みすぎだけど、一途な感じがとっても良いなあ。",
    }
);

$root->add($remark2);

my $remark3 = DUM::App::BBS::Data->new(
    {   key     => 3,
        title   => "Re おばんです。",
        content => "了解しました。",
    }
);

$remark->add($remark3);

my $remark4 = DUM::App::BBS::Data->new(
    {   key     => 4,
        title   => "Re おばんです。",
        content => "でもね、時には休まなきゃ。",
    }
);

$remark->add($remark4);

my $remark5 = DUM::App::BBS::Data->new(
    {   key   => 5,
        title => "Re Re おばんです。",
        content =>
            "そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・",
    }
);

$remark4->add($remark5);

$root->print_title;

1;

sub print_title {
    my $this    = shift;
    my $id      = ident($this);
    my $title   = $title{$id};
    my $space   = '';
    my $hi      = $hierarchy{$id};
    for my $i (0..$hi) {
        $space .= "  ";
    }
    print $space . "--" . $title,"\n";
    my $children = $children{$id};
    foreach my $c (@$children) {
        $c->print_title;
    }
}

です。実際には

$c->print_title;

が、再帰呼び出しになっています。もともと苦手なところなので、外しているかもしれませんが、順を追っていくと

  • $root->print_titleが呼び出される。
  • $rootのインスタンスでは自分のタイトルを出力し(--実験BBS)
  • $rootの子供たちを取得する。
  • $rootの子供は2人いるので($remarkとremark2)、その中の最初の$remarkを取得する(foreachループ1回目)。
    • $remarkのprint_titleで自分のタイトルを出力し( --おばんです。)
    • $remarkの子供たちを取得する。
    • $remarkの子供は2人いるので($remark3と$remark4)その内の$remark3を取得(foreachループ1回目)。
      • $remark3のprint_titleで自分のタイトルを出力し( --Re おばんです。)
      • $remark3の子供を取得する。
      • $remark3の子供はいないので、$remark3内のループは終了する。
    • $remarkの2人の子供の内の2番目の$remark4を取得(foreachループ2回目)。
      • $remark4のprint_titleで自分のタイトルを出力し( --Re おばんです。)
      • $remark4の子供たちを取得する。
      • $remark4の子供は1人いるので、その子供の$remark5を取得する(foreachループ1回目)。
        • $remark5のprint_titleで自分のタイトルを出力し( --Re Re おばんです。)
        • $remark5の子供たちを取得する。
        • $remark5の子供はいないので、$remark5内のループは終了する。
      • $remark4にはそれ以上子供はいないので、$remark4内のループは終了する。
    • $remarkにはそれ以上子供はいないので、$remark内のループは終了する。
  • $rootの2人の子供の内の2人目の$remark2を取得する(foreachループ2回目)。
    • $remark2のprint_titleで自分のタイトルを出力し( --ブラッド+は面白い!)
    • $remark2の子供たちを取得する。
    • $remark2にはいないので、$remark2内のループは終了する。
  • $rootの子供はこれ以上いないので、$root内のループは終了する。
  • おしまい!

という感じになります。そうして、

$ perl Data.pm
  --実験BBS
    --おばんです。
      --Re おばんです。
      --Re おばんです。
        --Re Re おばんです。
    --ブラッド+は面白い!

が出力されます。今度は、階層に関係なく全部出力されています。

再びVisitorパターン

再帰を使えば、あるデータ構造を遡って、なんらかの処理が行えます。「これで十分じゃないの?」ということも言えますが、次のようなケースではやはり、このVisitorパターンが必要になるかもしれません。

  1. Dataクラスを勝手に変えられない。
  2. Dataクラスを開発している人と、別の処理をそのDataクラスに対してやって欲しい人とが違っていて、Dataクラスの人になかなか時間が取れない(1と同じか?)。
  3. 全体の仕様がまだはっきりしておらず、メソッドの追加などが予想される。
  4. あるデータに対して、処理したい種類が際限なく増えそう。

など色々考えられます。今回で言えば、上記の(3)と(4)あたりが考えられるかもしれません。

さて、そこでprint_titleをVisitorクラスで実装してみましょう。

DUM::App::BBS::Data;

DUM::App::BBS::VisitorPlain;

main

package DUM::App::BBS::Data;
use warnings;
use strict;
use Carp;
use Class::Std;
use version; our $VERSION = qv('0.0.1');
use constant ROOT => 0;
{
    my %content : ATTR( :name<content>);
    my %title : ATTR( :name<title>);
    my %key : ATTR( :name<key>);
    my %hierarchy : ATTR( :set<hierarchy> :get<hierarchy>);
    my %children : ATTR( :set<children> :get<children>);

    sub BUILD {
        my ( $self, $id, $arg_ref ) = @_;
        if ( $arg_ref->{key} == 0 ) {
            $hierarchy{$id} = 0;
        }
        $children{$id} = [];
    }
    sub add {
        my $this  = shift;
        my $id    = ident($this);
        my $child = shift;
        my $hi    = $hierarchy{$id};
        $hi++;
        $child->set_hierarchy($hi);
        push( @{ $children{$id} }, $child );
    }
    sub accept {
        my $this    = shift;
        my $visitor = shift;
        $visitor->visit($this);

    }
}

package DUM::App::BBS::VisitorPlain;
use warnings;
use strict;
use Carp;
use Class::Std;
use version;
our $VERSION = qv('0.0.1');
{

    sub visit {
        my $this      = shift;
        my $element   = shift;
        my $title     = $element->get_title();
        my $hierarchy = $element->get_hierarchy();
        my $space     = '';
        foreach my $i ( 0 .. $hierarchy ) {
            $space .= "  ";
        }

        print "$space--$title\n";
        my $children = $element->get_children();
        foreach my $cs (@$children) {
            $cs->accept($this);
        }
    }
}

package main;
use Data::Dumper;
my $root = DUM::App::BBS::Data->new(
    {   key     => DUM::App::BBS::Data->ROOT,
        title   => "実験BBS",
        content => "実験BBS開催",
    }
);

my $remark = DUM::App::BBS::Data->new(
    {   key   => 1,
        title => "おばんです。",
        content =>
            "いやあ、最近は忙しくてかなわんですね。\nでも、頑張っていきましょう。",
    }
);
$root->add($remark);

my $remark2 = DUM::App::BBS::Data->new(
    {   key     => 2,
        title   => "ブラッド+は面白い!",
        content => "小夜は悩みすぎだけど、一途な感じがとっても良いなあ。",
    }
);
$root->add($remark2);

my $remark3 = DUM::App::BBS::Data->new(
    {   key     => 3,
        title   => "Re おばんです。",
        content => "了解しました。",
    }
);
$remark->add($remark3);

my $remark4 = DUM::App::BBS::Data->new(
    {   key     => 4,
        title   => "Re おばんです。",
        content => "でもね、時には休まなきゃ。",
    }
);
$remark->add($remark4);

my $remark5 = DUM::App::BBS::Data->new(
    {   key   => 5,
        title => "Re Re おばんです。",
        content =>
            "そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・",
    }
);
$remark4->add($remark5);

my $visitor = DUM::App::BBS::VisitorPlain->new();

$root->accept($visitor);

1;

1つ前のはDataクラスに、

sub print_title {
    my $this    = shift;
    my $id      = ident($this);
    my $title   = $title{$id};
    my $space   = '';
    my $hi      = $hierarchy{$id};
    for my $i (0..$hi) {
        $space .= "  ";
    }
    print $space . "--" . $title,"\n";
    my $children = $children{$id};
    foreach my $c (@$children) {
        $c->print_title;
    }
}

がありましたが、今度は

sub accept {
    my $this    = shift;
    my $visitor = shift;
    $visitor->visit($this);

}

というように、スッキリacceptだけに戻りました。その代わり、再びVisitorクラスが登場し、visitメソッドが

sub visit {
    my $this      = shift;
    my $element   = shift;
    my $title     = $element->get_title();
    my $hierarchy = $element->get_hierarchy();
    my $space     = '';
    foreach my $i ( 0 .. $hierarchy ) {
        $space .= "  ";
    }

    print "$space--$title\n";
    my $children = $element->get_children();
    foreach my $cs (@$children) {
        $cs->accept($this);
    }
}

とういうように、最初のvisitメソッドに比べて、複雑になりました。しかし、よく考えると、print_titleと同じような再帰が行われています。つまり、ここで再帰呼び出しを行って、階層の深さにを気にせず、どんどんデータクラスにacceptさせていって、再帰的に、そして間接的にvisitを呼び出しています。

データを作成する

これまでの例のように、手動でmainパッケージの中でデータ構造を作成することはありません。なんらかの媒体(DB或いはCSVファイルなど)からデータを取得し、それをもとに祖先ほどの$rootのようなデータ構造を構築する必要があります。

CSVから取り出した配列

データを実際のCSVやDBから取得するところは、話かやはり複雑になるので、とりあえず「なんらかの方法で」データをすでに取得し、次のようなデータがすでにあると仮定しましょう。データは「キー,親のキー,タイトル,本文」とし,さらに「レス」の場合は親のキーには0が入っているということにします。

my @lines;
my @line = (1,0,q{おばんです},qq{いやあ、最近は忙しくてかなわんですね。\nでも、頑張っていきましょう。});
push(@lines,\@line);
my @line2 = (2,0,q{ブラッド+は面白い!},qq{小夜は悩みすぎだけど、一途な感じがとっても良いなあ。});
push(@lines,\@line2);
my @line3 = (3,1, q{Re おばんです。},qq{了解しました。});
push(@lines,\@line3);
my @line4 = (4,1, q{Re おばんです。},qq{でもね、時には休まなきゃ。});
push(@lines,\@line4);
my @line5 = (5,4, q{Re Re おばんです。},qq{そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・});
push(@lines,\@line5);

これをData::Dumperで出力すると、

$VAR1 = [
          [
            1,
            0,
            'おばんです',
            'いやあ、最近は忙しくてかなわんですね。
でも、頑張っていきましょう。'
          ],
          [
            2,
            0,
            'ブラッド+は面白い!',
            '小夜は悩みすぎだけど、一途な感じがとっても良いなあ。'
          ],
          [
            3,
            1,
            'Re おばんです。',
            '了解しました。'
          ],
          [
            4,
            1,
            'Re おばんです。',
            'でもね、時には休まなきゃ。'
          ],
          [
            5,
            4,
            'Re Re おばんです。',
            'そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・'
          ]
        ];

というデータがすでに取得している、という仮定だと言うことです。さらに実は、それ以外にキーでソートされていて、子供のレスのキーは親のキーよりも絶対に大きいと言うことを改訂しています(通常そうなるだろうし)。

この配列のリファレンスを使って、データ構造をどうすれば出来るでしょうか。とりあえず、DUM::App::BBS::Dataのインスタンスを作っていくことは当然ですが、発言に対するレスの場合(つまり、誰かの子供だったりすると)自分の親を捜さなくてはなりません。つまり、自分の親を見つけて、その親にaddしなくてはならないわけです。

それをVisitorクラスで実現しましょう。さっきのVisitorのDUM::App::BBS::VisitorPlainを利用すれば、簡単にできます(Visitorクラスだけ---VisitorFindが違います。それ以外は前回のとほとんど同じ)。

package DUM::App::BBS::Data;
use warnings;
use strict;
use Carp;
use Class::Std;
use version; our $VERSION = qv('0.0.1');
use constant ROOT => 0;

{
    my %content : ATTR( :name<content>);
    my %title : ATTR( :name<title>);
    my %key : ATTR( :name<key>);
    my %hierarchy : ATTR( :set<hierarchy> :get<hierarchy>);
    my %children : ATTR( :set<children> :get<children>);

    sub BUILD {
        my ( $self, $id, $arg_ref ) = @_;
        if ( $arg_ref->{key} == 0 ) {
            $hierarchy{$id} = 0;
        }
        $children{$id} = [];
    }

    sub add {
        my $this  = shift;
        my $id    = ident($this);
        my $child = shift;
        my $hi    = $hierarchy{$id};
        $hi++;
        $child->set_hierarchy($hi);
        push( @{ $children{$id} }, $child );
    }
    sub accept {
        my $this    = shift;
        my $visitor = shift;
        $visitor->visit($this);

    }
}

package DUM::App::BBS::VisitorFind;
use warnings;
use strict;
use Carp;
use Class::Std;
use version;
our $VERSION = qv('0.0.1');
{
    my %result : ATTR( :set<result> :get<result>);
    my %key : ATTR( :set<key> :get<key>);

    sub find {
        my $this = shift;
        my $root = shift;
        my $key  = shift;
        $key{ ident $this} = $key;
        $root->accept($this);
        return $result{ ident $this};
    }

    sub visit {
        my $this    = shift;
        my $element = shift;
        my $key     = $element->get_key();
        if ( $key eq $key{ ident $this} ) {
            $result{ ident $this} = $element;
            return;
        }
        my $children = $element->get_children();
        foreach my $cs (@$children) {
            $cs->accept($this);
        }
    }
}

package main;
use Data::Dumper;
my $root = DUM::App::BBS::Data->new(
    {   key     => DUM::App::BBS::Data->ROOT,
        title   => "実験BBS",
        content => "実験BBS開催",
    }
);
my $remark = DUM::App::BBS::Data->new(
    {   key   => 1,
        title => "おばんです。",
        content =>
            "いやあ、最近は忙しくてかなわんですね。\nでも、頑張っていきましょう。",
    }
);
$root->add($remark);

my $remark2 = DUM::App::BBS::Data->new(
    {   key     => 2,
        title   => "ブラッド+は面白い!",
        content => "小夜は悩みすぎだけど、一途な感じがとっても良いなあ。",
    }
);
$root->add($remark2);

my $remark3 = DUM::App::BBS::Data->new(
    {   key     => 3,
        title   => "Re おばんです。",
        content => "了解しました。",
    }
);
$remark->add($remark3);

my $remark4 = DUM::App::BBS::Data->new(
    {   key     => 4,
        title   => "Re おばんです。",
        content => "でもね、時には休まなきゃ。",
    }
);
$remark->add($remark4);

my $remark5 = DUM::App::BBS::Data->new(
    {   key   => 5,
        title => "Re Re おばんです。",
        content =>
            "そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・",
    }
);
$remark4->add($remark5);

my $visitor = DUM::App::BBS::VisitorFind->new();
my $found = $visitor->find( $root, 5 );

if ( defined($found) ) {
    print $found->get_key . "/" . $found->get_title, "\n";
}

上記は以前のとは、Visitorクラスが違うだけです。上記では5のキーのデータを探して、結果をprintでキーとタイトルを出力しているだけです。出力は

5/Re Re おばんです。

と思った通りのものが、出力されています(ふう、よかった)。

それでは、配列からデータ構造を構築して、そしてスレッド表示をしてみましょう(mainパッケ時だけが違います。それ以外は前回のと同じ)。

package DUM::App::BBS::Data;

use warnings;
use strict;
use Carp;
use Class::Std;
use version; our $VERSION = qv('0.0.1');
use constant ROOT => 0;

{
    my %content : ATTR( :name<content>);
    my %title : ATTR( :name<title>);
    my %key : ATTR( :name<key>);
    my %hierarchy : ATTR( :set<hierarchy> :get<hierarchy>);
    my %children : ATTR( :set<children> :get<children>);

    sub BUILD {
        my ( $self, $id, $arg_ref ) = @_;
        if ( $arg_ref->{key} == 0 ) {
            $hierarchy{$id} = 0;
        }
        $children{$id} = [];
    }

    sub add {
        my $this  = shift;
        my $id    = ident($this);
        my $child = shift;
        my $hi    = $hierarchy{$id};
        $hi++;
        $child->set_hierarchy($hi);
        push( @{ $children{$id} }, $child );
    }
    sub accept {
        my $this    = shift;
        my $visitor = shift;
        $visitor->visit($this);

    }
}

package DUM::App::BBS::VisitorPlain;
use warnings;
use strict;
use Carp;
use Class::Std;
use version;
our $VERSION = qv('0.0.1');
{

    sub visit {
        my $this      = shift;
        my $element   = shift;
        my $title     = $element->get_title();
        my $hierarchy = $element->get_hierarchy();
        my $space     = '';
        foreach my $i ( 0 .. $hierarchy ) {
            $space .= "  ";
        }

        print "$space--$title\n";
        my $children = $element->get_children();
        foreach my $cs (@$children) {
            $cs->accept($this);
        }
    }
}

package DUM::App::BBS::VisitorFind;
use warnings;
use strict;
use Carp;
use Class::Std;
use version;
our $VERSION = qv('0.0.1');
{
    my %result : ATTR( :set<result> :get<result>);
    my %key : ATTR( :set<key> :get<key>);
    sub find {
        my $this = shift;
        my $root = shift;
        my $key  = shift;
        $key{ ident $this} = $key;
        $root->accept($this);
        return $result{ ident $this};
    }
    sub visit {
        my $this    = shift;
        my $element = shift;
        my $key     = $element->get_key();
        if ( $key eq $key{ ident $this} ) {
            $result{ ident $this} = $element;
            return;
        }
        my $children = $element->get_children();
        foreach my $cs (@$children) {
            $cs->accept($this);
        }
    }
}

package main;
use Data::Dumper;
my @lines;
my @line = (
    1, 0, q{おばんです},
    qq{いやあ、最近は忙しくてかなわんですね。\nでも、頑張っていきましょう。}
);
push( @lines, \@line );
my @line2 = (
    2, 0, q{ブラッド+は面白い!},
    qq{小夜は悩みすぎだけど、一途な感じがとっても良いなあ。}
);
push( @lines, \@line2 );
my @line3 = ( 3, 1, q{Re おばんです。}, qq{了解しました。} );
push( @lines, \@line3 );
my @line4 = ( 4, 1, q{Re おばんです。}, qq{でもね、時には休まなきゃ。} );
push( @lines, \@line4 );
my @line5 = (
    5, 4,
    q{Re Re おばんです。},
    qq{そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・}
);
push( @lines, \@line5 );

my $visitor = DUM::App::BBS::VisitorFind->new();

#ルートは仮想だけど、必要
my $root = DUM::App::BBS::Data->new(
    {   key     => DUM::App::BBS::Data->ROOT,
        title   => "実験BBS",
        content => "実験BBS開催",
    }
);

foreach my $line (@lines) {
    my $data = DUM::App::BBS::Data->new(
        {   key     => $line->[0],
            title   => $line->[2],
            content => $line->[3],
        }
    );
    my $found = $visitor->find( $root, $line->[1] );
    $found->add($data);
}

my $visitorPlain = DUM::App::BBS::VisitorPlain->new();

$root->accept($visitorPlain);

おおおおっ!

--実験BBS
  --おばんです
    --Re おばんです。
    --Re おばんです。
      --Re Re おばんです。
  --ブラッド+は面白い!

と出力された!

やったぜ,カトちゃん。ちょい古いか。

Tree::SimpleとTree::Simple::Visitor

基本的に,前の例で使っていたDUM::App::BBS::Dataをもっともっと便利にしたものと考えて良いと思います。addなどのメソッドも含めてすでに実装されています。

また、Tree::Simple::Visitorは、何度も作ってきたVisitorクラスをもっともっと便利にしたものですし、すでにそのTree::Simple::Visitorを継承して、すでにいくつものクラスをCPANに登録しているので、あまり、作る必要はなさそうです。

と思ったら、先ほどのようなあるキーの親をみつけるメソッド(単に、Tree::Simpleの枝葉が文字列のような場合の探す方法はTree::Simple::Visitor::FindByNodeValueで出来そうですが、インスタンスが入っていて、そのある値のもを探すようなことは出来そうじゃありません。そこで、Tree::Simple::Visitor::FindByNodeValueを拡張して、変更を加えてみましょう(といっても一部のみ---変更したところは^^^を入れています)。

package DUM::App::BBS::TreeSimple::VisitorFind;
use strict;
use warnings;
use Scalar::Util qw(blessed);
use base qw(Tree::Simple::Visitor::FindByNodeValue);

sub visit {
    my ( $self, $tree ) = @_;
    ( blessed($tree) && $tree->isa("Tree::Simple") )
        || die
"Insufficient Arguments : You must supply a valid Tree::Simple object";
    $self->{success} = 0;

    my $node_value = $self->{node_value_to_find};
    ( defined($node_value) )
        || die
"Illegal Operation : You cannot search for a node_value without setting one \
    first";
    my $func;
    if ( $self->{_filter_function} ) {
        $func = sub {
            my ( $tree, $test ) = @_;
            ( ( $tree->getNodeValue()->get_key eq $node_value )
#                                    ^^^^^^^^^
                    && $self->{_filter_function}->($tree) )
                && die $tree;
        };
    }
    else {
        $func = sub {
            my ( $tree, $test ) = @_;
            ( $tree->getNodeValue()->get_key eq $node_value ) && die $tree;
#                                  ^^^^^^^^^
        };
    }

    eval {
        unless ( defined( $self->{traversal_method} ) )
        {
            $func->($tree) if $self->includeTrunk();
            $tree->traverse($func);
        }
        else {

            $self->{traversal_method}->includeTrunk(1)
                if $self->includeTrunk();
            $self->{traversal_method}->setNodeFilter($func);
            $self->{traversal_method}->visit($tree);
        }
    };
    if ($@) {
        if ( blessed($@) && $@->isa('Tree::Simple') ) {
            $self->setResults($@);
            $self->{success} = 1;
        }
        else {
            die $@;
        }
    }
    else {
        $self->{success} = 0;
    }
}

です。Treeの中身をそのまま比較しているところを->get_keyで比較するようにしただけです。

それから、できたデータ構造を展開する部分をすでに存在するTree::Simple::View::HTMLあたりを使う手もありますが、これを真似して、もともとのアブストラクトであるTree::Simple::Viewを使って実装してみましょう。

このTree::Simple::Viewは、

sub expandPathSimple { ... }
sub expandPathComplex { ... }

sub expandAllSimple { ... }
sub expandAllComplex { ... } 

を実装する必要があると書いてありますが、特に複雑なことをやる必要がない場合は

sub expandPathSimple { ... }
sub expandAllSimple { ... }

の2つだけ実装すれば、動くようです(極端に言えば、今回の目的考えると「sub expandAllSimple { ... }」だけで十分なので、それだけを実装しよっと)。

package DUM::App::BBS::TreeSimple::View::Plain;
use strict;
use warnings;
use Scalar::Util qw(blessed);
use base qw(Tree::Simple::View);

sub expandAllSimple {
    my ($self)        = @_;
    my @results       = ();
    my $root_depth    = $self->{tree}->getDepth() + 1;
    my $last_depth    = -1;
    my $traversal_sub = sub {
        my ($t)           = @_;
        my $space         = '';
        my $current_depth = $t->getDepth();
        foreach my $i ( 0 .. $current_depth ) {
            $space .= "  ";
        }

        push @results => ( "${space}--" . $t->getNodeValue()->get_title );
        $last_depth = $current_depth;
    };
    $traversal_sub->( $self->{tree} ) if $self->{include_trunk};
    $self->{tree}->traverse($traversal_sub);
    $last_depth -= $root_depth;
    $last_depth++ if $self->{include_trunk};
    return ( join "\n" => @results );
}

です。さて、必要なソースを全部載せると

package DUM::App::BBS::Data;

use warnings;
use strict;
use Carp;
use Class::Std;
use version; our $VERSION = qv('0.0.1');
{
    my %content : ATTR( :name<content>);
    my %title : ATTR( :name<title>);
    my %key : ATTR( :name<key>);
    my %hierarchy : ATTR( :set<hierarchy> :get<hierarchy>);
    my %children : ATTR( :set<children> :get<children>);

}

package DUM::App::BBS::TreeSimple::VisitorFind;
use strict;
use warnings;
use Scalar::Util qw(blessed);
use base qw(Tree::Simple::Visitor::FindByNodeValue);

sub new {
    my ( $_class, $arg ) = @_;
    my $class = ref($_class) || $_class;
    my $visitor = {};
    bless( $visitor, $class );
    $visitor->_init();
    return $visitor;
}

sub visit {
    my ( $self, $tree ) = @_;
    ( blessed($tree) && $tree->isa("Tree::Simple") )
        || die
"Insufficient Arguments : You must supply a valid Tree::Simple object";
    $self->{success} = 0;

    my $node_value = $self->{node_value_to_find};
    ( defined($node_value) )
        || die
"Illegal Operation : You cannot search for a node_value without setting one \
    first";
    my $func;
    if ( $self->{_filter_function} ) {
        $func = sub {
            my ( $tree, $test ) = @_;
            ( ( $tree->getNodeValue()->get_key eq $node_value )
                    && $self->{_filter_function}->($tree) )
                && die $tree;
        };
    }
    else {
        $func = sub {
            my ( $tree, $test ) = @_;
            ( $tree->getNodeValue()->get_key eq $node_value ) && die $tree;
        };
    }

    eval {
        unless ( defined( $self->{traversal_method} ) )
        {
            $func->($tree) if $self->includeTrunk();
            $tree->traverse($func);
        }
        else {

            $self->{traversal_method}->includeTrunk(1)
                if $self->includeTrunk();
            $self->{traversal_method}->setNodeFilter($func);
            $self->{traversal_method}->visit($tree);
        }
    };
    if ($@) {
        if ( blessed($@) && $@->isa('Tree::Simple') ) {
            $self->setResults($@);
            $self->{success} = 1;
        }
        else {
            die $@;
        }
    }
    else {
        $self->{success} = 0;
    }
}

package DUM::App::BBS::TreeSimple::View::Plain;
use strict;
use warnings;
use Scalar::Util qw(blessed);
use base qw(Tree::Simple::View);

sub expandAllSimple {
    my ($self)        = @_;
    my @results       = ();
    my $root_depth    = $self->{tree}->getDepth() + 1;
    my $last_depth    = -1;
    my $traversal_sub = sub {
        my ($t)           = @_;
        my $space         = '';
        my $current_depth = $t->getDepth();
        foreach my $i ( 0 .. $current_depth ) {
            $space .= "  ";
        }

        push @results => ( "${space}--" . $t->getNodeValue()->get_title );
        $last_depth = $current_depth;
    };
    $traversal_sub->( $self->{tree} ) if $self->{include_trunk};
    $self->{tree}->traverse($traversal_sub);
    $last_depth -= $root_depth;
    $last_depth++ if $self->{include_trunk};
    return ( join "\n" => @results );
}

package main;
use Data::Dumper;
use Tree::Simple;

my @lines;
my @line = (
    1, 0, q{おばんです},
    qq{いやあ、最近は忙しくてかなわんですね。\nでも、頑張っていきましょう。}
);
push( @lines, \@line );
my @line2 = (
    2, 0, q{ブラッド+は面白い!},
    qq{小夜は悩みすぎだけど、一途な感じがとっても良いなあ。}
);
push( @lines, \@line2 );
my @line3 = ( 3, 1, q{Re おばんです。}, qq{了解しました。} );
push( @lines, \@line3 );
my @line4 = ( 4, 1, q{Re おばんです。}, qq{でもね、時には休まなきゃ。} );
push( @lines, \@line4 );
my @line5 = (
    5, 4,
    q{Re Re おばんです。},
    qq{そりゃ、時には休む必要がありますが、今はこんなに忙しいんだし・・・}
);
push( @lines, \@line5 );

my $visitor = DUM::App::BBS::TreeSimple::VisitorFind->new();
$visitor->includeTrunk(1);

#my $visitor = DUM::App::BBS::VisitorFind->new();
##ルートは仮想だけど、必要
my $root = DUM::App::BBS::Data->new(
    {   key     => DUM::App::BBS::Data->ROOT,
        title   => "実験BBS",
        content => "実験BBS開催",
    }
);

my $tree = Tree::Simple->new( $root, Tree::Simple->ROOT );

foreach my $line (@lines) {
    my $data = DUM::App::BBS::Data->new(
        {   key     => $line->[0],
            title   => $line->[2],
            content => $line->[3],
        }
    );
    $visitor->searchForNodeValue( $line->[1] );
    $tree->accept($visitor);
    my $found = $visitor->getResult();
    my $t     = Tree::Simple->new($data);
    $found->addChild($t);
}

my $tree_view = DUM::App::BBS::TreeSimple::View::Plain->new($tree);
$tree_view->includeTrunk(1);
print $tree_view->expandAll();
1;

で、最後のprint文による出力は

--実験BBS
  --おばんです
    --Re おばんです。
    --Re おばんです。
      --Re Re おばんです。
  --ブラッド+は面白い!

となり、やったああ。

$tree_view->includeTrunk(1);

をコメントアウトすると、

--おばんです
  --Re おばんです。
  --Re おばんです。
    --Re Re おばんです。
--ブラッド+は面白い!

と出力されるので、もっとBBSに近づきますね。

それで、今までと違うのはDUM::App::BBS::Dataが、完全にデータBean化しています。Tree::Simpleが色々やってくれるので、データの保持さえしてもらえればOKです。

また、2つのDUM::App::BBS::TreeSimple::VisitorFindDUM::App::BBS::TreeSimple::View::Plainは、use base ..で、それぞれTree::Simple::Visitor::FindByNodeValueTree::Simple::Viewを継承してコーディングを少し楽にしています。

ふう、長い道のりであった。