#!/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;# 終了する } # CGI 最初の部分の出力 print < ATOM Reader
ニュース
HEADER # 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; # 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"; } # Unicode文字16進表記を文字に変換 $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/(<\/[^>]+>)/$1\n/g; # 終了タグの前に改行を入れる $content =~ s/(<\/content>)/\n$1/g; $content =~ s/(<\/tagline>)/\n$1/g; $content =~ s/(<\/title>)/\n$1/g; $content =~ s/(<\/summary>)/\n$1/g; $content =~ s/(<\/subtitle>)/\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 =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; $content =~ s/(]*>)/$1\n/g; # CDATAセクションの処理 $content =~ s/()/\n$1/g; # データ文字列を改行で分割して、行単位のデータで配列に格納する @content = split(/\n+/, $content); $ver = "1.0";# デフォルトAtomバージョン # データを行単位で処理する。 foreach $line (@content){ # Atom バージョンの判定 if($line =~ / の除去と実体参照エンコード if($line =~ /^$/){ $cdata .= $line;next; }elsif($cdatasw == 3 && $line =~ /^\]\]>$/){ $line = &entities_encode($cdata);$cdatasw = 0;$cdata = ""; } ### 無駄部分(^^;)始まり if($line =~ /<[^>]+><\/[^>]+>/){ $line =~ s/<[^>]+>]+><\/[^>]+>/){ $line =~ s/<[^>]+><\/([^>]+)>//; $line = "<$1>" . &entities_encode($line) . ""; }elsif($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 = "";$prop = ""; } if($cdatasw == 2){ if($line !~ /^\]\]><\/[^>]+>$/){ $cdata .= $line;next; }else{ $line =~ /<\/([^>]+)>/; $prop = $1; $line = "<$prop>" . &entities_encode($cdata) . ""; $cdatasw = 0;$cdata = "";$prop = ""; } }elsif($cdatasw == 2 && $line =~ /.+\]\]><\/[^>]+>$/){ $line =~ s/\]\]><\/([^>]+)>//; $prop = $1; $cdata .= $line; $line = "<$prop>" . &entities_encode($cdata) . ""; $cdatasw = 0;$cdata = "";$prop = ""; } ### 無駄部分(^^;)終わり # feed、entry、author、content、tagline、title 要素開始の判定 if($line =~ //){ if($fsw == 1){ $feed{'subtitle'} = $buffer;$stsw = 0;$buffer = "";next; }elsif($esw == 1){ $entry{'subtitle'} = $buffer;$stsw = 0;$buffer = "";next; } } # subtitle 要素の格納 if($stsw == 1){ if($line =~ /[<>]+/){ $buffer .= &entities_encode($line); # }elsif($line =~ /\</){ }else{ $buffer .= $line; } next; } # summary 要素終了の判定 if($susw == 1 && $line =~ /<\/summary>/){ if($fsw == 1){ $feed{'summary'} = $buffer;$susw = 0;$buffer = "";next; }elsif($esw == 1){ $entry{'summary'} = $buffer;$susw = 0;$buffer = "";next; } } # summary 要素の格納 if($susw == 1){ if($line =~ /[<>]+/){ $buffer .= &entities_encode($line); # }elsif($line =~ /\</){ }else{ $buffer .= $line; } next; } # title 要素終了の判定 if($tisw == 1 && $line =~ /<\/title>/){ if($fsw == 1){ $feed{'title'} = $buffer;$tisw = 0;$buffer = "";next; }elsif($esw == 1){ $entry{'title'} = $buffer;$tisw = 0;$buffer = "";next; } } # title 要素の格納 if($tisw == 1){ if($line =~ /[<>]+/){ $buffer .= &entities_encode($line); # }elsif($line =~ /\</){ }else{ $buffer .= $line; } next; } # tagline 要素終了の判定 if($tsw == 1 && $line =~ /<\/tagline>/){ $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($line =~ //){ $linkattr = $1; @attrs = ($linkattr =~ /([^ =]+=["'][^"']+["'])/g); foreach $attr (@attrs){ # print "

$attr

\n"; if($attr =~ /^([^=]+)=["']([^"']+)["']$/){ $lattr{$1} = $2; # print "

= $1:$2

\n" } } if($fsw == 1){ if($lattr{'type'}){ if($lattr{'type'} eq "text/html"){ $feed{'link'} = $lattr{'href'}; $feed{'title'} = $lattr{'title'} unless($feed{'title'}); }elsif($lattr{'type'} eq "application/atom+xml"){ $feed{'xlink'} = $lattr{'href'}; $feed{'xtitle'} = $lattr{'title'} unless($feed{'title'}); } }else{ $feed{'link'} = $lattr{'href'}; $feed{'title'} = $lattr{'title'} unless($feed{'title'}); } } if($esw == 1){ if($lattr{'type'}){ if($lattr{'type'} eq "text/html"){ $entry{'link'} = $lattr{'href'}; $entry{'title'} = $lattr{'title'} unless($entry{'title'}); }elsif($lattr{'type'} eq "application/atom+xml"){ $entry{'xlink'} = $lattr{'href'}; $entry{'xtitle'} = $lattr{'title'} unless($entry{'title'}); } }else{ $entry{'link'} = $lattr{'href'}; $entry{'title'} = $lattr{'title'} unless($entry{'title'}); } } # print "

",$entry{'link'},"\n"; @attr = ();%lattr = ();$linkattr = "";$attr = ""; next; } # 属性を持たない要素データを要素毎に要素名をキーとして取得 if(($buff = $line) =~ s/<\/?([^>]+)>//g){ # print "

",$1,": $buff

\n"; # feed 要素の格納 if($fsw == 1){ $feed{$1} = $buff; } # entry 要素の格納 if($esw == 1){ $entry{$1} = $buff; } } # 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'},$entry{'updated'},$entry{'summary'})); $esw = 0;%entry = (); } } # feed 要素の info 要素を実体参照デコードしておく $feed{'info'} = &entities_decode($feed{'info'}); if($ver eq "0.3"){ print "
", $feed{'title'}, "

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

",$feed{'info'},"

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

",$feed{'subtitle'}," [",$feed{'updated'},"]

",$feed{'summary'},"

\n"; } # entry 要素データを HTML 表に変換して出力 print "\n"; # entry ごとに表示要素を処理する foreach $entry (@entries){ # 表示要素追加時チェック部(2) ($issued,$link,$title,$econtent,$name,$modified,$created,$id,$updated,$summary) = split(/\t/,$entry); print ""; # タイトルとリンクの処理 if($title){ # print "

title=$title

\n"; $title = &entities_decode($title); # タイトルにリンクがある場合は、別にリンクする if($title =~ s/((.+?)(<\/a>)/$2/i){ $titlelink = " -> $1 target=\"main\">LINK$3"; }else{ $titlelink = ""; } # ATOM の entry 主要素の link 要素の場合 if($link){ # print "

link=$link

\n"; print "
"; }else{ print ""; } }else{ # タイトルがない場合は、リンク文字列にリンクしてタイトルに表示する # ATOM の entry 主要素の link 要素の場合 # print "

link=$link

\n"; 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); # 実体参照への変換が二重に行われている場合の対応 if($econtent =~ /&[a-z0-9]{2};/){ $econtent = &entities_decode($econtent); } # HTML 表の表示が乱れるため、

タグは除去、

タグを
に置換して出力 $econtent =~ s///ig; $econtent =~ s/<\/p>/
/ig; print "
\n";$econtent = ""; }elsif($summary){ $summary = &entities_decode($summary); # 実体参照への変換が二重に行われている場合の対応 if($summary =~ /&[a-z0-9]{2};/){ $summary = &entities_decode($summary); } # HTML 表の表示が乱れるため、

タグは除去、

タグを
に置換して出力 $summary =~ s///ig; $summary =~ s/<\/p>/
/ig; print "
\n";$summary = ""; } # entry 日付要素 if($issued){ print "\n"; }elsif($updated){ 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,"",$summary,"",$issued,"",$updated,"",$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; }