#!/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 ディレクトリ # ATOM URL データの取得 &ReadParse(*in); if($in{'atom'}){ # CGI で URL を取得する $getfile = $in{'atom'}; }elsif($ARGV[0]){ # コマンドラインから URL を取得する $getfile = $ARGV[0]; }else{ print "ATOM URL データが存在しない。\n";exit;# 終了する } # 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 # ATOM URL の ATOM ファイルを取得 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/[\r\n]+[ \t]*//g; # 終了タグの後に改行を入れる $content =~ s/(<\/[^>]+>)/$1\n/g; # content 終了タグの前に改行を入れる $content =~ s/(<\/content>)/\n$1/g; $content =~ s/(<\/tagline>)/\n$1/g; # 主要素の開始タグの後に改行を入れ、要素タグのみの行を作る $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; # データ文字列を改行で分割して、行単位のデータで配列に格納する @content = split(/\n+/, $content); # データを行単位で処理する。 foreach $line (@content){ # CDATA セクションの処理 の除去と実体参照エンコード 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 = ""; } # feed、entry、author、content 、tagline 要素開始の判定 if($line =~ //){ $feed{'tagline'} = $buffer;$tsw = 0;$buffer = "";next; } # tagline 要素の格納 if($tsw == 1){ if($line =~ /[<>]+/){ $buffer .= &entities_encode($line); # }elsif($line =~ /\</){ }else{ $buffer .= $line; } next; } # info 要素終了の判定 if($isw == 1 && $line =~ /<\/info>/){ $feed{'info'} = $buffer;$isw = 0;$buffer = "";next; } # info 要素の格納 if($isw == 1){ if($line =~ /[<>]+/){ $buffer .= &entities_encode($line); }elsif($line =~ /\</){ # }else{ $buffer .= $line; } next; } # content 要素終了の判定 if($consw == 1 && $line =~ /<\/content>/){ $entry{'content'} = $buffer;$consw = 0;$buffer = "";next; } # content 要素の格納 if($consw == 1){ if($line =~ /[<>]+/){ $buffer .= &entities_encode($line); }elsif($line =~ /\</){ # }else{ $buffer .= $line; } # if($type eq "text/html"){ # $buffer .= $line; # }elsif($type eq "application/xhtml+xml"){ # $buffer .= &entities_encode($line); # } next; } # link 要素の格納 if($line =~ //){ # print "link match!\n"; if($fsw == 1){ if($3 eq "text/html"){ $feed{'link'} = $1; $feed{'title'} = $2; }elsif($3 eq "application/atom+xml"){ $feed{'xlink'} = $1; $feed{'xtitle'} = $2; } }elsif($esw == 1){ if($3 eq "text/html"){ $entry{'link'} = $1; $entry{'title'} = $2; }elsif($3 eq "application/atom+xml"){ $entry{'xlink'} = $1; $entry{'xtitle'} = $2; } } next; } # 属性を持たない要素データを要素毎に要素名をキーとして取得 if(($buff = $line) =~ s/<\/?([^>]+)>//g){ # feed 要素の格納 if($fsw == 1){ $feed{$1} = $buff; } # entry 要素の格納 if($esw == 1){ $entry{$1} = $buff; } } # feed 要素終了の判定 if($fsw == 1 && $line =~ /<\/feed>/){ $fsw = 0;# atom } # entry 要素終了の判定と entry ごとのデータの格納 if($esw == 1 && $line =~ /<\/entry>/){ # 表示要素追加時チェック部(1) push(@entries, join("\t",$entry{'issued'},$entry{'link'},$entry{'title'},$entry{'content'},$entry{'name'},$entry{'modified'},$entry{'created'},$entry{'id'})); $esw = 0;%entry = (); } } # feed 要素の info 要素を実体参照デコードしておく $feed{'info'} = &entities_decode($feed{'info'}); print "
", $feed{'title'}, "

",$feed{'tagline'}," [",$feed{'modified'},"]

",$feed{'info'},"

\n"; # entry 要素データを HTML 表に変換して出力 print "\n"; # entry ごとに表示要素を処理する foreach $entry (@entries){ # 表示要素追加時チェック部(2) ($issued,$link,$title,$econtent,$name,$modified,$created,$id) = split(/\t/,$entry); print ""; # タイトルとリンクの処理 if($title){ $title = &entities_decode($title); # タイトルにリンクがある場合は、別にリンクする if($title =~ s/((.+?)(<\/a>)/$2/i){ $titlelink = " -> $1 target=\"main\">LINK$3"; }else{ $titlelink = ""; } # ATOM の entry 主要素の link 要素の場合 if($link){ print ""; }else{ print ""; } }else{ # タイトルがない場合は、リンク文字列にリンクしてタイトルに表示する # ATOM の entry 主要素の link 要素の場合 if($link){ if($link !~ /http:/){ # PATH のみの URL の場合、 ($linkhead = $feed{'link'}) =~ s/^(http:\/\/.+?\/)(~\w+?\/)*.*$/$1$2/; # feed のリンクから BASE URL を取り出し、 $link = $linkhead . $link; # PATH に URL を付加する。 } print ""; } } # entry 記事相当要素の出力 if($econtent){ $econtent = &entities_decode($econtent); # HTML 表の表示が乱れるため、

タグは除去、

タグを
に置換して出力 $econtent =~ s///ig; $econtent =~ s/<\/p>/
/ig; print "\n";$econtent = ""; } # entry 日付要素 if($issued){ print "\n"; } # entry 製作者要素 if($name){ print "\n"; } # メモ作成用「メモる」システム CGI、memol_edit.cgiへのタイトルとリンク出力 if($link){ $link_encoding = &juri_encode($link); } $title_encoding = &juri_encode($title); print "\n"; } print "
", $title, "$titlelink$title$titlelink", $link, "",$econtent,"",$issued,"",$name,"メモ作成
\n";# RSS ファイルの記事内容表出力終了 print "
\n"; # 解析したRSSファイルの情報を表示する # エンコーディングの表示 print "エンコーディング: $enc

\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; }