Perl覚え書き20041122

web perl

　今回はタグが渡されると、それを分解して許可されたタグか、許可された属性かをチェックしてタグの場合は< >をそれぞれ&lt; &gt;に置き換え、属性の場合は除去するような関数の紹介。

　時間が無くなってしまったからあまりテスト出来なかったけどたぶん大丈夫…だといいな。ちなみに先頭の"1: "などは説明のために便宜上付けただけで実際には入力しない。

　なんてことは書くまでもないかな。いくらなんでも初心者は見ても理解できないだろうし（初心者＜初級者＜中級者＜上級者＜神 という分類で）。

 1: sub parse_print {
 2: 	my $tag = shift;
 3: 	my @tags;
 4: 	my($key,$value);
 5: 	my($ignore,$iscomment) = (0,0);
 6: 	my $tagname;
 7: 	my $res;
 8: 
 9: 	$tag =~ s!(^<|>$)!!g;
10: 	$tag =~ s!&!&amp;!g;
11: 	$tag =~ s!\n!&cr;!g;
12: 	$tag =~ s!\\'!&q;!g;
13: 	$tag =~ s!\\"!&qq;!g;
14: 
15: 	code_tag(\$tag);
16: 
17: 	@tags = split /\s/,$tag;
18: 
19: 	$tag = shift @tags;
20: 	$iscomment = 1 if $tag =~ /^!--/;		# コメントは特別扱い
21: 	$tag = ${clear_char($tag)};
22: 	$tag =~ m!/?(.+)!;
23: 	$tagname = $1;
24: 	$ignore = 1 unless $allow_tags{$tagname};
25: 	$res = "<$tag";
26: 	foreach (@tags) {
27: 		next unless length;
28: 		($key,$value) = split /=/;
29: 		if($ignore || $allow_tags{$tag}{${clear_char($key)}}) {
30: 			$res .= " $key";
31: 			$res .= "=$value" if $value;
32: 		}
33: 	}
34: 	$res .= ">";
35: 	decode_tag(\$res);
36: 	if($ignore && !$iscomment) {			# コメントの場合は通す
37: 		$res =~ s!^<!&lt;!;
38: 		$res =~ s!>$!&gt;!;
39: 	}
40: 	\$res;
41: }
42: 
43: sub code_tag {
44: 	my $ref = shift;
45: 	my $str = $$ref;
46: 	my $res = "";
47: 	my($pre,$demi,$match);
48: 
49: 	return if $str !~ m/["']/;
50: 	while($str =~ m!(["'])(.*?)\1!) {
51: 		$pre = $`;							# prematch
52: 		$demi = $1;
53: 		$match = $2;
54: 		$str = $';							# postmatch
55: 		$pre =~ s!\s*=\s*!=!g;
56: 		$res .= $pre;
57: 		$match =~ s/ /&spc;/g;
58: 		$match =~ s/=/&eql;/g;
59: 		$res .= "$demi$match$demi";
60: 	}
61: 	$res .= $str;
62: 	$$ref = $res;
63: }
64: 
65: sub decode_tag {
66: 	my $ref = shift;
67: 	my $str = $$ref;
68: 
69: 	$str =~ s!&spc;! !g;
70: 	$str =~ s!&eql;!=!g;
71: 	$str =~ s!&cr;!\n!g;
72: 	$str =~ s!&q;!\\'!g;
73: 	$str =~ s!&qq;!\\"!g;
74: 	$str =~ s!&amp;!&!g;
75: 	$$ref = $str;
76: }
77: sub clear_char {
78: 	my $str = shift;
79: 
80: 	$str =~ s![^a-zA-Z/]!!g if $str !~ /!--/;
81: 	\$str;
82: }

　ちょっと長くなってしまった。使い方は、

$tag = q{<a href="http://hoge/" target="_blank">};
print ${parse_print(\$tag)};

　とでもすればいいんじゃないかと。複数のタグを同時に渡してもダメで、一個だけ。その辺りの処理をどうするかはまた今度。

　処理の流れとしては、まずタグの両側にある括弧を取り除き、処理上不具合が出そうな文字を&〜;という形に変換。そしてタグの中に存在する" "や' 'で囲まれた中にあるスペースや=も変換してしまう。一部HTML中に書いても何も起きない、要するに自分で勝手に名付けた物もあるんで注意。返還するときにはちゃんと戻してるから問題ないかと。間違っても「そんなのも定義されてるのか」と思って書かないように。

　17行目から。都合の悪い文字の変換が終わったらスペースを区切り文字としてバラバラにする。先頭をタグ名として取得。この際、そこがコメントだった場合はフラグを立てておく。もうコメントはそのまま出力してしまう。ここでそのタグが許可されているかをチェック。不許可の場合はフラグを立てる。

　26行目から。属性部分を処理していく。27行目は、2つ以上のスペースが入っていた場合は処理する物が無いから飛ばすためのもの。=で分解し、属性が許可されてるかを調べる。そもそもそのタグが不許可の場合は先頭/最後尾の括弧が違う文字に置き換えられるため、属性の定義はそのまま通す。29行目がそれ。

　最初||の前後を逆にしていて、二回目通ったときに何故か不許可のタグが許可されてるものとして扱われていて悩んだ。たとえば$tag{a}{b}をチェックすると、次に$tag{a}をチェックしたらそれは定義されているものとされてしまうようだ。

my %tag = ();
print "ok1" if $tag{a}{b};
print "ok2" if $tag{a};

　これを実行してみるとok2と画面に出るはずだ。気づくのにけっこう掛かった。こんなのは基本事項なんだろうか…？

　そして組み立てが終わったら、都合が悪くて変換していた文字を元に戻す。

　最後、不許可タグでコメントでない場合は括弧を変換して終わり。

　参照渡しやこの日の日記に書いた「その場でスカラー変数を作る」技（？）を多用しているため多少読みにくいかもしれないが、やってることは単純だから追っていけば分かる、はず。いや分かってください。

　あ、書くまでもないと思うけどこれを実行するにはこの日の日記に書いた%allow_tagsという連想配列が定義されていないとどのタグも不許可になってしまうんで注意。

　と言うわけで次回は、実際のHTMLを読み込んでそれを処理してみる、という内容になる予定。