HTML::Parserの挙動がよく分かりません

解決済

質問者：zyousuke
質問日時：2008/08/25 23:15
回答数：1件

CGIプログラミング第2版を読みながらCGIを学習しています。
11章 "ステートの保持"の11.1 クエリ文字列とパス情報の例題ではまっております。。。
これはURLに識別子を埋め込んでユーザーを追跡するという、超ハイテクなスクリプトです。
とりあえず、記載されているとおりにスクリプトを作成してHTMLファイルも用意しました。
HTMLファイルの内容は超簡単で
<HTML><HEAD><TITLE>store</TITLE></HEAD><BODY><A href="abc.html">abc</A></BODY></HTML>
です。
これでユーザーがhttp://ウェブサーバー/store/下のファイルをリクエストすると、自動的にスクリプトが実行され、カスタマイズされたHTMLファイルが返されるという仕様です。
実際に返されたHTMLファイルを見てみると
<HTML><HEAD><TITLE>store</title></head><BODY>
なんと<A>タグ以降がばっさり切り落とされていました^^
しかもタグは全部大文字で書いたのに一部小文字になっていたりと、意味不明な状況です。
たぶんHTML::Parserなるものが、いろいろHTMLファイルを操作しているとは思うのですが、今回返されたHTMLはどう見ても壊れているような・・・。

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (1件)

ベストアンサー優先
最新から表示
回答順に表示

No.1ベストアンサー

回答者： sakusaker7
回答日時：2008/08/25 23:44

CGIプログラミングってオライリーの、表紙がネズミの本ですか?

だとするとこの本の邦訳は相当古いものになってしまっているので、
使っているHTML::Parserのバージョン違いによるものかもしれません。

><HTML><HEAD><TITLE>store</TITLE></HEAD><BODY><A href="abc.html">abc</A></BODY></HTML>

これはHTML4あたりだと不正なHTMLではないですか?
bodyのすぐ下に直接テキストを置くことはできなかったはずです。

HTML::Parserに対して想定するHTMLのバージョンを指定できたと
思うので、マニュアルを見て(perldoc HTML::Parser)、
2.0あたりのHTMLを指定して試してみてください。

この回答への補足

sakusaker7さん、ご返信ありがとうございます。
オライリーの本は表紙といい、内容といい、硬派な感じがして好きなのです^^
HTML::ParserでHTMLのバージョンを指定することは断念しましたが、
HTMLの構文チェックサイトの力を借りて、ちゃんとパースできるようにHTMLを修正しました。
これにより何とか意図どおりにカスタマイズされたHTMLが返ってくるようになりました！
しかし、そのページからリンク先へ飛ぶことができません。
多分スクリプトがURLに自動的に識別氏を埋め込んでしまい、そのようなアドレスが存在しないためだと思います。
<A href="/store/abc.html">
↓
<A href="/store/ウェブサーバーが生成したユニークな文字列/abc.html">
このようになってしまい、用意したabc.htmlへは飛べません！！

ここで失礼して禁断のコード貼り付けをさせてください。

まずはURLを操作するモジュール"UserTracker.pm"のソースコードです。
#!/usr/bin/perl -wT

#/----------------------------------------------------------------
# UserTrackerモジュール
#
# HTML::Parserを継承
#
#

package CGIBook::UserTracker;

push @ISA, "HTML::Parser";

use strict;
use URI;
use HTML::Parser;

1;

#/----------------------------------------------------------------
# Publicメソッド
#

sub new {
my( $class, $path ) = @_;
my $id;

if ( $ENV{PATH_INFO} and
$ENV{PATH_INFO} =~ s|^/\.([a-z0-9_.-]*)/|/|i ) {
$id = $1;
}
else {
$id ||= unique_id( );
}

my $self = $class->SUPER::new( );
$self->{user_id} = $id;
$self->{base_path} = defined( $path ) ? $path : "";

return $self;
}

sub base_path {
my( $self, $path ) = @_;
$self->{base_path} = $path if defined $path;
return $self->{base_path};
}

sub user_id {
my $self = shift;
return $self->{user_id};
}

#/----------------------------------------------------------------
# 内部（Private）サブルーチン
#

sub unique_id {
# Apacheのmod_unique_idが使用可能であればこれを使用する
return $ENV{UNIQUE_ID} if exists $ENV{UNIQUE_ID};

require Digest::MD5;

my $md5 = new Digest::MD5;
my $remote = $ENV{REMOTE_ADDR} . $ENV{REMOTE_PORT};

# 次のコードはユニークなIDの作成が目的（セキュアではない）
# 機密データのキー生成には使用しないこと
my $id = $md5->md5_base64( time, $$, $remote );
$id =~ tr|+/=|-_.|; # 非ワード文字をURLに使える文字に変換
return $id;
}

sub encode {
my( $self, $url ) = @_;
my $uri = new URI( $url, "http" );
my $id = $self->user_id( );
my $base = $self->base_path;

my $path = $uri->path;
$path =~ s|^$base|$base/.$id| or
die "設定されたベースパスが無効です\n";
$uri->path( $path );

return $uri->as_string;
}

#/----------------------------------------------------------------
# HTML::Parserのコールバックを実装するサブルーチン
#

sub start {
my ( $self, $tag, $attr, $attrseq, $origtext ) = @_;
my $new_text = $origtext;

my %relevant_pairs = (
frameset => "src",
a => "href",
area => "href",
form => "action",
# 画像データも追跡する場合は、次の2行の先頭の#を削除する
# img => "src",
# body => "background",
);

while ( my( $rel_tag, $rel_attr ) = each %relevant_pairs ) {
if ( $tag eq $rel_tag and $attr->{$rel_attr} ) {
$attr->{$rel_attr} = $self->encode( $attr->{$rel_attr} );
my @attribs = map { "$_=\"$attr->{$_}\"" } @$attrseq;
$new_text = "<$tag @attribs>";
}
}

補足日時：2008/08/29 01:54

通報する

- 0
- 件

通報する

この回答へのお礼

# リフレッシュを指定するMETAタグは形式が異なるのでここで別に処理
if ( $tag eq "meta" and $attr->{"http-equiv"} eq "refresh" ) {
my( $delay, $url ) = split ";URL=", $attr->{content}, 2;
$attr->{content} = "$delay;URL=" . $self->encode( $url );
my @attribs = map { "$_=\"$attr->{$_}\"" } @$attrseq;
$new_text = "<$tag @attribs>";
}
print $new_text;
}

sub declaration {
my( $self, $decl ) = @_;
print $decl;
}
sub text {
my( $self, $text ) = @_;
print $text;
}
sub end {
my( $self, $tag ) = @_;
print "</$tag>";
}
sub comment {
my( $self, $comment ) = @_;
print "";
}

続いて、ユーザーがhttp://ウェブサーバー/store/下のファイルをリクエストしたときに自動的に実行されるCGIスクリプト"query_track.cgi"です。
#!/usr/bin/perl -wT

use strict;
use CGIBook::UserTracker;

local *FILE;
my $track = new CGIBook::UserTracker;
$track->base_path( "/store" );

my $requested_doc = $ENV{PATH_TRANSLATED};
unless ( -e $requested_doc ) {
print "Location: /errors/not_found.html\n\n";
}

open FILE, $requested_doc or die "$requested_docのオープンに失敗しました: $!";

my $doc = do {
local $/ = undef;
<FILE>;
};

close FILE;

# HTMLファイルのみを追跡することが前提
print "Content-type: text/html\n\n";
$track->parse( $doc );

続いて、私が作成したHTMLファイルです。
<html lang="ja">
<head>
<META http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<title>store</title>
</head>
<body>
<a href="/store/abc.html">abc</a>
</body>
</html>

このページのabcというリンクをクリックすると/stroe/.XXXXXXXXXXXXXXXXXXXXXX/abc.htmlのような感じでリクエストしてしまい、ノットファウンドになってしまうのです。

sakusaker7さん、もしお暇な時間があれば、このスクリプトを叩いてもらって、どこが悪いか教えてほしいです!!!!!