作者: 藤岡和夫
日時: 2005/9/03(16:20)
毎度お世話になります。

On Sat, 03 Sep 2005 15:55:50 +0900 (JST)
Zazel <zazel.ts@...> さんwrote:

> どちらかというとそれ以前の行に問題がありそうですね。
> しかも普通なら syntax error at ファイル名 となるはずなのに
> (eval 25) となってしまうのが何かありそうです。

　このeval 25は私もどういう意味なのかなと思ったのですが、聞くほうが速そ
うだと思って。

> もっとスクリプトを短くしていってエラーを出す主因を見付けないと
> だめだと思います。極端な話、1行1行削っていってエラーが出なく
> なったとき、最後に削った行が主因だろうし。もしくはエラーが出る
> スクリプトを省略せずに全部見せてくれるか。

　全部載せるほうが速いので載せさせて頂きます(^^;;;

#!/PXPerl/bin/perl.exe
use encoding 'Shift_JIS';
$btime = time;# 処理開始時間取得
require 'cgi-lib.pl';
use Unicode::Japanese;
$s = Unicode::Japanese->new();
use LWP;
@header = (
	'UserAgent' => "libwww-perl/$LWP::VERSION",
);
$browser = LWP::UserAgent->new;

# 環境変数の取得
$docroot = $ENV{'DOCROOT'};# ローカル HTTP サーバーのドキュメントルート
$cgidir = $ENV{'CGIDIR'};# ローカル HTTP サーバーの CGI ディレクトリ
$mp = "QT";

# RSS URL データの取得
&ReadParse(*in);
if($in{'rss'}){
  # CGI で URL を取得する
  $getfile = $in{'rss'};
}elsif($ARGV[0]){
  # コマンドラインから URL を取得する
  $getfile = $ARGV[0];
}else{
  print "RSS URL データが存在しない。\n";
  exit;# 終了する
}

# CGI 最初の部分の出力
print <<HEADER;
Content-type: text/html

<HTML>
<HEAD>
  <TITLE>RSS Reader</TITLE>
  <META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=Shift_JIS\">
  <LINK REL=\"STYLESHEET\" TYPE=\"text/css\" HREF=\"/mystyle.css\">
</HEAD>
<BODY>
<div class=\"emph\">ニュース</div>
HEADER

# RSS URL の RSS ファイルを取得
unless($res = $browser->get($getfile,@header)){
	print "<p>LWP::UserAgentのget関数がundef値を返しました。</p></BODY></HTML>\n";
	exit;
}

$content = $res->content;# UserAgentのget関数の戻り値

# エンコーディングの取得
if($content =~ /<\?xml +version="1.0" +encoding="([^"]+)" *\?>/){
	$encoding = $1;$enc = $encoding;
	$encoding =~ s/^Shift_*JIS$/sjis/i; # シフト JIS
	$encoding =~ s/^euc-*j*p*$/euc/i;   # EUC-JP
	$encoding =~ s/^utf-*8$/utf8/i;     # UTF-8
	$encoding =~ s/^ISO-8859-1$/ascii/i;# ISO-8859-1
	$encoding =~ s/^us-ascii$/ascii/i;  # US-ASCII
	$encoding =~ s/^ISO-2022-JP$/jis/i; # JIS
}
if($encoding eq ""){
	# エンコーディング情報のないものは、UTF-8 とする
	# 実際のRSSファイルにはXMLを宣言する行、<?xml...?>自体がないものもある
	$encoding = "utf8";$enc = "None";
}

# エンコーディング情報をもとに、シフト JIS 文字コードに変換
$content = $s->set($content,$encoding)->sjis;

# RSS ファイルの解析
# 解析用の前処理: 文字列データから行頭行末の空白を取り除き、改行文字を削除する
$content =~ s/[ \t]*[\r\n]+[ \t]*//g;

# 終了タグの後に改行を入れる
$content =~ s/(<\/[^>]+>)/$1\n/g;

# 主要素の開始タグの後に改行を入れ、要素タグのみの行を作る
$content =~ s/(<channel[^>]*>)/$1\n/;
$content =~ s/(<image[^>]*>)/$1\n/g;
$content =~ s/(<item[^>]*>)/$1\n/g;

# データ文字列を改行で分割して、行単位のデータで配列に格納する
@content = split(/\n+/, $content);

# データを行単位で処理する。
foreach $line (@content){
	# RSS バージョンの取得
	if($line =~ /<rss.+?version\s*=\s*['"](.+?)['"]/i){
		# Rich Site Summary/Really Simple Syndicationのバージョン取得
		$ver = $1;
	}elsif($line =~ /xmlns\s*=\s*"http:\/\/purl\.org\/rss\/(.+?)\/"/){
		# RDF Site Summary 1.0 のバージョンの取得
		$ver = $1;
	}elsif($line =~ /xmlns\s*=\s*"http:\/\/my\.netscape\.com\/rdf\/simple\/0\.9\/"/){
		# RDF Site Summary 0.9 のバージョンの取得
		$ver = "0.9";
	}
	# rdf:RDF か rss のルート要素からXML 名前空間のリストを得る
	if($line =~ /(<rdf:RDF|<rss)/i){
		@nss = ($line =~ /(xmlns:?\w*?\s*=\s*["'].+?["'])/ig);
	}
	# CDATA セクションの処理 <![CDATA[・・・]]> の除去と実体参照エンコード
	if($line =~ /<[^>]+><!\[CDATA\[/i && $line !~ /\]\]><\/[^>]+>/){
		$line =~ s/<[^>]+><!\[CDATA\[//i;
		$cdatasw = 1;
		$cdata = $line;
	}elsif($cdatasw == 1 && $line !~ /\]\]><\/[^>]+>/){
		$line =~ s/<!\[CDATA\[//gi;
		$line =~ s/\]\]>//g;
		$cdata .=  $line;
	}elsif($cdatasw == 1 && $line =~ /\]\]><\/[^>]+>/){
		$line =~ s/\]\]><\/([^>]+)>//;
		$prop = $1;
		$cdata .=  $line;
		$line = "<$prop>" . &entities_encode($cdata) . "</$prop>";
		$cdatasw = 0;$cdata = "";
	}
	# channel、item、image 要素開始の判定
	if($line =~ /<channel/){
		$csw = 1;
	}elsif($line =~ /<item( |>)/){
		$isw = 1;$csw = 0;
	}elsif($line =~ /<image/){
		$imgsw = 1;$csw = 0;
	}
	# 要素データを主要素毎に要素名をキーとして取得
	if(($buff = $line) =~ s/<\/?([^>]+)>//g){
		# channel 要素の格納
		if($csw == 1){
			$channel{$1} = $buff;
		}
		# image 要素の格納
		if($imgsw == 1){
			$image{$1} = $buff;
		}
		# item 要素の格納
		if($isw == 1){
			if($1 eq 'guid'){
				# RSS 2.0 の guid 要素は、isPermaLink属性が true の場合には URL
				if($line =~ /isPermaLink\s*=\s*['"]true['"]/i){
					$item{'guid'} = $buff;
				}
			}else{
				$item{$1} = $buff;
			}
		}
	}
	# enclosureタグからURL属性を取得する
	if($line =~ /<enclosure +url="([^"]+)"[^>]+>/){
		$item{'enclosure_url'} = $1;
	}
	# channel 要素終了の判定
	if($csw == 1 && $line =~ /<\/channel>/){
		$csw = 0;# RSS 1.0
	}
	# image 要素終了の判定
	if($imgsw == 1 && $line =~ /<\/image>/){
		$imgsw = 0;
	}
	# item 要素終了の判定と item ごとのデータの格納
	if($isw == 1 && $line =~ /<\/item>/){
		# item 日付要素の選択
		# Dublin Core モジュールの dc:date 要素があれば、
		if($item{'dc:date'}){
			$item{'date'} = $item{'dc:date'};
			$elms{'dc:date'} = 1;# マッチした要素の収集
		# RSS 2.0 の pubDate 要素があれば、
		}elsif($item{'pubDate'}){
			$item{'date'} = $item{'pubDate'};
			$elms{'pubDate'} = 1;
		}
		# 表示要素追加時チェック部(1)
		push(@items, join("\t",$item{'date'},$item{'link'},$item{'guid'},$item{'title'},$item{'dc:description'},$item{'description'},$item{'content:encoded'},$item{'dc:subject'},$item{'category'},$item{'dc:creator'},$item{'author'},$item{'slash:department'},$item{'prism:publicationName'},$item{'enclosure_url'}));
		$isw = 0;%item = ();
	}
}

# channel 要素の description 要素を実体参照デコードしておく
$channel{'description'} = &entities_decode($channel{'description'});

# 実体参照への変換が二重に行われている場合の対応
if($channel{'description'} =~ /&[a-z0-9]{2};/){
	$channel{'description'} = &entities_decode($channel{'description'});
}

# image 要素データがある場合とない場合に分けて HTML 出力の仕方を指定
# image 要素データがある場合には、channel 主要素の title 要素
if($image{'url'}){
	print "<dl><dt><a href=\"",$channel{'link'},"\" target=\"main\">", $channel{'title'}, "</a><dd><p><a href=\"",$image{'link'},"\" target=\"main\"><img src=\"",$image{'url'},"\"></a> ",$channel{'description'},"</p></dl>\n";
}else{
	print "<dl><dt><a href=\"",$channel{'link'},"\" target=\"main\">", $channel{'title'}, "</a><dd><p>",$channel{'description'},"</p></dl>\n";
}

# item 要素データを HTML 表に変換して出力
print "<table border=0>\n";

# item ごとに表示要素を処理する
foreach $item (@items){
	# 表示要素追加時チェック部(2)
	($date,$ilink,$iguid,$ititle,$idescription,$rdescription,$cdescription,$isubject,$rcategory,$icreator,$rauthor,$sdepartment,$prismpubname,$enclosure_url) = split(/\t/,$item);
	print "<tr bgcolor=\"#eeeeee\">";
	# タイトルとリンクの処理
	if($ititle){
		$title = &entities_decode($ititle);
		# 実体参照への変換が二重に行われている場合の対応
		if($title =~ /&[a-z0-9]{2};/){
			$title = &entities_decode($title);
		}
		# タイトルにリンクがある場合は、別にリンクする
		if($title =~ s/(<a.+?)>(.+?)(<\/a>)/$2/i){
			$titlelink = " -> $1 target=\"main\">LINK$3";
		}else{
			$titlelink = "";
		}
		# RDF/RSS の item 主要素の link 要素の場合
		if($ilink){
			print "<td><font color=\"#000000\"><a href=\"", $ilink, "\" target=\"main\">", $title, "</a></font>$titlelink</td>";
			$elms{'link'} = 1;
		# RSS 2.0 の guid 要素の場合
		}elsif($iguid){
			print "<td><font color=\"#000000\"><a href=\"", $iguid, "\" target=\"main\">", $title, "</a></font>$titlelink</td>";
			$elms{'guid'} = 1;
		}else{
			print "<td><font color=\"#000000\">$title</font>$titlelink</td>";
		}
		$elms{'title'} = 1;
	}else{
		# タイトルがない場合は、リンク文字列にリンクしてタイトルに表示する
		# RDF/RSS の item 主要素の link 要素の場合
		if($ilink){
			if($ilink !~ /http:/){ # PATH のみの URL の場合、
				($linkhead = $channel{'link'}) =~ s/^(http:\/\/.+?\/)(~\w+?\/)*.*$/$1$2/; # channel のリンクから BASE URL を取り出し、
				$ilink = $linkhead . $ilink; # PATH に URL を付加する。
			}
			print "<td><font color=\"#000000\"><a href=\"", $ilink, "\" target=\"main\">", $ilink, "</a></font></td>";
			$elms{'link'} = 1;
		# RSS 2.0 の guid 要素の場合
		}elsif($iguid){
			print "<td><font color=\"#000000\"><a href=\"", $iguid, "\" target=\"main\">", $iguid, "</a></font></td>";
			$elms{'guid'} = 1;
		}
	}
	# 表示要素追加時チェック部(3)
	# item 記事要素に相当する要素の処理
	if($idescription){
		# Dublin Core モジュールの dc:description 要素
		$description = &entities_decode($idescription);
		$elms{'dc:description'} = 1;
	}elsif($rdescription){
		# RDF/RSS の item 主要素の description 要素
		$description = &entities_decode($rdescription);
		$elms{'description'} = 1;
	}elsif($cdescription){
		# content モジュールの content:encoded 要素
		$description = &entities_decode($cdescription);
		$elms{'content:encoded'} = 1;
	}
	# 実体参照への変換が二重に行われている場合の対応
	if($description =~ /&[a-z0-9]{2};/){
		$description = &entities_decode($description);
	}
	# item 記事相当要素の出力
	if($description){
		# HTML 表の表示が乱れるため、<p>タグは除去、</p>タグを<br>に置換して出力
		$description =~ s/<p.*?>//ig;
		$description =~ s/<\/p>/<br>/ig;
		print "<td>",$description,"</td>\n";$description = "";
	}
	# item 日付要素
	if($date){
		print "<td>",$date,"</td>\n";
	}
	# item 製作者要素
	if($icreator){
		# Dublin Core モジュールの dc:creator 要素
		print "<td>",$icreator,"</td>\n";
		$elms{'dc:creator'} = 1;
	}elsif($author){
		# RSS 2.0 の item 主要素の author 要素
		print "<td>",$author,"</td>\n";
		$elms{'author'} = 1;
	}
	# item カテゴリー要素
	if($isubject){
		$isubject = &entities_decode($isubject);
		if($isubject =~ /&[a-z0-9]{2};/){
			$isubject = &entities_decode($isubject);
		}
		print "<td>",$isubject,"</td>\n";
		$elms{'dc:subject'} = 1;
	}elsif($rcategory){
		print "<td>",$rcategory,"</td>\n";
		$elms{'category'} = 1;
	}
	# Slash モジュールの item 特殊分類要素
	if($sdepartment){
		$sdepartment = &entities_decode($sdepartment);
		print "<td>",$sdepartment,"</td>\n";
		$elms{'slash:department'} = 1;
	}
	# PRISM モジュールの item 特殊分類要素
	if($prismpubname){
		print "<td>",$prismpubname,"</td>\n";
		$elms{'prism:publicationName'} = 1;
	}
	# RSS 2.0のenclosureタグのurl属性
	#<A HREF SRC="MyMovie.qtl"> Click Here for a QuickTimeMovie </A>
	#Important
	#For this to work, your Web server must be configured to associate
	#the .qtl  file extension with the correct MIME type:
	#.qtl = application /x-quicktimeplayer
	#MyMovie.qtl
	#<?xml version="1.0"?>
	#<?quicktime type="application/x-quicktime-media-link"?>
	#<embed src="http://www.myserver.com/Movies/My.mov" />
	if($enclosure_url){
		if($enclosure_url !~ /\.mp3/i){
			$count++;
			if($mp eq "QT"){
				open(QT,"> qt${count}.qtl");
				print QT "<?xml version=\"1.0\"?>\n";
				print QT "<?quicktime type=\"application/x-quicktime-media-link\"?>\n";
				print QT "<embed src=\"$enclosure_url\" autoplay=\"true\" />\n";
				close(QT);
				print "<td><a href=\"./qt${count}.qtl\">Podcast</a></td>\n";
			}elsif($mp eq "WM"){
				open(WM,"> wm${count}.asx");
				print WM "<ASX version=\"3.0\">\n";
				print WM "<Entry>\n<Ref href=\"$enclosure_url\" />\n</Entry>\n</ASX>\n";
				close(WM);
				print "<td><a href=\"./wm${count}.asx\">Podcast</a></td>\n";
			}
		}else{
			print "<td><a href=\"$enclosure_url\" target=\"status\">Podcast</a></td>\n";
		}
#		print "<td><a href=\"",$enclosure_url,"\" target=\"_blank\">Podcast</a></td>\n";
#		print "<td><a href=\"",$enclosure_url,"\">Podcast</a></td>\n";
	}
	# メモ作成用「メモる」システム CGI、memol_edit.cgiへのタイトルとリンク出力
	if($ilink){
		$ilink_encoding = &juri_encode($ilink);
	}elsif($iguid){
		$ilink_encoding = &juri_encode($iguid);
	}
	$ititle_encoding = &juri_encode($ititle);
	print "<td><a href=\"$cgidir/memol_edit.cgi?url=$ilink_encoding&title=$ititle_encoding\" target=\"main\">メモ作成</a></td>\n";
}
print "</tr></table>\n";# RSS ファイルの記事内容表出力終了

print "<hr>\n";

# 解析したRSSファイルの情報を表示する

# エンコーディングの表示
print "エンコーディング: $enc<br><br>\n";

# 表示要素追加時チェック部(4)
# RSS/モジュールとRSS要素の表を作成する
foreach $elm (sort keys(%elms)){
	if($elm !~ /:/){
		$mod{$ver} .= $elm . "\t";# RSSバージョンデフォルト要素
	}elsif($elm =~ /^dc:/){
		$mod{'Dublin Core'} .= $elm . "\t";# Dublin Core モジュール要素
	}elsif($elm =~ /^content:/){
		$mod{'Content'} .= $elm . "\t";# Content モジュール要素
	}elsif($elm =~ /^slash:/){
		$mod{'Slash'} .= $elm . "\t";# Slash モジュール要素
	}elsif($elm =~ /^prism:/){
		$mod{'PRISM'} .= $elm . "\t";# PRISM モジュール要素
	}
}
print "<table border=0><tr bgcolor=\"#eeeeee\"><th>RSS/モジュール</th><th>item 表示要素</th></tr>\n";
foreach $key (sort keys(%mod)){
	print "<tr bgcolor=\"#eeeeee\"><td>$key</td><td>$mod{$key}</td></tr>\n";
}
print "</table><br>\n";

# XML 名前空間のリストを表示
print "<table border=0><tr bgcolor=\"#eeeeee\"><th>XML 名前空間</th><tr>\n";
if(@nss){
	foreach $ns (sort @nss){
		print "<tr bgcolor=\"#eeeeee\"><td>$ns</td></tr>\n";
	}
}else{
	print "<tr bgcolor=\"#eeeeee\"><td>None</td></tr>\n";
}
print "</table><br>\n";
print "<hr>\n";

# 表示に要した秒数を計算して出力
$etime = time - $btime;
print "表示に要した時間: $etime 秒<br>";

# HTML 出力終了
print "</BODY>\n</HTML>\n";

# サブルーチン

# Jperl 用 URL エンコーディング
sub juri_encode{
	my($str) = @_;
	$str =~ s/([^a-z0-9\-_.!*'\(\)~ ])/blength($1) == 2 ? sprintf "%%%1s%1s%%%1s%1s", split("",unpack("H4", $1)) : sprintf "%%%02X", ord($1)/egi;
	$str =~ tr/ /+/;
	return $str;
}
sub blength{
	my($s) = @_;
	use bytes;
	return bytes::length($s);
}

# マークアップ記号の実体参照デコード
# 文字実体参照と数値実体参照の両方に対応
sub entities_decode{
	my($str) = @_;
	$str =~ s/(&lt;|&#60;)/</g;
	$str =~ s/(&gt;|&#62;)/>/g;
	$str =~ s/(&apos;|&#39;)/'/g;
	$str =~ s/(&quot;|&#34;)/"/g;
	$str =~ s/(&amp;|&#38;)/&/g;
	return $str;
}

# マークアップ記号の実体参照エンコード
sub entities_encode{
	my($str) = @_;
	$str =~ s/&/&amp;/g;
	$str =~ s/</&lt;/g;
	$str =~ s/>/&gt;/g;
	$str =~ s/'/&apos;/g;
	$str =~ s/"/&quot;/g;
	return $str;
}

藤岡 和夫
kazuf@...
TS Networkのために http://homepage1.nifty.com/kazuf/