プログラミングの小石・大石

XML をあつかうための API 仕様として Sax があり，その実装としては Xerces をはじめ，いろいろある． Sax も比較的容易につかえるが，API のつかいかたをおぼえたり (おもいだしたり)，API とリンクしたりするために多少のてまがかかる． ちょっとしたプロトタイピングをするときには，そういうてまも，はぶきたくなる．

私はそういうとき，Perl のパターンマッチ機能をつかって，もっと安易な (疑似) XML インタフェースをつくっている． そういう簡易 XML インタフェースの応答者と要求者のプログラム断片の例を以下にしめす． このプログラムは要求者が XXP という HTML 風のプロトコルをつかって XML によってテーブルの値をかえすことを要求する (データ形式をテーブルに限定するところがミソである)．

テーブルの値はたとえばつぎのように表現される．

<tables>
<table>
<col1>value11</col1>
<col2>value12</col2>
</table>
<table>
<col1>value21</col1>
<col2>value22</col2>
</table>
</tables>

テーブルには型があり，ここでは "table" が型名である． これはつぎのようなテーブルを意味する．

ただし，最初の行 (col1, col2) はタイトルをあらわす (テーブルの内容ではない)．

応答者

make_xml() はハッシュを要素とする配列を入力してそれを XML に変換し，関数値 ($result) としてかえす． たとえば，上記の XML テキストを生成したければ，つぎの配列を入力する．

[{col1 => value11, col2 => value12}, {col1 => value21, col2 => value22}]

send_reply($result) はその XML テキストをふくむ HTML 風のプロトコル XXP による応答メッセージを受信者におくる． ここには質問メッセージに関する部分はのせないが，これは XXP による質問メッセージに対する応答である． ここではテーブル型名は TAG としている．

### make_xml(%hash)
#
sub make_xml(\%) {
    my ($group) = @_;
    my $result = "<TAGs>\r\n";
    foreach my $key (sort keys %group) {
	my $item = $group{$key};
	if (ref($item) eq 'HASH') {
	    $result .= "<TAG>\r\n";
	    foreach my $key (keys %$item) {
		$result .= "<${key}>$item->{$key}</${key}>\r\n";
	    };
	    $result .= "</TAG>\r\n";
	};
    };
    $result .= "</TAGs>\r\n";
    return $result;
}
# -- すべてをメモリ上でつくる

### send_reply($result)
#
sub send_reply($) {
    my ($result) = @_;
    my $protocol = "XXP/1.0 ";
    if ($result < 0) {
	put($Client, $protocol . (400-$result) . " $error_message{-$result}\r\n");
	put($Client, "Content-length: 0\r\n\r\n");
    } else {
	if ($result) {
	    $result = "<?xml version=\"1.0\" encoding=\"shift_jis\"?>\r\n" .
		"$result\r\n";
	};
	
	# Put XXP header
	put($Client, $protocol . "200 OK\r\n");
	put($Client, "Content-length: " . length($result) . "\r\n\r\n");

	# Put XXP body
	put($Client, $result);
    };
}

受信者

受信者はまず get_header($file_descriptor) をよびだして XXP の応答ヘッダを送信者からうけとり，つづいて get_body($file_descriptor, $table_type, $body_length) をよびだして XXP のメッセージ本体をうけとる． $body_length は get_header() がかえす値である． XXP の質問メッセージによって，うけとるテーブルの型 ($table_type) がきまることを前提としている． get_body() は make_xml() とは逆によみこんだ XML のテキストをハッシュに変換する．

### get_header($file)
#   get XXP reply message header
#   returns $body_length;
#
sub get_header($) {
    my ($file) = @_;
    my $line = <$file>;
    if ($line =~ / 200 /) {	# OK
	my $body_length = 0;
	while (($line = <$file>) !~ /^\s*$/) {	# Until empty line read
	    if ($line =~ /Content-length:\s+(\d+)\s/i) {
		$body_length = $1;		# Use content-length header only
	    };
	};
	return $body_length;
    } else {	# Error
	return -1;
    };
}

### get_body($file, $table_type, $body_length)
#   get XXP reply message body
#
sub get_body($$$) {
    my ($file, $table_type, $body_length) = @_;
    my $length = 0;
    my $table = [];
    my $record = {};
    while ($length < $body_length) {
	my $line = <$file>;
	$length += length($line);
	if ($line =~ /<\s*(\S+)\s*>(.*)<\s*\/\s*(\S+)\s*>/) {
	    my $stag = $1;
	    my $content = $2;
	    my $etag = $3;
	    if ($stag ne $etag) {
		system_error("Illegal tag syntax: <$stag$gt;...$lt;/$etag$gt;");
	    };
	    $record->{$stag} = $content;
	} elsif ($line =~ /<\s*${table_type}\s*>/) {		# record start tag
	    $record = {};		# create a new record
	} elsif ($line =~ /<\s*\/\s*${table_type}\s*>/) {	# record end tag
	    push(@$table, $record);	# push the record into the table
	} elsif ($line =~ /<\s*(\/\s*)?${table_type}s\s*>/) {	# collection tag
	    # ignore
	} elsif ($line =~ /<\s*\?\s*xml(.*)\?\s*>/) {	# first line
	    # ignore
	} elsif ($line =~ /\s*/) {
	    # ignore
	} else {
	    print STDERR "Illegal line: $line ($length)\n";
	};
    };
    return $table;
}

注意: 上記のプログラムは動作確認したプログラムをもとにしていますが，ここに掲載するにあたってかきかえて，それ以降はテストしていません． あしからず．