Exporter の使い方が分かったところで二択問題のクラス Node.pm に利用してみます。Node.pm ファイルの Linker パッケージは メソッド start を利用するだけなので、Linker パッケージをなくして、start サブルーチンを Exporter で main パッケージに導入(import)します。

ついでに QUESTION 属性の値を配列へのリファレンスにして、複数行の質問を表示できるようにします。

Node.pm をバージョンアップした Node2.pm は次のようになります。

package Node2;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(start);

sub new {
    my($class) = shift;
    my($self) = {};
    bless( $self, $class );
    $self->{QUESTION} = ["default\n"];
    $self->{MESSAGE} = 'Please answer yes or no :';
    $self->{LAST} = 'no';
    my(%hash) = @_;
    foreach $key ( keys( %hash ) ) {
        $self->{$key} = $hash{$key};
    }
    return $self;
}

sub ask {
    my($self) = shift;
    print @{$self->{QUESTION}};
    if ( $self->{LAST} eq 'no' ) {
        LABEL:
        print $self->{MESSAGE};
        $answer = <>;
        chomp($answer);
        if ( ! defined( $self->{$answer} ) ) { goto LABEL };
        return $self->{$answer};
    } else { return 'end' }
}

sub start {
    my($object, $table) = @_;
    do {
        $object_name = $object->ask;
        $object = $$table{ $object_name };
    } until ( ! defined( $object ) );
}
1;

次の部分が Exporter を使うときのお約束です。この３行で start サブルーチンが main パッケージに導入されます。

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(start);

属性 QUESTION の値は配列のリファレンスにして質問が複数行表示できるようにします。リファレンスの知識はオブジェクト指向の Perl スクリプトを使う上で必須の知識です。ここでは説明しませんが、man perlref か WWW の Perl5 日本語マニュアルを参考にしてください。Perl遊園地の扉で紹介した参考書もお勧めです。次の１行が変更部分です。

    $self->{QUESTION} = ["default\n"];

質問を表示する ask メソッドもこれにともなって変更します。

    print @{$self->{QUESTION}};

それでは Node.pm を利用した singer.pl スクリプトを Node2.pm 用に改造しましょう。ファイル名は singer2.pl とします。

#!/usr/bin/perl
use Node2;

$node_1 = new Node2(
	QUESTION => [
		"Do you know Hikaru or Ryoko?\n",
		"They are Japanese popular singers.\n",
		"Which do you like better, Hikaru or Ryoko?\n"
		],
	MESSAGE => 'Please answer Hikaru or Ryoko: ',
	'Hikaru' => 'hikaru', 'Ryoko' => 'ryoko');
$hikaru = new Node2(
	QUESTION => ["Hi, I am Hikaru.\n"],
	LAST => 'yes');
$ryoko = new Node2(
	QUESTION => ["Hi, I am Ryoko.\n"],
	LAST => 'yes');
$list = {
	node_1 => $node_1,
	hikaru => $hikaru,
	ryoko => $ryoko,
	};

start( $node_1, $list );

質問(QUESTION)の各行はダブルクォーテーションで括って、最後に \n で改行を指示してあるのに注意してください。また、start サブルーチンがパッケージ名なしで使われているのに注目です。それでは実行してみましょう。

$ singer2.pl
Do you know Hikaru or Ryoko?
They are Japanese popular singers.
Which do you like better, Hikaru or Ryoko?
Please answer Hikaru or Ryoko: Hikaru
Hi, I am Hikaru.

Exporter の有難味が良く分かる実験でした。

おまけで、二択問題を自動作成するプログラム mknode.pl も mknode2.pl にバージョンアップしましょう。次のソースを mknode2.pl と言うファイル名で作成します。

#!/usr/bin/perl
#
# main program
#
$filename = $ARGV[0];
if ($filename eq '') {
    $handle = STDIN;
} else {
    open FILE, $filename || die "File Error";
    $handle = FILE;
}

print "#!/usr/bin/perl\n";
print "use Node2;\n";
print "\n";

do {
    $flag = &node;
} while ($flag eq 'OK');

$start = $nodes[0];
print '%list = (', "\n";
foreach $object (@nodes) {
    print "\t$object => \$$object,\n";
}
print "\t);\n\n";

print "start( \$$start, *list );\n";
#
# subroutines
#
sub node {
    while( ($line = <$handle>) eq "\n" ) {};
    if ( !( $line ) ) { return 'end' };
    chomp($line);
    print "\$$line = new Node2(\n";
    push( @nodes, $line );
    $success = &question;
    return $success;
}

sub question {
    $line = <$handle>;
    if ( $line ne "[\n" ) { die "Question Error"; }
    print "\tQUESTION => [\n";
	$line = <$handle>;
        while ( $line && $line  ne "]\n" ) {
            chomp($line);
            print "\t\t\"$line\\n\",\n";
            $line = <$handle>;
        }
    if ( $line ne "]\n" ) { die "Question Error"; }
    print "\t\t],\n";
    $success = &message;
    return $success;
}

sub message {
    if ( !($line = <$handle>) || $line eq "\n") {
        chomp($line);
        print "\tLAST => 'yes');\n";
        $success = 'OK';
    }
    else {
        chomp($line);
        print "\tMESSAGE => '$line',\n";
        $success = &select;
    }
    return $success;
}

sub select {
    if ( !($line = <$handle>) || $line eq "\n" ) { die "Select Error"; }
    chomp($line);
    print "\t$line);\n";
    return 'OK';
}

二択問題プログラム作成用のソースファイルを singer2.txt という名前で次のように作成します。

node_1
[
Hikaru and Ryoko are Japanese singers.
Which do you like better, Hikaru or Ryoko?
]
Please answer Hikaru or Ryoko: 
'Hikaru' => 'hikaru', 'Ryoko' => 'ryoko'

hikaru
[
Hi, I am Hikaru.
]

ryoko
[
Hi, I am Ryoko.
]

以前の様式から変更したのは、質問が複数行になってもいいように、質問の部分を '[' だけの行と、']' だけの行で挟んだことです。

それでは、プログラムを作成して走らせてみましょう

$ perl mknode2.pl singer2.txt > singer3.pl 
$ perl singer3.pl
Hikaru and Ryoko are Japanese singers.
Which do you like better, Hikaru or Ryoko?
Please answer Hikaru or Ryoko: Hikaru
Hi, I am Hikaru.