[ トップページ ]

« テキストからの Perl データベース (tie) 生成 | メイン | Perl によって UDP ポートを “たたく” プログラム »

Web , ネットワーク・通信 , 文字列

Perl による簡易 XML インタフェース ― テーブル型データ表現のハッシュと XML 間の変換

ただしい XML インタフェースをつくるには XML の API をつかう必要があるが,かんたんに XML (もどき) のインタフェースをつくるには,Perl のパターンマッチ機能をつかうのが便利である. 本来の XML は 1 行にいくつタグがあってもよいし,タグでかこまれる内容が複数行にまたがってもかまわないが,それに制限をくわえればかんたんに処理することができる. こんなインチキな XML 処理は奨励されないかもしれないが,ちょっとしたプロトタイプをつくるには便利である.

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" が型名である. これはつぎのようなテーブルを意味する.

col1col2
value11value12
value21value22

ただし,最初の行 (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;
}

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

Keywords:

トラックバック

このエントリーのトラックバックURL:
http://www.kanadas.com/mt/mt-tb.cgi/1620

コメントを投稿

このページについて

2007-11-14 21:15 に投稿されたエントリーのページです。

他にも多くのエントリーがあります。メインページアーカイブページも見てください。

Creative Commons License
このブログは、次のライセンスで保護されています。 クリエイティブ・コモンズ・ライセンス.
Powered by
Movable Type 3.36