#!/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;# 終了する } # 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関数の戻り値 # エンコーディングの取得 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を宣言する行、自体がないものもある $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/(]*>)/$1\n/; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; # データ文字列を改行で分割して、行単位のデータで配列に格納する @content = split(/\n+/, $content); # データを行単位で処理する。 foreach $line (@content){ # RSS バージョンの取得 if($line =~ / の除去と実体参照エンコード if($line =~ /<[^>]+><\/[^>]+>/){ $line =~ s/<[^>]+>]+><\/[^>]+>/){ $line =~ s/<[^>]+><\/([^>]+)>//; $line = "<$1>" . &entities_encode($line) . ""; } if($cdatasw == 1 && $line !~ /\]\]><\/[^>]+>/){ $line =~ s///g; $cdata .= $line; }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($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 表の表示が乱れるため、

タグは除去、

タグを
に置換して出力 $description =~ s///ig; $description =~ s/<\/p>/
/ig; 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){ if($enclosure_url !~ /\.mp3/i){ $count++; if($mp eq "QT"){ open(QT,"> qt${count}.qtl"); print QT "\n"; print QT "\n"; print QT "\n"; close(QT); print "\n"; }elsif($mp eq "WM"){ open(WM,"> wm${count}.asx"); print WM "\n"; print WM "\n\n\n\n"; close(WM); print "\n"; } }else{ 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,"PodcastPodcastPodcastメモ作成
\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 秒
"; # 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; }