#!/Perl/bin/MSWin32-x86-object/jperl.exe $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;# 終了する } dbmopen(%FEEDSCOUNT, "feedscount", 0666); $FEEDSCOUNT{$getfile}++; # Feed Protocol対応 $getfile =~ s/^feed:\/\/(http:\/\/.+)$/$1/i; $getfile =~ s/^feed:(http:\/\/.+)$/$1/i; $getfile =~ s/^feed(:\/\/.+)$/http$1/i; $getfile =~ s/^feed:(.+)$/http:\/\/$1/i; # CGI 最初の部分の出力 print < RSS Reader
ニュース
HEADER # RSS URL の RSS ファイルを取得 unless($res = $browser->get($getfile,@header)){ print "

LWP::UserAgentのget関数がundef値を返しました。

\n"; exit; } $content = $res->content;# UserAgentのget関数の戻り値 my $encoding = ""; # RSSファイルのエンコーディング my $enc; # RSSファイルのエンコーディングの元の文字列データ # エンコーディングの取得 if($content =~ /<\?xml +version="1.0" +encoding="([^"]+)" *\?>/){ $encoding = $1;$enc = $encoding; $encoding =~ s/^Shift_*JIS$/sjis/i; # シフト JIS $encoding =~ s/^euc-*j*p*$/euc-jp/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を宣言する行、自体がないものもある $encoding = "utf8";$enc = "None"; } # Unicode文字16進表記をUnicode文字に変換 $content =~ s/&#x(\w{4});/chr(hex($1))/eg; # エンコーディング情報をもとに、シフト JIS 文字コードに変換 $content = $s->set($content,$encoding)->sjis; # RSS ファイルの解析 # 解析用の前処理: 文字列データから行頭行末の空白を取り除き、改行文字を削除する #$content =~ s/[ \t]*[\r\n]+[ \t]*//g; $content =~ s/[\r\n]+[ \t]*//g; # 主要素の終了タグの前に改行を入れる $content =~ s/(<\/pre>)/\n$1/ig;# preタグの処理 # 終了タグの後に改行を入れる $content =~ s/(<\/[^>]+>)/$1\n/g; # 主要素の開始タグの後に改行を入れ、要素タグのみの行を作る $content =~ s/(]*>)/$1\n/; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; $content =~ s/(
)/$1\n/ig;# preタグの処理

# CDATAセクションの処理(2006-03-05)
$content =~ s/()/\n$1\n/g;

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

# データを行単位で処理する。
foreach $line (@content){
	# RSS バージョンの取得
	if($line =~ / の除去と実体参照エンコード
	if($line =~ /^$/){
			$cdata .= $line;next;
	}elsif($cdatasw == 3 && $line =~ /^\]\]>$/){
		$eecdata = &entities_encode($cdata);$cdata = "";$cdatasw = 4;next;
	}
	if($cdatasw == 4 && $line =~ /^<\/([^>]+)>$/){
		$line = "<$1>" . $eecdata . "";$eecdata = "";$cdatasw = 0;
	}
#	if($line =~ /<[^>]+><\/[^>]+>/){
#		$line =~ s/<[^>]+>]+><\/[^>]+>/){
#		$line =~ s/<[^>]+><\/([^>]+)>//;
#		$line = "<$1>" . &entities_encode($line) . "";
#	}
#	if($cdatasw == 1 && $line !~ /\]\]><\/[^>]+>/){
#		$line =~ s///g;
#		$cdata .=  $line;next;
#	}elsif($cdatasw == 1 && $line =~ /\]\]><\/[^>]+>/){
#		$line =~ s/\]\]><\/([^>]+)>//;
#		$prop = $1;
#		$cdata .=  $line;
#		$line = "<$prop>" . &entities_encode($cdata) . "";
#		$cdatasw = 0;$cdata = "";
#	}
	# channel、item、image 要素開始の判定
	if($line =~ /)/){
		$isw = 1;$csw = 0;
	}elsif($line =~ /]+)>//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 =~ /]+>/){
		$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 "
", $channel{'title'}, "

",$channel{'description'},"

\n"; }else{ print "
", $channel{'title'}, "

",$channel{'description'},"

\n"; } # item 要素データを HTML 表に変換して出力 print "\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 ""; # タイトルとリンクの処理 if($ititle){ $title = &entities_decode($ititle); # 実体参照への変換が二重に行われている場合の対応 if($title =~ /&[a-z0-9]{2};/){ $title = &entities_decode($title); } # タイトルにリンクがある場合は、別にリンクする if($title =~ s/((.+?)(<\/a>)/$2/i){ $titlelink = " -> $1 target=\"main\">LINK$3"; }else{ $titlelink = ""; } # RDF/RSS の item 主要素の link 要素の場合 if($ilink){ print ""; $elms{'link'} = 1; # RSS 2.0 の guid 要素の場合 }elsif($iguid){ print ""; $elms{'guid'} = 1; }else{ print ""; } $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 ""; $elms{'link'} = 1; # RSS 2.0 の guid 要素の場合 }elsif($iguid){ print ""; $elms{'guid'} = 1; } } # 表示要素追加時チェック部(3) # item 記事要素に相当する要素の処理 if($cdescription){ # content モジュールの content:encoded 要素 $description = &entities_decode($cdescription); $elms{'content:encoded'} = 1; }elsif($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; } # 実体参照への変換が二重に行われている場合の対応 if($description =~ /&[a-z0-9]{2};/){ $description = &entities_decode($description); } # item 記事相当要素の出力 if($description){ # HTML 表の表示が乱れるため、

タグは除去、

タグを
に置換して出力 $description =~ s///ig; # $description =~ s/

//ig; $description =~ s/<\/p>/
/ig; # if($description =~ /

([^<]+)<\/pre>/){
#			$prestr = $1;
#			$prestr =~ s/([;}_])/$1\n/g;
#			$description = "
" . $prestr . "
"; # } print "
\n";$description = ""; } # item 日付要素 if($date){ print "\n"; } # item 製作者要素 if($icreator){ # Dublin Core モジュールの dc:creator 要素 print "\n"; $elms{'dc:creator'} = 1; }elsif($author){ # RSS 2.0 の item 主要素の author 要素 print "\n"; $elms{'author'} = 1; } # item カテゴリー要素 if($isubject){ $isubject = &entities_decode($isubject); if($isubject =~ /&[a-z0-9]{2};/){ $isubject = &entities_decode($isubject); } print "\n"; $elms{'dc:subject'} = 1; }elsif($rcategory){ print "\n"; $elms{'category'} = 1; } # Slash モジュールの item 特殊分類要素 if($sdepartment){ $sdepartment = &entities_decode($sdepartment); print "\n"; $elms{'slash:department'} = 1; } # PRISM モジュールの item 特殊分類要素 if($prismpubname){ print "\n"; $elms{'prism:publicationName'} = 1; } # RSS 2.0のenclosureタグのurl属性 # Click Here for a QuickTimeMovie #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 # # # if($enclosure_url){ print "\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 "\n"; } print "
", $title, "$titlelink", $title, "$titlelink$title$titlelink", $ilink, "", $iguid, "",$description,"",$date,"",$icreator,"",$author,"",$isubject,"",$rcategory,"",$sdepartment,"",$prismpubname,"Podcastメモ作成
\n";# RSS ファイルの記事内容表出力終了 print "
\n"; # 解析したRSSファイルの情報を表示する # エンコーディングの表示 print "エンコーディング: $enc

\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 "\n"; foreach $key (sort keys(%mod)){ print "\n"; } print "
RSS/モジュールitem 表示要素
$key$mod{$key}

\n"; # XML 名前空間のリストを表示 print "\n"; if(@nss){ foreach $ns (sort @nss){ print "\n"; } }else{ print "\n"; } print "
XML 名前空間
$ns
None

\n"; print "
\n"; # 表示に要した秒数を計算して出力 $etime = time - $btime; print "表示に要した時間: $etime 秒
"; print "参照回数: ",$FEEDSCOUNT{$getfile},"
"; dbmclose(%FEEDSCOUNT); # HTML 出力終了 print "\n\n"; # サブルーチン # Jperl 用 URL エンコーディング sub juri_encode{ my($str) = @_; $str =~ s/([^a-z0-9\-_.!*'\(\)~ ])/length($1) == 2 ? sprintf "%%%1s%1s%%%1s%1s", split("",unpack("H4", $1)) : sprintf "%%%02X", ord($1)/egi; $str =~ tr/ /+/; return $str; } # マークアップ記号の実体参照デコード # 文字実体参照と数値実体参照の両方に対応 sub entities_decode{ my($str) = @_; $str =~ s/(<|<)//g; $str =~ s/('|')/'/g; $str =~ s/("|")/"/g; $str =~ s/(&|&)/&/g; return $str; } # マークアップ記号の実体参照エンコード sub entities_encode{ my($str) = @_; $str =~ s/&/&/g; $str =~ s//>/g; $str =~ s/'/'/g; $str =~ s/"/"/g; return $str; }