前章で紹介した、選択問題プログラムを次のようなソースファイルから自動作成するプログラムを作ります。

node_1
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.

上のソースを singer.txt という名前で作成します。各行がそれぞれのノードの属性のデータになります。最初の行は「ノード名」です。次の行は「質問」になります。三行目は選択を入力するときの「プロンプトのメッセージ」です。四行目は選択するときの入力の種類とジャンプ先のオブジェクト(ノード)名です。両方ともシングルクォーテーションで囲み、=> で関係づけます。選択と選択の間はコンマで区切り、最期のコンマは省略する必要があります。ここを厳密にしておかないと、作成されたプログラムが動かない可能性があります。ノードとノードの間は空行で区切ります。

選択肢のないノードでは「ノード名」と「質問」だけを入力して空行で区切ります。

つぎに、前章で述べた Node.pm と Linker.pm は密接に関係しているし、依存関係にあるファイルの数は多くない方がよいので、この二つのクラスを、ひとつの Node.pm ファイルにまとめてしまいます。つまり、ひとつのファイルに二つ以上のクラス(package)が同居できることの例です。使うときは use Node; とするだけで、use Linker; は省略できます。新しい Node.pm の内容をここで再掲しておきます。

package Node;

sub new {
    my($class) = shift;
    my($self) = {};
    bless( $self, $class );
    $self->{QUESTION} = 'default';
    $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}, "\n";
    if ( $self->{LAST} eq 'no' ) {
        LABEL:
        print $self->{MESSAGE};
        $answer = <>;
        chomp($answer);
        if ( ! defined( $self->{$answer} ) ) { goto LABEL };
        return $self->{$answer};
    } else { return 'end' }
}

package Linker;

sub start {
    my($object) = shift;
    local(*link) = shift;
    do {
        $object_name = $object->ask;
        $object = $link{ $object_name };
    } until ( ! defined( $object ) );
}
1;

最初に述べたノードを簡潔に記述した singer.txt ソースから選択問題プログラムを作成するプログラム mknode.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 Node;\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 "Linker::start( \$$start, *list );\n";
#
# subroutines
#
sub node {
    while( ($line = <$handle>) eq "\n" ) {};
    if ( !( $line ) ) { return 'end' };
    chomp($line);
    print "\$$line = new Node(\n";
    push( @nodes, $line );
    $success = &question;
    return $success;
}

sub question {
    if ( !( $line = <$handle> ) || $line eq "\n" ) { die "Question Error"; }
    chomp($line);
    print "\tQUESTION => '$line',\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';
}

mknode.pl は chmod 755 mknode.pl でパーミッションを実行可能にしておきます。使い方は、mknode.pl singer.txt で先ず、出力を標準出力にしてきちんとプログラムが作成できるかを確認します。つぎに、mknode.pl singer.txt > singer.pl で目的のプログラムファイルを作成し、chmod 755 singer.pl で実行可能にしておきます。実行例を次に示します。

$ ./mknode.pl singer.txt 
#!/usr/bin/perl
use Node;

$node_1 = new Node(
	QUESTION => 'Which do you like better, Hikaru or Ryoko?',
	MESSAGE => 'Please answer Hikaru or Ryoko : ',
	'Hikaru' => 'hikaru', 'Ryoko' => 'ryoko');
$hikaru = new Node(
	QUESTION => 'Hi, I am Hikaru.',
	LAST => 'yes');
$ryoko = new Node(
	QUESTION => 'Hi, I am Ryoko.',
	LAST => 'yes');
%list = (
	node_1 => $node_1,
	hikaru => $hikaru,
	ryoko => $ryoko,
	);

Linker::start( $node_1, *list );
$ ./mknode.pl singer.txt > singer.pl

singer.pl を chmod +x singer.pl で実行可能にしてプログラムのテストです。

$ chmod +x singer.pl
$ ./singer.pl 
Which do you like better, Hikaru or Ryoko?
Please answer Hikaru or Ryoko : Ryoko     
Hi, I am Ryoko.

うまくいきました。「質問が一行しか入力できない。ソースのエラーチェック機能が甘い。」などの欠点はありますが、プログラム作成の労力がだいぶ減ります。